lisp/progmodes/pascal.el

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