lisp/progmodes/pascal.el

   1 ;;; pascal.el --- major mode for editing pascal source in Emacs
   2
   3 ;; Copyright (C) 1993, 94, 95, 96, 97, 98, 1999, 2000 Free Software Foundation, Inc.
   4
   5 ;; Author: Espen Skoglund <esk@gnu.org>
   6 ;; Keywords: languages
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; USAGE
  28 ;; =====
  29
  30 ;; Emacs should enter Pascal mode when you find a Pascal source file.
  31 ;; When you have entered Pascal mode, you may get more info by pressing
  32 ;; C-h m. You may also get online help describing various functions by:
  33 ;; C-h f <Name of function you want described>
  34
  35 ;; If you want to customize Pascal mode to fit you better, you may add
  36 ;; these lines (the values of the variables presented here are the defaults):
  37 ;;
  38 ;; ;; User customization for Pascal mode
  39 ;; (setq pascal-indent-level       3
  40 ;;       pascal-case-indent        2
  41 ;;       pascal-auto-newline       nil
  42 ;;       pascal-tab-always-indent  t
  43 ;;       pascal-auto-endcomments   t
  44 ;;       pascal-auto-lineup        '(all)
  45 ;;       pascal-toggle-completions nil
  46 ;;       pascal-type-keywords      '("array" "file" "packed" "char"
  47 ;;                                   "integer" "real" "string" "record")
  48 ;;       pascal-start-keywords     '("begin" "end" "function" "procedure"
  49 ;;                                   "repeat" "until" "while" "read" "readln"
  50 ;;                                   "reset" "rewrite" "write" "writeln")
  51 ;;       pascal-separator-keywords '("downto" "else" "mod" "div" "then"))
  52
  53 ;; KNOWN BUGS / BUGREPORTS
  54 ;; =======================
  55 ;; As far as I know, there are no bugs in the current version of this
  56 ;; package.  This may not be true however, since I never use this mode
  57 ;; myself and therefore would never notice them anyway.   If you do
  58 ;; find any bugs, you may submit them to: esk@gnu.org as well as to
  59 ;; bug-gnu-emacs@gnu.org.
  60 \f
  61 ;;; Code:
  62
  63 (defgroup pascal nil
  64   "Major mode for editing Pascal source in Emacs"
  65   :group 'languages)
  66
  67 (defvar pascal-mode-abbrev-table nil
  68   "Abbrev table in use in Pascal-mode buffers.")
  69 (define-abbrev-table 'pascal-mode-abbrev-table ())
  70
  71 (defvar pascal-mode-map ()
  72   "Keymap used in Pascal mode.")
  73 (if pascal-mode-map
  74     ()
  75   (setq pascal-mode-map (make-sparse-keymap))
  76   (define-key pascal-mode-map ";"        'electric-pascal-semi-or-dot)
  77   (define-key pascal-mode-map "."        'electric-pascal-semi-or-dot)
  78   (define-key pascal-mode-map ":"        'electric-pascal-colon)
  79   (define-key pascal-mode-map "="        'electric-pascal-equal)
  80   (define-key pascal-mode-map "#"        'electric-pascal-hash)
  81   (define-key pascal-mode-map "\r"       'electric-pascal-terminate-line)
  82   (define-key pascal-mode-map "\t"       'electric-pascal-tab)
  83   (define-key pascal-mode-map "\M-\t"    'pascal-complete-word)
  84   (define-key pascal-mode-map "\M-?"     'pascal-show-completions)
  85   (define-key pascal-mode-map "\177"     'backward-delete-char-untabify)
  86   (define-key pascal-mode-map "\M-\C-h"  'pascal-mark-defun)
  87   (define-key pascal-mode-map "\C-c\C-b" 'pascal-insert-block)
  88   (define-key pascal-mode-map "\M-*"     'pascal-star-comment)
  89   (define-key pascal-mode-map "\C-c\C-c" 'pascal-comment-area)
  90   (define-key pascal-mode-map "\C-c\C-u" 'pascal-uncomment-area)
  91   (define-key pascal-mode-map "\M-\C-a"  'pascal-beg-of-defun)
  92   (define-key pascal-mode-map "\M-\C-e"  'pascal-end-of-defun)
  93   (define-key pascal-mode-map "\C-c\C-d" 'pascal-goto-defun)
  94   (define-key pascal-mode-map "\C-c\C-o" 'pascal-outline)
  95 ;;; A command to change the whole buffer won't be used terribly
  96 ;;; often, so no need for a key binding.
  97 ;  (define-key pascal-mode-map "\C-cd"    'pascal-downcase-keywords)
  98 ;  (define-key pascal-mode-map "\C-cu"    'pascal-upcase-keywords)
  99 ;  (define-key pascal-mode-map "\C-cc"    'pascal-capitalize-keywords)
 100   )
 101
 102 (defvar pascal-imenu-generic-expression
 103   '((nil "^[ \t]*\\(function\\|procedure\\)[ \t\n]+\\([a-zA-Z0-9_.:]+\\)" 2))
 104   "Imenu expression for Pascal-mode.  See `imenu-generic-expression'.")
 105
 106 (defvar pascal-keywords
 107   '("and" "array" "begin" "case" "const" "div" "do" "downto" "else" "end"
 108     "file" "for" "function" "goto" "if" "in" "label" "mod" "nil" "not" "of"
 109     "or" "packed" "procedure" "program" "record" "repeat" "set" "then" "to"
 110     "type" "until" "var" "while" "with"
 111     ;; The following are not standard in pascal, but widely used.
 112     "get" "put" "input" "output" "read" "readln" "reset" "rewrite" "write"
 113     "writeln"))
 114
 115 ;;;
 116 ;;; Regular expressions used to calculate indent, etc.
 117 ;;;
 118 (defconst pascal-symbol-re      "\\<[a-zA-Z_][a-zA-Z_0-9.]*\\>")
 119 (defconst pascal-beg-block-re   "\\<\\(begin\\|case\\|record\\|repeat\\)\\>")
 120 (defconst pascal-end-block-re   "\\<\\(end\\|until\\)\\>")
 121 (defconst pascal-declaration-re "\\<\\(const\\|label\\|type\\|var\\)\\>")
 122 (defconst pascal-progbeg-re     "\\<\\program\\>")
 123 (defconst pascal-defun-re       "\\<\\(function\\|procedure\\|program\\)\\>")
 124 (defconst pascal-sub-block-re   "\\<\\(if\\|else\\|for\\|while\\|with\\)\\>")
 125 (defconst pascal-noindent-re    "\\<\\(begin\\|end\\|until\\|else\\)\\>")
 126 (defconst pascal-nosemi-re      "\\<\\(begin\\|repeat\\|then\\|do\\|else\\)\\>")
 127 (defconst pascal-autoindent-lines-re
 128   "\\<\\(label\\|var\\|type\\|const\\|until\\|end\\|begin\\|repeat\\|else\\)\\>")
 129
 130 ;;; Strings used to mark beginning and end of excluded text
 131 (defconst pascal-exclude-str-start "{-----\\/----- EXCLUDED -----\\/-----")
 132 (defconst pascal-exclude-str-end " -----/\\----- EXCLUDED -----/\\-----}")
 133
 134 (defvar pascal-mode-syntax-table nil
 135   "Syntax table in use in Pascal-mode buffers.")
 136
 137 (if pascal-mode-syntax-table
 138     ()
 139   (setq pascal-mode-syntax-table (make-syntax-table))
 140   (modify-syntax-entry ?\\ "."   pascal-mode-syntax-table)
 141   (modify-syntax-entry ?( "()1"  pascal-mode-syntax-table)
 142   (modify-syntax-entry ?) ")(4"  pascal-mode-syntax-table)
 143   (modify-syntax-entry ?* ". 23b" pascal-mode-syntax-table)
 144   (modify-syntax-entry ?{ "<"    pascal-mode-syntax-table)
 145   (modify-syntax-entry ?} ">"    pascal-mode-syntax-table)
 146   (modify-syntax-entry ?+ "."    pascal-mode-syntax-table)
 147   (modify-syntax-entry ?- "."    pascal-mode-syntax-table)
 148   (modify-syntax-entry ?= "."    pascal-mode-syntax-table)
 149   (modify-syntax-entry ?% "."    pascal-mode-syntax-table)
 150   (modify-syntax-entry ?< "."    pascal-mode-syntax-table)
 151   (modify-syntax-entry ?> "."    pascal-mode-syntax-table)
 152   (modify-syntax-entry ?& "."    pascal-mode-syntax-table)
 153   (modify-syntax-entry ?| "."    pascal-mode-syntax-table)
 154   (modify-syntax-entry ?_ "_"    pascal-mode-syntax-table)
 155   (modify-syntax-entry ?\' "\""  pascal-mode-syntax-table))
 156
 157 (defconst pascal-font-lock-keywords (purecopy
 158   (list
 159    '("^[ \t]*\\(function\\|pro\\(cedure\\|gram\\)\\)\\>[ \t]*\\([a-z]\\)"
 160      1 font-lock-keyword-face)
 161    '("^[ \t]*\\(function\\|pro\\(cedure\\|gram\\)\\)\\>[ \t]*\\([a-z][a-z0-9_]*\\)"
 162      3 font-lock-function-name-face t)
 163 ;   ("type" "const" "real" "integer" "char" "boolean" "var"
 164 ;    "record" "array" "file")
 165    (cons (concat "\\<\\(array\\|boolean\\|c\\(har\\|onst\\)\\|file\\|"
 166                  "integer\\|re\\(al\\|cord\\)\\|type\\|var\\)\\>")
 167          'font-lock-type-face)
 168    '("\\<\\(label\\|external\\|forward\\)\\>" . font-lock-constant-face)
 169    '("\\<\\([0-9]+\\)[ \t]*:" 1 font-lock-function-name-face)
 170 ;   ("of" "to" "for" "if" "then" "else" "case" "while"
 171 ;    "do" "until" "and" "or" "not" "in" "with" "repeat" "begin" "end")
 172    (concat "\\<\\("
 173            "and\\|begin\\|case\\|do\\|e\\(lse\\|nd\\)\\|for\\|i[fn]\\|"
 174            "not\\|o[fr]\\|repeat\\|t\\(hen\\|o\\)\\|until\\|w\\(hile\\|ith\\)"
 175            "\\)\\>")
 176    '("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?"
 177      1 font-lock-keyword-face)
 178    '("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?"
 179      2 font-lock-keyword-face t)))
 180   "Additional expressions to highlight in Pascal mode.")
 181 (put 'pascal-mode 'font-lock-defaults '(pascal-font-lock-keywords nil t))
 182
 183 (defcustom pascal-indent-level 3
 184   "*Indentation of Pascal statements with respect to containing block."
 185   :type 'integer
 186   :group 'pascal)
 187
 188 (defcustom pascal-case-indent 2
 189   "*Indentation for case statements."
 190   :type 'integer
 191   :group 'pascal)
 192
 193 (defcustom pascal-auto-newline nil
 194   "*Non-nil means automatically insert newlines in certain cases.
 195 These include after semicolons and after the punctuation mark after an `end'."
 196   :type 'boolean
 197   :group 'pascal)
 198
 199 (defcustom pascal-indent-nested-functions t
 200   "*Non-nil means nested functions are indented."
 201   :type 'boolean
 202   :group 'pascal)
 203
 204 (defcustom pascal-tab-always-indent t
 205   "*Non-nil means TAB in Pascal mode should always reindent the current line.
 206 If this is nil, TAB inserts a tab if it is at the end of the line
 207 and follows non-whitespace text."
 208   :type 'boolean
 209   :group 'pascal)
 210
 211 (defcustom pascal-auto-endcomments t
 212   "*Non-nil means automatically insert comments after certain `end's.
 213 Specifically, this is done after the ends of cases statements and functions.
 214 The name of the function or case is included between the braces."
 215   :type 'boolean
 216   :group 'pascal)
 217
 218 (defcustom pascal-auto-lineup '(all)
 219   "*List of contexts where auto lineup of :'s or ='s should be done.
 220 Elements can be of type: 'paramlist', 'declaration' or 'case', which will
 221 do auto lineup in parameterlist, declarations or case-statements
 222 respectively. The word 'all' will do all lineups. '(case paramlist) for
 223 instance will do lineup in case-statements and parameterlist, while '(all)
 224 will do all lineups."
 225   :type '(set :extra-offset 8
 226               (const :tag "Everything" all)
 227               (const :tag "Parameter lists" paramlist)
 228               (const :tag "Decalrations" declaration)
 229               (const :tag "Case statements" case))
 230   :group 'pascal)
 231
 232 (defcustom pascal-toggle-completions nil
 233   "*Non-nil means \\<pascal-mode-map>\\[pascal-complete-word] should try all possible completions one by one.
 234 Repeated use of \\[pascal-complete-word] will show you all of them.
 235 Normally, when there is more than one possible completion,
 236 it displays a list of all possible completions."
 237   :type 'boolean
 238   :group 'pascal)
 239
 240 (defcustom pascal-type-keywords
 241   '("array" "file" "packed" "char" "integer" "real" "string" "record")
 242   "*Keywords for types used when completing a word in a declaration or parmlist.
 243 These include integer, real, char, etc.
 244 The types defined within the Pascal program
 245 are handled in another way, and should not be added to this list."
 246   :type '(repeat (string :tag "Keyword"))
 247   :group 'pascal)
 248
 249 (defcustom pascal-start-keywords
 250   '("begin" "end" "function" "procedure" "repeat" "until" "while"
 251     "read" "readln" "reset" "rewrite" "write" "writeln")
 252   "*Keywords to complete when standing at the first word of a statement.
 253 These are keywords such as begin, repeat, until, readln.
 254 The procedures and variables defined within the Pascal program
 255 are handled in another way, and should not be added to this list."
 256   :type '(repeat (string :tag "Keyword"))
 257   :group 'pascal)
 258
 259 (defcustom pascal-separator-keywords
 260   '("downto" "else" "mod" "div" "then")
 261   "*Keywords to complete when NOT standing at the first word of a statement.
 262 These are keywords such as downto, else, mod, then.
 263 Variables and function names defined within the Pascal program
 264 are handled in another way, and should not be added to this list."
 265   :type '(repeat (string :tag "Keyword"))
 266   :group 'pascal)
 267
 268
 269 ;;;
 270 ;;;  Macros
 271 ;;;
 272
 273 (defsubst pascal-get-beg-of-line (&optional arg)
 274   (save-excursion
 275     (beginning-of-line arg)
 276     (point)))
 277
 278 (defsubst pascal-get-end-of-line (&optional arg)
 279   (save-excursion
 280     (end-of-line arg)
 281     (point)))
 282
 283 (defun pascal-declaration-end ()
 284   (let ((nest 1))
 285     (while (and (> nest 0)
 286                 (re-search-forward
 287                  "[:=]\\|\\(\\<record\\>\\)\\|\\(\\<end\\>\\)"
 288                  (save-excursion (end-of-line 2) (point)) t))
 289       (cond ((match-beginning 1) (setq nest (1+ nest)))
 290             ((match-beginning 2) (setq nest (1- nest)))
 291             ((looking-at "[^(\n]+)") (setq nest 0))))))
 292
 293
 294 (defun pascal-declaration-beg ()
 295   (let ((nest 1))
 296     (while (and (> nest 0)
 297                 (re-search-backward "[:=]\\|\\<\\(type\\|var\\|label\\|const\\)\\>\\|\\(\\<record\\>\\)\\|\\(\\<end\\>\\)" (pascal-get-beg-of-line 0) t))
 298       (cond ((match-beginning 1) (setq nest 0))
 299             ((match-beginning 2) (setq nest (1- nest)))
 300             ((match-beginning 3) (setq nest (1+ nest)))))
 301     (= nest 0)))
 302
 303
 304 (defsubst pascal-within-string ()
 305   (save-excursion
 306     (nth 3 (parse-partial-sexp (pascal-get-beg-of-line) (point)))))
 307
 308
 309 ;;;###autoload
 310 (defun pascal-mode ()
 311   "Major mode for editing Pascal code. \\<pascal-mode-map>
 312 TAB indents for Pascal code.  Delete converts tabs to spaces as it moves back.
 313
 314 \\[pascal-complete-word] completes the word around current point with respect \
 315 to position in code
 316 \\[pascal-show-completions] shows all possible completions at this point.
 317
 318 Other useful functions are:
 319
 320 \\[pascal-mark-defun]\t- Mark function.
 321 \\[pascal-insert-block]\t- insert begin ... end;
 322 \\[pascal-star-comment]\t- insert (* ... *)
 323 \\[pascal-comment-area]\t- Put marked area in a comment, fixing nested comments.
 324 \\[pascal-uncomment-area]\t- Uncomment an area commented with \
 325 \\[pascal-comment-area].
 326 \\[pascal-beg-of-defun]\t- Move to beginning of current function.
 327 \\[pascal-end-of-defun]\t- Move to end of current function.
 328 \\[pascal-goto-defun]\t- Goto function prompted for in the minibuffer.
 329 \\[pascal-outline]\t- Enter pascal-outline-mode (see also pascal-outline).
 330
 331 Variables controlling indentation/edit style:
 332
 333  pascal-indent-level (default 3)
 334     Indentation of Pascal statements with respect to containing block.
 335  pascal-case-indent (default 2)
 336     Indentation for case statements.
 337  pascal-auto-newline (default nil)
 338     Non-nil means automatically newline after semicolons and the punctuation
 339     mark after an end.
 340  pascal-indent-nested-functions (default t)
 341     Non-nil means nested functions are indented.
 342  pascal-tab-always-indent (default t)
 343     Non-nil means TAB in Pascal mode should always reindent the current line,
 344     regardless of where in the line point is when the TAB command is used.
 345  pascal-auto-endcomments (default t)
 346     Non-nil means a comment { ... } is set after the ends which ends cases and
 347     functions. The name of the function or case will be set between the braces.
 348  pascal-auto-lineup (default t)
 349     List of contexts where auto lineup of :'s or ='s should be done.
 350
 351 See also the user variables pascal-type-keywords, pascal-start-keywords and
 352 pascal-separator-keywords.
 353
 354 Turning on Pascal mode calls the value of the variable pascal-mode-hook with
 355 no args, if that value is non-nil."
 356   (interactive)
 357   (kill-all-local-variables)
 358   (use-local-map pascal-mode-map)
 359   (setq major-mode 'pascal-mode)
 360   (setq mode-name "Pascal")
 361   (setq local-abbrev-table pascal-mode-abbrev-table)
 362   (set-syntax-table pascal-mode-syntax-table)
 363   (make-local-variable 'indent-line-function)
 364   (setq indent-line-function 'pascal-indent-line)
 365   (make-local-variable 'comment-indent-function)
 366   (setq comment-indent-function 'pascal-indent-comment)
 367   (make-local-variable 'parse-sexp-ignore-comments)
 368   (setq parse-sexp-ignore-comments nil)
 369   (make-local-variable 'blink-matching-paren-dont-ignore-comments)
 370   (setq blink-matching-paren-dont-ignore-comments t)
 371   (make-local-variable 'case-fold-search)
 372   (setq case-fold-search t)
 373   (make-local-variable 'comment-start)
 374   (setq comment-start "{")
 375   (make-local-variable 'comment-start-skip)
 376   (setq comment-start-skip "(\\*+ *\\|{ *")
 377   (make-local-variable 'comment-end)
 378   (setq comment-end "}")
 379   ;; Font lock support
 380   (make-local-variable 'font-lock-defaults)
 381   (setq font-lock-defaults '(pascal-font-lock-keywords nil t))
 382   ;; Imenu support
 383   (make-local-variable 'imenu-generic-expression)
 384   (setq imenu-generic-expression pascal-imenu-generic-expression)
 385   (setq imenu-case-fold-search t)
 386   (run-hooks 'pascal-mode-hook))
 387
 388 \f
 389
 390 ;;;
 391 ;;;  Electric functions
 392 ;;;
 393 (defun electric-pascal-terminate-line ()
 394   "Terminate line and indent next line."
 395   (interactive)
 396   ;; First, check if current line should be indented
 397   (save-excursion
 398     (beginning-of-line)
 399     (skip-chars-forward " \t")
 400     (if (looking-at pascal-autoindent-lines-re)
 401         (pascal-indent-line)))
 402   (delete-horizontal-space) ; Removes trailing whitespaces
 403   (newline)
 404   ;; Indent next line
 405   (pascal-indent-line)
 406   ;; Maybe we should set some endcomments
 407   (if pascal-auto-endcomments
 408       (pascal-set-auto-comments))
 409   ;; Check if we shall indent inside comment
 410   (let ((setstar nil))
 411     (save-excursion
 412       (forward-line -1)
 413       (skip-chars-forward " \t")
 414       (cond ((looking-at "\\*[ \t]+)")
 415              ;; Delete region between `*' and `)' if there is only whitespaces.
 416              (forward-char 1)
 417              (delete-horizontal-space))
 418             ((and (looking-at "(\\*\\|\\*[^)]")
 419                   (not (save-excursion
 420                          (search-forward "*)" (pascal-get-end-of-line) t))))
 421              (setq setstar t))))
 422     ;; If last line was a star comment line then this one shall be too.
 423     (if (null setstar)
 424         (pascal-indent-line)
 425       (insert "*  "))))
 426
 427
 428 (defun electric-pascal-semi-or-dot ()
 429   "Insert `;' or `.' character and reindent the line."
 430   (interactive)
 431   (insert last-command-char)
 432   (save-excursion
 433     (beginning-of-line)
 434     (pascal-indent-line))
 435   (if pascal-auto-newline
 436       (electric-pascal-terminate-line)))
 437
 438 (defun electric-pascal-colon ()
 439   "Insert `:' and do all indentions except line indent on this line."
 440   (interactive)
 441   (insert last-command-char)
 442   ;; Do nothing if within string.
 443   (if (pascal-within-string)
 444       ()
 445     (save-excursion
 446       (beginning-of-line)
 447       (pascal-indent-line))
 448     (let ((pascal-tab-always-indent nil))
 449       (pascal-indent-command))))
 450
 451 (defun electric-pascal-equal ()
 452   "Insert `=', and do indention if within type declaration."
 453   (interactive)
 454   (insert last-command-char)
 455   (if (eq (car (pascal-calculate-indent)) 'declaration)
 456       (let ((pascal-tab-always-indent nil))
 457         (pascal-indent-command))))
 458
 459 (defun electric-pascal-hash ()
 460   "Insert `#', and indent to column 0 if this is a CPP directive."
 461   (interactive)
 462   (insert last-command-char)
 463   (if (save-excursion (beginning-of-line) (looking-at "^[ \t]*#"))
 464       (save-excursion (beginning-of-line)
 465                       (delete-horizontal-space))))
 466
 467 (defun electric-pascal-tab ()
 468   "Function called when TAB is pressed in Pascal mode."
 469   (interactive)
 470   ;; Do nothing if within a string or in a CPP directive.
 471   (if (or (pascal-within-string)
 472           (and (not (bolp))
 473                (save-excursion (beginning-of-line) (eq (following-char) ?#))))
 474       (insert "\t")
 475     ;; If pascal-tab-always-indent, indent the beginning of the line.
 476     (if pascal-tab-always-indent
 477         (save-excursion
 478           (beginning-of-line)
 479           (pascal-indent-line))
 480       (if (save-excursion
 481             (skip-chars-backward " \t")
 482             (bolp))
 483           (pascal-indent-line)
 484         (insert "\t")))
 485     (pascal-indent-command)))
 486
 487 \f
 488
 489 ;;;
 490 ;;; Interactive functions
 491 ;;;
 492 (defun pascal-insert-block ()
 493   "Insert Pascal begin ... end; block in the code with right indentation."
 494   (interactive)
 495   (insert "begin")
 496   (electric-pascal-terminate-line)
 497   (save-excursion
 498     (newline)
 499     (insert "end;")
 500     (beginning-of-line)
 501     (pascal-indent-line)))
 502
 503 (defun pascal-star-comment ()
 504   "Insert Pascal star comment at point."
 505   (interactive)
 506   (pascal-indent-line)
 507   (insert "(*")
 508   (electric-pascal-terminate-line)
 509   (save-excursion
 510     (electric-pascal-terminate-line)
 511     (delete-horizontal-space)
 512     (insert ")"))
 513   (insert "  "))
 514
 515 (defun pascal-mark-defun ()
 516   "Mark the current pascal function (or procedure).
 517 This puts the mark at the end, and point at the beginning."
 518   (interactive)
 519   (push-mark (point))
 520   (pascal-end-of-defun)
 521   (push-mark (point))
 522   (pascal-beg-of-defun)
 523   (if (fboundp 'zmacs-activate-region)
 524       (zmacs-activate-region)))
 525
 526 (defun pascal-comment-area (start end)
 527   "Put the region into a Pascal comment.
 528 The comments that are in this area are \"deformed\":
 529 `*)' becomes `!(*' and `}' becomes `!{'.
 530 These deformed comments are returned to normal if you use
 531 \\[pascal-uncomment-area] to undo the commenting.
 532
 533 The commented area starts with `pascal-exclude-str-start', and ends with
 534 `pascal-include-str-end'.  But if you change these variables,
 535 \\[pascal-uncomment-area] won't recognize the comments."
 536   (interactive "r")
 537   (save-excursion
 538     ;; Insert start and endcomments
 539     (goto-char end)
 540     (if (and (save-excursion (skip-chars-forward " \t") (eolp))
 541              (not (save-excursion (skip-chars-backward " \t") (bolp))))
 542         (forward-line 1)
 543       (beginning-of-line))
 544     (insert pascal-exclude-str-end)
 545     (setq end (point))
 546     (newline)
 547     (goto-char start)
 548     (beginning-of-line)
 549     (insert pascal-exclude-str-start)
 550     (newline)
 551     ;; Replace end-comments within commented area
 552     (goto-char end)
 553     (save-excursion
 554       (while (re-search-backward "\\*)" start t)
 555         (replace-match "!(*" t t)))
 556     (save-excursion
 557       (while (re-search-backward "}" start t)
 558         (replace-match "!{" t t)))))
 559
 560 (defun pascal-uncomment-area ()
 561   "Uncomment a commented area; change deformed comments back to normal.
 562 This command does nothing if the pointer is not in a commented
 563 area.  See also `pascal-comment-area'."
 564   (interactive)
 565   (save-excursion
 566     (let ((start (point))
 567           (end (point)))
 568       ;; Find the boundaries of the comment
 569       (save-excursion
 570         (setq start (progn (search-backward pascal-exclude-str-start nil t)
 571                            (point)))
 572         (setq end (progn (search-forward pascal-exclude-str-end nil t)
 573                          (point))))
 574       ;; Check if we're really inside a comment
 575       (if (or (equal start (point)) (<= end (point)))
 576           (message "Not standing within commented area.")
 577         (progn
 578           ;; Remove endcomment
 579           (goto-char end)
 580           (beginning-of-line)
 581           (let ((pos (point)))
 582             (end-of-line)
 583             (delete-region pos (1+ (point))))
 584           ;; Change comments back to normal
 585           (save-excursion
 586             (while (re-search-backward "!{" start t)
 587               (replace-match "}" t t)))
 588           (save-excursion
 589             (while (re-search-backward "!(\\*" start t)
 590               (replace-match "*)" t t)))
 591           ;; Remove startcomment
 592           (goto-char start)
 593           (beginning-of-line)
 594           (let ((pos (point)))
 595             (end-of-line)
 596             (delete-region pos (1+ (point)))))))))
 597
 598 (defun pascal-beg-of-defun ()
 599   "Move backward to the beginning of the current function or procedure."
 600   (interactive)
 601   (catch 'found
 602     (if (not (looking-at (concat "\\s \\|\\s)\\|" pascal-defun-re)))
 603         (forward-sexp 1))
 604     (let ((nest 0) (max -1) (func 0)
 605           (reg (concat pascal-beg-block-re "\\|"
 606                        pascal-end-block-re "\\|"
 607                        pascal-defun-re)))
 608       (while (re-search-backward reg nil 'move)
 609         (cond ((let ((state (save-excursion
 610                               (parse-partial-sexp (point-min) (point)))))
 611                  (or (nth 3 state) (nth 4 state))) ; Inside string or comment
 612                ())
 613               ((match-end 1)                       ; begin|case|record|repeat
 614                (if (and (looking-at "\\<record\\>") (>= max 0))
 615                    (setq func (1- func)))
 616                (setq nest (1+ nest)
 617                      max (max nest max)))
 618               ((match-end 2)                       ; end|until
 619                (if (and (= nest max) (>= max 0))
 620                    (setq func (1+ func)))
 621                (setq nest (1- nest)))
 622               ((match-end 3)                       ; function|procedure
 623                (if (= 0 func)
 624                    (throw 'found t)
 625                  (setq func (1- func)))))))
 626     nil))
 627
 628 (defun pascal-end-of-defun ()
 629   "Move forward to the end of the current function or procedure."
 630   (interactive)
 631   (if (looking-at "\\s ")
 632       (forward-sexp 1))
 633   (if (not (looking-at pascal-defun-re))
 634       (pascal-beg-of-defun))
 635   (forward-char 1)
 636   (let ((nest 0) (func 1)
 637         (reg (concat pascal-beg-block-re "\\|"
 638                      pascal-end-block-re "\\|"
 639                      pascal-defun-re)))
 640     (while (and (/= func 0)
 641                 (re-search-forward reg nil 'move))
 642       (cond ((let ((state (save-excursion
 643                               (parse-partial-sexp (point-min) (point)))))
 644                  (or (nth 3 state) (nth 4 state))) ; Inside string or comment
 645                ())
 646             ((match-end 1)
 647              (setq nest (1+ nest))
 648              (if (save-excursion
 649                    (goto-char (match-beginning 0))
 650                    (looking-at "\\<record\\>"))
 651                  (setq func (1+ func))))
 652             ((match-end 2)
 653              (setq nest (1- nest))
 654              (if (= nest 0)
 655                  (setq func (1- func))))
 656             ((match-end 3)
 657              (setq func (1+ func))))))
 658   (forward-line 1))
 659
 660 (defun pascal-end-of-statement ()
 661   "Move forward to end of current statement."
 662   (interactive)
 663   (let ((parse-sexp-ignore-comments t)
 664         (nest 0) pos
 665         (regexp (concat "\\(" pascal-beg-block-re "\\)\\|\\("
 666                         pascal-end-block-re "\\)")))
 667     (if (not (looking-at "[ \t\n]")) (forward-sexp -1))
 668     (or (looking-at pascal-beg-block-re)
 669         ;; Skip to end of statement
 670         (setq pos (catch 'found
 671                     (while t
 672                       (forward-sexp 1)
 673                       (cond ((looking-at "[ \t]*;")
 674                              (skip-chars-forward "^;")
 675                              (forward-char 1)
 676                              (throw 'found (point)))
 677                             ((save-excursion
 678                                (forward-sexp -1)
 679                                (looking-at pascal-beg-block-re))
 680                              (goto-char (match-beginning 0))
 681                              (throw 'found nil))
 682                             ((eobp)
 683                              (throw 'found (point))))))))
 684     (if (not pos)
 685         ;; Skip a whole block
 686         (catch 'found
 687           (while t
 688             (re-search-forward regexp nil 'move)
 689             (setq nest (if (match-end 1)
 690                            (1+ nest)
 691                          (1- nest)))
 692             (cond ((eobp)
 693                    (throw 'found (point)))
 694                   ((= 0 nest)
 695                    (throw 'found (pascal-end-of-statement))))))
 696       pos)))
 697
 698 (defun pascal-downcase-keywords ()
 699   "Downcase all Pascal keywords in the buffer."
 700   (interactive)
 701   (pascal-change-keywords 'downcase-word))
 702
 703 (defun pascal-upcase-keywords ()
 704   "Upcase all Pascal keywords in the buffer."
 705   (interactive)
 706   (pascal-change-keywords 'upcase-word))
 707
 708 (defun pascal-capitalize-keywords ()
 709   "Capitalize all Pascal keywords in the buffer."
 710   (interactive)
 711   (pascal-change-keywords 'capitalize-word))
 712
 713 ;; Change the keywords according to argument.
 714 (defun pascal-change-keywords (change-word)
 715   (save-excursion
 716     (let ((keyword-re (concat "\\<\\("
 717                               (mapconcat 'identity pascal-keywords "\\|")
 718                               "\\)\\>")))
 719       (goto-char (point-min))
 720       (while (re-search-forward keyword-re nil t)
 721         (funcall change-word -1)))))
 722
 723 \f
 724
 725 ;;;
 726 ;;; Other functions
 727 ;;;
 728 (defun pascal-set-auto-comments ()
 729   "Insert `{ case }' or `{ NAME }' on this line if appropriate.
 730 Insert `{ case }' if there is an `end' on the line which
 731 ends a case block.  Insert `{ NAME }' if there is an `end'
 732 on the line which ends a function or procedure named NAME."
 733   (save-excursion
 734     (forward-line -1)
 735     (skip-chars-forward " \t")
 736     (if (and (looking-at "\\<end;")
 737              (not (save-excursion
 738                     (end-of-line)
 739                     (search-backward "{" (pascal-get-beg-of-line) t))))
 740         (let ((type (car (pascal-calculate-indent))))
 741           (if (eq type 'declaration)
 742               ()
 743             (if (eq type 'case)
 744                 ;; This is a case block
 745                 (progn
 746                   (end-of-line)
 747                   (delete-horizontal-space)
 748                   (insert " { case }"))
 749               (let ((nest 1))
 750                 ;; Check if this is the end of a function
 751                 (save-excursion
 752                   (while (not (or (looking-at pascal-defun-re) (bobp)))
 753                     (backward-sexp 1)
 754                     (cond ((looking-at pascal-beg-block-re)
 755                            (setq nest (1- nest)))
 756                           ((looking-at pascal-end-block-re)
 757                            (setq nest (1+ nest)))))
 758                   (if (bobp)
 759                       (setq nest 1)))
 760                 (if (zerop nest)
 761                     (progn
 762                       (end-of-line)
 763                       (delete-horizontal-space)
 764                       (insert " { ")
 765                       (let (b e)
 766                         (save-excursion
 767                           (setq b (progn (pascal-beg-of-defun)
 768                                          (skip-chars-forward "^ \t")
 769                                          (skip-chars-forward " \t")
 770                                          (point))
 771                                 e (progn (skip-chars-forward "a-zA-Z0-9_")
 772                                          (point))))
 773                         (insert-buffer-substring (current-buffer) b e))
 774                       (insert " }"))))))))))
 775
 776 \f
 777
 778 ;;;
 779 ;;; Indentation
 780 ;;;
 781 (defconst pascal-indent-alist
 782   '((block . (+ ind pascal-indent-level))
 783     (case . (+ ind pascal-case-indent))
 784     (caseblock . ind) (cpp . 0)
 785     (declaration . (+ ind pascal-indent-level))
 786     (paramlist . (pascal-indent-paramlist t))
 787     (comment . (pascal-indent-comment))
 788     (defun . ind) (contexp . ind)
 789     (unknown . ind) (string . 0) (progbeg . 0)))
 790
 791 (defun pascal-indent-command ()
 792   "Indent for special part of code."
 793   (let* ((indent-str (pascal-calculate-indent))
 794          (type (car indent-str))
 795          (ind (car (cdr indent-str))))
 796     (cond ((and (eq type 'paramlist)
 797                 (or (memq 'all pascal-auto-lineup)
 798                     (memq 'paramlist pascal-auto-lineup)))
 799            (pascal-indent-paramlist)
 800            (pascal-indent-paramlist))
 801           ((and (eq type 'declaration)
 802                 (or (memq 'all pascal-auto-lineup)
 803                     (memq 'declaration  pascal-auto-lineup)))
 804            (pascal-indent-declaration))
 805           ((and (eq type 'case) (not (looking-at "^[ \t]*$"))
 806                 (or (memq 'all pascal-auto-lineup)
 807                     (memq 'case pascal-auto-lineup)))
 808            (pascal-indent-case)))
 809     (if (looking-at "[ \t]+$")
 810         (skip-chars-forward " \t"))))
 811
 812 (defun pascal-indent-line ()
 813   "Indent current line as a Pascal statement."
 814   (let* ((indent-str (pascal-calculate-indent))
 815          (type (car indent-str))
 816          (ind (car (cdr indent-str))))
 817     ;; Labels should not be indented.
 818     (if (and (looking-at "^[0-9a-zA-Z]+[ \t]*:[^=]")
 819              (not (eq type 'declaration)))
 820         (search-forward ":" nil t))
 821     (delete-horizontal-space)
 822     (cond (; Some things should not be indented
 823            (or (and (eq type 'declaration) (looking-at pascal-declaration-re))
 824                (eq type 'cpp))
 825            ())
 826           (; Other things should have no extra indent
 827            (looking-at pascal-noindent-re)
 828            (indent-to ind))
 829           (; Nested functions should be indented
 830            (looking-at pascal-defun-re)
 831            (if (and pascal-indent-nested-functions
 832                     (eq type 'defun))
 833                (indent-to (+ ind pascal-indent-level))
 834              (indent-to ind)))
 835           (; But most lines are treated this way
 836            (indent-to (eval (cdr (assoc type pascal-indent-alist))))
 837            ))))
 838
 839 (defun pascal-calculate-indent ()
 840   "Calculate the indent of the current Pascal line.
 841 Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
 842   (save-excursion
 843     (let* ((parse-sexp-ignore-comments t)
 844            (oldpos (point))
 845            (state (save-excursion (parse-partial-sexp (point-min) (point))))
 846            (nest 0) (par 0) (complete (looking-at "[ \t]*end\\>"))
 847            (elsed (looking-at "[ \t]*else\\>")) (funccnt 0)
 848            (did-func (looking-at "[ \t]*\\(procedure\\|function\\)\\>"))
 849            (type (catch 'nesting
 850                    ;; Check if inside a string, comment or parenthesis
 851                    (cond ((nth 3 state) (throw 'nesting 'string))
 852                          ((nth 4 state) (throw 'nesting 'comment))
 853                          ((> (car state) 0)
 854                           (goto-char (scan-lists (point) -1 (car state)))
 855                           (setq par (1+ (current-column))))
 856                          ((save-excursion (beginning-of-line)
 857                                           (eq (following-char) ?#))
 858                           (throw 'nesting 'cpp)))
 859                    ;; Loop until correct indent is found
 860                    (while t
 861                      (backward-sexp 1)
 862                      (cond (;--Escape from case statements
 863                             (and (looking-at "[A-Za-z0-9]+[ \t]*:[^=]")
 864                                  (not complete)
 865                                  (save-excursion (skip-chars-backward " \t")
 866                                                  (bolp))
 867                                  (= (save-excursion
 868                                       (end-of-line) (backward-sexp) (point))
 869                                     (point))
 870                                  (> (save-excursion (goto-char oldpos)
 871                                                     (beginning-of-line)
 872                                                     (point))
 873                                     (point)))
 874                             (throw 'nesting 'caseblock))
 875                            (;--Beginning of program
 876                             (looking-at pascal-progbeg-re)
 877                             (throw 'nesting 'progbeg))
 878                            (;--No known statements
 879                             (bobp)
 880                             (throw 'nesting 'progbeg))
 881                            (;--Nest block outwards
 882                             (looking-at pascal-beg-block-re)
 883                             (if (= nest 0)
 884                                 (cond ((looking-at "case\\>")
 885                                        (throw 'nesting 'case))
 886                                       ((looking-at "record\\>")
 887                                        (throw 'nesting 'declaration))
 888                                       (t (throw 'nesting 'block)))
 889                               (if (and (looking-at "record\\>") (= nest 1))
 890                                   (setq funccnt (1- funccnt)))
 891                               (setq nest (1- nest))))
 892                            (;--Nest block inwards
 893                             (looking-at pascal-end-block-re)
 894                             (if (and (looking-at "end\\s ")
 895                                      elsed (not complete))
 896                                 (throw 'nesting 'block))
 897                             (if (= nest 0)
 898                                 (setq funccnt (1+ funccnt)))
 899                             (setq complete t
 900                                   nest (1+ nest)))
 901                            (;--Defun (or parameter list)
 902                             (and (looking-at pascal-defun-re)
 903                                  (progn (setq funccnt (1- funccnt)
 904                                               did-func t)
 905                                         (or (bolp) (< funccnt 0))))
 906                             ;; Prevent searching whole buffer
 907                             (if (and (bolp) (>= funccnt 0))
 908                                 (throw 'nesting 'progbeg))
 909                             (if (= 0 par)
 910                                 (throw 'nesting 'defun)
 911                               (setq par 0)
 912                               (let ((n 0))
 913                                 (while (re-search-forward
 914                                         "\\(\\<record\\>\\)\\|\\<end\\>"
 915                                         oldpos t)
 916                                   (if (match-end 1)
 917                                       (setq n (1+ n)) (setq n (1- n))))
 918                                 (if (> n 0)
 919                                     (throw 'nesting 'declaration)
 920                                   (throw 'nesting 'paramlist)))))
 921                            (;--Declaration part
 922                             (and (looking-at pascal-declaration-re)
 923                                  (not did-func)
 924                                  (= funccnt 0))
 925                             (if (save-excursion
 926                                   (goto-char oldpos)
 927                                   (forward-line -1)
 928                                   (looking-at "^[ \t]*$"))
 929                                 (throw 'nesting 'unknown)
 930                               (throw 'nesting 'declaration)))
 931                            (;--If, else or while statement
 932                             (and (not complete)
 933                                  (looking-at pascal-sub-block-re))
 934                             (throw 'nesting 'block))
 935                            (;--Found complete statement
 936                             (save-excursion (forward-sexp 1)
 937                                             (= (following-char) ?\;))
 938                             (setq complete t))
 939                            )))))
 940
 941       ;; Return type of block and indent level.
 942       (if (> par 0)                               ; Unclosed Parenthesis
 943           (list 'contexp par)
 944         (list type (pascal-indent-level))))))
 945
 946 (defun pascal-indent-level ()
 947   "Return the indent-level the current statement has.
 948 Do not count labels, case-statements or records."
 949   (save-excursion
 950     (beginning-of-line)
 951     (if (looking-at "[ \t]*[0-9a-zA-Z]+[ \t]*:[^=]")
 952         (search-forward ":" nil t)
 953       (if (looking-at ".*=[ \t]*record\\>")
 954           (search-forward "=" nil t)))
 955     (skip-chars-forward " \t")
 956     (current-column)))
 957
 958 (defun pascal-indent-comment ()
 959   "Return indent for current comment."
 960   (save-excursion
 961     (re-search-backward "\\((\\*\\)\\|{" nil t)
 962     (if (match-beginning 1)
 963         (1+ (current-column))
 964       (current-column))))
 965
 966 (defun pascal-indent-case ()
 967   "Indent within case statements."
 968   (let ((savepos (point-marker))
 969         (end (prog2
 970                  (end-of-line)
 971                  (point-marker)
 972                (re-search-backward "\\<case\\>" nil t)))
 973         (beg (point)) oldpos
 974         (ind 0))
 975     ;; Get right indent
 976     (while (< (point) end)
 977       (if (re-search-forward
 978            "^[ \t]*[^ \t,:]+[ \t]*\\(,[ \t]*[^ \t,:]+[ \t]*\\)*:"
 979            (marker-position end) 'move)
 980           (forward-char -1))
 981       (if (< (point) end)
 982           (progn
 983             (delete-horizontal-space)
 984             (if (> (current-column) ind)
 985                 (setq ind (current-column)))
 986             (pascal-end-of-statement))))
 987     (goto-char beg)
 988     (setq oldpos (marker-position end))
 989     ;; Indent all case statements
 990     (while (< (point) end)
 991       (if (re-search-forward
 992            "^[ \t]*[^][ \t,\\.:]+[ \t]*\\(,[ \t]*[^ \t,:]+[ \t]*\\)*:"
 993            (marker-position end) 'move)
 994           (forward-char -1))
 995       (indent-to (1+ ind))
 996       (if (/= (following-char) ?:)
 997           ()
 998         (forward-char 1)
 999         (delete-horizontal-space)
1000         (insert " "))
1001       (setq oldpos (point))
1002       (pascal-end-of-statement))
1003     (goto-char savepos)))
1004
1005 (defun pascal-indent-paramlist (&optional arg)
1006   "Indent current line in parameterlist.
1007 If optional arg is non-nil, just return the
1008 indent of the current line in parameterlist."
1009   (save-excursion
1010     (let* ((oldpos (point))
1011            (stpos (progn (goto-char (scan-lists (point) -1 1)) (point)))
1012            (stcol (1+ (current-column)))
1013            (edpos (progn (pascal-declaration-end)
1014                          (search-backward ")" (pascal-get-beg-of-line) t)
1015                          (point)))
1016            (usevar (re-search-backward "\\<var\\>" stpos t)))
1017       (if arg (progn
1018                 ;; If arg, just return indent
1019                 (goto-char oldpos)
1020                 (beginning-of-line)
1021                 (if (or (not usevar) (looking-at "[ \t]*var\\>"))
1022                     stcol (+ 4 stcol)))
1023         (goto-char stpos)
1024         (forward-char 1)
1025         (delete-horizontal-space)
1026         (if (and usevar (not (looking-at "var\\>")))
1027             (indent-to (+ 4 stcol)))
1028         (pascal-indent-declaration nil stpos edpos)))))
1029
1030 (defun pascal-indent-declaration (&optional arg start end)
1031   "Indent current lines as declaration, lining up the `:'s or `='s."
1032   (let ((pos (point-marker)))
1033     (if (and (not (or arg start)) (not (pascal-declaration-beg)))
1034         ()
1035       (let ((lineup (if (or (looking-at "\\<var\\>\\|\\<record\\>") arg start)
1036                         ":" "="))
1037             (stpos (if start start
1038                        (forward-word 2) (backward-word 1) (point)))
1039             (edpos (set-marker (make-marker)
1040                                (if end end
1041                                  (max (progn (pascal-declaration-end)
1042                                              (point))
1043                                       pos))))
1044             ind)
1045
1046         (goto-char stpos)
1047         ;; Indent lines in record block
1048         (if arg
1049             (while (<= (point) edpos)
1050               (beginning-of-line)
1051               (delete-horizontal-space)
1052               (if (looking-at "end\\>")
1053                   (indent-to arg)
1054                 (indent-to (+ arg pascal-indent-level)))
1055               (forward-line 1)))
1056
1057         ;; Do lineup
1058         (setq ind (pascal-get-lineup-indent stpos edpos lineup))
1059         (goto-char stpos)
1060         (while (and (<= (point) edpos) (not (eobp)))
1061           (if (search-forward lineup (pascal-get-end-of-line) 'move)
1062               (forward-char -1))
1063           (delete-horizontal-space)
1064           (indent-to ind)
1065           (if (not (looking-at lineup))
1066               (forward-line 1) ; No more indent if there is no : or =
1067             (forward-char 1)
1068             (delete-horizontal-space)
1069             (insert " ")
1070             ;; Indent record block
1071             (if (looking-at "record\\>")
1072                 (pascal-indent-declaration (current-column)))
1073             (forward-line 1)))))
1074
1075     ;; If arg - move point
1076     (if arg (forward-line -1)
1077       (goto-char pos))))
1078
1079 ;  "Return the indent level that will line up several lines within the region
1080 ;from b to e nicely. The lineup string is str."
1081 (defun pascal-get-lineup-indent (b e str)
1082   (save-excursion
1083     (let ((ind 0)
1084           (reg (concat str "\\|\\(\\<record\\>\\)\\|" pascal-defun-re)))
1085       (goto-char b)
1086       ;; Get rightmost position
1087       (while (< (point) e)
1088         (and (re-search-forward reg (min e (pascal-get-end-of-line 2)) 'move)
1089              (cond ((match-beginning 1)
1090                     ;; Skip record blocks
1091                     (pascal-declaration-end))
1092                    ((match-beginning 2)
1093                     ;; We have entered a new procedure.  Exit.
1094                     (goto-char e))
1095                    (t
1096                     (goto-char (match-beginning 0))
1097                     (skip-chars-backward " \t")
1098                     (if (> (current-column) ind)
1099                         (setq ind (current-column)))
1100                     (goto-char (match-end 0))
1101                     (end-of-line)
1102                     ))))
1103       ;; In case no lineup was found
1104       (if (> ind 0)
1105           (1+ ind)
1106         ;; No lineup-string found
1107         (goto-char b)
1108         (end-of-line)
1109         (skip-chars-backward " \t")
1110         (1+ (current-column))))))
1111
1112 \f
1113
1114 ;;;
1115 ;;; Completion
1116 ;;;
1117 (defvar pascal-str nil)
1118 (defvar pascal-all nil)
1119 (defvar pascal-pred nil)
1120 (defvar pascal-buffer-to-use nil)
1121 (defvar pascal-flag nil)
1122
1123 (defun pascal-string-diff (str1 str2)
1124   "Return index of first letter where STR1 and STR2 differs."
1125   (catch 'done
1126     (let ((diff 0))
1127       (while t
1128         (if (or (> (1+ diff) (length str1))
1129                 (> (1+ diff) (length str2)))
1130             (throw 'done diff))
1131         (or (equal (aref str1 diff) (aref str2 diff))
1132             (throw 'done diff))
1133         (setq diff (1+ diff))))))
1134
1135 ;; Calculate all possible completions for functions if argument is `function',
1136 ;; completions for procedures if argument is `procedure' or both functions and
1137 ;; procedures otherwise.
1138
1139 (defun pascal-func-completion (type)
1140   ;; Build regular expression for function/procedure names
1141   (if (string= pascal-str "")
1142       (setq pascal-str "[a-zA-Z_]"))
1143   (let ((pascal-str (concat (cond
1144                              ((eq type 'procedure) "\\<\\(procedure\\)\\s +")
1145                              ((eq type 'function) "\\<\\(function\\)\\s +")
1146                              (t "\\<\\(function\\|procedure\\)\\s +"))
1147                             "\\<\\(" pascal-str "[a-zA-Z0-9_.]*\\)\\>"))
1148         match)
1149
1150     (if (not (looking-at "\\<\\(function\\|procedure\\)\\>"))
1151         (re-search-backward "\\<\\(function\\|procedure\\)\\>" nil t))
1152     (forward-char 1)
1153
1154     ;; Search through all reachable functions
1155     (while (pascal-beg-of-defun)
1156       (if (re-search-forward pascal-str (pascal-get-end-of-line) t)
1157           (progn (setq match (buffer-substring (match-beginning 2)
1158                                                (match-end 2)))
1159                  (if (or (null pascal-pred)
1160                          (funcall pascal-pred match))
1161                      (setq pascal-all (cons match pascal-all)))))
1162       (goto-char (match-beginning 0)))))
1163
1164 (defun pascal-get-completion-decl ()
1165   ;; Macro for searching through current declaration (var, type or const)
1166   ;; for matches of `str' and adding the occurrence to `all'
1167   (let ((end (save-excursion (pascal-declaration-end)
1168                              (point)))
1169         match)
1170     ;; Traverse lines
1171     (while (< (point) end)
1172       (if (re-search-forward "[:=]" (pascal-get-end-of-line) t)
1173           ;; Traverse current line
1174           (while (and (re-search-backward
1175                        (concat "\\((\\|\\<\\(var\\|type\\|const\\)\\>\\)\\|"
1176                                pascal-symbol-re)
1177                        (pascal-get-beg-of-line) t)
1178                       (not (match-end 1)))
1179             (setq match (buffer-substring (match-beginning 0) (match-end 0)))
1180             (if (string-match (concat "\\<" pascal-str) match)
1181                 (if (or (null pascal-pred)
1182                         (funcall pascal-pred match))
1183                     (setq pascal-all (cons match pascal-all))))))
1184       (if (re-search-forward "\\<record\\>" (pascal-get-end-of-line) t)
1185           (pascal-declaration-end)
1186         (forward-line 1)))))
1187
1188 (defun pascal-type-completion ()
1189   "Calculate all possible completions for types."
1190   (let ((start (point))
1191         goon)
1192     ;; Search for all reachable type declarations
1193     (while (or (pascal-beg-of-defun)
1194                (setq goon (not goon)))
1195       (save-excursion
1196         (if (and (< start (prog1 (save-excursion (pascal-end-of-defun)
1197                                                  (point))
1198                             (forward-char 1)))
1199                  (re-search-forward
1200                   "\\<type\\>\\|\\<\\(begin\\|function\\|procedure\\)\\>"
1201                   start t)
1202                  (not (match-end 1)))
1203             ;; Check current type declaration
1204             (pascal-get-completion-decl))))))
1205
1206 (defun pascal-var-completion ()
1207   "Calculate all possible completions for variables (or constants)."
1208   (let ((start (point))
1209         goon twice)
1210     ;; Search for all reachable var declarations
1211     (while (or (pascal-beg-of-defun)
1212                (setq goon (not goon)))
1213       (save-excursion
1214         (if (> start (prog1 (save-excursion (pascal-end-of-defun)
1215                                             (point))))
1216             () ; Declarations not reachable
1217           (if (search-forward "(" (pascal-get-end-of-line) t)
1218               ;; Check parameterlist
1219                 (pascal-get-completion-decl))
1220           (setq twice 2)
1221           (while (>= (setq twice (1- twice)) 0)
1222             (cond ((and (re-search-forward
1223                          (concat "\\<\\(var\\|const\\)\\>\\|"
1224                                  "\\<\\(begin\\|function\\|procedure\\)\\>")
1225                          start t)
1226                         (not (match-end 2)))
1227                    ;; Check var/const declarations
1228                    (pascal-get-completion-decl))
1229                   ((match-end 2)
1230                    (setq twice 0)))))))))
1231
1232
1233 (defun pascal-keyword-completion (keyword-list)
1234   "Give list of all possible completions of keywords in KEYWORD-LIST."
1235   (mapcar '(lambda (s)
1236              (if (string-match (concat "\\<" pascal-str) s)
1237                  (if (or (null pascal-pred)
1238                          (funcall pascal-pred s))
1239                      (setq pascal-all (cons s pascal-all)))))
1240           keyword-list))
1241
1242 ;; Function passed to completing-read, try-completion or
1243 ;; all-completions to get completion on STR. If predicate is non-nil,
1244 ;; it must be a function to be called for every match to check if this
1245 ;; should really be a match. If flag is t, the function returns a list
1246 ;; of all possible completions. If it is nil it returns a string, the
1247 ;; longest possible completion, or t if STR is an exact match. If flag
1248 ;; is 'lambda, the function returns t if STR is an exact match, nil
1249 ;; otherwise.
1250
1251 (defun pascal-completion (pascal-str pascal-pred pascal-flag)
1252   (save-excursion
1253     (let ((pascal-all nil))
1254       ;; Set buffer to use for searching labels. This should be set
1255       ;; within functions which use pascal-completions
1256       (set-buffer pascal-buffer-to-use)
1257
1258       ;; Determine what should be completed
1259       (let ((state (car (pascal-calculate-indent))))
1260         (cond (;--Within a declaration or parameterlist
1261                (or (eq state 'declaration) (eq state 'paramlist)
1262                    (and (eq state 'defun)
1263                         (save-excursion
1264                           (re-search-backward ")[ \t]*:"
1265                                               (pascal-get-beg-of-line) t))))
1266                (if (or (eq state 'paramlist) (eq state 'defun))
1267                    (pascal-beg-of-defun))
1268                (pascal-type-completion)
1269                (pascal-keyword-completion pascal-type-keywords))
1270               (;--Starting a new statement
1271                (and (not (eq state 'contexp))
1272                     (save-excursion
1273                       (skip-chars-backward "a-zA-Z0-9_.")
1274                       (backward-sexp 1)
1275                       (or (looking-at pascal-nosemi-re)
1276                           (progn
1277                             (forward-sexp 1)
1278                             (looking-at "\\s *\\(;\\|:[^=]\\)")))))
1279                (save-excursion (pascal-var-completion))
1280                (pascal-func-completion 'procedure)
1281                (pascal-keyword-completion pascal-start-keywords))
1282               (t;--Anywhere else
1283                (save-excursion (pascal-var-completion))
1284                (pascal-func-completion 'function)
1285                (pascal-keyword-completion pascal-separator-keywords))))
1286
1287       ;; Now we have built a list of all matches. Give response to caller
1288       (pascal-completion-response))))
1289
1290 (defun pascal-completion-response ()
1291   (cond ((or (equal pascal-flag 'lambda) (null pascal-flag))
1292          ;; This was not called by all-completions
1293          (if (null pascal-all)
1294              ;; Return nil if there was no matching label
1295              nil
1296            ;; Get longest string common in the labels
1297            (let* ((elm (cdr pascal-all))
1298                   (match (car pascal-all))
1299                   (min (length match))
1300                   tmp)
1301              (if (string= match pascal-str)
1302                  ;; Return t if first match was an exact match
1303                  (setq match t)
1304                (while (not (null elm))
1305                  ;; Find longest common string
1306                  (if (< (setq tmp (pascal-string-diff match (car elm))) min)
1307                      (progn
1308                        (setq min tmp)
1309                        (setq match (substring match 0 min))))
1310                  ;; Terminate with match=t if this is an exact match
1311                  (if (string= (car elm) pascal-str)
1312                      (progn
1313                        (setq match t)
1314                        (setq elm nil))
1315                    (setq elm (cdr elm)))))
1316              ;; If this is a test just for exact match, return nil ot t
1317              (if (and (equal pascal-flag 'lambda) (not (equal match 't)))
1318                  nil
1319                match))))
1320         ;; If flag is t, this was called by all-completions. Return
1321         ;; list of all possible completions
1322         (pascal-flag
1323          pascal-all)))
1324
1325 (defvar pascal-last-word-numb 0)
1326 (defvar pascal-last-word-shown nil)
1327 (defvar pascal-last-completions nil)
1328
1329 (defun pascal-complete-word ()
1330   "Complete word at current point.
1331 \(See also `pascal-toggle-completions', `pascal-type-keywords',
1332 `pascal-start-keywords' and `pascal-separator-keywords'.)"
1333   (interactive)
1334   (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
1335          (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))
1336          (pascal-str (buffer-substring b e))
1337          ;; The following variable is used in pascal-completion
1338          (pascal-buffer-to-use (current-buffer))
1339          (allcomp (if (and pascal-toggle-completions
1340                            (string= pascal-last-word-shown pascal-str))
1341                       pascal-last-completions
1342                     (all-completions pascal-str 'pascal-completion)))
1343          (match (if pascal-toggle-completions
1344                     "" (try-completion
1345                         pascal-str (mapcar '(lambda (elm)
1346                                               (cons elm 0)) allcomp)))))
1347     ;; Delete old string
1348     (delete-region b e)
1349
1350     ;; Toggle-completions inserts whole labels
1351     (if pascal-toggle-completions
1352         (progn
1353           ;; Update entry number in list
1354           (setq pascal-last-completions allcomp
1355                 pascal-last-word-numb
1356                 (if (>= pascal-last-word-numb (1- (length allcomp)))
1357                     0
1358                   (1+ pascal-last-word-numb)))
1359           (setq pascal-last-word-shown (elt allcomp pascal-last-word-numb))
1360           ;; Display next match or same string if no match was found
1361           (if (not (null allcomp))
1362               (insert "" pascal-last-word-shown)
1363             (insert "" pascal-str)
1364             (message "(No match)")))
1365       ;; The other form of completion does not necessarily do that.
1366
1367       ;; Insert match if found, or the original string if no match
1368       (if (or (null match) (equal match 't))
1369           (progn (insert "" pascal-str)
1370                  (message "(No match)"))
1371         (insert "" match))
1372       ;; Give message about current status of completion
1373       (cond ((equal match 't)
1374              (if (not (null (cdr allcomp)))
1375                  (message "(Complete but not unique)")
1376                (message "(Sole completion)")))
1377             ;; Display buffer if the current completion didn't help
1378             ;; on completing the label.
1379             ((and (not (null (cdr allcomp))) (= (length pascal-str)
1380                                                 (length match)))
1381              (with-output-to-temp-buffer "*Completions*"
1382                (display-completion-list allcomp))
1383              ;; Wait for a keypress. Then delete *Completion*  window
1384              (momentary-string-display "" (point))
1385              (delete-window (get-buffer-window (get-buffer "*Completions*")))
1386              )))))
1387
1388 (defun pascal-show-completions ()
1389   "Show all possible completions at current point."
1390   (interactive)
1391   (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
1392          (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))
1393          (pascal-str (buffer-substring b e))
1394          ;; The following variable is used in pascal-completion
1395          (pascal-buffer-to-use (current-buffer))
1396          (allcomp (if (and pascal-toggle-completions
1397                            (string= pascal-last-word-shown pascal-str))
1398                       pascal-last-completions
1399                     (all-completions pascal-str 'pascal-completion))))
1400     ;; Show possible completions in a temporary buffer.
1401     (with-output-to-temp-buffer "*Completions*"
1402       (display-completion-list allcomp))
1403     ;; Wait for a keypress. Then delete *Completion*  window
1404     (momentary-string-display "" (point))
1405     (delete-window (get-buffer-window (get-buffer "*Completions*")))))
1406
1407
1408 (defun pascal-get-default-symbol ()
1409   "Return symbol around current point as a string."
1410   (save-excursion
1411     (buffer-substring (progn
1412                         (skip-chars-backward " \t")
1413                         (skip-chars-backward "a-zA-Z0-9_")
1414                         (point))
1415                       (progn
1416                         (skip-chars-forward "a-zA-Z0-9_")
1417                         (point)))))
1418
1419 (defun pascal-build-defun-re (str &optional arg)
1420   "Return function/procedure starting with STR as regular expression.
1421 With optional second arg non-nil, STR is the complete name of the instruction."
1422   (if arg
1423       (concat "^\\(function\\|procedure\\)[ \t]+\\(" str "\\)\\>")
1424     (concat "^\\(function\\|procedure\\)[ \t]+\\(" str "[a-zA-Z0-9_]*\\)\\>")))
1425
1426 ;; Function passed to completing-read, try-completion or
1427 ;; all-completions to get completion on any function name. If
1428 ;; predicate is non-nil, it must be a function to be called for every
1429 ;; match to check if this should really be a match. If flag is t, the
1430 ;; function returns a list of all possible completions. If it is nil
1431 ;; it returns a string, the longest possible completion, or t if STR
1432 ;; is an exact match. If flag is 'lambda, the function returns t if
1433 ;; STR is an exact match, nil otherwise.
1434
1435 (defun pascal-comp-defun (pascal-str pascal-pred pascal-flag)
1436   (save-excursion
1437     (let ((pascal-all nil)
1438           match)
1439
1440       ;; Set buffer to use for searching labels. This should be set
1441       ;; within functions which use pascal-completions
1442       (set-buffer pascal-buffer-to-use)
1443
1444       (let ((pascal-str pascal-str))
1445         ;; Build regular expression for functions
1446         (if (string= pascal-str "")
1447             (setq pascal-str (pascal-build-defun-re "[a-zA-Z_]"))
1448           (setq pascal-str (pascal-build-defun-re pascal-str)))
1449         (goto-char (point-min))
1450
1451         ;; Build a list of all possible completions
1452         (while (re-search-forward pascal-str nil t)
1453           (setq match (buffer-substring (match-beginning 2) (match-end 2)))
1454           (if (or (null pascal-pred)
1455                   (funcall pascal-pred match))
1456               (setq pascal-all (cons match pascal-all)))))
1457
1458       ;; Now we have built a list of all matches. Give response to caller
1459       (pascal-completion-response))))
1460
1461 (defun pascal-goto-defun ()
1462   "Move to specified Pascal function/procedure.
1463 The default is a name found in the buffer around point."
1464   (interactive)
1465   (let* ((default (pascal-get-default-symbol))
1466          ;; The following variable is used in pascal-comp-function
1467          (pascal-buffer-to-use (current-buffer))
1468          (default (if (pascal-comp-defun default nil 'lambda)
1469                       default ""))
1470          (label (if (not (string= default ""))
1471                     ;; Do completion with default
1472                     (completing-read (concat "Label: (default " default ") ")
1473                                      'pascal-comp-defun nil t "")
1474                   ;; There is no default value. Complete without it
1475                   (completing-read "Label: "
1476                                    'pascal-comp-defun nil t ""))))
1477     ;; If there was no response on prompt, use default value
1478     (if (string= label "")
1479         (setq label default))
1480     ;; Goto right place in buffer if label is not an empty string
1481     (or (string= label "")
1482         (progn
1483           (goto-char (point-min))
1484           (re-search-forward (pascal-build-defun-re label t))
1485           (beginning-of-line)))))
1486
1487 \f
1488
1489 ;;;
1490 ;;; Pascal-outline-mode
1491 ;;;
1492 (defvar pascal-outline-map nil "Keymap used in Pascal Outline mode.")
1493
1494 (if pascal-outline-map
1495     nil
1496   (if (boundp 'set-keymap-name)
1497       (set-keymap-name pascal-outline-map 'pascal-outline-map))
1498   (if (not (boundp 'set-keymap-parent))
1499       (setq pascal-outline-map (copy-keymap pascal-mode-map))
1500     (setq pascal-outline-map (make-sparse-keymap))
1501     (set-keymap-parent pascal-outline-map pascal-mode-map))
1502   (define-key pascal-outline-map "\M-\C-a"  'pascal-outline-prev-defun)
1503   (define-key pascal-outline-map "\M-\C-e"  'pascal-outline-next-defun)
1504   (define-key pascal-outline-map "\C-c\C-d" 'pascal-outline-goto-defun)
1505   (define-key pascal-outline-map "\C-c\C-s" 'pascal-show-all)
1506   (define-key pascal-outline-map "\C-c\C-h" 'pascal-hide-other-defuns))
1507
1508 (defvar pascal-outline-mode nil "Non-nil while using Pascal Outline mode.")
1509 (make-variable-buffer-local 'pascal-outline-mode)
1510 (set-default 'pascal-outline-mode nil)
1511 (if (not (assoc 'pascal-outline-mode minor-mode-alist))
1512     (setq minor-mode-alist (append minor-mode-alist
1513                                    (list '(pascal-outline-mode " Outl")))))
1514
1515 (defun pascal-outline (&optional arg)
1516   "Outline-line minor mode for Pascal mode.
1517 When in Pascal Outline mode, portions
1518 of the text being edited may be made invisible. \\<pascal-outline-map>
1519
1520 Pascal Outline mode provides some additional commands.
1521
1522 \\[pascal-outline-prev-defun]\
1523 \t- Move to previous function/procedure, hiding everything else.
1524 \\[pascal-outline-next-defun]\
1525 \t- Move to next function/procedure, hiding everything else.
1526 \\[pascal-outline-goto-defun]\
1527 \t- Goto function/procedure prompted for in minibuffer,
1528 \t  hide all other functions.
1529 \\[pascal-show-all]\t- Show the whole buffer.
1530 \\[pascal-hide-other-defuns]\
1531 \t- Hide everything but the current function (function under the cursor).
1532 \\[pascal-outline]\t- Leave pascal-outline-mode."
1533   (interactive "P")
1534   (setq pascal-outline-mode
1535         (if (null arg) (not pascal-outline-mode) t))
1536   (if (boundp 'redraw-mode-line)
1537       (redraw-mode-line))
1538   (if pascal-outline-mode
1539       (progn
1540         (setq selective-display t)
1541         (use-local-map pascal-outline-map))
1542     (progn
1543       (setq selective-display nil)
1544       (pascal-show-all)
1545       (use-local-map pascal-mode-map))))
1546
1547 (defun pascal-outline-change (b e pascal-flag)
1548   (let ((modp (buffer-modified-p)))
1549     (unwind-protect
1550         (subst-char-in-region b e (if (= pascal-flag ?\n)
1551                                       ?\^M ?\n) pascal-flag)
1552       (set-buffer-modified-p modp))))
1553
1554 (defun pascal-show-all ()
1555   "Show all of the text in the buffer."
1556   (interactive)
1557   (pascal-outline-change (point-min) (point-max) ?\n))
1558
1559 (defun pascal-hide-other-defuns ()
1560   "Show only the current defun."
1561   (interactive)
1562   (save-excursion
1563     (let ((beg (progn (if (not (looking-at "\\(function\\|procedure\\)\\>"))
1564                           (pascal-beg-of-defun))
1565                       (point)))
1566           (end (progn (pascal-end-of-defun)
1567                       (backward-sexp 1)
1568                       (search-forward "\n\\|\^M" nil t)
1569                       (point)))
1570           (opoint (point-min)))
1571       (goto-char (point-min))
1572
1573       ;; Hide all functions before current function
1574       (while (re-search-forward "^\\(function\\|procedure\\)\\>" beg 'move)
1575         (pascal-outline-change opoint (1- (match-beginning 0)) ?\^M)
1576         (setq opoint (point))
1577         ;; Functions may be nested
1578         (if (> (progn (pascal-end-of-defun) (point)) beg)
1579             (goto-char opoint)))
1580       (if (> beg opoint)
1581           (pascal-outline-change opoint (1- beg) ?\^M))
1582
1583       ;; Show current function
1584       (pascal-outline-change beg end ?\n)
1585       ;; Hide nested functions
1586       (forward-char 1)
1587       (while (re-search-forward "^\\(function\\|procedure\\)\\>" end 'move)
1588         (setq opoint (point))
1589         (pascal-end-of-defun)
1590         (pascal-outline-change opoint (point) ?\^M))
1591
1592       (goto-char end)
1593       (setq opoint end)
1594
1595       ;; Hide all function after current function
1596       (while (re-search-forward "^\\(function\\|procedure\\)\\>" nil 'move)
1597         (pascal-outline-change opoint (1- (match-beginning 0)) ?\^M)
1598         (setq opoint (point))
1599         (pascal-end-of-defun))
1600       (pascal-outline-change opoint (point-max) ?\^M)
1601
1602       ;; Hide main program
1603       (if (< (progn (forward-line -1) (point)) end)
1604           (progn
1605             (goto-char beg)
1606             (pascal-end-of-defun)
1607             (backward-sexp 1)
1608             (pascal-outline-change (point) (point-max) ?\^M))))))
1609
1610 (defun pascal-outline-next-defun ()
1611   "Move to next function/procedure, hiding all others."
1612   (interactive)
1613   (pascal-end-of-defun)
1614   (pascal-hide-other-defuns))
1615
1616 (defun pascal-outline-prev-defun ()
1617   "Move to previous function/procedure, hiding all others."
1618   (interactive)
1619   (pascal-beg-of-defun)
1620   (pascal-hide-other-defuns))
1621
1622 (defun pascal-outline-goto-defun ()
1623   "Move to specified function/procedure, hiding all others."
1624   (interactive)
1625   (pascal-goto-defun)
1626   (pascal-hide-other-defuns))
1627
1628 (provide 'pascal)
1629
1630 ;;; arch-tag: 04535136-fd93-40b4-a505-c9bebdc051f5
1631 ;;; pascal.el ends here