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

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