code.delx.au - gnu-emacs/blob - lisp/progmodes/pascal.el

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