lisp/progmodes/pascal.el

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