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

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