]> code.delx.au - gnu-emacs/blob - lisp/progmodes/simula.el
delx.au / code / gnu-emacs / blob


dc2773a9efe7cf495792b99ae1fb0fd69a973407
[gnu-emacs] / lisp / progmodes / simula.el
1 ;;; simula.el --- SIMULA 87 code editing commands for Emacs
2
3 ;; Copyright (C) 1992, 1994, 1996, 2001-2011 Free Software Foundation, Inc.
4
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)
8 ;; Adapted-By: ESR
9 ;; Keywords: languages
10
11 ;; This file is part of GNU Emacs.
12
13 ;; GNU Emacs 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 3 of the License, or
16 ;; (at your option) any later version.
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
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25
26 ;;; Commentary:
27
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:
33 ;; Institutt for informatikk,
34 ;; Universitetet i Oslo
35
36 ;;; Code:
37
38 \f
39 (defgroup simula nil
40 "Major mode for editing Simula code."
41 :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
42 :prefix "simula-"
43 :group 'languages)
44
45 (defconst simula-tab-always-indent-default nil
46 "Non-nil means TAB in SIMULA mode should always reindent the current line.
47 Otherwise TAB indents only when point is within
48 the run of whitespace at the beginning of the line.")
49
50 (defcustom simula-tab-always-indent simula-tab-always-indent-default
51 "*Non-nil means TAB in SIMULA mode should always reindent the current line.
52 Otherwise TAB indents only when point is within
53 the run of whitespace at the beginning of the line."
54 :type 'boolean
55 :group 'simula)
56
57 (defconst simula-indent-level-default 3
58 "Indentation of SIMULA statements with respect to containing block.")
59
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
65
66 (defconst simula-substatement-offset-default 3
67 "Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE.")
68
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)
73
74 (defconst simula-continued-statement-offset-default 3
75 "Extra indentation for lines not starting a statement or substatement.
76 If value is a list, each line in a multipleline continued statement
77 will have the car of the list extra indentation with respect to
78 the previous line of the statement.")
79
80 (defcustom simula-continued-statement-offset
81 simula-continued-statement-offset-default
82 "*Extra indentation for lines not starting a statement or substatement.
83 If value is a list, each line in a multipleline continued statement
84 will have the car of the list extra indentation with respect to
85 the previous line of the statement."
86 :type 'integer
87 :group 'simula)
88
89 (defconst simula-label-offset-default -4711
90 "Offset of SIMULA label lines relative to usual indentation.")
91
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)
96
97 (defconst simula-if-indent-default '(0 . 0)
98 "Extra indentation of THEN and ELSE with respect to the starting IF.
99 Value is a cons cell, the car is extra THEN indentation and the cdr
100 extra ELSE indentation. IF after ELSE is indented as the starting IF.")
101
102 (defcustom simula-if-indent simula-if-indent-default
103 "*Extra indentation of THEN and ELSE with respect to the starting IF.
104 Value is a cons cell, the car is extra THEN indentation and the cdr
105 extra ELSE indentation. IF after ELSE is indented as the starting IF."
106 :type '(cons integer integer)
107 :group 'simula)
108
109 (defconst simula-inspect-indent-default '(0 . 0)
110 "Extra indentation of WHEN and OTHERWISE with respect to the INSPECT.
111 Value is a cons cell, the car is extra WHEN indentation
112 and the cdr extra OTHERWISE indentation.")
113
114 (defcustom simula-inspect-indent simula-inspect-indent-default
115 "*Extra indentation of WHEN and OTHERWISE with respect to the INSPECT.
116 Value is a cons cell, the car is extra WHEN indentation
117 and the cdr extra OTHERWISE indentation."
118 :type '(cons integer integer)
119 :group 'simula)
120
121 (defconst simula-electric-indent-default nil
122 "Non-nil means `simula-indent-line' function may reindent previous line.")
123
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)
128
129 (defconst simula-abbrev-keyword-default 'upcase
130 "Specify how to convert case for SIMULA keywords.
131 Value is one of the symbols `upcase', `downcase', `capitalize',
132 \(as in) `abbrev-table' or nil if they should not be changed.")
133
134 (defcustom simula-abbrev-keyword simula-abbrev-keyword-default
135 "*Specify how to convert case for SIMULA keywords.
136 Value is one of the symbols `upcase', `downcase', `capitalize',
137 \(as in) `abbrev-table' or nil if they should not be changed."
138 :type '(choice (const upcase) (const downcase) (const capitalize)(const nil))
139 :group 'simula)
140
141 (defconst simula-abbrev-stdproc-default 'abbrev-table
142 "Specify how to convert case for standard SIMULA procedure and class names.
143 Value is one of the symbols `upcase', `downcase', `capitalize',
144 \(as in) `abbrev-table', or nil if they should not be changed.")
145
146 (defcustom simula-abbrev-stdproc simula-abbrev-stdproc-default
147 "*Specify how to convert case for standard SIMULA procedure and class names.
148 Value is one of the symbols `upcase', `downcase', `capitalize',
149 \(as in) `abbrev-table', or nil if they should not be changed."
150 :type '(choice (const upcase) (const downcase) (const capitalize)
151 (const abbrev-table) (const nil))
152 :group 'simula)
153
154 (defcustom simula-abbrev-file nil
155 "*File with extra abbrev definitions for use in SIMULA mode.
156 These are used together with the standard abbrev definitions for SIMULA.
157 Please note that the standard definitions are required
158 for SIMULA mode to function correctly."
159 :type '(choice file (const nil))
160 :group 'simula)
161
162 (defvar simula-mode-syntax-table nil
163 "Syntax table in SIMULA mode buffers.")
164
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 "."))))
177
178 ;; Regexps written with help from Alf-Ivar Holm <alfh@ifi.uio.no>.
179 (defconst simula-font-lock-keywords-1
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)))
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 ;;
193 ;; Constants.
194 '("\\<\\(false\\|none\\|notext\\|true\\)\\>" . font-lock-constant-face)
195 ;;
196 ;; Keywords.
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)
204 ;;
205 ;; Types.
206 (cons (regexp-opt
207 '("array" "boolean" "character" "integer"
208 "long" "name" "real" "short" "text" "value" "ref") 'words)
209 'font-lock-type-face)))
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+\\>\\)*")
223 '(font-lock-match-c-style-declaration-item-and-skip-to-next
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)
234 (font-lock-match-c-style-declaration-item-and-skip-to-next nil nil
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
242 ; The following function is taken from cc-mode.el,
243 ; it determines the flavor of the Emacs running
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]
251 ["Forward Down Statement" simula-forward-down-level t])
252 "Lucid Emacs menu for SIMULA mode.")
253
254 (if simula-mode-syntax-table
255 ()
256 (setq simula-mode-syntax-table (copy-syntax-table (standard-syntax-table)))
257 (modify-syntax-entry ?! "<" simula-mode-syntax-table)
258 (modify-syntax-entry ?$ "." simula-mode-syntax-table)
259 (modify-syntax-entry ?% "< b" simula-mode-syntax-table)
260 (modify-syntax-entry ?\n "> b" simula-mode-syntax-table)
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)
268 (modify-syntax-entry ?_ "_" simula-mode-syntax-table)
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
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'.")
325
326 ;; menus for Lucid
327 (defun simula-popup-menu (_e)
328 "Pops up the SIMULA menu."
329 (interactive "@e")
330 (popup-menu (cons (concat mode-name " Mode Commands") simula-mode-menu)))
331
332 ;;;###autoload
333 (define-derived-mode simula-mode prog-mode "Simula"
334 "Major mode for editing SIMULA code.
335 \\{simula-mode-map}
336 Variables controlling indentation style:
337 `simula-tab-always-indent'
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.
340 `simula-indent-level'
341 Indentation of SIMULA statements with respect to containing block.
342 `simula-substatement-offset'
343 Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE.
344 `simula-continued-statement-offset' 3
345 Extra indentation for lines not starting a statement or substatement,
346 e.g. a nested FOR-loop. If value is a list, each line in a multiple-
347 line continued statement will have the car of the list extra indentation
348 with respect to the previous line of the statement.
349 `simula-label-offset' -4711
350 Offset of SIMULA label lines relative to usual indentation.
351 `simula-if-indent' '(0 . 0)
352 Extra indentation of THEN and ELSE with respect to the starting IF.
353 Value is a cons cell, the car is extra THEN indentation and the cdr
354 extra ELSE indentation. IF after ELSE is indented as the starting IF.
355 `simula-inspect-indent' '(0 . 0)
356 Extra indentation of WHEN and OTHERWISE with respect to the
357 corresponding INSPECT. Value is a cons cell, the car is
358 extra WHEN indentation and the cdr extra OTHERWISE indentation.
359 `simula-electric-indent' nil
360 If this variable is non-nil, `simula-indent-line'
361 will check the previous line to see if it has to be reindented.
362 `simula-abbrev-keyword' 'upcase
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.
366 `simula-abbrev-stdproc' 'abbrev-table
367 Determine how standard SIMULA procedure and class names will be
368 expanded. Value is one of the symbols `upcase', `downcase', `capitalize',
369 (as in) `abbrev-table', or nil if they should not be changed.
370
371 Turning on SIMULA mode calls the value of the variable simula-mode-hook
372 with no arguments, if that value is non-nil."
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"))))
387 (set (make-local-variable 'syntax-propertize-function)
388 simula-syntax-propertize-function)
389 (abbrev-mode 1))
390
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))))))
411
412
413 (defun simula-indent-line ()
414 "Indent this line as SIMULA code.
415 If `simula-electric-indent' is non-nil, indent previous line if necessary."
416 (let ((origin (- (point-max) (point)))
417 (indent (simula-calculate-indent))
418 (case-fold-search t))
419 (unwind-protect
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))))))
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.
449 If `simula-tab-always-indent' is non-nil, always indent current line.
450 Otherwise, indent only if point is before any non-whitespace
451 character on the line.
452
453 A numeric argument, regardless of its value, means indent rigidly
454 all the lines of the SIMULA statement after point so that this line
455 becomes properly indented.
456 The 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 ()
498 "Return value according to syntactic SIMULA context of point.
499 0 point inside COMMENT comment
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)
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)))))
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 ()
605 "If this is a label that starts the line, reindent the line."
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 := :-
612 ;; therefore take a peek at next typed character...
613 (next-char (read-event)))
614 (unwind-protect
615 (setq unread-command-events (append unread-command-events
616 (list next-char)))
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)))))
643
644
645 (defun simula-backward-up-level (count)
646 "Move backward up COUNT block levels.
647 If COUNT is negative, move forward up block level instead."
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.
678 If COUNT is negative, move backward down block level instead."
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
712
713 (defun simula-previous-statement (count)
714 "Move backward COUNT statements.
715 If COUNT is negative, move forward instead."
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 ()
723 ;;
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) ?\;)
732 (backward-char 1))
733 )
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)
749 "Move forward COUNT statements.
750 If COUNT is negative, move backward instead."
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
773 (defun simula-skip-comment-backward (&optional stop-at-end)
774 "Search towards bob to find first char that is outside a comment."
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)
783 (setq context (simula-context))
784 (if (and stop-at-end (eq context 2))
785 (setq context nil)))
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)
802 (beginning-of-line)
803 (if (bobp)
804 (throw 'simula-out nil)
805 (backward-char)))
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 ()
816 "Search towards eob to find first char that is outside a comment."
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")
822 ;; BUG: the following (0 2) branches don't take into account intermixing
823 ;; directive lines
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)))
880 ((eq where 1)
881 ;;
882 ;; Directive. Always 0.
883 ;;
884 0)
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
901 ;; special indentation (END/IF/THEN/ELSE/WHEN/OTHERWISE or label)
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
941 (simula-skip-comment-backward 'dont-skip-end)
942 (if (and found-end
943 (not (eq (preceding-char) ?\;))
944 (if (memq (preceding-char) '(?N ?n))
945 (save-excursion
946 (backward-word 1)
947 (not (looking-at "begin\\>")))
948 t))
949 (progn
950 (simula-previous-statement 1)
951 (simula-skip-comment-backward)))
952 (setq start-line
953 (line-beginning-position)
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
1004 ;; add indentation for continued statement
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
1012 (line-beginning-position)
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
1019 (and (not (simula-context))
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
1042 ;; changed, add indentation for continued statement
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)
1053 (setq start-line (line-beginning-position))
1054 (beginning-of-line))))
1055 ;;
1056 ;; return indentation
1057 ;;
1058 indent)))))
1059
1060
1061 (defun simula-find-if ()
1062 "Find starting IF of a IF-THEN[-ELSE[-IF-THEN...]] statement."
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 ()
1087 "Find INSPECT matching WHEN or OTHERWISE."
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 ()
1106 "Find keyword matching DO: FOR, WHILE, INSPECT or WHEN."
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 ()
1118 "Return position after `(' on line if inside parentheses, nil otherwise."
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)
1130 (error "Parenthesis mismatch or misplaced ';'")))
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))
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))))))
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))
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))))))
1174
1175
1176 (defun simula-electric-keyword ()
1177 "Expand SIMULA keyword. If it starts the line, reindent."
1178 ;; redisplay
1179 (let ((show-char (eq this-command 'self-insert-command)))
1180 ;; If the abbrev expansion results in reindentation, the user may have
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
1188 (insert-char last-command-event 1)
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)))
1205 (case-fold-search t))
1206 (condition-case nil
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)
1217 (message "Matches %s"
1218 (buffer-substring
1219 (point)
1220 (+ (point) (window-width)))))))
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
1237 (defun simula-search-backward (regexp &optional bound noerror)
1238 "Search backward from point for regular expression REGEXP,
1239 ignoring matches found inside SIMULA comments, string literals,
1240 and BEGIN..END blocks.
1241 Set point to the end of the occurrence found, and return point.
1242 An optional second argument BOUND bounds the search, it is a buffer position.
1243 The match found must not extend after that position. Optional third argument
1244 NOERROR, if t, means if fail just return nil (no error).
1245 If not nil and not t, move to limit of search and return nil."
1246 (let ((comb-regexp (concat regexp "\\|\\<end\\>"))
1247 (start-point (point))
1248 context match)
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)))
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)))
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)
1301 "Search forward from point for regular expression REGEXP,
1302 ignoring matches found inside SIMULA comments, string literals,
1303 and BEGIN..END blocks.
1304 Set point to the end of the occurrence found, and return point.
1305 An optional second argument BOUND bounds the search, it is a buffer position.
1306 The match found must not extend after that position. Optional third argument
1307 NOERROR, if t, means if fail just return nil (no error).
1308 If not nil and not t, move to limit of search and return nil."
1309 (let ((comb-regexp (concat regexp "\\|\\<begin\\>"))
1310 (start-point (point))
1311 context match)
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)))
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)))
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))))))
1360
1361
1362 (defun simula-install-standard-abbrevs ()
1363 "Define Simula keywords, procedures and classes in local abbrev table."
1364 ;; procedure and class names are as of the SIMULA 87 standard.
1365 (interactive)
1366 (dolist (args
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)
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))
1604
1605 ;; Hilit mode support.
1606 (when (fboundp 'hilit-set-mode-patterns)
1607 (when (and (boundp 'hilit-patterns-alist)
1608 (not (assoc 'simula-mode hilit-patterns-alist)))
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))
1617 nil 'case-insensitive)))
1618 \f
1619 ;; defuns for submitting bug reports
1620
1621 (defconst simula-mode-help-address "bug-gnu-emacs@gnu.org"
1622 "Address accepting submission of `simula-mode' bug reports.")
1623
1624 (defun simula-submit-bug-report ()
1625 "Submit via mail a bug report on `simula-mode'."
1626 (interactive)
1627 (and
1628 (y-or-n-p "Do you want to submit a report on simula-mode? ")
1629 (reporter-submit-bug-report
1630 simula-mode-help-address
1631 (concat "simula-mode from Emacs " emacs-version)
1632 (list
1633 ;; report only the vars that affect indentation
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
1647 (provide 'simula)
1648
1649 ;;; simula.el ends here