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