lisp/progmodes/pascal.el

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