lisp/progmodes/simula.el

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