lisp/progmodes/pascal.el

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