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

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