cgit.sxemacs.org Git - packages/blob - xemacs-packages/prog-modes/pascal.el

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