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