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

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