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


9deed398ea9af0b7fa99cf416dbc21116096107a
[gnu-emacs] / lisp / progmodes / simula.el
1 ;;; simula.el --- SIMULA 87 code editing commands for Emacs
2
3 ;; Copyright (C) 1992, 1994, 1996, 2001, 2002, 2003, 2004, 2005, 2006,
4 ;; 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
5
6 ;; Author: Hans Henrik Eriksen <hhe@ifi.uio.no>
7 ;; Maintainer: simula-mode@ifi.uio.no
8 ;; (above email addresses invalid as of April 2008)
9 ;; Adapted-By: ESR
10 ;; Keywords: languages
11
12 ;; This file is part of GNU Emacs.
13
14 ;; GNU Emacs is free software: you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation, either version 3 of the License, or
17 ;; (at your option) any later version.
18
19 ;; GNU Emacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
23
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26
27 ;;; Commentary:
28
29 ;; A major mode for editing the Simula language. It knows about Simula
30 ;; syntax and standard indentation commands. It also provides convenient
31 ;; abbrevs for Simula keywords.
32 ;;
33 ;; Hans Henrik Eriksen (the author) may be reached at:
34 ;; Institutt for informatikk,
35 ;; Universitetet i Oslo
36
37 ;;; Code:
38
39 \f
40 (defgroup simula nil
41 "Major mode for editing Simula code."
42 :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
43 :prefix "simula-"
44 :group 'languages)
45
46 (defconst simula-tab-always-indent-default nil
47 "Non-nil means TAB in SIMULA mode should always reindent the current line.
48 Otherwise TAB indents only when point is within
49 the run of whitespace at the beginning of the line.")
50
51 (defcustom simula-tab-always-indent simula-tab-always-indent-default
52 "*Non-nil means TAB in SIMULA mode should always reindent the current line.
53 Otherwise TAB indents only when point is within
54 the run of whitespace at the beginning of the line."
55 :type 'boolean
56 :group 'simula)
57
58 (defconst simula-indent-level-default 3
59 "Indentation of SIMULA statements with respect to containing block.")
60
61 (defcustom simula-indent-level simula-indent-level-default
62 "*Indentation of SIMULA statements with respect to containing block."
63 :type 'integer
64 :group 'simula)
65
66
67 (defconst simula-substatement-offset-default 3
68 "Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE.")
69
70 (defcustom simula-substatement-offset simula-substatement-offset-default
71 "*Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE."
72 :type 'integer
73 :group 'simula)
74
75 (defconst simula-continued-statement-offset-default 3
76 "Extra indentation for lines not starting a statement or substatement.
77 If value is a list, each line in a multipleline continued statement
78 will have the car of the list extra indentation with respect to
79 the previous line of the statement.")
80
81 (defcustom simula-continued-statement-offset
82 simula-continued-statement-offset-default
83 "*Extra indentation for lines not starting a statement or substatement.
84 If value is a list, each line in a multipleline continued statement
85 will have the car of the list extra indentation with respect to
86 the previous line of the statement."
87 :type 'integer
88 :group 'simula)
89
90 (defconst simula-label-offset-default -4711
91 "Offset of SIMULA label lines relative to usual indentation.")
92
93 (defcustom simula-label-offset simula-label-offset-default
94 "*Offset of SIMULA label lines relative to usual indentation."
95 :type 'integer
96 :group 'simula)
97
98 (defconst simula-if-indent-default '(0 . 0)
99 "Extra indentation of THEN and ELSE with respect to the starting IF.
100 Value is a cons cell, the car is extra THEN indentation and the cdr
101 extra ELSE indentation. IF after ELSE is indented as the starting IF.")
102
103 (defcustom simula-if-indent simula-if-indent-default
104 "*Extra indentation of THEN and ELSE with respect to the starting IF.
105 Value is a cons cell, the car is extra THEN indentation and the cdr
106 extra ELSE indentation. IF after ELSE is indented as the starting IF."
107 :type '(cons integer integer)
108 :group 'simula)
109
110 (defconst simula-inspect-indent-default '(0 . 0)
111 "Extra indentation of WHEN and OTHERWISE with respect to the INSPECT.
112 Value is a cons cell, the car is extra WHEN indentation
113 and the cdr extra OTHERWISE indentation.")
114
115 (defcustom simula-inspect-indent simula-inspect-indent-default
116 "*Extra indentation of WHEN and OTHERWISE with respect to the INSPECT.
117 Value is a cons cell, the car is extra WHEN indentation
118 and the cdr extra OTHERWISE indentation."
119 :type '(cons integer integer)
120 :group 'simula)
121
122 (defconst simula-electric-indent-default nil
123 "Non-nil means `simula-indent-line' function may reindent previous line.")
124
125 (defcustom simula-electric-indent simula-electric-indent-default
126 "*Non-nil means `simula-indent-line' function may reindent previous line."
127 :type 'boolean
128 :group 'simula)
129
130 (defconst simula-abbrev-keyword-default 'upcase
131 "Specify how to convert case for SIMULA keywords.
132 Value is one of the symbols `upcase', `downcase', `capitalize',
133 \(as in) `abbrev-table' or nil if they should not be changed.")
134
135 (defcustom simula-abbrev-keyword simula-abbrev-keyword-default
136 "*Specify how to convert case for SIMULA keywords.
137 Value is one of the symbols `upcase', `downcase', `capitalize',
138 \(as in) `abbrev-table' or nil if they should not be changed."
139 :type '(choice (const upcase) (const downcase) (const capitalize)(const nil))
140 :group 'simula)
141
142 (defconst simula-abbrev-stdproc-default 'abbrev-table
143 "Specify how to convert case for standard SIMULA procedure and class names.
144 Value is one of the symbols `upcase', `downcase', `capitalize',
145 \(as in) `abbrev-table', or nil if they should not be changed.")
146
147 (defcustom simula-abbrev-stdproc simula-abbrev-stdproc-default
148 "*Specify how to convert case for standard SIMULA procedure and class names.
149 Value is one of the symbols `upcase', `downcase', `capitalize',
150 \(as in) `abbrev-table', or nil if they should not be changed."
151 :type '(choice (const upcase) (const downcase) (const capitalize)
152 (const abbrev-table) (const nil))
153 :group 'simula)
154
155 (defcustom simula-abbrev-file nil
156 "*File with extra abbrev definitions for use in SIMULA mode.
157 These are used together with the standard abbrev definitions for SIMULA.
158 Please note that the standard definitions are required
159 for SIMULA mode to function correctly."
160 :type '(choice file (const nil))
161 :group 'simula)
162
163 (defvar simula-mode-syntax-table nil
164 "Syntax table in SIMULA mode buffers.")
165
166 (defconst simula-syntax-propertize-function
167 (syntax-propertize-rules
168 ;; `comment' directive.
169 ("\\<\\(c\\)omment\\>" (1 "<"))
170 ;; end comments
171 ((concat "\\<end\\>\\([^;\n]\\).*?\\(\n\\|\\(.\\)\\(;\\|"
172 (regexp-opt '("end" "else" "when" "otherwise"))
173 "\\)\\)")
174 (1 "< b")
175 (3 "> b"))
176 ;; non-quoted single-quote char.
177 ("'\\('\\)'" (1 "."))))
178
179 ;; Regexps written with help from Alf-Ivar Holm <alfh@ifi.uio.no>.
180 (defconst simula-font-lock-keywords-1
181 '(;;
182 ;; Compiler directives.
183 ("^%\\([^ \t\n].*\\)" 1 font-lock-constant-face t)
184 ;;
185 ;; Class and procedure names.
186 ("\\<\\(class\\|procedure\\)\\>[ \t]*\\(\\sw+\\)?"
187 (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)))
188 "Subdued level highlighting for Simula mode.")
189
190 (defconst simula-font-lock-keywords-2
191 (append simula-font-lock-keywords-1
192 (list
193 ;;
194 ;; Constants.
195 '("\\<\\(false\\|none\\|notext\\|true\\)\\>" . font-lock-constant-face)
196 ;;
197 ;; Keywords.
198 (regexp-opt
199 '("activate" "after" "and" "at" "before" "begin" "delay" "do"
200 "else" "end" "eq" "eqv" "external" "for" "ge" "go" "goto" "gt"
201 "hidden" "if" "imp" "in" "inner" "inspect" "is" "label" "le"
202 "lt" "ne" "new" "not" "or" "otherwise" "prior" "protected"
203 "qua" "reactivate" "step" "switch" "then" "this" "to" "until"
204 "virtual" "when" "while") 'words)
205 ;;
206 ;; Types.
207 (cons (regexp-opt
208 '("array" "boolean" "character" "integer"
209 "long" "name" "real" "short" "text" "value" "ref") 'words)
210 'font-lock-type-face)))
211 "Medium level highlighting for Simula mode.")
212
213 (defconst simula-font-lock-keywords-3
214 (append simula-font-lock-keywords-2
215 (list
216 ;;
217 ;; Super-class names and super-slow.
218 '("\\<\\(\\sw+\\)[ \t]+class\\>" 1 font-lock-function-name-face)
219 ;;
220 ;; Types and their declarations.
221 (list (concat "\\<\\(array\\|boolean\\|character\\|integer\\|"
222 "long\\|name\\|real\\|short\\|text\\|value\\)\\>"
223 "\\([ \t]+\\sw+\\>\\)*")
224 '(font-lock-match-c-style-declaration-item-and-skip-to-next
225 ;; Start with point after all type specifiers.
226 (goto-char (or (match-beginning 2) (match-end 1)))
227 ;; Finish with point after first type specifier.
228 (goto-char (match-end 1))
229 ;; Fontify as a variable name.
230 (1 font-lock-variable-name-face)))
231 ;;
232 ;; Object references and their declarations.
233 '("\\<\\(ref\\)\\>[ \t]*\\((\\(\\sw+\\))\\)?"
234 (3 font-lock-function-name-face nil t)
235 (font-lock-match-c-style-declaration-item-and-skip-to-next nil nil
236 (1 font-lock-variable-name-face)))
237 ))
238 "Gaudy level highlighting for Simula mode.")
239
240 (defvar simula-font-lock-keywords simula-font-lock-keywords-1
241 "Default expressions to highlight in Simula mode.")
242
243 ; The following function is taken from cc-mode.el,
244 ; it determines the flavor of the Emacs running
245
246 (defvar simula-mode-menu
247 '(["Report Bug" simula-submit-bug-report t]
248 ["Indent Line" simula-indent-line t]
249 ["Backward Statement" simula-previous-statement t]
250 ["Forward Statement" simula-next-statement t]
251 ["Backward Up Level" simula-backward-up-level t]
252 ["Forward Down Statement" simula-forward-down-level t])
253 "Lucid Emacs menu for SIMULA mode.")
254
255 (if simula-mode-syntax-table
256 ()
257 (setq simula-mode-syntax-table (copy-syntax-table (standard-syntax-table)))
258 (modify-syntax-entry ?! "<" simula-mode-syntax-table)
259 (modify-syntax-entry ?$ "." simula-mode-syntax-table)
260 (modify-syntax-entry ?% "< b" simula-mode-syntax-table)
261 (modify-syntax-entry ?\n "> b" 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 (modify-syntax-entry ?\} "." simula-mode-syntax-table))
273
274 (defvar simula-mode-map
275 (let ((map (make-sparse-keymap)))
276 (define-key map "\C-c\C-u" 'simula-backward-up-level)
277 (define-key map "\C-c\C-p" 'simula-previous-statement)
278 (define-key map "\C-c\C-d" 'simula-forward-down-level)
279 (define-key map "\C-c\C-n" 'simula-next-statement)
280 ;; (define-key map "\C-c\C-g" 'simula-goto-definition)
281 ;; (define-key map "\C-c\C-h" 'simula-standard-help)
282 (define-key map "\177" 'backward-delete-char-untabify)
283 (define-key map ":" 'simula-electric-label)
284 (define-key map "\e\C-q" 'simula-indent-exp)
285 (define-key map "\t" 'simula-indent-command)
286 ;; Emacs 19 defines menus in the mode map
287 (define-key map [menu-bar simula]
288 (cons "SIMULA" (make-sparse-keymap "SIMULA")))
289 (define-key map [menu-bar simula bug-report]
290 '("Submit Bug Report" . simula-submit-bug-report))
291 (define-key map [menu-bar simula separator-indent]
292 '("--"))
293 (define-key map [menu-bar simula indent-exp]
294 '("Indent Expression" . simula-indent-exp))
295 (define-key map [menu-bar simula indent-line]
296 '("Indent Line" . simula-indent-command))
297 (define-key map [menu-bar simula separator-navigate]
298 '("--"))
299 (define-key map [menu-bar simula backward-stmt]
300 '("Previous Statement" . simula-previous-statement))
301 (define-key map [menu-bar simula forward-stmt]
302 '("Next Statement" . simula-next-statement))
303 (define-key map [menu-bar simula backward-up]
304 '("Backward Up Level" . simula-backward-up-level))
305 (define-key map [menu-bar simula forward-down]
306 '("Forward Down Statement" . simula-forward-down-level))
307
308 (put 'simula-next-statement 'menu-enable '(not (eobp)))
309 (put 'simula-previous-statement 'menu-enable '(not (bobp)))
310 (put 'simula-forward-down-level 'menu-enable '(not (eobp)))
311 (put 'simula-backward-up-level 'menu-enable '(not (bobp)))
312 (put 'simula-indent-command 'menu-enable '(not buffer-read-only))
313 (put 'simula-indent-exp 'menu-enable '(not buffer-read-only))
314
315 ;; RMS: mouse-3 should not select this menu. mouse-3's global
316 ;; definition is useful in SIMULA mode and we should not interfere
317 ;; with that. The menu is mainly for beginners, and for them,
318 ;; the menubar requires less memory than a special click.
319 ;; in Lucid Emacs, we want the menu to popup when the 3rd button is
320 ;; hit. In 19.10 and beyond this is done automatically if we put
321 ;; the menu on mode-popup-menu variable, see c-common-init [cc-mode.el]
322 ;;(if (not (boundp 'mode-popup-menu))
323 ;; (define-key simula-mode-map 'button3 'simula-popup-menu))
324 map)
325 "Keymap used in `simula-mode'.")
326
327 ;; menus for Lucid
328 (defun simula-popup-menu (e)
329 "Pops up the SIMULA menu."
330 (interactive "@e")
331 (popup-menu (cons (concat mode-name " Mode Commands") simula-mode-menu)))
332
333 ;;;###autoload
334 (define-derived-mode simula-mode prog-mode "Simula"
335 "Major mode for editing SIMULA code.
336 \\{simula-mode-map}
337 Variables controlling indentation style:
338 `simula-tab-always-indent'
339 Non-nil means TAB in SIMULA mode should always reindent the current line,
340 regardless of where in the line point is when the TAB command is used.
341 `simula-indent-level'
342 Indentation of SIMULA statements with respect to containing block.
343 `simula-substatement-offset'
344 Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE.
345 `simula-continued-statement-offset' 3
346 Extra indentation for lines not starting a statement or substatement,
347 e.g. a nested FOR-loop. If value is a list, each line in a multiple-
348 line continued statement will have the car of the list extra indentation
349 with respect to the previous line of the statement.
350 `simula-label-offset' -4711
351 Offset of SIMULA label lines relative to usual indentation.
352 `simula-if-indent' '(0 . 0)
353 Extra indentation of THEN and ELSE with respect to the starting IF.
354 Value is a cons cell, the car is extra THEN indentation and the cdr
355 extra ELSE indentation. IF after ELSE is indented as the starting IF.
356 `simula-inspect-indent' '(0 . 0)
357 Extra indentation of WHEN and OTHERWISE with respect to the
358 corresponding INSPECT. Value is a cons cell, the car is
359 extra WHEN indentation and the cdr extra OTHERWISE indentation.
360 `simula-electric-indent' nil
361 If this variable is non-nil, `simula-indent-line'
362 will check the previous line to see if it has to be reindented.
363 `simula-abbrev-keyword' 'upcase
364 Determine how SIMULA keywords will be expanded. Value is one of
365 the symbols `upcase', `downcase', `capitalize', (as in) `abbrev-table',
366 or nil if they should not be changed.
367 `simula-abbrev-stdproc' 'abbrev-table
368 Determine how standard SIMULA procedure and class names will be
369 expanded. Value is one of the symbols `upcase', `downcase', `capitalize',
370 (as in) `abbrev-table', or nil if they should not be changed.
371
372 Turning on SIMULA mode calls the value of the variable simula-mode-hook
373 with no arguments, if that value is non-nil."
374 (set (make-local-variable 'comment-column) 40)
375 ;; (set (make-local-variable 'end-comment-column) 75)
376 (set (make-local-variable 'paragraph-start) "[ \t]*$\\|\\f")
377 (set (make-local-variable 'paragraph-separate) paragraph-start)
378 (set (make-local-variable 'indent-line-function) 'simula-indent-line)
379 (set (make-local-variable 'comment-start) "! ")
380 (set (make-local-variable 'comment-end) " ;")
381 (set (make-local-variable 'comment-start-skip) "!+ *")
382 (set (make-local-variable 'parse-sexp-ignore-comments) nil)
383 (set (make-local-variable 'comment-multi-line) t)
384 (set (make-local-variable 'font-lock-defaults)
385 '((simula-font-lock-keywords simula-font-lock-keywords-1
386 simula-font-lock-keywords-2 simula-font-lock-keywords-3)
387 nil t ((?_ . "w"))))
388 (set (make-local-variable 'syntax-propertize-function)
389 simula-syntax-propertize-function)
390 (abbrev-mode 1))
391
392 (defun simula-indent-exp ()
393 "Indent SIMULA expression following point."
394 (interactive)
395 (let ((here (point))
396 (simula-electric-indent nil)
397 end)
398 (simula-skip-comment-forward)
399 (if (eobp)
400 (goto-char here)
401 (unwind-protect
402 (progn
403 (simula-next-statement 1)
404 (setq end (point-marker))
405 (simula-previous-statement 1)
406 (beginning-of-line)
407 (while (< (point) end)
408 (if (not (looking-at "[ \t]*$"))
409 (simula-indent-line))
410 (forward-line 1)))
411 (and end (set-marker end nil))))))
412
413
414 (defun simula-indent-line ()
415 "Indent this line as SIMULA code.
416 If `simula-electric-indent' is non-nil, indent previous line if necessary."
417 (let ((origin (- (point-max) (point)))
418 (indent (simula-calculate-indent))
419 (case-fold-search t))
420 (unwind-protect
421 (if simula-electric-indent
422 (progn
423 ;;
424 ;; manually expand abbrev on last line, if any
425 ;;
426 (end-of-line 0)
427 (expand-abbrev)
428 ;; now maybe we should reindent that line
429 (beginning-of-line)
430 (skip-chars-forward " \t\f")
431 (if (and
432 (looking-at
433 "\\(end\\|if\\|then\\|else\\|when\\|otherwise\\)\\>")
434 (not (simula-context)))
435 ;; yes - reindent
436 (let ((post-indent (simula-calculate-indent)))
437 (if (eq (current-indentation) post-indent)
438 ()
439 (delete-horizontal-space)
440 (indent-to post-indent))))))
441 (goto-char (- (point-max) origin))
442 (if (eq (current-indentation) indent)
443 (back-to-indentation)
444 (delete-horizontal-space)
445 (indent-to indent)))))
446
447
448 (defun simula-indent-command (&optional whole-exp)
449 "Indent current line as SIMULA code, or insert TAB character.
450 If `simula-tab-always-indent' is non-nil, always indent current line.
451 Otherwise, indent only if point is before any non-whitespace
452 character on the line.
453
454 A numeric argument, regardless of its value, means indent rigidly
455 all the lines of the SIMULA statement after point so that this line
456 becomes properly indented.
457 The relative indentation among the lines of the statement are preserved."
458 (interactive "P")
459 (let ((case-fold-search t))
460 (if (or whole-exp simula-tab-always-indent
461 (save-excursion
462 (skip-chars-backward " \t\f")
463 (bolp)))
464 ;; reindent current line
465 (let ((indent (save-excursion
466 (beginning-of-line)
467 (simula-calculate-indent)))
468 (current (current-indentation))
469 (origin (- (point-max) (point)))
470 (bol (save-excursion
471 (skip-chars-backward " \t\f")
472 (bolp)))
473 beg end)
474 (unwind-protect
475 (if (eq current indent)
476 (if (save-excursion
477 (skip-chars-backward " \t\f")
478 (bolp))
479 (back-to-indentation))
480 (beginning-of-line)
481 (delete-horizontal-space)
482 (indent-to indent))
483 (if (not bol)
484 (goto-char (- (point-max) origin))))
485 (setq origin (point))
486 (if whole-exp
487 (save-excursion
488 (beginning-of-line 2)
489 (setq beg (point))
490 (goto-char origin)
491 (simula-next-statement 1)
492 (setq end (point))
493 (if (and (> end beg) (not (eq indent current)))
494 (indent-code-rigidly beg end (- indent current) "%")))))
495 (insert-tab))))
496
497
498 (defun simula-context ()
499 "Return value according to syntactic SIMULA context of point.
500 0 point inside COMMENT comment
501 1 point on SIMULA-compiler directive line
502 2 point inside END comment
503 3 point inside string
504 4 point inside character constant
505 nil otherwise."
506 ;; first, find out if this is a compiler directive line
507 (if (save-excursion
508 (beginning-of-line)
509 (eq (following-char) ?%))
510 ;; YES - return 1
511 1
512 (save-excursion
513 ;; The current line is NOT a compiler directive line.
514 ;; Now, the strategy is to search backward to find a semicolon
515 ;; that is NOT inside a string. The point after semicolon MUST be
516 ;; outside a comment, since semicolons are comment-ending and
517 ;; comments are non-recursive. We take advantage of the fact
518 ;; that strings MUST end on the same line as they started, so
519 ;; that we can easily decide whether we are inside a string or not.
520 (let (return-value (origin (point)))
521 (skip-chars-backward "^;" (point-min))
522 ;; found semicolon or beginning of buffer
523 (let (loopvalue (saved-point origin))
524 (while (and (not (bobp))
525 (if (progn
526 (beginning-of-line)
527 ;; compiler directive line? If so, cont searching..
528 (eq (following-char) ?%))
529 t
530 (while (< (point) saved-point)
531 (skip-chars-forward "^;\"'")
532 (forward-char 1)
533 (cond
534 ((eq (preceding-char) ?\;)
535 (setq saved-point (point)))
536 ((eq (preceding-char) ?\")
537 (skip-chars-forward "^\";")
538 (if (eq (following-char) ?\;)
539 (setq saved-point (point) loopvalue t)
540 (forward-char 1)))
541 (t
542 (if (eq (following-char) ?')
543 (forward-char 1))
544 (skip-chars-forward "^';")
545 (if (eq (following-char) ?\;)
546 (setq saved-point (point) loopvalue t)
547 (forward-char 1)))))
548 loopvalue))
549 (backward-char 1)
550 (skip-chars-backward "^;")
551 (setq saved-point (point) loopvalue nil)))
552 ;; Now we are CERTAIN that we are outside comments and strings.
553 ;; The job now is to search forward again towards the origin
554 ;; skipping directives, comments and strings correctly,
555 ;; so that we know what context we are in when we find the origin.
556 (while (and
557 (< (point) origin)
558 (re-search-forward
559 "\\<end\\>\\|!\\|\"\\|'\\|^%\\|\\<comment\\>" origin 'move))
560 (cond
561 ((memq (preceding-char) '(?d ?D))
562 (setq return-value 2)
563 (while (and (re-search-forward
564 ";\\|\\<end\\>\\|\\<else\\>\\|\\<otherwise\\>\\|\\<when\\>\\|^%"
565 origin 'move)
566 ;; found another END?
567 (or (memq (preceding-char) '(?d ?D))
568 ;; if directive, skip line
569 (and (eq (preceding-char) ?%)
570 (beginning-of-line 2))
571 ;; found other keyword, out of END comment
572 (setq return-value nil))))
573 (if (and (eq (char-syntax (preceding-char)) ?w)
574 (eq (char-syntax (following-char)) ?w))
575 (save-excursion
576 (backward-word 1)
577 (if (looking-at "end\\>\\|else\\>\\|otherwise\\>\\|when\\>")
578 (setq return-value nil)))))
579 ((memq (preceding-char) '(?! ?t ?T))
580 ; skip comment
581 (setq return-value 0)
582 (skip-chars-forward "^%;" origin)
583 (while (and return-value (< (point) origin))
584 (if (eq (following-char) ?\;)
585 (setq return-value nil)
586 (if (bolp)
587 (beginning-of-line 2) ; skip directive inside comment
588 (forward-char 1)) ; or single '%'
589 (skip-chars-forward "^%;" origin))))
590 ((eq (preceding-char) ?\")
591 (if (not (search-forward "\"" origin 'move))
592 (setq return-value 3)))
593 ((eq (preceding-char) ?\')
594 (if (or (eq (point) origin) (eobp))
595 (setq return-value 4)
596 (forward-char 1)
597 (if (not (search-forward "'" origin 'move))
598 (setq return-value 4))))
599 ;; compiler directive line - skip
600 (t (beginning-of-line 2))))
601 return-value)
602 )))
603
604
605 (defun simula-electric-label ()
606 "If this is a label that starts the line, reindent the line."
607 (interactive)
608 (expand-abbrev)
609 (insert ?:)
610 (let ((origin (- (point-max) (point)))
611 (case-fold-search t)
612 ;; don't mix a label with an assignment operator := :-
613 ;; therefore take a peek at next typed character...
614 (next-char (read-event)))
615 (unwind-protect
616 (setq unread-command-events (append unread-command-events
617 (list next-char)))
618 ;; Problem: find out if character just read is a command char
619 ;; that would insert something after ':' making it a label.
620 ;; At least \n, \r (and maybe \t) falls into this category.
621 ;; This is a real crock, it depends on traditional keymap
622 ;; bindings, that is, printing characters doing self-insert,
623 ;; and no other command sequence inserting '-' or '='.
624 ;; simula-electric-label can be easily fooled...
625 (if (and (not (memq next-char '(?= ?-)))
626 (or (memq next-char '(?\n ?\r))
627 (and (eq next-char ?\t)
628 simula-tab-always-indent)
629 (not (memq (following-char) '(?= ?-))))
630 (not (simula-context))
631 ;; label?
632 (progn
633 (backward-char 1)
634 (skip-chars-backward " \t\f")
635 (skip-chars-backward "a-zA-Z0-9_")
636 (if (looking-at "virtual\\>")
637 nil
638 (skip-chars-backward " \t\f")
639 (bolp))))
640 (let ((amount (simula-calculate-indent)))
641 (delete-horizontal-space)
642 (indent-to amount)))
643 (goto-char (- (point-max) origin)))))
644
645
646 (defun simula-backward-up-level (count)
647 "Move backward up COUNT block levels.
648 If COUNT is negative, move forward up block level instead."
649 (interactive "p")
650 (let ((origin (point))
651 (case-fold-search t))
652 (condition-case ()
653 (if (> count 0)
654 (while (> count 0)
655 (re-search-backward "\\<begin\\>\\|\\<end\\>")
656 (if (not (simula-context))
657 (setq count (if (memq (following-char) '(?b ?B))
658 (1- count)
659 (1+ count)))))
660 (while (< count 0)
661 (re-search-forward "\\<begin\\>\\|\\<end\\>")
662 (backward-word 1)
663 (if (not (simula-context))
664 (setq count (if (memq (following-char) '(?e ?E))
665 (1+ count)
666 (1- count))))
667 (backward-word -1)))
668 ;; If block level not found, jump back to origin and signal an error
669 (error (progn
670 (goto-char origin)
671 (error "No higher block level")))
672 (quit (progn
673 (goto-char origin)
674 (signal 'quit nil))))))
675
676
677 (defun simula-forward-down-level (count)
678 "Move forward down COUNT block levels.
679 If COUNT is negative, move backward down block level instead."
680 (interactive "p")
681 ;; When we search for a deeper block level, we must never
682 ;; get out of the block where we started -> count >= start-count
683 (let ((start-count count)
684 (origin (point))
685 (case-fold-search t))
686 (condition-case ()
687 (if (< count 0)
688 (while (< count 0)
689 (re-search-backward "\\<begin\\>\\|\\<end\\>")
690 (if (not (simula-context))
691 (setq count (if (memq (following-char) '(?e ?E))
692 (1+ count)
693 (1- count))))
694 (if (< count start-count) (signal 'error nil)))
695 (while (> count 0)
696 (re-search-forward "\\<begin\\>\\|\\<end\\>")
697 (backward-word 1)
698 (if (not (simula-context))
699 (setq count (if (memq (following-char) '(?b ?B))
700 (1- count)
701 (1+ count))))
702 (backward-word -1)
703 ;; deeper level has to be found within starting block
704 (if (> count start-count) (signal 'error nil))))
705 ;; If block level not found, jump back to origin and signal an error
706 (error (progn
707 (goto-char origin)
708 (error "No containing block level")))
709 (quit (progn
710 (goto-char origin)
711 (signal 'quit nil))))))
712
713
714 (defun simula-previous-statement (count)
715 "Move backward COUNT statements.
716 If COUNT is negative, move forward instead."
717 (interactive "p")
718 (if (< count 0)
719 (simula-next-statement (- count))
720 (let (status
721 (case-fold-search t)
722 (origin (point)))
723 (condition-case ()
724 ;;
725 (progn
726 (simula-skip-comment-backward)
727 (if (memq (preceding-char) '(?n ?N))
728 (progn
729 (backward-word 1)
730 (if (not (looking-at "\\<begin\\>"))
731 (backward-word -1)))
732 (if (eq (preceding-char) ?\;)
733 (backward-char 1))
734 )
735 (while (and (natnump (setq count (1- count)))
736 (setq status (simula-search-backward
737 ";\\|\\<begin\\>" nil 'move))))
738 (if status
739 (progn
740 (if (eq (following-char) ?\;)
741 (forward-char 1)
742 (backward-word -1))))
743 (simula-skip-comment-forward))
744 (error (progn (goto-char origin)
745 (error "Incomplete statement (too many ENDs)")))
746 (quit (progn (goto-char origin) (signal 'quit nil)))))))
747
748
749 (defun simula-next-statement (count)
750 "Move forward COUNT statements.
751 If COUNT is negative, move backward instead."
752 (interactive "p")
753 (if (< count 0)
754 (simula-previous-statement (- count))
755 (let (status
756 (case-fold-search t)
757 (origin (point)))
758 (condition-case ()
759 (progn
760 (simula-skip-comment-forward)
761 (if (looking-at "\\<end\\>") (forward-word 1))
762 (while (and (natnump (setq count (1- count)))
763 (setq status (simula-search-forward
764 ";\\|\\<end\\>" (point-max) 'move))))
765 (if (and status (/= (preceding-char) ?\;))
766 (progn
767 (backward-word 1)
768 (simula-skip-comment-backward))))
769 (error (progn (goto-char origin)
770 (error "Incomplete statement (too few ENDs)")))
771 (quit (progn (goto-char origin) (signal 'quit nil)))))))
772
773
774 (defun simula-skip-comment-backward (&optional stop-at-end)
775 "Search towards bob to find first char that is outside a comment."
776 (interactive)
777 (catch 'simula-out
778 (let (context)
779 (while t
780 (skip-chars-backward " \t\n\f")
781 (if (eq (preceding-char) ?\;)
782 (save-excursion
783 (backward-char 1)
784 (setq context (simula-context))
785 (if (and stop-at-end (eq context 2))
786 (setq context nil)))
787 (setq context (simula-context)))
788 (cond
789 ((memq context '(nil 3 4))
790 ;; check to see if we found a label
791 (if (and (eq (preceding-char) ?:)
792 (not (memq (following-char) '(?- ?=)))
793 (save-excursion
794 (skip-chars-backward ": \t\fa-zA-Z0-9_")
795 (not (looking-at "virtual\\>"))))
796 (skip-chars-backward ": \t\fa-zA-Z0-9_")
797 (throw 'simula-out nil)))
798 ((eq context 0)
799 ;; since we are inside a comment, it must start somewhere!
800 (while (and (re-search-backward "!\\|\\<comment\\>")
801 (memq (simula-context) '(0 1)))))
802 ((eq context 1)
803 (beginning-of-line)
804 (if (bobp)
805 (throw 'simula-out nil)
806 (backward-char)))
807 ((eq context 2)
808 ;; an END-comment must belong to an END
809 (re-search-backward "\\<end\\>")
810 (forward-word 1)
811 (throw 'simula-out nil))
812 ;; should be impossible to get here..
813 )))))
814
815
816 (defun simula-skip-comment-forward ()
817 "Search towards eob to find first char that is outside a comment."
818 ;; this function assumes we start with point .outside a comment
819 (interactive)
820 (catch 'simula-out
821 (while t
822 (skip-chars-forward " \t\n\f")
823 ;; BUG: the following (0 2) branches don't take into account intermixing
824 ;; directive lines
825 (cond
826 ((looking-at "!\\|\\<comment\\>")
827 (search-forward ";" nil 'move))
828 ((and (bolp) (eq (following-char) ?%))
829 (beginning-of-line 2))
830 ((and (looking-at "[a-z0-9_]*[ \t\f]*:[^-=]")
831 (not (looking-at "virtual\\>")))
832 (skip-chars-forward "a-zA-Z0-9_ \t\f:"))
833 (t
834 (throw 'simula-out t))))))
835
836
837 (defun simula-forward-up-level ()
838 (let ((continue-loop t)
839 (origin (point))
840 (case-fold-search t)
841 return-value
842 temp)
843 (while continue-loop
844 (if (re-search-backward "\\<begin\\>\\|\\<end\\>" (point-min) 'move)
845 (setq temp (simula-context)
846 return-value (and (memq (preceding-char) '(?d ?D))
847 (memq temp '(nil 2)))
848 continue-loop (and (not return-value)
849 (simula-forward-up-level)))
850 (setq continue-loop nil)))
851 (if return-value
852 t
853 (goto-char origin)
854 nil)))
855
856
857 (defun simula-calculate-indent ()
858 (save-excursion
859 (let ((where (simula-context))
860 (origin (point))
861 (indent 0)
862 continued
863 start-line
864 temp
865 found-end
866 prev-cont)
867 (cond
868 ((eq where 0)
869 ;;
870 ;; Comment.
871 ;; If comment started on previous non-blank line, indent to the
872 ;; column where the comment started, else indent as that line.
873 ;;
874 (skip-chars-backward " \t\n\f")
875 (while (and (not (bolp)) (eq (simula-context) 0))
876 (re-search-backward "^\\|!\\|\\<comment\\>"))
877 (skip-chars-forward " \t\n\f")
878 (prog1
879 (current-column)
880 (goto-char origin)))
881 ((eq where 1)
882 ;;
883 ;; Directive. Always 0.
884 ;;
885 0)
886 ;;
887 ;; Detect missing string delimiters
888 ;;
889 ((eq where 3)
890 (error "Inside string"))
891 ((eq where 4)
892 (error "Inside character constant"))
893 ;;
894 ;; check to see if inside ()'s
895 ;;
896 ((setq temp (simula-inside-parens))
897 temp)
898 ;;
899 ;; Calculate non-comment indentation
900 (t
901 ;; first, find out if this line starts with something that needs
902 ;; special indentation (END/IF/THEN/ELSE/WHEN/OTHERWISE or label)
903 ;;
904 (skip-chars-forward " \t\f")
905 (cond
906 ;;
907 ;; END
908 ;;
909 ((looking-at "end\\>")
910 (setq indent (- simula-indent-level)
911 found-end t))
912 ;;
913 ;; IF/THEN/ELSE
914 ;;
915 ((looking-at "if\\>\\|then\\>\\|else\\>")
916 ;; search for the *starting* IF
917 (cond
918 ((memq (following-char) '(?T ?t))
919 (setq indent (car simula-if-indent)))
920 ((memq (following-char) '(?E ?e))
921 (setq indent (cdr simula-if-indent)))
922 (t
923 (forward-word 1)
924 (setq indent 0)))
925 (simula-find-if))
926 ;;
927 ;; WHEN/OTHERWISE
928 ;;
929 ((looking-at "when\\>\\|otherwise\\>")
930 ;; search for corresponding INSPECT
931 (if (memq (following-char) '(?W ?w))
932 (setq indent (car simula-inspect-indent))
933 (setq indent (cdr simula-inspect-indent)))
934 (simula-find-inspect))
935 ;;
936 ;; label:
937 ;;
938 ((and (not (looking-at "virtual\\>"))
939 (looking-at "[a-z0-9_]*[ \t\f]*:[^-=]"))
940 (setq indent simula-label-offset)))
941 ;; find line with non-comment text
942 (simula-skip-comment-backward 'dont-skip-end)
943 (if (and found-end
944 (not (eq (preceding-char) ?\;))
945 (if (memq (preceding-char) '(?N ?n))
946 (save-excursion
947 (backward-word 1)
948 (not (looking-at "begin\\>")))
949 t))
950 (progn
951 (simula-previous-statement 1)
952 (simula-skip-comment-backward)))
953 (setq start-line
954 (line-beginning-position)
955 ;; - perhaps this is a continued statement
956 continued
957 (save-excursion
958 (and (not (bobp))
959 ;; (not found-end)
960 (if (eq (char-syntax (preceding-char)) ?w)
961 (progn
962 (backward-word 1)
963 (not (looking-at
964 "begin\\|then\\|else\\|when\\|otherwise\\|do"
965 )))
966 (not (memq (preceding-char) '(?: ?\;)))))))
967 ;;
968 ;; MAIN calculation loop - count BEGIN/DO etc.
969 ;;
970 (while (not (bolp))
971 (if (re-search-backward
972 ";\\|\\<\\(begin\\|end\\|if\\|else\\|then\\|when\\|otherwise\\|do\\)\\>"
973 start-line 'move)
974 (if (simula-context)
975 ();; found something in a comment/string - ignore
976 (setq temp (following-char))
977 (cond
978 ((eq temp ?\;)
979 (simula-previous-statement 1))
980 ((looking-at "begin\\>")
981 (setq indent (+ indent simula-indent-level)))
982 ((looking-at "end\\>")
983 (forward-word 1)
984 (simula-previous-statement 1))
985 ((looking-at "do\\>")
986 (setq indent (+ indent simula-substatement-offset))
987 (simula-find-do-match))
988 ((looking-at "\\(if\\|then\\|else\\)\\>")
989 (if (memq temp '(?I ?i))
990 (forward-word 1)
991 (setq indent (+ indent
992 simula-substatement-offset
993 (if (memq temp '(?T ?t))
994 (car simula-if-indent)
995 (cdr simula-if-indent)))))
996 (simula-find-if))
997 ((looking-at "\\<when\\>\\|\\<otherwise\\>")
998 (setq indent (+ indent
999 simula-substatement-offset
1000 (if (memq temp '(?W ?w))
1001 (car simula-if-indent)
1002 (cdr simula-if-indent))))
1003 (simula-find-inspect)))
1004 ;; found the start of a [sub]statement
1005 ;; add indentation for continued statement
1006 (if continued
1007 (setq indent
1008 (+ indent
1009 (if (listp simula-continued-statement-offset)
1010 (car simula-continued-statement-offset)
1011 simula-continued-statement-offset))))
1012 (setq start-line
1013 (line-beginning-position)
1014 continued nil))
1015 ;; search failed .. point is at beginning of line
1016 ;; determine if we should continue searching
1017 ;; (at or before comment or label)
1018 ;; temp = t means finished
1019 (setq temp
1020 (and (not (simula-context))
1021 (save-excursion
1022 (skip-chars-forward " \t\f")
1023 (or (looking-at "virtual")
1024 (not
1025 (looking-at
1026 "!\\|comment\\>\\|[a-z0-9_]*[ \t\f]*:[^-=]")))))
1027 prev-cont continued)
1028 ;; if we are finished, find current line's indentation
1029 (if temp
1030 (setq indent (+ indent (current-indentation))))
1031 ;; find next line with non-comment SIMULA text
1032 ;; maybe indent extra if statement continues
1033 (simula-skip-comment-backward)
1034 (setq continued
1035 (and (not (bobp))
1036 (if (eq (char-syntax (preceding-char)) ?w)
1037 (save-excursion
1038 (backward-word 1)
1039 (not (looking-at
1040 "begin\\|then\\|else\\|when\\|otherwise\\|do")))
1041 (not (memq (preceding-char) '(?: ?\;))))))
1042 ;; if we the state of the continued-variable
1043 ;; changed, add indentation for continued statement
1044 (if (or (and prev-cont (not continued))
1045 (and continued
1046 (listp simula-continued-statement-offset)))
1047 (setq indent
1048 (+ indent
1049 (if (listp simula-continued-statement-offset)
1050 (car simula-continued-statement-offset)
1051 simula-continued-statement-offset))))
1052 ;; while ends if point is at beginning of line at loop test
1053 (if (not temp)
1054 (setq start-line (line-beginning-position))
1055 (beginning-of-line))))
1056 ;;
1057 ;; return indentation
1058 ;;
1059 indent)))))
1060
1061
1062 (defun simula-find-if ()
1063 "Find starting IF of a IF-THEN[-ELSE[-IF-THEN...]] statement."
1064 (catch 'simula-out
1065 (while t
1066 (if (and (simula-search-backward "\\<if\\>\\|;\\|\\<begin\\>"nil t)
1067 (memq (following-char) '(?I ?i)))
1068 (save-excursion
1069 ;;
1070 ;; find out if this IF was really the start of the IF statement
1071 ;;
1072 (simula-skip-comment-backward)
1073 (if (and (eq (char-syntax (preceding-char)) ?w)
1074 (progn
1075 (backward-word 1)
1076 (looking-at "else\\>")))
1077 ()
1078 (throw 'simula-out t)))
1079 (if (not (looking-at "\\<if\\>"))
1080 (error "Missing IF or misplaced BEGIN or ';' (can't find IF)")
1081 ;;
1082 ;; we were at the starting IF in the first place..
1083 ;;
1084 (throw 'simula-out t))))))
1085
1086
1087 (defun simula-find-inspect ()
1088 "Find INSPECT matching WHEN or OTHERWISE."
1089 (catch 'simula-out
1090 (let ((level 0))
1091 ;;
1092 ;; INSPECTs can be nested, have to find the corresponding one
1093 ;;
1094 (while t
1095 (if (and (simula-search-backward "\\<inspect\\>\\|\\<otherwise\\>\\|;"
1096 nil t)
1097 (/= (following-char) ?\;))
1098 (if (memq (following-char) '(?O ?o))
1099 (setq level (1+ level))
1100 (if (zerop level)
1101 (throw 'simula-out t)
1102 (setq level (1- level))))
1103 (error "Missing INSPECT or misplaced ';' (can't find INSPECT)"))))))
1104
1105
1106 (defun simula-find-do-match ()
1107 "Find keyword matching DO: FOR, WHILE, INSPECT or WHEN."
1108 (while (and (re-search-backward
1109 "\\<\\(do\\|for\\|while\\|inspect\\|when\\|end\\|begin\\)\\>\\|;"
1110 nil 'move)
1111 (simula-context)))
1112 (if (and (looking-at "\\<\\(for\\|while\\|inspect\\|when\\)\\>")
1113 (not (simula-context)))
1114 () ;; found match
1115 (error "No matching FOR, WHILE or INSPECT for DO, or misplaced ';'")))
1116
1117
1118 (defun simula-inside-parens ()
1119 "Return position after `(' on line if inside parentheses, nil otherwise."
1120 (save-excursion
1121 (let ((parlevel 0))
1122 (catch 'simula-out
1123 (while t
1124 (if (re-search-backward "(\\|)\\|;" nil t)
1125 (if (eq (simula-context) nil)
1126 ;; found something - check it out
1127 (cond
1128 ((eq (following-char) ?\;)
1129 (if (zerop parlevel)
1130 (throw 'simula-out nil)
1131 (error "Parenthesis mismatch or misplaced ';'")))
1132 ((eq (following-char) ?\()
1133 (if (zerop parlevel)
1134 (throw 'simula-out (1+ (current-column)))
1135 (setq parlevel (1- parlevel))))
1136 (t (setq parlevel (1+ parlevel))))
1137 );; nothing - inside comment or string
1138 ;; search failed
1139 (throw 'simula-out nil)))))))
1140
1141
1142 (defun simula-goto-definition ()
1143 "Goto point of definition of variable, procedure or class."
1144 (interactive))
1145
1146
1147 (defun simula-expand-stdproc ()
1148 (if (or (not simula-abbrev-stdproc) (simula-context))
1149 (unexpand-abbrev)
1150 (cond
1151 ((eq simula-abbrev-stdproc 'upcase) (upcase-word -1))
1152 ((eq simula-abbrev-stdproc 'downcase) (downcase-word -1))
1153 ((eq simula-abbrev-stdproc 'capitalize) (capitalize-word -1))
1154 ((eq simula-abbrev-stdproc 'abbrev-table)
1155 ;; If not in lowercase, expansions are always capitalized.
1156 ;; We then want to replace with the exact expansion.
1157 (if (equal (symbol-name last-abbrev) last-abbrev-text)
1158 ()
1159 (downcase-word -1)
1160 (expand-abbrev))))))
1161
1162
1163 (defun simula-expand-keyword ()
1164 (if (or (not simula-abbrev-keyword) (simula-context))
1165 (unexpand-abbrev)
1166 (cond
1167 ((eq simula-abbrev-keyword 'upcase) (upcase-word -1))
1168 ((eq simula-abbrev-keyword 'downcase) (downcase-word -1))
1169 ((eq simula-abbrev-keyword 'capitalize) (capitalize-word -1))
1170 ((eq simula-abbrev-stdproc 'abbrev-table)
1171 (if (equal (symbol-name last-abbrev) last-abbrev-text)
1172 ()
1173 (downcase-word -1)
1174 (expand-abbrev))))))
1175
1176
1177 (defun simula-electric-keyword ()
1178 "Expand SIMULA keyword. If it starts the line, reindent."
1179 ;; redisplay
1180 (let ((show-char (eq this-command 'self-insert-command)))
1181 ;; If the abbrev expansion results in reindentation, the user may have
1182 ;; to wait some time before the character he typed is displayed
1183 ;; (the char causing the expansion is inserted AFTER the hook function
1184 ;; is called). This is annoying in case of normal characters.
1185 ;; However, if the user pressed a key bound to newline, it is better
1186 ;; to have the line inserted after the begin-end match.
1187 (if show-char
1188 (progn
1189 (insert-char last-command-event 1)
1190 (sit-for 0)
1191 (backward-char 1)))
1192 (if (let ((where (simula-context))
1193 (case-fold-search t))
1194 (if where
1195 (if (and (eq where 2) (eq (char-syntax (preceding-char)) ?w))
1196 (save-excursion
1197 (backward-word 1)
1198 (not (looking-at "end\\>"))))))
1199 (unexpand-abbrev)
1200 (cond
1201 ((not simula-abbrev-keyword) (unexpand-abbrev))
1202 ((eq simula-abbrev-keyword 'upcase) (upcase-word -1))
1203 ((eq simula-abbrev-keyword 'downcase) (downcase-word -1))
1204 ((eq simula-abbrev-keyword 'capitalize) (capitalize-word -1)))
1205 (let ((pos (- (point-max) (point)))
1206 (case-fold-search t)
1207 null)
1208 (condition-case null
1209 (progn
1210 ;; check if the expanded word is on the beginning of the line.
1211 (if (and (eq (char-syntax (preceding-char)) ?w)
1212 (progn
1213 (backward-word 1)
1214 (if (looking-at "end\\>")
1215 (save-excursion
1216 (simula-backward-up-level 1)
1217 (if (pos-visible-in-window-p)
1218 (sit-for 1)
1219 (message "Matches %s"
1220 (buffer-substring
1221 (point)
1222 (+ (point) (window-width)))))))
1223 (skip-chars-backward " \t\f")
1224 (bolp)))
1225 (let ((indent (simula-calculate-indent)))
1226 (if (eq indent (current-indentation))
1227 ()
1228 (delete-horizontal-space)
1229 (indent-to indent)))
1230 (skip-chars-forward " \t\f"))
1231 ;; check for END - blow whistles and ring bells
1232
1233 (goto-char (- (point-max) pos))
1234 (if show-char
1235 (delete-char 1)))
1236 (quit (goto-char (- (point-max) pos))))))))
1237
1238
1239 (defun simula-search-backward (regexp &optional bound noerror)
1240 "Search backward from point for regular expression REGEXP,
1241 ignoring matches found inside SIMULA comments, string literals,
1242 and BEGIN..END blocks.
1243 Set point to the end of the occurrence found, and return point.
1244 An optional second argument BOUND bounds the search, it is a buffer position.
1245 The match found must not extend after that position. Optional third argument
1246 NOERROR, if t, means if fail just return nil (no error).
1247 If not nil and not t, move to limit of search and return nil."
1248 (let (begin end context (comb-regexp (concat regexp "\\|\\<end\\>"))
1249 match (start-point (point)))
1250 (catch 'simula-backward
1251 (while (re-search-backward comb-regexp bound 1)
1252 ;; We have a match, check SIMULA context at match-beginning
1253 ;; to see if we are outside comments etc.
1254 ;; Set MATCH to t if we found a true match,
1255 ;; set MATCH to 'BLOCK if we found a BEGIN..END block,
1256 ;; else set MATCH to nil.
1257 (save-match-data
1258 (setq context (simula-context))
1259 (cond
1260 ((eq context nil)
1261 (setq match (if (looking-at regexp) t 'BLOCK)))
1262 ;; A comment-ending `;' is part of the comment, and shouldn't match.
1263 ;; ((eq context 0)
1264 ;; (setq match (if (eq (following-char) ?\;) t nil)))
1265 ((eq context 2)
1266 (setq match (if (and (looking-at regexp)
1267 (looking-at ";\\|\\<end\\>\\|\\<else\\>\\|\\<otherwise\\>\\|\\<when\\>"))
1268 t
1269 (if (looking-at "\\<end\\>") 'BLOCK nil))))
1270 (t (setq match nil))))
1271 ;; Exit if true match
1272 (if (eq match t) (throw 'simula-backward (point)))
1273 (if (eq match 'BLOCK)
1274 ;; We found the END of a block
1275 (let ((level 0))
1276 (while (natnump level)
1277 (if (re-search-backward "\\<begin\\>\\|\\<end\\>" bound 1)
1278 (let ((context (simula-context)))
1279 ;; We found a BEGIN -> decrease level count
1280 (cond ((and (eq context nil)
1281 (memq (following-char) '(?b ?B)))
1282 (setq level (1- level)))
1283 ;; END -> increase level count
1284 ((and (memq context '(nil 2))
1285 (memq (following-char) '(?e ?E)))
1286 (setq level (1+ level)))))
1287 ;; Block search failed. Action depends on noerror.
1288 (if (or (not noerror) (eq noerror t))
1289 (goto-char start-point))
1290 (if (not noerror)
1291 (signal 'search-failed (list regexp)))
1292 (throw 'simula-backward nil))))))
1293 ;; Search failed. Action depends on noerror.
1294 (if (or (not noerror) (eq noerror t))
1295 (goto-char start-point))
1296 (if noerror
1297 nil
1298 (signal 'search-failed (list regexp))))))
1299
1300
1301 (defun simula-search-forward (regexp &optional bound noerror)
1302 "Search forward from point for regular expression REGEXP,
1303 ignoring matches found inside SIMULA comments, string literals,
1304 and BEGIN..END blocks.
1305 Set point to the end of the occurrence found, and return point.
1306 An optional second argument BOUND bounds the search, it is a buffer position.
1307 The match found must not extend after that position. Optional third argument
1308 NOERROR, if t, means if fail just return nil (no error).
1309 If not nil and not t, move to limit of search and return nil."
1310 (let (begin end context (comb-regexp (concat regexp "\\|\\<begin\\>"))
1311 match (start-point (point)))
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