Merge from trunk.
[bpt/emacs.git] / lisp / progmodes / simula.el
CommitLineData
a26389d1
ER
1;;; simula.el --- SIMULA 87 code editing commands for Emacs
2
acaf905b 3;; Copyright (C) 1992, 1994, 1996, 2001-2012 Free Software Foundation, Inc.
58142744 4
62507a6a
GM
5;; Author: Hans Henrik Eriksen <hhe@ifi.uio.no>
6;; Maintainer: simula-mode@ifi.uio.no
7;; (above email addresses invalid as of April 2008)
f961a17c
ER
8;; Adapted-By: ESR
9;; Keywords: languages
10
a26389d1
ER
11;; This file is part of GNU Emacs.
12
b1fc2b50 13;; GNU Emacs is free software: you can redistribute it and/or modify
a26389d1 14;; it under the terms of the GNU General Public License as published by
b1fc2b50
GM
15;; the Free Software Foundation, either version 3 of the License, or
16;; (at your option) any later version.
a26389d1
ER
17
18;; GNU Emacs 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
b1fc2b50 24;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
a26389d1 25
f961a17c
ER
26;;; Commentary:
27
d9ecc911
ER
28;; A major mode for editing the Simula language. It knows about Simula
29;; syntax and standard indentation commands. It also provides convenient
30;; abbrevs for Simula keywords.
31;;
32;; Hans Henrik Eriksen (the author) may be reached at:
a26389d1
ER
33;; Institutt for informatikk,
34;; Universitetet i Oslo
a26389d1 35
f961a17c 36;;; Code:
a26389d1 37
8ca3cd44 38\f
5636765c
SE
39(defgroup simula nil
40 "Major mode for editing Simula code."
8ec3bce0 41 :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
5636765c
SE
42 :prefix "simula-"
43 :group 'languages)
44
8ca3cd44
RS
45(defconst simula-tab-always-indent-default nil
46 "Non-nil means TAB in SIMULA mode should always reindent the current line.
47Otherwise TAB indents only when point is within
48the run of whitespace at the beginning of the line.")
a26389d1 49
5636765c 50(defcustom simula-tab-always-indent simula-tab-always-indent-default
3005d32e
RS
51 "*Non-nil means TAB in SIMULA mode should always reindent the current line.
52Otherwise TAB indents only when point is within
5636765c
SE
53the run of whitespace at the beginning of the line."
54 :type 'boolean
55 :group 'simula)
a26389d1 56
8ca3cd44
RS
57(defconst simula-indent-level-default 3
58 "Indentation of SIMULA statements with respect to containing block.")
59
5636765c
SE
60(defcustom simula-indent-level simula-indent-level-default
61 "*Indentation of SIMULA statements with respect to containing block."
62 :type 'integer
63 :group 'simula)
64
a26389d1 65
8ca3cd44
RS
66(defconst simula-substatement-offset-default 3
67 "Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE.")
68
5636765c
SE
69(defcustom simula-substatement-offset simula-substatement-offset-default
70 "*Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE."
71 :type 'integer
72 :group 'simula)
a26389d1 73
8ca3cd44
RS
74(defconst simula-continued-statement-offset-default 3
75 "Extra indentation for lines not starting a statement or substatement.
76If value is a list, each line in a multipleline continued statement
77will have the car of the list extra indentation with respect to
78the previous line of the statement.")
79
a1506d29 80(defcustom simula-continued-statement-offset
5636765c 81 simula-continued-statement-offset-default
a26389d1
ER
82 "*Extra indentation for lines not starting a statement or substatement.
83If value is a list, each line in a multipleline continued statement
84will have the car of the list extra indentation with respect to
5636765c
SE
85the previous line of the statement."
86 :type 'integer
87 :group 'simula)
a26389d1 88
8ca3cd44
RS
89(defconst simula-label-offset-default -4711
90 "Offset of SIMULA label lines relative to usual indentation.")
91
5636765c
SE
92(defcustom simula-label-offset simula-label-offset-default
93 "*Offset of SIMULA label lines relative to usual indentation."
94 :type 'integer
95 :group 'simula)
a26389d1 96
8ca3cd44
RS
97(defconst simula-if-indent-default '(0 . 0)
98 "Extra indentation of THEN and ELSE with respect to the starting IF.
99Value is a cons cell, the car is extra THEN indentation and the cdr
100extra ELSE indentation. IF after ELSE is indented as the starting IF.")
101
5636765c 102(defcustom simula-if-indent simula-if-indent-default
a26389d1 103 "*Extra indentation of THEN and ELSE with respect to the starting IF.
eb8c3be9 104Value is a cons cell, the car is extra THEN indentation and the cdr
5636765c
SE
105extra ELSE indentation. IF after ELSE is indented as the starting IF."
106 :type '(cons integer integer)
107 :group 'simula)
a26389d1 108
8ca3cd44
RS
109(defconst simula-inspect-indent-default '(0 . 0)
110 "Extra indentation of WHEN and OTHERWISE with respect to the INSPECT.
111Value is a cons cell, the car is extra WHEN indentation
112and the cdr extra OTHERWISE indentation.")
113
5636765c 114(defcustom simula-inspect-indent simula-inspect-indent-default
3005d32e
RS
115 "*Extra indentation of WHEN and OTHERWISE with respect to the INSPECT.
116Value is a cons cell, the car is extra WHEN indentation
5636765c
SE
117and the cdr extra OTHERWISE indentation."
118 :type '(cons integer integer)
119 :group 'simula)
a26389d1 120
8ca3cd44
RS
121(defconst simula-electric-indent-default nil
122 "Non-nil means `simula-indent-line' function may reindent previous line.")
123
5636765c
SE
124(defcustom simula-electric-indent simula-electric-indent-default
125 "*Non-nil means `simula-indent-line' function may reindent previous line."
126 :type 'boolean
127 :group 'simula)
a26389d1 128
8ca3cd44
RS
129(defconst simula-abbrev-keyword-default 'upcase
130 "Specify how to convert case for SIMULA keywords.
131Value is one of the symbols `upcase', `downcase', `capitalize',
82e736c1 132\(as in) `abbrev-table' or nil if they should not be changed.")
8ca3cd44 133
5636765c 134(defcustom simula-abbrev-keyword simula-abbrev-keyword-default
3005d32e
RS
135 "*Specify how to convert case for SIMULA keywords.
136Value is one of the symbols `upcase', `downcase', `capitalize',
82e736c1 137\(as in) `abbrev-table' or nil if they should not be changed."
5636765c
SE
138 :type '(choice (const upcase) (const downcase) (const capitalize)(const nil))
139 :group 'simula)
8ca3cd44
RS
140
141(defconst simula-abbrev-stdproc-default 'abbrev-table
142 "Specify how to convert case for standard SIMULA procedure and class names.
143Value is one of the symbols `upcase', `downcase', `capitalize',
82e736c1 144\(as in) `abbrev-table', or nil if they should not be changed.")
a26389d1 145
5636765c 146(defcustom simula-abbrev-stdproc simula-abbrev-stdproc-default
3005d32e
RS
147 "*Specify how to convert case for standard SIMULA procedure and class names.
148Value is one of the symbols `upcase', `downcase', `capitalize',
82e736c1 149\(as in) `abbrev-table', or nil if they should not be changed."
5636765c 150 :type '(choice (const upcase) (const downcase) (const capitalize)
e284737d 151 (const abbrev-table) (const nil))
5636765c 152 :group 'simula)
a26389d1 153
5636765c 154(defcustom simula-abbrev-file nil
3005d32e
RS
155 "*File with extra abbrev definitions for use in SIMULA mode.
156These are used together with the standard abbrev definitions for SIMULA.
157Please note that the standard definitions are required
5636765c
SE
158for SIMULA mode to function correctly."
159 :type '(choice file (const nil))
160 :group 'simula)
a26389d1
ER
161
162(defvar simula-mode-syntax-table nil
3005d32e 163 "Syntax table in SIMULA mode buffers.")
a26389d1 164
cf38dd42
SM
165(defconst simula-syntax-propertize-function
166 (syntax-propertize-rules
167 ;; `comment' directive.
168 ("\\<\\(c\\)omment\\>" (1 "<"))
169 ;; end comments
170 ((concat "\\<end\\>\\([^;\n]\\).*?\\(\n\\|\\(.\\)\\(;\\|"
171 (regexp-opt '("end" "else" "when" "otherwise"))
172 "\\)\\)")
173 (1 "< b")
174 (3 "> b"))
175 ;; non-quoted single-quote char.
176 ("'\\('\\)'" (1 "."))))
e284737d 177
2ff2cda8
SM
178;; Regexps written with help from Alf-Ivar Holm <alfh@ifi.uio.no>.
179(defconst simula-font-lock-keywords-1
e284737d
SM
180 '(;;
181 ;; Compiler directives.
182 ("^%\\([^ \t\n].*\\)" 1 font-lock-constant-face t)
183 ;;
184 ;; Class and procedure names.
185 ("\\<\\(class\\|procedure\\)\\>[ \t]*\\(\\sw+\\)?"
186 (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)))
2ff2cda8
SM
187 "Subdued level highlighting for Simula mode.")
188
189(defconst simula-font-lock-keywords-2
190 (append simula-font-lock-keywords-1
191 (list
192 ;;
883212ce
SM
193 ;; Constants.
194 '("\\<\\(false\\|none\\|notext\\|true\\)\\>" . font-lock-constant-face)
2ff2cda8
SM
195 ;;
196 ;; Keywords.
e284737d
SM
197 (regexp-opt
198 '("activate" "after" "and" "at" "before" "begin" "delay" "do"
199 "else" "end" "eq" "eqv" "external" "for" "ge" "go" "goto" "gt"
200 "hidden" "if" "imp" "in" "inner" "inspect" "is" "label" "le"
201 "lt" "ne" "new" "not" "or" "otherwise" "prior" "protected"
202 "qua" "reactivate" "step" "switch" "then" "this" "to" "until"
203 "virtual" "when" "while") 'words)
2ff2cda8
SM
204 ;;
205 ;; Types.
e284737d
SM
206 (cons (regexp-opt
207 '("array" "boolean" "character" "integer"
208 "long" "name" "real" "short" "text" "value" "ref") 'words)
209 'font-lock-type-face)))
2ff2cda8
SM
210 "Medium level highlighting for Simula mode.")
211
212(defconst simula-font-lock-keywords-3
213 (append simula-font-lock-keywords-2
214 (list
215 ;;
216 ;; Super-class names and super-slow.
217 '("\\<\\(\\sw+\\)[ \t]+class\\>" 1 font-lock-function-name-face)
218 ;;
219 ;; Types and their declarations.
220 (list (concat "\\<\\(array\\|boolean\\|character\\|integer\\|"
221 "long\\|name\\|real\\|short\\|text\\|value\\)\\>"
222 "\\([ \t]+\\sw+\\>\\)*")
d3aadf0b 223 '(font-lock-match-c-style-declaration-item-and-skip-to-next
2ff2cda8
SM
224 ;; Start with point after all type specifiers.
225 (goto-char (or (match-beginning 2) (match-end 1)))
226 ;; Finish with point after first type specifier.
227 (goto-char (match-end 1))
228 ;; Fontify as a variable name.
229 (1 font-lock-variable-name-face)))
230 ;;
231 ;; Object references and their declarations.
232 '("\\<\\(ref\\)\\>[ \t]*\\((\\(\\sw+\\))\\)?"
233 (3 font-lock-function-name-face nil t)
d3aadf0b 234 (font-lock-match-c-style-declaration-item-and-skip-to-next nil nil
2ff2cda8
SM
235 (1 font-lock-variable-name-face)))
236 ))
237 "Gaudy level highlighting for Simula mode.")
238
239(defvar simula-font-lock-keywords simula-font-lock-keywords-1
240 "Default expressions to highlight in Simula mode.")
241
8ca3cd44
RS
242; The following function is taken from cc-mode.el,
243; it determines the flavor of the Emacs running
8ca3cd44
RS
244
245(defvar simula-mode-menu
246 '(["Report Bug" simula-submit-bug-report t]
247 ["Indent Line" simula-indent-line t]
248 ["Backward Statement" simula-previous-statement t]
249 ["Forward Statement" simula-next-statement t]
250 ["Backward Up Level" simula-backward-up-level t]
e284737d 251 ["Forward Down Statement" simula-forward-down-level t])
8ca3cd44
RS
252 "Lucid Emacs menu for SIMULA mode.")
253
a26389d1
ER
254(if simula-mode-syntax-table
255 ()
3005d32e 256 (setq simula-mode-syntax-table (copy-syntax-table (standard-syntax-table)))
a26389d1
ER
257 (modify-syntax-entry ?! "<" simula-mode-syntax-table)
258 (modify-syntax-entry ?$ "." simula-mode-syntax-table)
e284737d
SM
259 (modify-syntax-entry ?% "< b" simula-mode-syntax-table)
260 (modify-syntax-entry ?\n "> b" simula-mode-syntax-table)
a26389d1
ER
261 (modify-syntax-entry ?' "\"" simula-mode-syntax-table)
262 (modify-syntax-entry ?\( "()" simula-mode-syntax-table)
263 (modify-syntax-entry ?\) ")(" simula-mode-syntax-table)
264 (modify-syntax-entry ?\; ">" simula-mode-syntax-table)
265 (modify-syntax-entry ?\[ "." simula-mode-syntax-table)
266 (modify-syntax-entry ?\\ "." simula-mode-syntax-table)
267 (modify-syntax-entry ?\] "." simula-mode-syntax-table)
2ff2cda8 268 (modify-syntax-entry ?_ "_" simula-mode-syntax-table)
a26389d1
ER
269 (modify-syntax-entry ?\| "." simula-mode-syntax-table)
270 (modify-syntax-entry ?\{ "." simula-mode-syntax-table)
271 (modify-syntax-entry ?\} "." simula-mode-syntax-table))
272
e284737d
SM
273(defvar simula-mode-map
274 (let ((map (make-sparse-keymap)))
275 (define-key map "\C-c\C-u" 'simula-backward-up-level)
276 (define-key map "\C-c\C-p" 'simula-previous-statement)
277 (define-key map "\C-c\C-d" 'simula-forward-down-level)
278 (define-key map "\C-c\C-n" 'simula-next-statement)
279 ;; (define-key map "\C-c\C-g" 'simula-goto-definition)
280 ;; (define-key map "\C-c\C-h" 'simula-standard-help)
281 (define-key map "\177" 'backward-delete-char-untabify)
282 (define-key map ":" 'simula-electric-label)
283 (define-key map "\e\C-q" 'simula-indent-exp)
284 (define-key map "\t" 'simula-indent-command)
285 ;; Emacs 19 defines menus in the mode map
286 (define-key map [menu-bar simula]
287 (cons "SIMULA" (make-sparse-keymap "SIMULA")))
288 (define-key map [menu-bar simula bug-report]
289 '("Submit Bug Report" . simula-submit-bug-report))
290 (define-key map [menu-bar simula separator-indent]
291 '("--"))
292 (define-key map [menu-bar simula indent-exp]
293 '("Indent Expression" . simula-indent-exp))
294 (define-key map [menu-bar simula indent-line]
295 '("Indent Line" . simula-indent-command))
296 (define-key map [menu-bar simula separator-navigate]
297 '("--"))
298 (define-key map [menu-bar simula backward-stmt]
299 '("Previous Statement" . simula-previous-statement))
300 (define-key map [menu-bar simula forward-stmt]
301 '("Next Statement" . simula-next-statement))
302 (define-key map [menu-bar simula backward-up]
303 '("Backward Up Level" . simula-backward-up-level))
304 (define-key map [menu-bar simula forward-down]
305 '("Forward Down Statement" . simula-forward-down-level))
306
307 (put 'simula-next-statement 'menu-enable '(not (eobp)))
308 (put 'simula-previous-statement 'menu-enable '(not (bobp)))
309 (put 'simula-forward-down-level 'menu-enable '(not (eobp)))
310 (put 'simula-backward-up-level 'menu-enable '(not (bobp)))
311 (put 'simula-indent-command 'menu-enable '(not buffer-read-only))
312 (put 'simula-indent-exp 'menu-enable '(not buffer-read-only))
313
314 ;; RMS: mouse-3 should not select this menu. mouse-3's global
315 ;; definition is useful in SIMULA mode and we should not interfere
316 ;; with that. The menu is mainly for beginners, and for them,
317 ;; the menubar requires less memory than a special click.
318 ;; in Lucid Emacs, we want the menu to popup when the 3rd button is
319 ;; hit. In 19.10 and beyond this is done automatically if we put
320 ;; the menu on mode-popup-menu variable, see c-common-init [cc-mode.el]
321 ;;(if (not (boundp 'mode-popup-menu))
322 ;; (define-key simula-mode-map 'button3 'simula-popup-menu))
323 map)
324 "Keymap used in `simula-mode'.")
8ca3cd44
RS
325
326;; menus for Lucid
e02f48d7 327(defun simula-popup-menu (_e)
8ca3cd44
RS
328 "Pops up the SIMULA menu."
329 (interactive "@e")
e284737d 330 (popup-menu (cons (concat mode-name " Mode Commands") simula-mode-menu)))
a26389d1 331
2ff2cda8 332;;;###autoload
ae0c2494 333(define-derived-mode simula-mode prog-mode "Simula"
a26389d1
ER
334 "Major mode for editing SIMULA code.
335\\{simula-mode-map}
336Variables controlling indentation style:
e284737d 337 `simula-tab-always-indent'
a26389d1
ER
338 Non-nil means TAB in SIMULA mode should always reindent the current line,
339 regardless of where in the line point is when the TAB command is used.
e284737d 340 `simula-indent-level'
a26389d1 341 Indentation of SIMULA statements with respect to containing block.
e284737d 342 `simula-substatement-offset'
a26389d1 343 Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE.
e284737d 344 `simula-continued-statement-offset' 3
a26389d1 345 Extra indentation for lines not starting a statement or substatement,
3005d32e 346 e.g. a nested FOR-loop. If value is a list, each line in a multiple-
a26389d1
ER
347 line continued statement will have the car of the list extra indentation
348 with respect to the previous line of the statement.
e284737d 349 `simula-label-offset' -4711
3005d32e 350 Offset of SIMULA label lines relative to usual indentation.
e284737d 351 `simula-if-indent' '(0 . 0)
a26389d1 352 Extra indentation of THEN and ELSE with respect to the starting IF.
eb8c3be9 353 Value is a cons cell, the car is extra THEN indentation and the cdr
3005d32e 354 extra ELSE indentation. IF after ELSE is indented as the starting IF.
e284737d 355 `simula-inspect-indent' '(0 . 0)
a26389d1 356 Extra indentation of WHEN and OTHERWISE with respect to the
3005d32e 357 corresponding INSPECT. Value is a cons cell, the car is
eb8c3be9 358 extra WHEN indentation and the cdr extra OTHERWISE indentation.
e284737d 359 `simula-electric-indent' nil
3005d32e 360 If this variable is non-nil, `simula-indent-line'
a26389d1 361 will check the previous line to see if it has to be reindented.
e284737d 362 `simula-abbrev-keyword' 'upcase
3005d32e
RS
363 Determine how SIMULA keywords will be expanded. Value is one of
364 the symbols `upcase', `downcase', `capitalize', (as in) `abbrev-table',
365 or nil if they should not be changed.
e284737d 366 `simula-abbrev-stdproc' 'abbrev-table
a26389d1 367 Determine how standard SIMULA procedure and class names will be
3005d32e
RS
368 expanded. Value is one of the symbols `upcase', `downcase', `capitalize',
369 (as in) `abbrev-table', or nil if they should not be changed.
a26389d1
ER
370
371Turning on SIMULA mode calls the value of the variable simula-mode-hook
e284737d 372with no arguments, if that value is non-nil."
175069ef
SM
373 (set (make-local-variable 'comment-column) 40)
374 ;; (set (make-local-variable 'end-comment-column) 75)
375 (set (make-local-variable 'paragraph-start) "[ \t]*$\\|\\f")
376 (set (make-local-variable 'paragraph-separate) paragraph-start)
377 (set (make-local-variable 'indent-line-function) 'simula-indent-line)
378 (set (make-local-variable 'comment-start) "! ")
379 (set (make-local-variable 'comment-end) " ;")
380 (set (make-local-variable 'comment-start-skip) "!+ *")
381 (set (make-local-variable 'parse-sexp-ignore-comments) nil)
382 (set (make-local-variable 'comment-multi-line) t)
383 (set (make-local-variable 'font-lock-defaults)
384 '((simula-font-lock-keywords simula-font-lock-keywords-1
385 simula-font-lock-keywords-2 simula-font-lock-keywords-3)
386 nil t ((?_ . "w"))))
cf38dd42
SM
387 (set (make-local-variable 'syntax-propertize-function)
388 simula-syntax-propertize-function)
e284737d 389 (abbrev-mode 1))
a26389d1 390
8ca3cd44
RS
391(defun simula-indent-exp ()
392 "Indent SIMULA expression following point."
393 (interactive)
394 (let ((here (point))
395 (simula-electric-indent nil)
396 end)
397 (simula-skip-comment-forward)
398 (if (eobp)
399 (goto-char here)
400 (unwind-protect
401 (progn
402 (simula-next-statement 1)
403 (setq end (point-marker))
404 (simula-previous-statement 1)
405 (beginning-of-line)
406 (while (< (point) end)
407 (if (not (looking-at "[ \t]*$"))
408 (simula-indent-line))
409 (forward-line 1)))
410 (and end (set-marker end nil))))))
a1506d29 411
a26389d1
ER
412
413(defun simula-indent-line ()
3005d32e
RS
414 "Indent this line as SIMULA code.
415If `simula-electric-indent' is non-nil, indent previous line if necessary."
a26389d1
ER
416 (let ((origin (- (point-max) (point)))
417 (indent (simula-calculate-indent))
418 (case-fold-search t))
419 (unwind-protect
8ca3cd44
RS
420 (if simula-electric-indent
421 (progn
422 ;;
423 ;; manually expand abbrev on last line, if any
424 ;;
425 (end-of-line 0)
426 (expand-abbrev)
427 ;; now maybe we should reindent that line
428 (beginning-of-line)
429 (skip-chars-forward " \t\f")
430 (if (and
431 (looking-at
432 "\\(end\\|if\\|then\\|else\\|when\\|otherwise\\)\\>")
433 (not (simula-context)))
434 ;; yes - reindent
435 (let ((post-indent (simula-calculate-indent)))
436 (if (eq (current-indentation) post-indent)
437 ()
438 (delete-horizontal-space)
439 (indent-to post-indent))))))
a26389d1
ER
440 (goto-char (- (point-max) origin))
441 (if (eq (current-indentation) indent)
442 (back-to-indentation)
443 (delete-horizontal-space)
444 (indent-to indent)))))
445
446
447(defun simula-indent-command (&optional whole-exp)
448 "Indent current line as SIMULA code, or insert TAB character.
3005d32e 449If `simula-tab-always-indent' is non-nil, always indent current line.
a26389d1
ER
450Otherwise, indent only if point is before any non-whitespace
451character on the line.
452
453A numeric argument, regardless of its value, means indent rigidly
454all the lines of the SIMULA statement after point so that this line
455becomes properly indented.
456The relative indentation among the lines of the statement are preserved."
457 (interactive "P")
458 (let ((case-fold-search t))
459 (if (or whole-exp simula-tab-always-indent
460 (save-excursion
461 (skip-chars-backward " \t\f")
462 (bolp)))
463 ;; reindent current line
464 (let ((indent (save-excursion
465 (beginning-of-line)
466 (simula-calculate-indent)))
467 (current (current-indentation))
468 (origin (- (point-max) (point)))
469 (bol (save-excursion
470 (skip-chars-backward " \t\f")
471 (bolp)))
472 beg end)
473 (unwind-protect
474 (if (eq current indent)
475 (if (save-excursion
476 (skip-chars-backward " \t\f")
477 (bolp))
478 (back-to-indentation))
479 (beginning-of-line)
480 (delete-horizontal-space)
481 (indent-to indent))
482 (if (not bol)
483 (goto-char (- (point-max) origin))))
484 (setq origin (point))
485 (if whole-exp
486 (save-excursion
487 (beginning-of-line 2)
488 (setq beg (point))
489 (goto-char origin)
490 (simula-next-statement 1)
491 (setq end (point))
492 (if (and (> end beg) (not (eq indent current)))
493 (indent-code-rigidly beg end (- indent current) "%")))))
494 (insert-tab))))
495
496
497(defun simula-context ()
e284737d 498 "Return value according to syntactic SIMULA context of point.
3005d32e 499 0 point inside COMMENT comment
a26389d1
ER
500 1 point on SIMULA-compiler directive line
501 2 point inside END comment
502 3 point inside string
503 4 point inside character constant
504 nil otherwise."
505 ;; first, find out if this is a compiler directive line
506 (if (save-excursion
507 (beginning-of-line)
508 (eq (following-char) ?%))
509 ;; YES - return 1
510 1
511 (save-excursion
512 ;; The current line is NOT a compiler directive line.
513 ;; Now, the strategy is to search backward to find a semicolon
514 ;; that is NOT inside a string. The point after semicolon MUST be
515 ;; outside a comment, since semicolons are comment-ending and
516 ;; comments are non-recursive. We take advantage of the fact
517 ;; that strings MUST end on the same line as they started, so
518 ;; that we can easily decide whether we are inside a string or not.
519 (let (return-value (origin (point)))
520 (skip-chars-backward "^;" (point-min))
521 ;; found semicolon or beginning of buffer
522 (let (loopvalue (saved-point origin))
523 (while (and (not (bobp))
524 (if (progn
525 (beginning-of-line)
526 ;; compiler directive line? If so, cont searching..
527 (eq (following-char) ?%))
528 t
529 (while (< (point) saved-point)
530 (skip-chars-forward "^;\"'")
531 (forward-char 1)
532 (cond
533 ((eq (preceding-char) ?\;)
534 (setq saved-point (point)))
535 ((eq (preceding-char) ?\")
536 (skip-chars-forward "^\";")
537 (if (eq (following-char) ?\;)
538 (setq saved-point (point) loopvalue t)
539 (forward-char 1)))
540 (t
541 (if (eq (following-char) ?')
542 (forward-char 1))
543 (skip-chars-forward "^';")
544 (if (eq (following-char) ?\;)
545 (setq saved-point (point) loopvalue t)
546 (forward-char 1)))))
547 loopvalue))
548 (backward-char 1)
549 (skip-chars-backward "^;")
550 (setq saved-point (point) loopvalue nil)))
551 ;; Now we are CERTAIN that we are outside comments and strings.
552 ;; The job now is to search forward again towards the origin
553 ;; skipping directives, comments and strings correctly,
554 ;; so that we know what context we are in when we find the origin.
555 (while (and
556 (< (point) origin)
557 (re-search-forward
558 "\\<end\\>\\|!\\|\"\\|'\\|^%\\|\\<comment\\>" origin 'move))
559 (cond
560 ((memq (preceding-char) '(?d ?D))
561 (setq return-value 2)
8ca3cd44
RS
562 (while (and (re-search-forward
563 ";\\|\\<end\\>\\|\\<else\\>\\|\\<otherwise\\>\\|\\<when\\>\\|^%"
564 origin 'move)
565 ;; found another END?
566 (or (memq (preceding-char) '(?d ?D))
567 ;; if directive, skip line
568 (and (eq (preceding-char) ?%)
569 (beginning-of-line 2))
570 ;; found other keyword, out of END comment
571 (setq return-value nil))))
572 (if (and (eq (char-syntax (preceding-char)) ?w)
573 (eq (char-syntax (following-char)) ?w))
574 (save-excursion
575 (backward-word 1)
576 (if (looking-at "end\\>\\|else\\>\\|otherwise\\>\\|when\\>")
577 (setq return-value nil)))))
a26389d1
ER
578 ((memq (preceding-char) '(?! ?t ?T))
579 ; skip comment
580 (setq return-value 0)
581 (skip-chars-forward "^%;" origin)
582 (while (and return-value (< (point) origin))
583 (if (eq (following-char) ?\;)
584 (setq return-value nil)
585 (if (bolp)
586 (beginning-of-line 2) ; skip directive inside comment
587 (forward-char 1)) ; or single '%'
588 (skip-chars-forward "^%;" origin))))
589 ((eq (preceding-char) ?\")
590 (if (not (search-forward "\"" origin 'move))
591 (setq return-value 3)))
592 ((eq (preceding-char) ?\')
593 (if (or (eq (point) origin) (eobp))
594 (setq return-value 4)
595 (forward-char 1)
596 (if (not (search-forward "'" origin 'move))
597 (setq return-value 4))))
598 ;; compiler directive line - skip
599 (t (beginning-of-line 2))))
600 return-value)
601 )))
602
603
604(defun simula-electric-label ()
3005d32e 605 "If this is a label that starts the line, reindent the line."
a26389d1
ER
606 (interactive)
607 (expand-abbrev)
608 (insert ?:)
609 (let ((origin (- (point-max) (point)))
610 (case-fold-search t)
611 ;; don't mix a label with an assignment operator := :-
8ca3cd44
RS
612 ;; therefore take a peek at next typed character...
613 (next-char (read-event)))
a26389d1 614 (unwind-protect
8ca3cd44
RS
615 (setq unread-command-events (append unread-command-events
616 (list next-char)))
a26389d1
ER
617 ;; Problem: find out if character just read is a command char
618 ;; that would insert something after ':' making it a label.
619 ;; At least \n, \r (and maybe \t) falls into this category.
620 ;; This is a real crock, it depends on traditional keymap
621 ;; bindings, that is, printing characters doing self-insert,
622 ;; and no other command sequence inserting '-' or '='.
623 ;; simula-electric-label can be easily fooled...
624 (if (and (not (memq next-char '(?= ?-)))
625 (or (memq next-char '(?\n ?\r))
626 (and (eq next-char ?\t)
627 simula-tab-always-indent)
628 (not (memq (following-char) '(?= ?-))))
629 (not (simula-context))
630 ;; label?
631 (progn
632 (backward-char 1)
633 (skip-chars-backward " \t\f")
634 (skip-chars-backward "a-zA-Z0-9_")
635 (if (looking-at "virtual\\>")
636 nil
637 (skip-chars-backward " \t\f")
638 (bolp))))
639 (let ((amount (simula-calculate-indent)))
640 (delete-horizontal-space)
641 (indent-to amount)))
642 (goto-char (- (point-max) origin)))))
a1506d29 643
a26389d1
ER
644
645(defun simula-backward-up-level (count)
646 "Move backward up COUNT block levels.
3005d32e 647If COUNT is negative, move forward up block level instead."
a26389d1
ER
648 (interactive "p")
649 (let ((origin (point))
650 (case-fold-search t))
651 (condition-case ()
652 (if (> count 0)
653 (while (> count 0)
654 (re-search-backward "\\<begin\\>\\|\\<end\\>")
655 (if (not (simula-context))
656 (setq count (if (memq (following-char) '(?b ?B))
657 (1- count)
658 (1+ count)))))
659 (while (< count 0)
660 (re-search-forward "\\<begin\\>\\|\\<end\\>")
661 (backward-word 1)
662 (if (not (simula-context))
663 (setq count (if (memq (following-char) '(?e ?E))
664 (1+ count)
665 (1- count))))
666 (backward-word -1)))
667 ;; If block level not found, jump back to origin and signal an error
668 (error (progn
669 (goto-char origin)
670 (error "No higher block level")))
671 (quit (progn
672 (goto-char origin)
673 (signal 'quit nil))))))
674
675
676(defun simula-forward-down-level (count)
677 "Move forward down COUNT block levels.
3005d32e 678If COUNT is negative, move backward down block level instead."
a26389d1
ER
679 (interactive "p")
680 ;; When we search for a deeper block level, we must never
681 ;; get out of the block where we started -> count >= start-count
682 (let ((start-count count)
683 (origin (point))
684 (case-fold-search t))
685 (condition-case ()
686 (if (< count 0)
687 (while (< count 0)
688 (re-search-backward "\\<begin\\>\\|\\<end\\>")
689 (if (not (simula-context))
690 (setq count (if (memq (following-char) '(?e ?E))
691 (1+ count)
692 (1- count))))
693 (if (< count start-count) (signal 'error nil)))
694 (while (> count 0)
695 (re-search-forward "\\<begin\\>\\|\\<end\\>")
696 (backward-word 1)
697 (if (not (simula-context))
698 (setq count (if (memq (following-char) '(?b ?B))
699 (1- count)
700 (1+ count))))
701 (backward-word -1)
702 ;; deeper level has to be found within starting block
703 (if (> count start-count) (signal 'error nil))))
704 ;; If block level not found, jump back to origin and signal an error
705 (error (progn
706 (goto-char origin)
707 (error "No containing block level")))
708 (quit (progn
709 (goto-char origin)
710 (signal 'quit nil))))))
711
a1506d29 712
a26389d1
ER
713(defun simula-previous-statement (count)
714 "Move backward COUNT statements.
3005d32e 715If COUNT is negative, move forward instead."
a26389d1
ER
716 (interactive "p")
717 (if (< count 0)
718 (simula-next-statement (- count))
719 (let (status
720 (case-fold-search t)
721 (origin (point)))
722 (condition-case ()
a1506d29 723 ;;
a26389d1
ER
724 (progn
725 (simula-skip-comment-backward)
726 (if (memq (preceding-char) '(?n ?N))
727 (progn
728 (backward-word 1)
729 (if (not (looking-at "\\<begin\\>"))
730 (backward-word -1)))
731 (if (eq (preceding-char) ?\;)
8ca3cd44
RS
732 (backward-char 1))
733 )
a26389d1
ER
734 (while (and (natnump (setq count (1- count)))
735 (setq status (simula-search-backward
736 ";\\|\\<begin\\>" nil 'move))))
737 (if status
738 (progn
739 (if (eq (following-char) ?\;)
740 (forward-char 1)
741 (backward-word -1))))
742 (simula-skip-comment-forward))
743 (error (progn (goto-char origin)
744 (error "Incomplete statement (too many ENDs)")))
745 (quit (progn (goto-char origin) (signal 'quit nil)))))))
746
747
748(defun simula-next-statement (count)
3005d32e
RS
749 "Move forward COUNT statements.
750If COUNT is negative, move backward instead."
a26389d1
ER
751 (interactive "p")
752 (if (< count 0)
753 (simula-previous-statement (- count))
754 (let (status
755 (case-fold-search t)
756 (origin (point)))
757 (condition-case ()
758 (progn
759 (simula-skip-comment-forward)
760 (if (looking-at "\\<end\\>") (forward-word 1))
761 (while (and (natnump (setq count (1- count)))
762 (setq status (simula-search-forward
763 ";\\|\\<end\\>" (point-max) 'move))))
764 (if (and status (/= (preceding-char) ?\;))
765 (progn
766 (backward-word 1)
767 (simula-skip-comment-backward))))
768 (error (progn (goto-char origin)
769 (error "Incomplete statement (too few ENDs)")))
770 (quit (progn (goto-char origin) (signal 'quit nil)))))))
771
772
8ca3cd44 773(defun simula-skip-comment-backward (&optional stop-at-end)
3005d32e 774 "Search towards bob to find first char that is outside a comment."
a26389d1
ER
775 (interactive)
776 (catch 'simula-out
777 (let (context)
778 (while t
779 (skip-chars-backward " \t\n\f")
780 (if (eq (preceding-char) ?\;)
781 (save-excursion
782 (backward-char 1)
8ca3cd44
RS
783 (setq context (simula-context))
784 (if (and stop-at-end (eq context 2))
785 (setq context nil)))
a26389d1
ER
786 (setq context (simula-context)))
787 (cond
788 ((memq context '(nil 3 4))
789 ;; check to see if we found a label
790 (if (and (eq (preceding-char) ?:)
791 (not (memq (following-char) '(?- ?=)))
792 (save-excursion
793 (skip-chars-backward ": \t\fa-zA-Z0-9_")
794 (not (looking-at "virtual\\>"))))
795 (skip-chars-backward ": \t\fa-zA-Z0-9_")
796 (throw 'simula-out nil)))
797 ((eq context 0)
798 ;; since we are inside a comment, it must start somewhere!
799 (while (and (re-search-backward "!\\|\\<comment\\>")
800 (memq (simula-context) '(0 1)))))
801 ((eq context 1)
8ca3cd44 802 (beginning-of-line)
a26389d1 803 (if (bobp)
8ca3cd44
RS
804 (throw 'simula-out nil)
805 (backward-char)))
a26389d1
ER
806 ((eq context 2)
807 ;; an END-comment must belong to an END
808 (re-search-backward "\\<end\\>")
809 (forward-word 1)
810 (throw 'simula-out nil))
811 ;; should be impossible to get here..
812 )))))
813
814
815(defun simula-skip-comment-forward ()
3005d32e 816 "Search towards eob to find first char that is outside a comment."
a26389d1
ER
817 ;; this function assumes we start with point .outside a comment
818 (interactive)
819 (catch 'simula-out
820 (while t
821 (skip-chars-forward " \t\n\f")
8ca3cd44
RS
822 ;; BUG: the following (0 2) branches don't take into account intermixing
823 ;; directive lines
a26389d1
ER
824 (cond
825 ((looking-at "!\\|\\<comment\\>")
826 (search-forward ";" nil 'move))
827 ((and (bolp) (eq (following-char) ?%))
828 (beginning-of-line 2))
829 ((and (looking-at "[a-z0-9_]*[ \t\f]*:[^-=]")
830 (not (looking-at "virtual\\>")))
831 (skip-chars-forward "a-zA-Z0-9_ \t\f:"))
832 (t
833 (throw 'simula-out t))))))
834
835
836(defun simula-forward-up-level ()
837 (let ((continue-loop t)
838 (origin (point))
839 (case-fold-search t)
840 return-value
841 temp)
842 (while continue-loop
843 (if (re-search-backward "\\<begin\\>\\|\\<end\\>" (point-min) 'move)
844 (setq temp (simula-context)
845 return-value (and (memq (preceding-char) '(?d ?D))
846 (memq temp '(nil 2)))
847 continue-loop (and (not return-value)
848 (simula-forward-up-level)))
849 (setq continue-loop nil)))
850 (if return-value
851 t
852 (goto-char origin)
853 nil)))
854
855
856(defun simula-calculate-indent ()
857 (save-excursion
858 (let ((where (simula-context))
859 (origin (point))
860 (indent 0)
861 continued
862 start-line
863 temp
864 found-end
865 prev-cont)
866 (cond
867 ((eq where 0)
868 ;;
869 ;; Comment.
870 ;; If comment started on previous non-blank line, indent to the
871 ;; column where the comment started, else indent as that line.
872 ;;
873 (skip-chars-backward " \t\n\f")
874 (while (and (not (bolp)) (eq (simula-context) 0))
875 (re-search-backward "^\\|!\\|\\<comment\\>"))
876 (skip-chars-forward " \t\n\f")
877 (prog1
878 (current-column)
879 (goto-char origin)))
8ca3cd44
RS
880 ((eq where 1)
881 ;;
882 ;; Directive. Always 0.
883 ;;
884 0)
a26389d1
ER
885 ;;
886 ;; Detect missing string delimiters
887 ;;
888 ((eq where 3)
889 (error "Inside string"))
890 ((eq where 4)
891 (error "Inside character constant"))
892 ;;
893 ;; check to see if inside ()'s
894 ;;
895 ((setq temp (simula-inside-parens))
896 temp)
897 ;;
898 ;; Calculate non-comment indentation
899 (t
900 ;; first, find out if this line starts with something that needs
eb8c3be9 901 ;; special indentation (END/IF/THEN/ELSE/WHEN/OTHERWISE or label)
a26389d1
ER
902 ;;
903 (skip-chars-forward " \t\f")
904 (cond
905 ;;
906 ;; END
907 ;;
908 ((looking-at "end\\>")
909 (setq indent (- simula-indent-level)
910 found-end t))
911 ;;
912 ;; IF/THEN/ELSE
913 ;;
914 ((looking-at "if\\>\\|then\\>\\|else\\>")
915 ;; search for the *starting* IF
916 (cond
917 ((memq (following-char) '(?T ?t))
918 (setq indent (car simula-if-indent)))
919 ((memq (following-char) '(?E ?e))
920 (setq indent (cdr simula-if-indent)))
921 (t
922 (forward-word 1)
923 (setq indent 0)))
924 (simula-find-if))
925 ;;
926 ;; WHEN/OTHERWISE
927 ;;
928 ((looking-at "when\\>\\|otherwise\\>")
929 ;; search for corresponding INSPECT
930 (if (memq (following-char) '(?W ?w))
931 (setq indent (car simula-inspect-indent))
932 (setq indent (cdr simula-inspect-indent)))
933 (simula-find-inspect))
934 ;;
935 ;; label:
936 ;;
937 ((and (not (looking-at "virtual\\>"))
938 (looking-at "[a-z0-9_]*[ \t\f]*:[^-=]"))
939 (setq indent simula-label-offset)))
940 ;; find line with non-comment text
8ca3cd44 941 (simula-skip-comment-backward 'dont-skip-end)
a26389d1
ER
942 (if (and found-end
943 (not (eq (preceding-char) ?\;))
944 (if (memq (preceding-char) '(?N ?n))
945 (save-excursion
ca3e10c7 946 (backward-word 1)
a26389d1
ER
947 (not (looking-at "begin\\>")))
948 t))
949 (progn
950 (simula-previous-statement 1)
951 (simula-skip-comment-backward)))
952 (setq start-line
5ed619e0 953 (line-beginning-position)
a26389d1
ER
954 ;; - perhaps this is a continued statement
955 continued
956 (save-excursion
957 (and (not (bobp))
958 ;; (not found-end)
959 (if (eq (char-syntax (preceding-char)) ?w)
960 (progn
961 (backward-word 1)
962 (not (looking-at
963 "begin\\|then\\|else\\|when\\|otherwise\\|do"
964 )))
965 (not (memq (preceding-char) '(?: ?\;)))))))
966 ;;
967 ;; MAIN calculation loop - count BEGIN/DO etc.
968 ;;
969 (while (not (bolp))
970 (if (re-search-backward
971 ";\\|\\<\\(begin\\|end\\|if\\|else\\|then\\|when\\|otherwise\\|do\\)\\>"
972 start-line 'move)
973 (if (simula-context)
974 ();; found something in a comment/string - ignore
975 (setq temp (following-char))
976 (cond
977 ((eq temp ?\;)
978 (simula-previous-statement 1))
979 ((looking-at "begin\\>")
980 (setq indent (+ indent simula-indent-level)))
981 ((looking-at "end\\>")
982 (forward-word 1)
983 (simula-previous-statement 1))
984 ((looking-at "do\\>")
985 (setq indent (+ indent simula-substatement-offset))
986 (simula-find-do-match))
987 ((looking-at "\\(if\\|then\\|else\\)\\>")
988 (if (memq temp '(?I ?i))
989 (forward-word 1)
990 (setq indent (+ indent
991 simula-substatement-offset
992 (if (memq temp '(?T ?t))
993 (car simula-if-indent)
994 (cdr simula-if-indent)))))
995 (simula-find-if))
996 ((looking-at "\\<when\\>\\|\\<otherwise\\>")
997 (setq indent (+ indent
998 simula-substatement-offset
999 (if (memq temp '(?W ?w))
1000 (car simula-if-indent)
1001 (cdr simula-if-indent))))
1002 (simula-find-inspect)))
1003 ;; found the start of a [sub]statement
eb8c3be9 1004 ;; add indentation for continued statement
a26389d1
ER
1005 (if continued
1006 (setq indent
1007 (+ indent
1008 (if (listp simula-continued-statement-offset)
1009 (car simula-continued-statement-offset)
1010 simula-continued-statement-offset))))
1011 (setq start-line
5ed619e0 1012 (line-beginning-position)
a26389d1
ER
1013 continued nil))
1014 ;; search failed .. point is at beginning of line
1015 ;; determine if we should continue searching
1016 ;; (at or before comment or label)
1017 ;; temp = t means finished
1018 (setq temp
a1506d29 1019 (and (not (simula-context))
a26389d1
ER
1020 (save-excursion
1021 (skip-chars-forward " \t\f")
1022 (or (looking-at "virtual")
1023 (not
1024 (looking-at
1025 "!\\|comment\\>\\|[a-z0-9_]*[ \t\f]*:[^-=]")))))
1026 prev-cont continued)
1027 ;; if we are finished, find current line's indentation
1028 (if temp
1029 (setq indent (+ indent (current-indentation))))
1030 ;; find next line with non-comment SIMULA text
1031 ;; maybe indent extra if statement continues
1032 (simula-skip-comment-backward)
1033 (setq continued
1034 (and (not (bobp))
1035 (if (eq (char-syntax (preceding-char)) ?w)
1036 (save-excursion
1037 (backward-word 1)
1038 (not (looking-at
1039 "begin\\|then\\|else\\|when\\|otherwise\\|do")))
1040 (not (memq (preceding-char) '(?: ?\;))))))
1041 ;; if we the state of the continued-variable
eb8c3be9 1042 ;; changed, add indentation for continued statement
a26389d1
ER
1043 (if (or (and prev-cont (not continued))
1044 (and continued
1045 (listp simula-continued-statement-offset)))
1046 (setq indent
1047 (+ indent
1048 (if (listp simula-continued-statement-offset)
1049 (car simula-continued-statement-offset)
1050 simula-continued-statement-offset))))
1051 ;; while ends if point is at beginning of line at loop test
1052 (if (not temp)
5ed619e0 1053 (setq start-line (line-beginning-position))
a26389d1
ER
1054 (beginning-of-line))))
1055 ;;
eb8c3be9 1056 ;; return indentation
a26389d1
ER
1057 ;;
1058 indent)))))
1059
1060
1061(defun simula-find-if ()
3005d32e 1062 "Find starting IF of a IF-THEN[-ELSE[-IF-THEN...]] statement."
a26389d1
ER
1063 (catch 'simula-out
1064 (while t
1065 (if (and (simula-search-backward "\\<if\\>\\|;\\|\\<begin\\>"nil t)
1066 (memq (following-char) '(?I ?i)))
1067 (save-excursion
1068 ;;
1069 ;; find out if this IF was really the start of the IF statement
1070 ;;
1071 (simula-skip-comment-backward)
1072 (if (and (eq (char-syntax (preceding-char)) ?w)
1073 (progn
1074 (backward-word 1)
1075 (looking-at "else\\>")))
1076 ()
1077 (throw 'simula-out t)))
1078 (if (not (looking-at "\\<if\\>"))
1079 (error "Missing IF or misplaced BEGIN or ';' (can't find IF)")
1080 ;;
1081 ;; we were at the starting IF in the first place..
1082 ;;
1083 (throw 'simula-out t))))))
1084
1085
1086(defun simula-find-inspect ()
3005d32e 1087 "Find INSPECT matching WHEN or OTHERWISE."
a26389d1
ER
1088 (catch 'simula-out
1089 (let ((level 0))
1090 ;;
1091 ;; INSPECTs can be nested, have to find the corresponding one
1092 ;;
1093 (while t
1094 (if (and (simula-search-backward "\\<inspect\\>\\|\\<otherwise\\>\\|;"
1095 nil t)
1096 (/= (following-char) ?\;))
1097 (if (memq (following-char) '(?O ?o))
1098 (setq level (1+ level))
1099 (if (zerop level)
1100 (throw 'simula-out t)
1101 (setq level (1- level))))
1102 (error "Missing INSPECT or misplaced ';' (can't find INSPECT)"))))))
1103
1104
1105(defun simula-find-do-match ()
e284737d 1106 "Find keyword matching DO: FOR, WHILE, INSPECT or WHEN."
a26389d1
ER
1107 (while (and (re-search-backward
1108 "\\<\\(do\\|for\\|while\\|inspect\\|when\\|end\\|begin\\)\\>\\|;"
1109 nil 'move)
1110 (simula-context)))
1111 (if (and (looking-at "\\<\\(for\\|while\\|inspect\\|when\\)\\>")
1112 (not (simula-context)))
1113 () ;; found match
1114 (error "No matching FOR, WHILE or INSPECT for DO, or misplaced ';'")))
1115
1116
1117(defun simula-inside-parens ()
3005d32e 1118 "Return position after `(' on line if inside parentheses, nil otherwise."
a26389d1
ER
1119 (save-excursion
1120 (let ((parlevel 0))
1121 (catch 'simula-out
1122 (while t
1123 (if (re-search-backward "(\\|)\\|;" nil t)
1124 (if (eq (simula-context) nil)
1125 ;; found something - check it out
1126 (cond
1127 ((eq (following-char) ?\;)
1128 (if (zerop parlevel)
1129 (throw 'simula-out nil)
eb8c3be9 1130 (error "Parenthesis mismatch or misplaced ';'")))
a26389d1
ER
1131 ((eq (following-char) ?\()
1132 (if (zerop parlevel)
1133 (throw 'simula-out (1+ (current-column)))
1134 (setq parlevel (1- parlevel))))
1135 (t (setq parlevel (1+ parlevel))))
1136 );; nothing - inside comment or string
1137 ;; search failed
1138 (throw 'simula-out nil)))))))
1139
1140
1141(defun simula-goto-definition ()
1142 "Goto point of definition of variable, procedure or class."
1143 (interactive))
1144
1145
1146(defun simula-expand-stdproc ()
1147 (if (or (not simula-abbrev-stdproc) (simula-context))
1148 (unexpand-abbrev)
1149 (cond
1150 ((eq simula-abbrev-stdproc 'upcase) (upcase-word -1))
1151 ((eq simula-abbrev-stdproc 'downcase) (downcase-word -1))
8ca3cd44
RS
1152 ((eq simula-abbrev-stdproc 'capitalize) (capitalize-word -1))
1153 ((eq simula-abbrev-stdproc 'abbrev-table)
1154 ;; If not in lowercase, expansions are always capitalized.
1155 ;; We then want to replace with the exact expansion.
1156 (if (equal (symbol-name last-abbrev) last-abbrev-text)
1157 ()
1158 (downcase-word -1)
1159 (expand-abbrev))))))
a26389d1
ER
1160
1161
1162(defun simula-expand-keyword ()
1163 (if (or (not simula-abbrev-keyword) (simula-context))
1164 (unexpand-abbrev)
1165 (cond
1166 ((eq simula-abbrev-keyword 'upcase) (upcase-word -1))
1167 ((eq simula-abbrev-keyword 'downcase) (downcase-word -1))
8ca3cd44
RS
1168 ((eq simula-abbrev-keyword 'capitalize) (capitalize-word -1))
1169 ((eq simula-abbrev-stdproc 'abbrev-table)
1170 (if (equal (symbol-name last-abbrev) last-abbrev-text)
1171 ()
1172 (downcase-word -1)
1173 (expand-abbrev))))))
a26389d1
ER
1174
1175
1176(defun simula-electric-keyword ()
3005d32e 1177 "Expand SIMULA keyword. If it starts the line, reindent."
a26389d1
ER
1178 ;; redisplay
1179 (let ((show-char (eq this-command 'self-insert-command)))
eb8c3be9 1180 ;; If the abbrev expansion results in reindentation, the user may have
a26389d1
ER
1181 ;; to wait some time before the character he typed is displayed
1182 ;; (the char causing the expansion is inserted AFTER the hook function
1183 ;; is called). This is annoying in case of normal characters.
1184 ;; However, if the user pressed a key bound to newline, it is better
1185 ;; to have the line inserted after the begin-end match.
1186 (if show-char
1187 (progn
1ba983e8 1188 (insert-char last-command-event 1)
a26389d1
ER
1189 (sit-for 0)
1190 (backward-char 1)))
1191 (if (let ((where (simula-context))
1192 (case-fold-search t))
1193 (if where
1194 (if (and (eq where 2) (eq (char-syntax (preceding-char)) ?w))
1195 (save-excursion
1196 (backward-word 1)
1197 (not (looking-at "end\\>"))))))
1198 (unexpand-abbrev)
1199 (cond
1200 ((not simula-abbrev-keyword) (unexpand-abbrev))
1201 ((eq simula-abbrev-keyword 'upcase) (upcase-word -1))
1202 ((eq simula-abbrev-keyword 'downcase) (downcase-word -1))
1203 ((eq simula-abbrev-keyword 'capitalize) (capitalize-word -1)))
1204 (let ((pos (- (point-max) (point)))
e02f48d7
JB
1205 (case-fold-search t))
1206 (condition-case nil
a26389d1
ER
1207 (progn
1208 ;; check if the expanded word is on the beginning of the line.
1209 (if (and (eq (char-syntax (preceding-char)) ?w)
1210 (progn
1211 (backward-word 1)
1212 (if (looking-at "end\\>")
1213 (save-excursion
1214 (simula-backward-up-level 1)
1215 (if (pos-visible-in-window-p)
1216 (sit-for 1)
23161c61 1217 (message "Matches %s"
a26389d1
ER
1218 (buffer-substring
1219 (point)
23161c61 1220 (+ (point) (window-width)))))))
a26389d1
ER
1221 (skip-chars-backward " \t\f")
1222 (bolp)))
1223 (let ((indent (simula-calculate-indent)))
1224 (if (eq indent (current-indentation))
1225 ()
1226 (delete-horizontal-space)
1227 (indent-to indent)))
1228 (skip-chars-forward " \t\f"))
1229 ;; check for END - blow whistles and ring bells
1230
1231 (goto-char (- (point-max) pos))
1232 (if show-char
1233 (delete-char 1)))
1234 (quit (goto-char (- (point-max) pos))))))))
1235
1236
8ca3cd44 1237(defun simula-search-backward (regexp &optional bound noerror)
e284737d
SM
1238 "Search backward from point for regular expression REGEXP,
1239ignoring matches found inside SIMULA comments, string literals,
1240and BEGIN..END blocks.
8ca3cd44
RS
1241Set point to the end of the occurrence found, and return point.
1242An optional second argument BOUND bounds the search, it is a buffer position.
1243The match found must not extend after that position. Optional third argument
1244NOERROR, if t, means if fail just return nil (no error).
1245If not nil and not t, move to limit of search and return nil."
e02f48d7
JB
1246 (let ((comb-regexp (concat regexp "\\|\\<end\\>"))
1247 (start-point (point))
1248 context match)
8ca3cd44
RS
1249 (catch 'simula-backward
1250 (while (re-search-backward comb-regexp bound 1)
1251 ;; We have a match, check SIMULA context at match-beginning
1252 ;; to see if we are outside comments etc.
1253 ;; Set MATCH to t if we found a true match,
1254 ;; set MATCH to 'BLOCK if we found a BEGIN..END block,
1255 ;; else set MATCH to nil.
1256 (save-match-data
1257 (setq context (simula-context))
1258 (cond
1259 ((eq context nil)
1260 (setq match (if (looking-at regexp) t 'BLOCK)))
e284737d
SM
1261 ;; A comment-ending `;' is part of the comment, and shouldn't match.
1262 ;; ((eq context 0)
1263 ;; (setq match (if (eq (following-char) ?\;) t nil)))
8ca3cd44
RS
1264 ((eq context 2)
1265 (setq match (if (and (looking-at regexp)
1266 (looking-at ";\\|\\<end\\>\\|\\<else\\>\\|\\<otherwise\\>\\|\\<when\\>"))
1267 t
1268 (if (looking-at "\\<end\\>") 'BLOCK nil))))
1269 (t (setq match nil))))
1270 ;; Exit if true match
1271 (if (eq match t) (throw 'simula-backward (point)))
1272 (if (eq match 'BLOCK)
1273 ;; We found the END of a block
1274 (let ((level 0))
1275 (while (natnump level)
1276 (if (re-search-backward "\\<begin\\>\\|\\<end\\>" bound 1)
1277 (let ((context (simula-context)))
1278 ;; We found a BEGIN -> decrease level count
1279 (cond ((and (eq context nil)
1280 (memq (following-char) '(?b ?B)))
1281 (setq level (1- level)))
1282 ;; END -> increase level count
1283 ((and (memq context '(nil 2))
1284 (memq (following-char) '(?e ?E)))
1285 (setq level (1+ level)))))
1286 ;; Block search failed. Action depends on noerror.
1287 (if (or (not noerror) (eq noerror t))
1288 (goto-char start-point))
1289 (if (not noerror)
1290 (signal 'search-failed (list regexp)))
1291 (throw 'simula-backward nil))))))
1292 ;; Search failed. Action depends on noerror.
1293 (if (or (not noerror) (eq noerror t))
1294 (goto-char start-point))
1295 (if noerror
1296 nil
1297 (signal 'search-failed (list regexp))))))
1298
1299
1300(defun simula-search-forward (regexp &optional bound noerror)
e284737d
SM
1301 "Search forward from point for regular expression REGEXP,
1302ignoring matches found inside SIMULA comments, string literals,
1303and BEGIN..END blocks.
8ca3cd44
RS
1304Set point to the end of the occurrence found, and return point.
1305An optional second argument BOUND bounds the search, it is a buffer position.
1306The match found must not extend after that position. Optional third argument
1307NOERROR, if t, means if fail just return nil (no error).
1308If not nil and not t, move to limit of search and return nil."
e02f48d7
JB
1309 (let ((comb-regexp (concat regexp "\\|\\<begin\\>"))
1310 (start-point (point))
1311 context match)
8ca3cd44
RS
1312 (catch 'simula-forward
1313 (while (re-search-forward comb-regexp bound 1)
1314 ;; We have a match, check SIMULA context at match-beginning
1315 ;; to see if we are outside comments.
1316 ;; Set MATCH to t if we found a true match,
1317 ;; set MATCH to 'BLOCK if we found a BEGIN..END block,
1318 ;; else set MATCH to nil.
1319 (save-match-data
1320 (save-excursion
1321 (goto-char (match-beginning 0))
1322 (setq context (simula-context))
1323 (cond
1324 ((not context)
1325 (setq match (if (looking-at regexp) t 'BLOCK)))
e284737d
SM
1326 ;; Comment-ending `;' is part of the comment, and shouldn't match.
1327 ;; ((eq context 0)
1328 ;; (setq match (if (eq (following-char) ?\;) t nil)))
8ca3cd44
RS
1329 ((eq context 2)
1330 (setq match (if (and (looking-at regexp)
1331 (looking-at ";\\|\\<end\\>\\|\\<else\\>\\|\\<otherwise\\>\\|\\<when\\>")) t nil)))
1332 (t (setq match nil)))))
1333 ;; Exit if true match
1334 (if (eq match t) (throw 'simula-forward (point)))
1335 (if (eq match 'BLOCK)
1336 ;; We found the BEGINning of a block
1337 (let ((level 0))
1338 (while (natnump level)
1339 (if (re-search-forward "\\<begin\\>\\|\\<end\\>" bound 1)
1340 (let ((context (simula-context)))
1341 ;; We found a BEGIN -> increase level count
1342 (cond ((eq context nil) (setq level (1+ level)))
1343 ;; END -> decrease level count
1344 ((and (eq context 2)
1345 ;; Don't match BEGIN inside END comment
1346 (memq (preceding-char) '(?d ?D)))
1347 (setq level (1- level)))))
1348 ;; Block search failed. Action depends on noerror.
1349 (if (or (not noerror) (eq noerror t))
1350 (goto-char start-point))
1351 (if (not noerror)
1352 (signal 'search-failed (list regexp)))
1353 (throw 'simula-forward nil))))))
1354 ;; Search failed. Action depends on noerror.
1355 (if (or (not noerror) (eq noerror t))
1356 (goto-char start-point))
1357 (if noerror
1358 nil
1359 (signal 'search-failed (list regexp))))))
a26389d1 1360
a1506d29 1361
a26389d1 1362(defun simula-install-standard-abbrevs ()
3005d32e 1363 "Define Simula keywords, procedures and classes in local abbrev table."
a26389d1
ER
1364 ;; procedure and class names are as of the SIMULA 87 standard.
1365 (interactive)
8fc98fc4 1366 (dolist (args
a26389d1
ER
1367 '(("abs" "Abs" simula-expand-stdproc)
1368 ("accum" "Accum" simula-expand-stdproc)
1369 ("activate" "ACTIVATE" simula-expand-keyword)
1370 ("addepsilon" "AddEpsilon" simula-expand-stdproc)
1371 ("after" "AFTER" simula-expand-keyword)
1372 ("and" "AND" simula-expand-keyword)
1373 ("arccos" "ArcCos" simula-expand-stdproc)
1374 ("arcsin" "ArcSin" simula-expand-stdproc)
1375 ("arctan" "ArcTan" simula-expand-stdproc)
1376 ("arctan2" "ArcTan2" simula-expand-stdproc)
1377 ("array" "ARRAY" simula-expand-keyword)
1378 ("at" "AT" simula-expand-keyword)
1379 ("before" "BEFORE" simula-expand-keyword)
1380 ("begin" "BEGIN" simula-expand-keyword)
1381 ("blanks" "Blanks" simula-expand-stdproc)
1382 ("boolean" "BOOLEAN" simula-expand-keyword)
1383 ("breakoutimage" "BreakOutImage" simula-expand-stdproc)
1384 ("bytefile" "ByteFile" simula-expand-stdproc)
1385 ("call" "Call" simula-expand-stdproc)
1386 ("cancel" "Cancel" simula-expand-stdproc)
1387 ("cardinal" "Cardinal" simula-expand-stdproc)
1388 ("char" "Char" simula-expand-stdproc)
1389 ("character" "CHARACTER" simula-expand-keyword)
1390 ("checkpoint" "CheckPoint" simula-expand-stdproc)
1391 ("class" "CLASS" simula-expand-keyword)
1392 ("clear" "Clear" simula-expand-stdproc)
1393 ("clocktime" "ClockTime" simula-expand-stdproc)
1394 ("close" "Close" simula-expand-stdproc)
1395 ("comment" "COMMENT" simula-expand-keyword)
1396 ("constant" "Constant" simula-expand-stdproc)
1397 ("copy" "Copy" simula-expand-stdproc)
1398 ("cos" "Cos" simula-expand-stdproc)
1399 ("cosh" "CosH" simula-expand-stdproc)
1400 ("cotan" "CoTan" simula-expand-stdproc)
1401 ("cputime" "CpuTime" simula-expand-stdproc)
1402 ("current" "Current" simula-expand-stdproc)
1403 ("datetime" "DateTime" simula-expand-stdproc)
1404 ("decimalmark" "DecimalMark" simula-expand-stdproc)
1405 ("delay" "DELAY" simula-expand-keyword)
1406 ("deleteimage" "DeleteImage" simula-expand-stdproc)
1407 ("detach" "Detach" simula-expand-stdproc)
1408 ("digit" "Digit" simula-expand-stdproc)
1409 ("directbytefile" "DirectByteFile" simula-expand-stdproc)
1410 ("directfile" "DirectFile" simula-expand-stdproc)
1411 ("discrete" "Discrete" simula-expand-stdproc)
1412 ("do" "DO" simula-expand-keyword)
1413 ("downcase" "Downcase" simula-expand-stdproc)
1414 ("draw" "Draw" simula-expand-stdproc)
1415 ("eject" "Eject" simula-expand-stdproc)
1416 ("else" "ELSE" simula-electric-keyword)
1417 ("empty" "Empty" simula-expand-stdproc)
1418 ("end" "END" simula-electric-keyword)
1419 ("endfile" "Endfile" simula-expand-stdproc)
1420 ("entier" "Entier" simula-expand-stdproc)
1421 ("eq" "EQ" simula-expand-keyword)
1422 ("eqv" "EQV" simula-expand-keyword)
1423 ("erlang" "Erlang" simula-expand-stdproc)
1424 ("error" "Error" simula-expand-stdproc)
1425 ("evtime" "EvTime" simula-expand-stdproc)
1426 ("exp" "Exp" simula-expand-stdproc)
1427 ("external" "EXTERNAL" simula-expand-keyword)
1428 ("false" "FALSE" simula-expand-keyword)
1429 ("field" "Field" simula-expand-stdproc)
1430 ("file" "File" simula-expand-stdproc)
1431 ("first" "First" simula-expand-stdproc)
1432 ("follow" "Follow" simula-expand-stdproc)
1433 ("for" "FOR" simula-expand-keyword)
1434 ("ge" "GE" simula-expand-keyword)
1435 ("getchar" "GetChar" simula-expand-stdproc)
1436 ("getfrac" "GetFrac" simula-expand-stdproc)
1437 ("getint" "GetInt" simula-expand-stdproc)
1438 ("getreal" "GetReal" simula-expand-stdproc)
1439 ("go" "GO" simula-expand-keyword)
1440 ("goto" "GOTO" simula-expand-keyword)
1441 ("gt" "GT" simula-expand-keyword)
1442 ("head" "Head" simula-expand-stdproc)
1443 ("hidden" "HIDDEN" simula-expand-keyword)
1444 ("histd" "HistD" simula-expand-stdproc)
1445 ("histo" "Histo" simula-expand-stdproc)
1446 ("hold" "Hold" simula-expand-stdproc)
1447 ("idle" "Idle" simula-expand-stdproc)
1448 ("if" "IF" simula-expand-keyword)
1449 ("image" "Image" simula-expand-stdproc)
1450 ("imagefile" "ImageFile" simula-expand-stdproc)
1451 ("imp" "IMP" simula-expand-keyword)
1452 ("in" "IN" simula-expand-keyword)
1453 ("inbyte" "InByte" simula-expand-stdproc)
1454 ("inbytefile" "InByteFile" simula-expand-stdproc)
1455 ("inchar" "InChar" simula-expand-stdproc)
1456 ("infile" "InFile" simula-expand-stdproc)
1457 ("infrac" "InFrac" simula-expand-stdproc)
1458 ("inimage" "InImage" simula-expand-stdproc)
1459 ("inint" "InInt" simula-expand-stdproc)
1460 ("inner" "INNER" simula-expand-keyword)
1461 ("inreal" "InReal" simula-expand-stdproc)
1462 ("inrecord" "InRecord" simula-expand-stdproc)
1463 ("inspect" "INSPECT" simula-expand-keyword)
1464 ("integer" "INTEGER" simula-expand-keyword)
1465 ("intext" "InText" simula-expand-stdproc)
1466 ("into" "Into" simula-expand-stdproc)
1467 ("is" "IS" simula-expand-keyword)
1468 ("isochar" "ISOChar" simula-expand-stdproc)
1469 ("isopen" "IsOpen" simula-expand-stdproc)
1470 ("isorank" "ISORank" simula-expand-stdproc)
1471 ("label" "LABEL" simula-expand-keyword)
1472 ("last" "Last" simula-expand-stdproc)
1473 ("lastitem" "LastItem" simula-expand-stdproc)
1474 ("lastloc" "LastLoc" simula-expand-stdproc)
1475 ("le" "LE" simula-expand-keyword)
1476 ("length" "Length" simula-expand-stdproc)
1477 ("letter" "Letter" simula-expand-stdproc)
1478 ("line" "Line" simula-expand-stdproc)
1479 ("linear" "Linear" simula-expand-stdproc)
1480 ("linesperpage" "LinesPerPage" simula-expand-stdproc)
1481 ("link" "Link" simula-expand-stdproc)
1482 ("linkage" "Linkage" simula-expand-stdproc)
1483 ("ln" "Ln" simula-expand-stdproc)
1484 ("locate" "Locate" simula-expand-stdproc)
1485 ("location" "Location" simula-expand-stdproc)
1486 ("lock" "Lock" simula-expand-stdproc)
1487 ("locked" "Locked" simula-expand-stdproc)
1488 ("log10" "Log10" simula-expand-stdproc)
1489 ("long" "LONG" simula-expand-keyword)
1490 ("lowcase" "LowCase" simula-expand-stdproc)
1491 ("lowerbound" "LowerBound" simula-expand-stdproc)
1492 ("lowten" "LowTen" simula-expand-stdproc)
1493 ("lt" "LT" simula-expand-keyword)
1494 ("main" "Main" simula-expand-stdproc)
1495 ("max" "Max" simula-expand-stdproc)
1496 ("maxint" "MaxInt" simula-expand-stdproc)
1497 ("maxlongreal" "MaxLongReal" simula-expand-stdproc)
1498 ("maxloc" "MaxLoc" simula-expand-stdproc)
1499 ("maxrank" "MaxRank" simula-expand-stdproc)
1500 ("maxreal" "MaxReal" simula-expand-stdproc)
1501 ("min" "Min" simula-expand-stdproc)
1502 ("minint" "MinInt" simula-expand-stdproc)
1503 ("minlongreal" "MinLongReal" simula-expand-stdproc)
1504 ("minrank" "MinRank" simula-expand-stdproc)
1505 ("minreal" "MinReal" simula-expand-stdproc)
1506 ("mod" "Mod" simula-expand-stdproc)
1507 ("more" "More" simula-expand-stdproc)
1508 ("name" "NAME" simula-expand-keyword)
1509 ("ne" "NE" simula-expand-keyword)
1510 ("negexp" "NegExp" simula-expand-stdproc)
1511 ("new" "NEW" simula-expand-keyword)
1512 ("nextev" "NextEv" simula-expand-stdproc)
1513 ("none" "NONE" simula-expand-keyword)
1514 ("normal" "Normal" simula-expand-stdproc)
1515 ("not" "NOT" simula-expand-keyword)
1516 ("notext" "NOTEXT" simula-expand-keyword)
1517 ("open" "Open" simula-expand-stdproc)
1518 ("or" "OR" simula-expand-keyword)
1519 ("otherwise" "OTHERWISE" simula-electric-keyword)
1520 ("out" "Out" simula-expand-stdproc)
1521 ("outbyte" "OutByte" simula-expand-stdproc)
1522 ("outbytefile" "OutByteFile" simula-expand-stdproc)
1523 ("outchar" "OutChar" simula-expand-stdproc)
1524 ("outfile" "OutFile" simula-expand-stdproc)
1525 ("outfix" "OutFix" simula-expand-stdproc)
1526 ("outfrac" "OutFrac" simula-expand-stdproc)
1527 ("outimage" "OutImage" simula-expand-stdproc)
1528 ("outint" "OutInt" simula-expand-stdproc)
1529 ("outreal" "OutReal" simula-expand-stdproc)
1530 ("outrecord" "OutRecord" simula-expand-stdproc)
1531 ("outtext" "OutText" simula-expand-stdproc)
1532 ("page" "Page" simula-expand-stdproc)
1533 ("passivate" "Passivate" simula-expand-stdproc)
1534 ("poisson" "Poisson" simula-expand-stdproc)
1535 ("pos" "Pos" simula-expand-stdproc)
1536 ("precede" "Precede" simula-expand-stdproc)
1537 ("pred" "Pred" simula-expand-stdproc)
1538 ("prev" "Prev" simula-expand-stdproc)
1539 ("printfile" "PrintFile" simula-expand-stdproc)
1540 ("prior" "PRIOR" simula-expand-keyword)
1541 ("procedure" "PROCEDURE" simula-expand-keyword)
1542 ("process" "Process" simula-expand-stdproc)
1543 ("protected" "PROTECTED" simula-expand-keyword)
1544 ("putchar" "PutChar" simula-expand-stdproc)
1545 ("putfix" "PutFix" simula-expand-stdproc)
1546 ("putfrac" "PutFrac" simula-expand-stdproc)
1547 ("putint" "PutInt" simula-expand-stdproc)
1548 ("putreal" "PutReal" simula-expand-stdproc)
1549 ("qua" "QUA" simula-expand-keyword)
1550 ("randint" "RandInt" simula-expand-stdproc)
1551 ("rank" "Rank" simula-expand-stdproc)
1552 ("reactivate" "REACTIVATE" simula-expand-keyword)
1553 ("real" "REAL" simula-expand-keyword)
1554 ("ref" "REF" simula-expand-keyword)
1555 ("resume" "Resume" simula-expand-stdproc)
1556 ("setaccess" "SetAccess" simula-expand-stdproc)
1557 ("setpos" "SetPos" simula-expand-stdproc)
1558 ("short" "SHORT" simula-expand-keyword)
1559 ("sign" "Sign" simula-expand-stdproc)
1560 ("simset" "SimSet" simula-expand-stdproc)
1561 ("simulaid" "SimulaId" simula-expand-stdproc)
1562 ("simulation" "Simulation" simula-expand-stdproc)
1563 ("sin" "Sin" simula-expand-stdproc)
1564 ("sinh" "SinH" simula-expand-stdproc)
1565 ("sourceline" "SourceLine" simula-expand-stdproc)
1566 ("spacing" "Spacing" simula-expand-stdproc)
1567 ("sqrt" "Sqrt" simula-expand-stdproc)
1568 ("start" "Start" simula-expand-stdproc)
1569 ("step" "STEP" simula-expand-keyword)
1570 ("strip" "Strip" simula-expand-stdproc)
1571 ("sub" "Sub" simula-expand-stdproc)
1572 ("subepsilon" "SubEpsilon" simula-expand-stdproc)
1573 ("suc" "Suc" simula-expand-stdproc)
1574 ("switch" "SWITCH" simula-expand-keyword)
1575 ("sysin" "SysIn" simula-expand-stdproc)
1576 ("sysout" "SysOut" simula-expand-stdproc)
1577 ("tan" "Tan" simula-expand-stdproc)
1578 ("tanh" "TanH" simula-expand-stdproc)
1579 ("terminate_program" "Terminate_Program" simula-expand-stdproc)
1580 ("terminated" "Terminated" simula-expand-stdproc)
1581 ("text" "TEXT" simula-expand-keyword)
1582 ("then" "THEN" simula-electric-keyword)
1583 ("this" "THIS" simula-expand-keyword)
1584 ("time" "Time" simula-expand-stdproc)
1585 ("to" "TO" simula-expand-keyword)
1586 ("true" "TRUE" simula-expand-keyword)
1587 ("uniform" "Uniform" simula-expand-stdproc)
1588 ("unlock" "Unlock" simula-expand-stdproc)
1589 ("until" "UNTIL" simula-expand-keyword)
1590 ("upcase" "Upcase" simula-expand-stdproc)
1591 ("upperbound" "UpperBound" simula-expand-stdproc)
1592 ("value" "VALUE" simula-expand-keyword)
1593 ("virtual" "VIRTUAL" simula-expand-keyword)
1594 ("wait" "Wait" simula-expand-stdproc)
1595 ("when" "WHEN" simula-electric-keyword)
8fc98fc4
SM
1596 ("while" "WHILE" simula-expand-keyword)))
1597 (define-abbrev simula-mode-abbrev-table
1598 (nth 0 args) (nth 1 args) (nth 2 args) nil 'system)))
1599
1600(if simula-abbrev-file
1601 (read-abbrev-file simula-abbrev-file))
1602(let (abbrevs-changed)
1603 (simula-install-standard-abbrevs))
a26389d1 1604
e284737d 1605;; Hilit mode support.
91dd4dc4
DN
1606(when (fboundp 'hilit-set-mode-patterns)
1607 (when (and (boundp 'hilit-patterns-alist)
1608 (not (assoc 'simula-mode hilit-patterns-alist)))
8ca3cd44
RS
1609 (hilit-set-mode-patterns
1610 'simula-mode
1611 '(
1612 ("^%\\([ \t\f].*\\)?$" nil comment)
1613 ("^%include\\>" nil include)
1614 ("\"[^\"\n]*\"\\|'.'\\|'![0-9]+!'" nil string)
1615 ("\\<\\(ACTIVATE\\|AFTER\\|AND\\|ARRAY\\|AT\\|BEFORE\\|BEGIN\\|BOOLEAN\\|CHARACTER\\|CLASS\\|DELAY\\|DO\\|ELSE\\|END\\|EQ\\|EQV\\|EXTERNAL\\|FALSE\\|FOR\\|GE\\|GO\\|GOTO\\|GT\\|HIDDEN\\|IF\\|IMP\\|IN\\|INNER\\|INSPECT\\|INTEGER\\|IS\\|LABEL\\|LE\\|LONG\\|LT\\|NAME\\|NE\\|NEW\\|NONE\\|NOT\\|NOTEXT\\|OR\\|OTHERWISE\\|PRIOR\\|PROCEDURE\\|PROTECTED\\|QUA\\|REACTIVATE\\|REAL\\|REF\\|SHORT\\|STEP\\|SWITCH\\|TEXT\\|THEN\\|THIS\\|TO\\|TRUE\\|UNTIL\\|VALUE\\|VIRTUAL\\|WHEN\\|WHILE\\)\\>" nil keyword)
1616 ("!\\|\\<COMMENT\\>" ";" comment))
91dd4dc4 1617 nil 'case-insensitive)))
8ca3cd44
RS
1618\f
1619;; defuns for submitting bug reports
1620
241760a3 1621(defconst simula-mode-help-address "bug-gnu-emacs@gnu.org"
e284737d 1622 "Address accepting submission of `simula-mode' bug reports.")
8ca3cd44 1623
8ca3cd44 1624(defun simula-submit-bug-report ()
e284737d 1625 "Submit via mail a bug report on `simula-mode'."
8ca3cd44
RS
1626 (interactive)
1627 (and
1628 (y-or-n-p "Do you want to submit a report on simula-mode? ")
8ca3cd44
RS
1629 (reporter-submit-bug-report
1630 simula-mode-help-address
8b09046c 1631 (concat "simula-mode from Emacs " emacs-version)
8ca3cd44
RS
1632 (list
1633 ;; report only the vars that affect indentation
8ca3cd44
RS
1634 'simula-indent-level
1635 'simula-substatement-offset
1636 'simula-continued-statement-offset
1637 'simula-label-offset
1638 'simula-if-indent
1639 'simula-inspect-indent
1640 'simula-electric-indent
1641 'simula-abbrev-keyword
1642 'simula-abbrev-stdproc
1643 'simula-abbrev-file
1644 'simula-tab-always-indent
1645 ))))
1646
51508f6d 1647(provide 'simula)
8ca3cd44 1648
a26389d1 1649;;; simula.el ends here