Commit 8ca3cd44 authored by Richard M. Stallman's avatar Richard M. Stallman

(simula-tab-always-indent, simula-indent-level)

(simula-substatement-offset, simula-continued-statement-offset)
(simula-label-offset, simula-if-indent, simula-inspect-indent)
(simula-electric-indent, simula-abbrev-keyword, simula-abbrev-stdproc):
Added default constants.
(simula-emacs-features): new constant to hold information
on which flavor if emacs is running (from cc-mode.el).
(simula-mode-menu): Menu definition for Lucid Emacs
(simula-mode-map): Bound new command simula-indent-exp to C-M-q
and added lots of commands to [menu-bar].
(simula-popup-menu): New function for Lucid menus.
(simula-keep-region-active): New function for Lucid menus.
(simula-indent-exp): New command that indents a whole expression.
(simula-indent-line): New strategies for finding the right amount to indent.
(simula-skip-comment-backward): Added optional parameter stop-at-end
to stop at the first END statement.
(simula-expand-stdproc): Added abbrev expansion to verbatim copy
of abbrev table, same for function simula-expand-keyword.
(simula-search-backward): Added Doc string, and lots of error checking.
(simula-search-forward): Added Doc string, and lots of error checking.
Added hilit19 config code.
(simula-version): New variable and function to report value.
(simula-submit-bug-report): New function to submit bug report.
parent c80718cc
;;; simula.el --- SIMULA 87 code editing commands for Emacs
;; Copyright (C) 1992 Free Software Foundation, Inc.
;; Copyright (C) 1994 Hans Henrik Eriksen
;; Copyright (C) 1992, 1994 Free Software Foundation, Inc.
;; Author: Hans Henrik Eriksen <hhe@ifi.uio.no>
;; Maintainer: simula-mode@ifi.uio.no
;; Version: 0.992
;; Version: 0.994
;; Adapted-By: ESR
;; Keywords: languages
......@@ -37,50 +38,92 @@
;;; Code:
(provide 'simula-mode)
(defconst simula-tab-always-indent-default nil
"Non-nil means TAB in SIMULA mode should always reindent the current line.
Otherwise TAB indents only when point is within
the run of whitespace at the beginning of the line.")
(defconst simula-tab-always-indent nil
(defvar simula-tab-always-indent simula-tab-always-indent-default
"*Non-nil means TAB in SIMULA mode should always reindent the current line.
Otherwise TAB indents only when point is within
the run of whitespace at the beginning of the line.")
(defconst simula-indent-level 3
(defconst simula-indent-level-default 3
"Indentation of SIMULA statements with respect to containing block.")
(defvar simula-indent-level simula-indent-level-default
"*Indentation of SIMULA statements with respect to containing block.")
(defconst simula-substatement-offset 3
(defconst simula-substatement-offset-default 3
"Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE.")
(defvar simula-substatement-offset simula-substatement-offset-default
"*Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE.")
(defconst simula-continued-statement-offset 3
(defconst simula-continued-statement-offset-default 3
"Extra indentation for lines not starting a statement or substatement.
If value is a list, each line in a multipleline continued statement
will have the car of the list extra indentation with respect to
the previous line of the statement.")
(defvar simula-continued-statement-offset simula-continued-statement-offset-default
"*Extra indentation for lines not starting a statement or substatement.
If value is a list, each line in a multipleline continued statement
will have the car of the list extra indentation with respect to
the previous line of the statement.")
(defconst simula-label-offset -4711
(defconst simula-label-offset-default -4711
"Offset of SIMULA label lines relative to usual indentation.")
(defvar simula-label-offset simula-label-offset-default
"*Offset of SIMULA label lines relative to usual indentation.")
(defconst simula-if-indent '(0 . 0)
(defconst simula-if-indent-default '(0 . 0)
"Extra indentation of THEN and ELSE with respect to the starting IF.
Value is a cons cell, the car is extra THEN indentation and the cdr
extra ELSE indentation. IF after ELSE is indented as the starting IF.")
(defvar simula-if-indent simula-if-indent-default
"*Extra indentation of THEN and ELSE with respect to the starting IF.
Value is a cons cell, the car is extra THEN indentation and the cdr
extra ELSE indentation. IF after ELSE is indented as the starting IF.")
(defconst simula-inspect-indent '(0 . 0)
(defconst simula-inspect-indent-default '(0 . 0)
"Extra indentation of WHEN and OTHERWISE with respect to the INSPECT.
Value is a cons cell, the car is extra WHEN indentation
and the cdr extra OTHERWISE indentation.")
(defvar simula-inspect-indent simula-inspect-indent-default
"*Extra indentation of WHEN and OTHERWISE with respect to the INSPECT.
Value is a cons cell, the car is extra WHEN indentation
and the cdr extra OTHERWISE indentation.")
(defconst simula-electric-indent nil
(defconst simula-electric-indent-default nil
"Non-nil means `simula-indent-line' function may reindent previous line.")
(defvar simula-electric-indent simula-electric-indent-default
"*Non-nil means `simula-indent-line' function may reindent previous line.")
(defconst simula-abbrev-keyword 'upcase
(defconst simula-abbrev-keyword-default 'upcase
"Specify how to convert case for SIMULA keywords.
Value is one of the symbols `upcase', `downcase', `capitalize',
(as in) `abbrev-table' or nil if they should not be changed.")
(defvar simula-abbrev-keyword simula-abbrev-keyword-default
"*Specify how to convert case for SIMULA keywords.
Value is one of the symbols `upcase', `downcase', `capitalize',
\(as in) `abbrev-table' or nil if they should not be changed.")
(as in) `abbrev-table' or nil if they should not be changed.")
(defconst simula-abbrev-stdproc-default 'abbrev-table
"Specify how to convert case for standard SIMULA procedure and class names.
Value is one of the symbols `upcase', `downcase', `capitalize',
(as in) `abbrev-table', or nil if they should not be changed.")
(defconst simula-abbrev-stdproc 'abbrev-table
(defvar simula-abbrev-stdproc simula-abbrev-stdproc-default
"*Specify how to convert case for standard SIMULA procedure and class names.
Value is one of the symbols `upcase', `downcase', `capitalize',
\(as in) `abbrev-table', or nil if they should not be changed.")
(as in) `abbrev-table', or nil if they should not be changed.")
(defvar simula-abbrev-file nil
"*File with extra abbrev definitions for use in SIMULA mode.
......@@ -91,6 +134,55 @@ for SIMULA mode to function correctly.")
(defvar simula-mode-syntax-table nil
"Syntax table in SIMULA mode buffers.")
; The following function is taken from cc-mode.el,
; it determines the flavor of the Emacs running
(defconst simula-emacs-features
(let ((major (and (boundp 'emacs-major-version)
emacs-major-version))
(minor (and (boundp 'emacs-minor-version)
emacs-minor-version))
flavor comments)
;; figure out version numbers if not already discovered
(and (or (not major) (not minor))
(string-match "\\([0-9]+\\).\\([0-9]+\\)" emacs-version)
(setq major (string-to-int (substring emacs-version
(match-beginning 1)
(match-end 1)))
minor (string-to-int (substring emacs-version
(match-beginning 2)
(match-end 2)))))
(if (not (and major minor))
(error "Cannot figure out the major and minor version numbers."))
;; calculate the major version
(cond
((= major 18) (setq major 'v18)) ;Emacs 18
((= major 4) (setq major 'v18)) ;Epoch 4
((= major 19) (setq major 'v19 ;Emacs 19
flavor (if (string-match "Lucid" emacs-version)
'Lucid 'FSF)))
;; I don't know
(t (error "Cannot recognize major version number: %s" major)))
(list major flavor comments))
"A list of features extant in the Emacs you are using.
There are many flavors of Emacs out there, each with different
features supporting those needed by simula-mode. Here's the current
supported list, along with the values for this variable:
Emacs 19: (v19 FSF 1-bit)
Vanilla Emacs 18/Epoch 4: (v18 no-dual-comments)
Emacs 18/Epoch 4 (patch2): (v18 8-bit)
Lucid Emacs 19: (v19 Lucid 8-bit).")
(defvar simula-mode-menu
'(["Report Bug" simula-submit-bug-report t]
["Indent Line" simula-indent-line t]
["Backward Statement" simula-previous-statement t]
["Forward Statement" simula-next-statement t]
["Backward Up Level" simula-backward-up-level t]
["Forward Down Statement" simula-forward-down-level t]
)
"Lucid Emacs menu for SIMULA mode.")
(if simula-mode-syntax-table
()
(setq simula-mode-syntax-table (copy-syntax-table (standard-syntax-table)))
......@@ -123,7 +215,65 @@ for SIMULA mode to function correctly.")
;(define-key simula-mode-map "\C-c\C-h" 'simula-standard-help)
(define-key simula-mode-map "\177" 'backward-delete-char-untabify)
(define-key simula-mode-map ":" 'simula-electric-label)
(define-key simula-mode-map "\t" 'simula-indent-command))
(define-key simula-mode-map "\e\C-q" 'simula-indent-exp)
(define-key simula-mode-map "\t" 'simula-indent-command)
;; Emacs 19 defines menus in the mode map
(if (memq 'FSF simula-emacs-features)
(progn
(define-key simula-mode-map [menu-bar] (make-sparse-keymap))
(define-key simula-mode-map [menu-bar simula]
(cons "SIMULA" (make-sparse-keymap "SIMULA")))
(define-key simula-mode-map [menu-bar simula bug-report]
'("Submit Bug Report" . simula-submit-bug-report))
(define-key simula-mode-map [menu-bar simula separator-indent]
'("--"))
(define-key simula-mode-map [menu-bar simula indent-exp]
'("Indent Expression" . simula-indent-exp))
(define-key simula-mode-map [menu-bar simula indent-line]
'("Indent Line" . simula-indent-command))
(define-key simula-mode-map [menu-bar simula separator-navigate]
'("--"))
(define-key simula-mode-map [menu-bar simula backward-stmt]
'("Previous Statement" . simula-previous-statement))
(define-key simula-mode-map [menu-bar simula forward-stmt]
'("Next Statement" . simula-next-statement))
(define-key simula-mode-map [menu-bar simula backward-up]
'("Backward Up Level" . simula-backward-up-level))
(define-key simula-mode-map [menu-bar simula forward-down]
'("Forward Down Statement" . simula-forward-down-level))
(put 'simula-next-statement 'menu-enable '(not (eobp)))
(put 'simula-previous-statement 'menu-enable '(not (bobp)))
(put 'simula-forward-down-level 'menu-enable '(not (eobp)))
(put 'simula-backward-up-level 'menu-enable '(not (bobp)))
(put 'simula-indent-command 'menu-enable '(not buffer-read-only))
(put 'simula-indent-exp 'menu-enable '(not buffer-read-only))))
;; RMS: mouse-3 should not select this menu. mouse-3's global
;; definition is useful in SIMULA mode and we should not interfere
;; with that. The menu is mainly for beginners, and for them,
;; the menubar requires less memory than a special click.
;; in Lucid Emacs, we want the menu to popup when the 3rd button is
;; hit. In 19.10 and beyond this is done automatically if we put
;; the menu on mode-popup-menu variable, see c-common-init [cc-mode.el]
(if (memq 'Lucid simula-emacs-features)
(if (not (boundp 'mode-popup-menu))
(define-key simula-mode-map 'button3 'simula-popup-menu))))
;; menus for Lucid
(defun simula-popup-menu (e)
"Pops up the SIMULA menu."
(interactive "@e")
(popup-menu (cons (concat mode-name " Mode Commands") simula-mode-menu))
(simula-keep-region-active))
;; active regions, and auto-newline/hungry delete key
(defun simula-keep-region-active ()
;; do whatever is necessary to keep the region active in
;; Lucid. ignore byte-compiler warnings you might see
(and (boundp 'zmacs-region-stays)
(setq zmacs-region-stays t)))
(defvar simula-mode-abbrev-table nil
"Abbrev table in SIMULA mode buffers")
......@@ -180,8 +330,8 @@ at all."
(setq mode-name "SIMULA")
(make-local-variable 'comment-column)
(setq comment-column 40)
(make-local-variable 'end-comment-column)
(setq end-comment-column 75)
; (make-local-variable 'end-comment-column)
; (setq end-comment-column 75)
(set-syntax-table simula-mode-syntax-table)
(make-local-variable 'paragraph-start)
(setq paragraph-start "[ \t]*$\\|\\f")
......@@ -213,6 +363,27 @@ at all."
(run-hooks 'simula-mode-hook))
(defun simula-indent-exp ()
"Indent SIMULA expression following point."
(interactive)
(let ((here (point))
(simula-electric-indent nil)
end)
(simula-skip-comment-forward)
(if (eobp)
(goto-char here)
(unwind-protect
(progn
(simula-next-statement 1)
(setq end (point-marker))
(simula-previous-statement 1)
(beginning-of-line)
(while (< (point) end)
(if (not (looking-at "[ \t]*$"))
(simula-indent-line))
(forward-line 1)))
(and end (set-marker end nil))))))
(defun simula-indent-line ()
"Indent this line as SIMULA code.
......@@ -221,27 +392,26 @@ If `simula-electric-indent' is non-nil, indent previous line if necessary."
(indent (simula-calculate-indent))
(case-fold-search t))
(unwind-protect
(progn
;;
;; manually expand abbrev on last line, if any
;;
(end-of-line 0)
(expand-abbrev)
;; now maybe we should reindent that line
(if simula-electric-indent
(progn
(beginning-of-line)
(skip-chars-forward " \t\f")
(if (and
(looking-at
"\\(end\\|if\\|then\\|else\\|when\\|otherwise\\)\\>")
(not (simula-context)))
;; yes - reindent
(let ((post-indent (simula-calculate-indent)))
(if (eq (current-indentation) post-indent)
()
(delete-horizontal-space)
(indent-to post-indent)))))))
(if simula-electric-indent
(progn
;;
;; manually expand abbrev on last line, if any
;;
(end-of-line 0)
(expand-abbrev)
;; now maybe we should reindent that line
(beginning-of-line)
(skip-chars-forward " \t\f")
(if (and
(looking-at
"\\(end\\|if\\|then\\|else\\|when\\|otherwise\\)\\>")
(not (simula-context)))
;; yes - reindent
(let ((post-indent (simula-calculate-indent)))
(if (eq (current-indentation) post-indent)
()
(delete-horizontal-space)
(indent-to post-indent))))))
(goto-char (- (point-max) origin))
(if (eq (current-indentation) indent)
(back-to-indentation)
......@@ -364,14 +534,22 @@ The relative indentation among the lines of the statement are preserved."
(cond
((memq (preceding-char) '(?d ?D))
(setq return-value 2)
(while (and (memq (preceding-char) '(?d ?D)) (not return-value))
(while (and (re-search-forward
";\\|\\<end\\>\\|\\<else\\>\\|\\<otherwise\\>\\|\\<when\\>\\|^%"
origin 'move)
(eq (preceding-char) ?%))
(beginning-of-line 2)))
(if (looking-at "[ \t\n\f]*\\(;\\|\\<end\\>\\|\\<else\\>\\|\\<otherwise\\>\\|\\<when\\>\\)")
(setq return-value nil)))
(while (and (re-search-forward
";\\|\\<end\\>\\|\\<else\\>\\|\\<otherwise\\>\\|\\<when\\>\\|^%"
origin 'move)
;; found another END?
(or (memq (preceding-char) '(?d ?D))
;; if directive, skip line
(and (eq (preceding-char) ?%)
(beginning-of-line 2))
;; found other keyword, out of END comment
(setq return-value nil))))
(if (and (eq (char-syntax (preceding-char)) ?w)
(eq (char-syntax (following-char)) ?w))
(save-excursion
(backward-word 1)
(if (looking-at "end\\>\\|else\\>\\|otherwise\\>\\|when\\>")
(setq return-value nil)))))
((memq (preceding-char) '(?! ?t ?T))
; skip comment
(setq return-value 0)
......@@ -406,10 +584,11 @@ The relative indentation among the lines of the statement are preserved."
(let ((origin (- (point-max) (point)))
(case-fold-search t)
;; don't mix a label with an assignment operator := :-
;; therefore look at next typed character...
(next-char (setq unread-command-events (list (read-event))))
(com-char last-command-char))
;; therefore take a peek at next typed character...
(next-char (read-event)))
(unwind-protect
(setq unread-command-events (append unread-command-events
(list next-char)))
;; Problem: find out if character just read is a command char
;; that would insert something after ':' making it a label.
;; At least \n, \r (and maybe \t) falls into this category.
......@@ -516,6 +695,7 @@ If COUNT is negative, move forward instead."
(case-fold-search t)
(origin (point)))
(condition-case ()
;;
(progn
(simula-skip-comment-backward)
(if (memq (preceding-char) '(?n ?N))
......@@ -524,7 +704,8 @@ If COUNT is negative, move forward instead."
(if (not (looking-at "\\<begin\\>"))
(backward-word -1)))
(if (eq (preceding-char) ?\;)
(backward-char 1)))
(backward-char 1))
)
(while (and (natnump (setq count (1- count)))
(setq status (simula-search-backward
";\\|\\<begin\\>" nil 'move))))
......@@ -564,7 +745,7 @@ If COUNT is negative, move backward instead."
(quit (progn (goto-char origin) (signal 'quit nil)))))))
(defun simula-skip-comment-backward ()
(defun simula-skip-comment-backward (&optional stop-at-end)
"Search towards bob to find first char that is outside a comment."
(interactive)
(catch 'simula-out
......@@ -574,7 +755,9 @@ If COUNT is negative, move backward instead."
(if (eq (preceding-char) ?\;)
(save-excursion
(backward-char 1)
(setq context (simula-context)))
(setq context (simula-context))
(if (and stop-at-end (eq context 2))
(setq context nil)))
(setq context (simula-context)))
(cond
((memq context '(nil 3 4))
......@@ -591,9 +774,10 @@ If COUNT is negative, move backward instead."
(while (and (re-search-backward "!\\|\\<comment\\>")
(memq (simula-context) '(0 1)))))
((eq context 1)
(end-of-line 0)
(beginning-of-line)
(if (bobp)
(throw 'simula-out nil)))
(throw 'simula-out nil)
(backward-char)))
((eq context 2)
;; an END-comment must belong to an END
(re-search-backward "\\<end\\>")
......@@ -610,6 +794,8 @@ If COUNT is negative, move backward instead."
(catch 'simula-out
(while t
(skip-chars-forward " \t\n\f")
;; BUG: the following (0 2) branches don't take into account intermixing
;; directive lines
(cond
((looking-at "!\\|\\<comment\\>")
(search-forward ";" nil 'move))
......@@ -666,6 +852,11 @@ If COUNT is negative, move backward instead."
(prog1
(current-column)
(goto-char origin)))
((eq where 1)
;;
;; Directive. Always 0.
;;
0)
;;
;; Detect missing string delimiters
;;
......@@ -722,7 +913,7 @@ If COUNT is negative, move backward instead."
(looking-at "[a-z0-9_]*[ \t\f]*:[^-=]"))
(setq indent simula-label-offset)))
;; find line with non-comment text
(simula-skip-comment-backward)
(simula-skip-comment-backward 'dont-skip-end)
(if (and found-end
(not (eq (preceding-char) ?\;))
(if (memq (preceding-char) '(?N ?n))
......@@ -933,7 +1124,14 @@ If COUNT is negative, move backward instead."
(cond
((eq simula-abbrev-stdproc 'upcase) (upcase-word -1))
((eq simula-abbrev-stdproc 'downcase) (downcase-word -1))
((eq simula-abbrev-stdproc 'capitalize) (capitalize-word -1)))))
((eq simula-abbrev-stdproc 'capitalize) (capitalize-word -1))
((eq simula-abbrev-stdproc 'abbrev-table)
;; If not in lowercase, expansions are always capitalized.
;; We then want to replace with the exact expansion.
(if (equal (symbol-name last-abbrev) last-abbrev-text)
()
(downcase-word -1)
(expand-abbrev))))))
(defun simula-expand-keyword ()
......@@ -942,7 +1140,12 @@ If COUNT is negative, move backward instead."
(cond
((eq simula-abbrev-keyword 'upcase) (upcase-word -1))
((eq simula-abbrev-keyword 'downcase) (downcase-word -1))
((eq simula-abbrev-keyword 'capitalize) (capitalize-word -1)))))
((eq simula-abbrev-keyword 'capitalize) (capitalize-word -1))
((eq simula-abbrev-stdproc 'abbrev-table)
(if (equal (symbol-name last-abbrev) last-abbrev-text)
()
(downcase-word -1)
(expand-abbrev))))))
(defun simula-electric-keyword ()
......@@ -1007,48 +1210,125 @@ If COUNT is negative, move backward instead."
(quit (goto-char (- (point-max) pos))))))))
(defun simula-search-backward (string &optional limit move)
(setq string (concat string "\\|\\<end\\>"))
(let (level)
(catch 'simula-out
(while (re-search-backward string limit move)
(if (simula-context)
()
(if (looking-at "\\<end\\>")
(progn
(setq level 0)
(while (natnump level)
(re-search-backward "\\<begin\\>\\|\\<end\\>")
(if (simula-context)
()
(setq level (if (memq (following-char) '(?b ?B))
(1- level)
(1+ level))))))
(throw 'simula-out t)))))))
(defun simula-search-forward (string &optional limit move)
(setq string (concat string "\\|\\<begin\\>"))
(let (level)
(catch 'exit
(while (re-search-forward string limit move)
(goto-char (match-beginning 0))
(if (simula-context)
(goto-char (1- (match-end 0)))
(if (looking-at "\\<begin\\>")
(progn
(goto-char (1- (match-end 0)))
(setq level 0)
(while (natnump level)
(re-search-forward "\\<begin\\>\\|\\<end\\>")
(backward-word 1)
(if (not (simula-context))
(setq level (if (memq (following-char) '(?e ?E))
(1- level)
(1+ level))))
(backward-word -1)))
(goto-char (1- (match-end 0)))
(throw 'exit t)))))))
(defun simula-search-backward (regexp &optional bound noerror)
"Search backward from point for regular expression REGEXP, ignoring matches
found inside SIMULA comments, string literals, and BEGIN..END blocks.
Set point to the end of the occurrence found, and return point.
An optional second argument BOUND bounds the search, it is a buffer position.
The match found must not extend after that position. Optional third argument
NOERROR, if t, means if fail just return nil (no error).
If not nil and not t, move to limit of search and return nil."
(let (begin end context (comb-regexp (concat regexp "\\|\\<end\\>"))
match (start-point (point)))
(catch 'simula-backward
(while (re-search-backward comb-regexp bound 1)
;; We have a match, check SIMULA context at match-beginning
;; to see if we are outside comments etc.
;; Set MATCH to t if we found a true match,
;; set MATCH to 'BLOCK if we found a BEGIN..END block,
;; else set MATCH to nil.
(save-match-data
(setq context (simula-context))
(cond
((eq context nil)
(setq match (if (looking-at regexp) t 'BLOCK)))
;;; A comment-ending semicolon is part of the comment, and shouldn't match.
;;; ((eq context 0)
;;; (setq match (if (eq (following-char) ?\;) t nil)))
((eq context 2)
(setq match (if (and (looking-at regexp)
(looking-at ";\\|\\<end\\>\\|\\<else\\>\\|\\<otherwise\\>\\|\\<when\\>"))
t
(if (looking-at "\\<end\\>") 'BLOCK nil))))
(t (setq match nil))))
;; Exit if true match
(if (eq match t) (throw 'simula-backward (point)))
(if (eq match 'BLOCK)
;; We found the END of a block
(let ((level 0))
(while (natnump level)
(if (re-search-backward "\\<begin\\>\\|\\<end\\>" bound 1)
(let ((context (simula-context)))
;; We found a BEGIN -> decrease level count
(cond ((and (eq context nil)
(memq (following-char) '(?b ?B)))
(setq level (1- level)))
;; END -> increase level count
((and (memq context '(nil 2))
(memq (following-char) '(?e ?E)))
(setq level (1+ level)))))
;; Block search failed. Action depends on noerror.
(if (or (not noerror) (eq noerror t))
(goto-char start-point))
(if (not noerror)
(signal 'search-failed (list regexp)))
(throw 'simula-backward nil))))))
;; Search failed. Action depends on noerror.
(if (or (not noerror) (eq noerror t))
(goto-char start-point))
(if noerror
nil
(signal 'search-failed (list regexp))))))
(defun simula-search-forward (regexp &optional bound noerror)
"Search forward from point for regular expression REGEXP, ignoring matches
found inside SIMULA comments, string literals, and BEGIN..END blocks.
Set point to the end of the occurrence found, and return point.
An optional second argument BOUND bounds the search, it is a buffer position.
The match found must not extend after that position. Optional third argument
NOERROR, if t, means if fail just return nil (no error).
If not nil and not t, move to limit of search and return nil."
(let (begin end context (comb-regexp (concat regexp "\\|\\<begin\\>"))
match (start-point (point)))
(catch 'simula-forward
(while (re-search-forward comb-regexp bound 1)
;; We have a match, check SIMULA context at match-beginning
;; to see if we are outside comments.
;; Set MATCH to t if we found a true match,
;; set MATCH to 'BLOCK if we found a BEGIN..END block,
;; else set MATCH to nil.
(save-match-data
(save-excursion
(goto-char (match-beginning 0))
(setq context (simula-context))
(cond
((not context)
(setq match (if (looking-at regexp) t 'BLOCK)))
;;; A comment-ending semicolon is part of the comment, and shouldn't match.
;;; ((eq context 0)
;;; (setq match (if (eq (following-char) ?\;) t nil)))
((eq context 2)
(setq match (if (and (looking-at regexp)
(looking-at ";\\|\\<end\\>\\|\\<else\\>\\|\\<otherwise\\>\\|\\<when\\>")) t nil)))
(t (setq match nil)))))
;; Exit if true match
(if (eq match t) (throw 'simula-forward (point)))
(if (eq match 'BLOCK)
;; We found the BEGINning of a block
(let ((level 0))
(while (natnump level)
(if (re-search-forward "\\<begin\\>\\|\\<end\\>" bound 1)
(let ((context (simula-context)))
;; We found a BEGIN -> increase level count
(cond ((eq context nil) (setq level (1+ level)))
;; END -> decrease level count
((and (eq context 2)
;; Don't match BEGIN inside END comment
(memq (preceding-char) '(?d ?D)))
(setq level (1- level)))))
;; Block search failed. Action depends on noerror.
(if (or (not noerror) (eq noerror t))
(goto-char start-point))
(if (not noerror)
(signal 'search-failed (list regexp)))
(throw 'simula-forward nil))))))
;; Search failed. Action depends on noerror.
(if (or (not noerror) (eq noerror t))
(goto-char start-point))
(if noerror
nil
(signal 'search-failed (list regexp))))))