lisp/progmodes/simula.el

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