1 ;;; pascal.el --- major mode for editing pascal source in Emacs
3 ;; Copyright (C) 1993, 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
5 ;; Author: Espen Skoglund (espensk@stud.cs.uit.no)
8 ;; This file is part of XEmacs.
10 ;; XEmacs is free software; you can redistribute it and/or modify it
11 ;; under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; XEmacs is distributed in the hope that it will be useful, but
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with XEmacs; see the file COPYING. If not, write to
22 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
25 ;;; Synched up with: FSF 19.34
32 ;; Emacs should enter Pascal mode when you find a Pascal source file.
33 ;; When you have entered Pascal mode, you may get more info by pressing
34 ;; C-h m. You may also get online help describing various functions by:
35 ;; C-h f <Name of function you want described>
37 ;; If you want to customize Pascal mode to fit you better, you may add
38 ;; these lines (the values of the variables presented here are the defaults):
40 ;; ;; User customization for Pascal mode
41 ;; (setq pascal-indent-level 3
42 ;; pascal-case-indent 2
43 ;; pascal-auto-newline nil
44 ;; pascal-tab-always-indent t
45 ;; pascal-auto-endcomments t
46 ;; pascal-auto-lineup '(all)
47 ;; pascal-toggle-completions nil
48 ;; pascal-type-keywords '("array" "file" "packed" "char"
49 ;; "integer" "real" "string" "record")
50 ;; pascal-start-keywords '("begin" "end" "function" "procedure"
51 ;; "repeat" "until" "while" "read" "readln"
52 ;; "reset" "rewrite" "write" "writeln")
53 ;; pascal-separator-keywords '("downto" "else" "mod" "div" "then"))
55 ;; KNOWN BUGS / BUGREPORTS
56 ;; =======================
57 ;; As far as I know, there are no bugs in the current version of this
58 ;; package. This may not be true however, since I never use this mode
59 ;; myself and therefore would never notice them anyway. If you do
60 ;; find any bugs, you may submit them to: espensk@stud.cs.uit.no
61 ;; as well as to bug-gnu-emacs@prep.ai.mit.edu.
65 (defconst pascal-mode-version "2.5"
66 "Version of `pascal.el'.")
69 "Major mode for editing Pascal source in Emacs"
72 (defvar pascal-mode-abbrev-table nil
73 "Abbrev table in use in Pascal-mode buffers.")
74 (define-abbrev-table 'pascal-mode-abbrev-table ())
76 (defvar pascal-mode-map ()
77 "Keymap used in Pascal mode.")
80 (setq pascal-mode-map (make-sparse-keymap))
81 (define-key pascal-mode-map ";" 'electric-pascal-semi-or-dot)
82 (define-key pascal-mode-map "." 'electric-pascal-semi-or-dot)
83 (define-key pascal-mode-map ":" 'electric-pascal-colon)
84 (define-key pascal-mode-map "=" 'electric-pascal-equal)
85 (define-key pascal-mode-map "#" 'electric-pascal-hash)
86 (define-key pascal-mode-map "\r" 'electric-pascal-terminate-line)
87 (define-key pascal-mode-map "\t" 'electric-pascal-tab)
88 (define-key pascal-mode-map "\M-\t" 'pascal-complete-word)
89 (define-key pascal-mode-map "\M-?" 'pascal-show-completions)
90 (define-key pascal-mode-map "\M-\C-h" 'pascal-mark-defun)
91 (define-key pascal-mode-map "\C-c\C-b" 'pascal-insert-block)
92 (define-key pascal-mode-map "\M-*" 'pascal-star-comment)
93 (define-key pascal-mode-map "\C-c\C-c" 'pascal-comment-area)
94 (define-key pascal-mode-map "\C-c\C-u" 'pascal-uncomment-area)
95 (define-key pascal-mode-map "\M-\C-a" 'pascal-beg-of-defun)
96 (define-key pascal-mode-map "\M-\C-e" 'pascal-end-of-defun)
97 (define-key pascal-mode-map "\C-c\C-d" 'pascal-goto-defun)
98 (define-key pascal-mode-map "\C-c\C-o" 'pascal-outline)
99 ;;; A command to change the whole buffer won't be used terribly
100 ;;; often, so no need for a key binding.
101 ; (define-key pascal-mode-map "\C-cd" 'pascal-downcase-keywords)
102 ; (define-key pascal-mode-map "\C-cu" 'pascal-upcase-keywords)
103 ; (define-key pascal-mode-map "\C-cc" 'pascal-capitalize-keywords)
106 (defvar pascal-imenu-generic-expression
107 '("^[ \t]*\\(function\\|procedure\\)[ \t\n]+\\([a-zA-Z0-9_.:]+\\)" . (2))
108 "Imenu expression for Pascal-mode. See `imenu-generic-expression'.")
110 (defvar pascal-keywords
111 '("and" "array" "begin" "case" "const" "div" "do" "downto" "else" "end"
112 "file" "for" "function" "goto" "if" "in" "label" "mod" "nil" "not" "of"
113 "or" "packed" "procedure" "program" "record" "repeat" "set" "then" "to"
114 "type" "until" "var" "while" "with"
115 ;; The following are not standard in pascal, but widely used.
116 "get" "put" "input" "output" "read" "readln" "reset" "rewrite" "write"
120 ;;; Regular expressions used to calculate indent, etc.
122 (defconst pascal-symbol-re "\\<[a-zA-Z_][a-zA-Z_0-9.]*\\>")
123 (defconst pascal-beg-block-re "\\<\\(begin\\|case\\|record\\|repeat\\)\\>")
124 (defconst pascal-end-block-re "\\<\\(end\\|until\\)\\>")
125 (defconst pascal-declaration-re "\\<\\(const\\|label\\|type\\|var\\)\\>")
126 (defconst pascal-defun-re "\\<\\(function\\|procedure\\|program\\)\\>")
127 (defconst pascal-sub-block-re "\\<\\(if\\|else\\|for\\|while\\|with\\)\\>")
128 (defconst pascal-noindent-re "\\<\\(begin\\|end\\|until\\|else\\)\\>")
129 (defconst pascal-nosemi-re "\\<\\(begin\\|repeat\\|then\\|do\\|else\\)\\>")
130 (defconst pascal-autoindent-lines-re
131 "\\<\\(label\\|var\\|type\\|const\\|until\\|end\\|begin\\|repeat\\|else\\)\\>")
133 ;;; Strings used to mark beginning and end of excluded text
134 (defconst pascal-exclude-str-start "{-----\\/----- EXCLUDED -----\\/-----")
135 (defconst pascal-exclude-str-end " -----/\\----- EXCLUDED -----/\\-----}")
137 (defvar pascal-mode-syntax-table nil
138 "Syntax table in use in Pascal-mode buffers.")
140 (if pascal-mode-syntax-table
142 (setq pascal-mode-syntax-table (make-syntax-table))
143 (modify-syntax-entry ?\\ "." pascal-mode-syntax-table)
144 (modify-syntax-entry ?( "()1" pascal-mode-syntax-table)
145 (modify-syntax-entry ?) ")(4" pascal-mode-syntax-table)
146 (modify-syntax-entry ?* ". 23" pascal-mode-syntax-table)
147 (modify-syntax-entry ?{ "<" pascal-mode-syntax-table)
148 (modify-syntax-entry ?} ">" pascal-mode-syntax-table)
149 (modify-syntax-entry ?+ "." pascal-mode-syntax-table)
150 (modify-syntax-entry ?- "." pascal-mode-syntax-table)
151 (modify-syntax-entry ?= "." pascal-mode-syntax-table)
152 (modify-syntax-entry ?% "." pascal-mode-syntax-table)
153 (modify-syntax-entry ?< "." pascal-mode-syntax-table)
154 (modify-syntax-entry ?> "." pascal-mode-syntax-table)
155 (modify-syntax-entry ?& "." pascal-mode-syntax-table)
156 (modify-syntax-entry ?| "." pascal-mode-syntax-table)
157 (modify-syntax-entry ?_ "_" pascal-mode-syntax-table)
158 (modify-syntax-entry ?\' "\"" pascal-mode-syntax-table))
160 (defvar pascal-font-lock-keywords (purecopy
162 '("^[ \t]*\\(function\\|pro\\(cedure\\|gram\\)\\)\\>[ \t]*\\(\\[a-z]\\)?"
163 1 font-lock-keyword-face)
164 '("^[ \t]*\\(function\\|pro\\(cedure\\|gram\\)\\)\\>[ \t]*\\([a-z][a-z0-9_]*\\)"
165 3 font-lock-function-name-face t)
166 ; ("type" "const" "real" "integer" "char" "boolean" "var"
167 ; "record" "array" "file")
168 (cons (concat "\\<\\(array\\|boolean\\|c\\(har\\|onst\\)\\|file\\|"
169 "integer\\|re\\(al\\|cord\\)\\|type\\|var\\)\\>")
170 'font-lock-type-face)
171 '("\\<\\(label\\|external\\|forward\\)\\>" . font-lock-reference-face)
172 '("\\<\\([0-9]+\\)[ \t]*:" 1 font-lock-function-name-face)
173 ; ("of" "to" "for" "if" "then" "else" "case" "while"
174 ; "do" "until" "and" "or" "not" "in" "with" "repeat" "begin" "end")
176 "and\\|begin\\|case\\|do\\|e\\(lse\\|nd\\)\\|for\\|i[fn]\\|"
177 "not\\|o[fr]\\|repeat\\|t\\(hen\\|o\\)\\|until\\|w\\(hile\\|ith\\)"
179 '("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?"
180 1 font-lock-keyword-face)
181 '("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?"
182 2 font-lock-keyword-face nil t)))
183 "Additional expressions to highlight in Pascal mode.")
184 (put 'pascal-mode 'font-lock-defaults '(pascal-font-lock-keywords nil t))
186 (defcustom pascal-indent-level 3
187 "*Indentation of Pascal statements with respect to containing block."
191 (defcustom pascal-case-indent 2
192 "*Indentation for case statements."
196 (defcustom pascal-auto-newline nil
197 "*Non-nil means automatically newline after semicolons and the punctuation
202 (defcustom pascal-tab-always-indent t
203 "*Non-nil means TAB in Pascal mode should always reindent the current line,
204 regardless of where in the line point is when the TAB command is used."
208 (defcustom pascal-auto-endcomments t
209 "*Non-nil means a comment { ... } is set after the ends which ends cases and
210 functions. The name of the function or case will be set between the braces."
214 (defcustom pascal-auto-lineup '(all)
215 "*List of contexts where auto lineup of :'s or ='s should be done.
216 Elements can be of type: 'paramlist', 'declaration' or 'case', which will
217 do auto lineup in parameterlist, declarations or case-statements
218 respectively. The word 'all' will do all lineups. '(case paramlist) for
219 instance will do lineup in case-statements and parameterlist, while '(all)
220 will do all lineups."
221 :type '(repeat (choice (const all)
227 (defcustom pascal-toggle-completions nil
228 "*Non-nil means that repeated use of \
229 \\<pascal-mode-map>\\[pascal-complete-word] will toggle the possible
230 completions in the minibuffer. Normally, when there is more than one possible
231 completion, a buffer will display all completions."
235 (defcustom pascal-type-keywords
236 '("array" "file" "packed" "char" "integer" "real" "string" "record")
237 "*Keywords for types used when completing a word in a declaration or parmlist.
238 \(eg. integer, real, char.) The types defined within the Pascal program
239 will be completed runtime, and should not be added to this list."
240 :type '(repeat (string :tag "Keyword"))
243 (defcustom pascal-start-keywords
244 '("begin" "end" "function" "procedure" "repeat" "until" "while"
245 "read" "readln" "reset" "rewrite" "write" "writeln")
246 "*Keywords to complete when standing at the first word of a statement.
247 \(eg. begin, repeat, until, readln.)
248 The procedures and variables defined within the Pascal program
249 will be completed runtime and should not be added to this list."
250 :type '(repeat (string :tag "Keyword"))
253 (defcustom pascal-separator-keywords
254 '("downto" "else" "mod" "div" "then")
255 "*Keywords to complete when NOT standing at the first word of a statement.
256 \(eg. downto, else, mod, then.)
257 Variables and function names defined within the
258 Pascal program are completed runtime and should not be added to this list."
259 :type '(repeat (string :tag "Keyword"))
266 (defsubst pascal-get-beg-of-line (&optional arg)
268 (beginning-of-line arg)
271 (defsubst pascal-get-end-of-line (&optional arg)
276 (defun pascal-declaration-end ()
278 (while (and (> nest 0)
280 "[:=]\\|\\(\\<record\\>\\)\\|\\(\\<end\\>\\)"
281 (save-excursion (end-of-line 2) (point)) t))
282 (cond ((match-beginning 1) (setq nest (1+ nest)))
283 ((match-beginning 2) (setq nest (1- nest)))
284 ((looking-at "[^(\n]+)") (setq nest 0))))))
287 (defun pascal-declaration-beg ()
289 (while (and (> nest 0)
290 (re-search-backward "[:=]\\|\\<\\(type\\|var\\|label\\|const\\)\\>\\|\\(\\<record\\>\\)\\|\\(\\<end\\>\\)" (pascal-get-beg-of-line 0) t))
291 (cond ((match-beginning 1) (setq nest 0))
292 ((match-beginning 2) (setq nest (1- nest)))
293 ((match-beginning 3) (setq nest (1+ nest)))))
297 (defsubst pascal-within-string ()
299 (nth 3 (parse-partial-sexp (pascal-get-beg-of-line) (point)))))
303 (defun pascal-mode ()
304 "Major mode for editing Pascal code. \\<pascal-mode-map>
305 TAB indents for Pascal code. Delete converts tabs to spaces as it moves back.
307 \\[pascal-complete-word] completes the word around current point with respect \
309 \\[pascal-show-completions] shows all possible completions at this point.
311 Other useful functions are:
313 \\[pascal-mark-defun]\t- Mark function.
314 \\[pascal-insert-block]\t- insert begin ... end;
315 \\[pascal-star-comment]\t- insert (* ... *)
316 \\[pascal-comment-area]\t- Put marked area in a comment, fixing nested comments.
317 \\[pascal-uncomment-area]\t- Uncomment an area commented with \
318 \\[pascal-comment-area].
319 \\[pascal-beg-of-defun]\t- Move to beginning of current function.
320 \\[pascal-end-of-defun]\t- Move to end of current function.
321 \\[pascal-goto-defun]\t- Goto function prompted for in the minibuffer.
322 \\[pascal-outline]\t- Enter pascal-outline-mode (see also pascal-outline).
324 Variables controlling indentation/edit style:
326 pascal-indent-level (default 3)
327 Indentation of Pascal statements with respect to containing block.
328 pascal-case-indent (default 2)
329 Indentation for case statements.
330 pascal-auto-newline (default nil)
331 Non-nil means automatically newline after semicolons and the punctuation
333 pascal-tab-always-indent (default t)
334 Non-nil means TAB in Pascal mode should always reindent the current line,
335 regardless of where in the line point is when the TAB command is used.
336 pascal-auto-endcomments (default t)
337 Non-nil means a comment { ... } is set after the ends which ends cases and
338 functions. The name of the function or case will be set between the braces.
339 pascal-auto-lineup (default t)
340 List of contexts where auto lineup of :'s or ='s should be done.
342 See also the user variables pascal-type-keywords, pascal-start-keywords and
343 pascal-separator-keywords.
345 Turning on Pascal mode calls the value of the variable pascal-mode-hook with
346 no args, if that value is non-nil."
348 (kill-all-local-variables)
349 (use-local-map pascal-mode-map)
350 (setq major-mode 'pascal-mode)
351 (setq mode-name "Pascal")
352 (setq local-abbrev-table pascal-mode-abbrev-table)
353 (set-syntax-table pascal-mode-syntax-table)
354 (make-local-variable 'indent-line-function)
355 (setq indent-line-function 'pascal-indent-line)
356 (setq comment-indent-function 'pascal-indent-comment)
357 (make-local-variable 'parse-sexp-ignore-comments)
358 (setq parse-sexp-ignore-comments nil)
359 (make-local-variable 'case-fold-search)
360 (setq case-fold-search t)
361 (make-local-variable 'comment-start)
362 (setq comment-start "{")
363 (make-local-variable 'comment-start-skip)
364 (setq comment-start-skip "(\\*+ *\\|{ *")
365 (make-local-variable 'comment-end)
366 (setq comment-end "}")
368 ;(make-local-variable 'font-lock-defaults)
369 ;(setq font-lock-defaults '(pascal-font-lock-keywords nil t))
371 (make-local-variable 'imenu-generic-expression)
372 (setq imenu-generic-expression pascal-imenu-generic-expression)
373 (run-hooks 'pascal-mode-hook))
378 ;;; Electric functions
380 (defun electric-pascal-terminate-line ()
381 "Terminate line and indent next line."
383 ;; First, check if current line should be indented
386 (skip-chars-forward " \t")
387 (if (looking-at pascal-autoindent-lines-re)
388 (pascal-indent-line)))
389 (delete-horizontal-space) ; Removes trailing whitespaces
393 ;; Maybe we should set some endcomments
394 (if pascal-auto-endcomments
395 (pascal-set-auto-comments))
396 ;; Check if we shall indent inside comment
400 (skip-chars-forward " \t")
401 (cond ((looking-at "\\*[ \t]+)")
402 ;; Delete region between `*' and `)' if there is only whitespaces.
404 (delete-horizontal-space))
405 ((and (looking-at "(\\*\\|\\*[^)]")
407 (search-forward "*)" (pascal-get-end-of-line) t))))
409 ;; If last line was a star comment line then this one shall be too.
415 (defun electric-pascal-semi-or-dot ()
416 "Insert `;' or `.' character and reindent the line."
418 (insert last-command-char)
421 (pascal-indent-line))
422 (if pascal-auto-newline
423 (electric-pascal-terminate-line)))
425 (defun electric-pascal-colon ()
426 "Insert `:' and do all indentions except line indent on this line."
428 (insert last-command-char)
429 ;; Do nothing if within string.
430 (if (pascal-within-string)
434 (pascal-indent-line))
435 (let ((pascal-tab-always-indent nil))
436 (pascal-indent-command))))
438 (defun electric-pascal-equal ()
439 "Insert `=', and do indention if within type declaration."
441 (insert last-command-char)
442 (if (eq (car (pascal-calculate-indent)) 'declaration)
443 (let ((pascal-tab-always-indent nil))
444 (pascal-indent-command))))
446 (defun electric-pascal-hash ()
447 "Insert `#', and indent to column 0 if this is a CPP directive."
449 (insert last-command-char)
450 (if (save-excursion (beginning-of-line) (looking-at "^[ \t]*#"))
451 (save-excursion (beginning-of-line)
452 (delete-horizontal-space))))
454 (defun electric-pascal-tab ()
455 "Function called when TAB is pressed in Pascal mode."
457 ;; Do nothing if within a string or in a CPP directive.
458 (if (or (pascal-within-string)
460 (save-excursion (beginning-of-line) (eq (following-char) ?#))))
462 ;; If pascal-tab-always-indent, indent the beginning of the line.
463 (if pascal-tab-always-indent
466 (pascal-indent-line))
468 (skip-chars-backward " \t")
472 (pascal-indent-command)))
477 ;;; Interactive functions
479 (defun pascal-insert-block ()
480 "Insert Pascal begin ... end; block in the code with right indentation."
484 (electric-pascal-terminate-line)
486 (electric-pascal-terminate-line)
489 (pascal-indent-line)))
491 (defun pascal-star-comment ()
492 "Insert Pascal star comment at point."
496 (electric-pascal-terminate-line)
498 (electric-pascal-terminate-line)
499 (delete-horizontal-space)
503 (defun pascal-mark-defun ()
504 "Mark the current pascal function (or procedure).
505 This puts the mark at the end, and point at the beginning."
508 (pascal-end-of-defun)
510 (pascal-beg-of-defun)
511 (if (fboundp 'zmacs-activate-region)
512 (zmacs-activate-region)))
514 (defun pascal-comment-area (start end)
515 "Put the region into a Pascal comment.
516 The comments that are in this area are \"deformed\":
517 `*)' becomes `!(*' and `}' becomes `!{'.
518 These deformed comments are returned to normal if you use
519 \\[pascal-uncomment-area] to undo the commenting.
521 The commented area starts with `pascal-exclude-str-start', and ends with
522 `pascal-include-str-end'. But if you change these variables,
523 \\[pascal-uncomment-area] won't recognize the comments."
526 ;; Insert start and endcomments
528 (if (and (save-excursion (skip-chars-forward " \t") (eolp))
529 (not (save-excursion (skip-chars-backward " \t") (bolp))))
532 (insert pascal-exclude-str-end)
537 (insert pascal-exclude-str-start)
539 ;; Replace end-comments within commented area
542 (while (re-search-backward "\\*)" start t)
543 (replace-match "!(*" t t)))
545 (while (re-search-backward "}" start t)
546 (replace-match "!{" t t)))))
548 (defun pascal-uncomment-area ()
549 "Uncomment a commented area; change deformed comments back to normal.
550 This command does nothing if the pointer is not in a commented
551 area. See also `pascal-comment-area'."
554 (let ((start (point))
556 ;; Find the boundaries of the comment
558 (setq start (progn (search-backward pascal-exclude-str-start nil t)
560 (setq end (progn (search-forward pascal-exclude-str-end nil t)
562 ;; Check if we're really inside a comment
563 (if (or (equal start (point)) (<= end (point)))
564 (message "Not standing within commented area.")
571 (delete-region pos (1+ (point))))
572 ;; Change comments back to normal
574 (while (re-search-backward "!{" start t)
575 (replace-match "}" t t)))
577 (while (re-search-backward "!(\\*" start t)
578 (replace-match "*)" t t)))
579 ;; Remove startcomment
584 (delete-region pos (1+ (point)))))))))
586 (defun pascal-beg-of-defun ()
587 "Move backward to the beginning of the current function or procedure."
590 (if (not (looking-at (concat "\\s \\|\\s)\\|" pascal-defun-re)))
592 (let ((nest 0) (max -1) (func 0)
593 (reg (concat pascal-beg-block-re "\\|"
594 pascal-end-block-re "\\|"
596 (while (re-search-backward reg nil 'move)
597 (cond ((let ((state (save-excursion
598 (parse-partial-sexp (point-min) (point)))))
599 (or (nth 3 state) (nth 4 state))) ; Inside string or comment
601 ((match-end 1) ; begin|case|record|repeat
602 (if (and (looking-at "\\<record\\>") (>= max 0))
603 (setq func (1- func)))
606 ((match-end 2) ; end|until
607 (if (and (= nest max) (>= max 0))
608 (setq func (1+ func)))
609 (setq nest (1- nest)))
610 ((match-end 3) ; function|procedure
613 (setq func (1- func)))))))
616 (defun pascal-end-of-defun ()
617 "Move forward to the end of the current function or procedure."
619 (if (looking-at "\\s ")
621 (if (not (looking-at pascal-defun-re))
622 (pascal-beg-of-defun))
624 (let ((nest 0) (func 1)
625 (reg (concat pascal-beg-block-re "\\|"
626 pascal-end-block-re "\\|"
628 (while (and (/= func 0)
629 (re-search-forward reg nil 'move))
630 (cond ((let ((state (save-excursion
631 (parse-partial-sexp (point-min) (point)))))
632 (or (nth 3 state) (nth 4 state))) ; Inside string or comment
635 (setq nest (1+ nest))
637 (goto-char (match-beginning 0))
638 (looking-at "\\<record\\>"))
639 (setq func (1+ func))))
641 (setq nest (1- nest))
643 (setq func (1- func))))
645 (setq func (1+ func))))))
648 (defun pascal-end-of-statement ()
649 "Move forward to end of current statement."
651 (let ((parse-sexp-ignore-comments t)
653 (regexp (concat "\\(" pascal-beg-block-re "\\)\\|\\("
654 pascal-end-block-re "\\)")))
655 (if (not (looking-at "[ \t\n]")) (forward-sexp -1))
656 (or (looking-at pascal-beg-block-re)
657 ;; Skip to end of statement
658 (setq pos (catch 'found
661 (cond ((looking-at "[ \t]*;")
662 (skip-chars-forward "^;")
664 (throw 'found (point)))
667 (looking-at pascal-beg-block-re))
668 (goto-char (match-beginning 0))
671 (throw 'found (point))))))))
673 ;; Skip a whole block
676 (re-search-forward regexp nil 'move)
677 (setq nest (if (match-end 1)
681 (throw 'found (point)))
683 (throw 'found (pascal-end-of-statement))))))
686 (defun pascal-downcase-keywords ()
687 "Downcase all Pascal keywords in the buffer."
689 (pascal-change-keywords 'downcase-word))
691 (defun pascal-upcase-keywords ()
692 "Upcase all Pascal keywords in the buffer."
694 (pascal-change-keywords 'upcase-word))
696 (defun pascal-capitalize-keywords ()
697 "Capitalize all Pascal keywords in the buffer."
699 (pascal-change-keywords 'capitalize-word))
701 ;; Change the keywords according to argument.
702 (defun pascal-change-keywords (change-word)
704 (let ((keyword-re (concat "\\<\\("
705 (mapconcat 'identity pascal-keywords "\\|")
707 (goto-char (point-min))
708 (while (re-search-forward keyword-re nil t)
709 (funcall change-word -1)))))
716 (defun pascal-set-auto-comments ()
717 "Insert `{ case }' or `{ NAME }' on this line if appropriate.
718 Insert `{ case }' if there is an `end' on the line which
719 ends a case block. Insert `{ NAME }' if there is an `end'
720 on the line which ends a function or procedure named NAME."
723 (skip-chars-forward " \t")
724 (if (and (looking-at "\\<end;")
727 (search-backward "{" (pascal-get-beg-of-line) t))))
728 (let ((type (car (pascal-calculate-indent))))
729 (if (eq type 'declaration)
732 ;; This is a case block
735 (delete-horizontal-space)
736 (insert " { case }"))
738 ;; Check if this is the end of a function
740 (while (not (or (looking-at pascal-defun-re) (bobp)))
742 (cond ((looking-at pascal-beg-block-re)
743 (setq nest (1- nest)))
744 ((looking-at pascal-end-block-re)
745 (setq nest (1+ nest)))))
751 (delete-horizontal-space)
755 (setq b (progn (pascal-beg-of-defun)
756 (skip-chars-forward "^ \t")
757 (skip-chars-forward " \t")
759 e (progn (skip-chars-forward "a-zA-Z0-9_")
761 (insert-buffer-substring (current-buffer) b e))
762 (insert " }"))))))))))
769 (defconst pascal-indent-alist
770 '((block . (+ ind pascal-indent-level))
771 (case . (+ ind pascal-case-indent))
772 (caseblock . ind) (cpp . 0)
773 (declaration . (+ ind pascal-indent-level))
774 (paramlist . (pascal-indent-paramlist t))
775 (comment . (pascal-indent-comment t))
776 (defun . ind) (contexp . ind)
777 (unknown . 0) (string . 0)))
779 (defun pascal-indent-command ()
780 "Indent for special part of code."
781 (let* ((indent-str (pascal-calculate-indent))
782 (type (car indent-str))
783 (ind (car (cdr indent-str))))
784 (cond ((and (eq type 'paramlist)
785 (or (memq 'all pascal-auto-lineup)
786 (memq 'paramlist pascal-auto-lineup)))
787 (pascal-indent-paramlist)
788 (pascal-indent-paramlist))
789 ((and (eq type 'declaration)
790 (or (memq 'all pascal-auto-lineup)
791 (memq 'declaration pascal-auto-lineup)))
792 (pascal-indent-declaration))
793 ((and (eq type 'case) (not (looking-at "^[ \t]*$"))
794 (or (memq 'all pascal-auto-lineup)
795 (memq 'case pascal-auto-lineup)))
796 (pascal-indent-case)))
797 (if (looking-at "[ \t]+$")
798 (skip-chars-forward " \t"))))
800 (defun pascal-indent-line ()
801 "Indent current line as a Pascal statement."
802 (let* ((indent-str (pascal-calculate-indent))
803 (type (car indent-str))
804 (ind (car (cdr indent-str))))
805 (if (looking-at "^[0-9a-zA-Z]+[ \t]*:[^=]")
806 (search-forward ":" nil t))
807 (delete-horizontal-space)
808 ;; Some things should not be indented
809 (if (or (and (eq type 'declaration) (looking-at pascal-declaration-re))
811 (looking-at pascal-defun-re))
813 ;; Other things should have no extra indent
814 (if (looking-at pascal-noindent-re)
816 ;; But most lines are treated this way:
817 (indent-to (eval (cdr (assoc type pascal-indent-alist))))
820 (defun pascal-calculate-indent ()
821 "Calculate the indent of the current Pascal line.
822 Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
824 (let* ((parse-sexp-ignore-comments t)
826 (state (save-excursion (parse-partial-sexp (point-min) (point))))
827 (nest 0) (par 0) (complete (looking-at "[ \t]*end\\>"))
828 (elsed (looking-at "[ \t]*else\\>"))
829 (type (catch 'nesting
830 ;; Check if inside a string, comment or parenthesis
831 (cond ((nth 3 state) (throw 'nesting 'string))
832 ((nth 4 state) (throw 'nesting 'comment))
834 (goto-char (scan-lists (point) -1 (car state)))
835 (setq par (1+ (current-column))))
836 ((save-excursion (beginning-of-line)
837 (eq (following-char) ?#))
838 (throw 'nesting 'cpp)))
839 ;; Loop until correct indent is found
842 (cond (;--Escape from case statements
843 (and (looking-at "[A-Za-z0-9]+[ \t]*:[^=]")
845 (save-excursion (skip-chars-backward " \t")
848 (end-of-line) (backward-sexp) (point))
850 (> (save-excursion (goto-char oldpos)
854 (throw 'nesting 'caseblock))
855 (;--Nest block outwards
856 (looking-at pascal-beg-block-re)
858 (cond ((looking-at "case\\>")
859 (throw 'nesting 'case))
860 ((looking-at "record\\>")
861 (throw 'nesting 'declaration))
862 (t (throw 'nesting 'block)))
863 (setq nest (1- nest))))
864 (;--Nest block inwards
865 (looking-at pascal-end-block-re)
866 (if (and (looking-at "end\\s ")
867 elsed (not complete))
868 (throw 'nesting 'block))
871 (;--Defun (or parameter list)
872 (looking-at pascal-defun-re)
874 (throw 'nesting 'defun)
877 (while (re-search-forward
878 "\\(\\<record\\>\\)\\|\\<end\\>"
881 (setq n (1+ n)) (setq n (1- n))))
883 (throw 'nesting 'declaration)
884 (throw 'nesting 'paramlist)))))
886 (looking-at pascal-declaration-re)
890 (looking-at "^[ \t]*$"))
891 (throw 'nesting 'unknown)
892 (throw 'nesting 'declaration)))
893 (;--If, else or while statement
895 (looking-at pascal-sub-block-re))
896 (throw 'nesting 'block))
897 (;--Found complete statement
898 (save-excursion (forward-sexp 1)
899 (= (following-char) ?\;))
901 (;--No known statements
903 (throw 'nesting 'unknown))
906 ;; Return type of block and indent level.
907 (if (> par 0) ; Unclosed Parenthesis
909 (list type (pascal-indent-level))))))
911 (defun pascal-indent-level ()
912 "Return the indent-level the current statement has.
913 Do not count labels, case-statements or records."
916 (if (looking-at "[ \t]*[0-9a-zA-Z]+[ \t]*:[^=]")
917 (search-forward ":" nil t)
918 (if (looking-at ".*=[ \t]*record\\>")
919 (search-forward "=" nil t)))
920 (skip-chars-forward " \t")
923 (defun pascal-indent-comment (&optional arg)
924 "Indent current line as comment.
925 If optional arg is non-nil, just return the
926 column number the line should be indented to."
927 (let* ((stcol (save-excursion
928 (re-search-backward "(\\*\\|{" nil t)
929 (1+ (current-column)))))
931 (delete-horizontal-space)
934 (defun pascal-indent-case ()
935 "Indent within case statements."
936 (let ((savepos (point-marker))
940 (re-search-backward "\\<case\\>" nil t)))
944 (while (< (point) end)
945 (if (re-search-forward
946 "^[ \t]*[^ \t,:]+[ \t]*\\(,[ \t]*[^ \t,:]+[ \t]*\\)*:"
947 (marker-position end) 'move)
951 (delete-horizontal-space)
952 (if (> (current-column) ind)
953 (setq ind (current-column)))
954 (pascal-end-of-statement))))
956 (setq oldpos (marker-position end))
957 ;; Indent all case statements
958 (while (< (point) end)
959 (if (re-search-forward
960 "^[ \t]*[^][ \t,\\.:]+[ \t]*\\(,[ \t]*[^ \t,:]+[ \t]*\\)*:"
961 (marker-position end) 'move)
964 (if (/= (following-char) ?:)
967 (delete-horizontal-space)
969 (setq oldpos (point))
970 (pascal-end-of-statement))
971 (goto-char savepos)))
973 (defun pascal-indent-paramlist (&optional arg)
974 "Indent current line in parameterlist.
975 If optional arg is non-nil, just return the
976 indent of the current line in parameterlist."
978 (let* ((oldpos (point))
979 (stpos (progn (goto-char (scan-lists (point) -1 1)) (point)))
980 (stcol (1+ (current-column)))
981 (edpos (progn (pascal-declaration-end)
982 (search-backward ")" (pascal-get-beg-of-line) t)
984 (usevar (re-search-backward "\\<var\\>" stpos t)))
986 ;; If arg, just return indent
989 (if (or (not usevar) (looking-at "[ \t]*var\\>"))
993 (delete-horizontal-space)
994 (if (and usevar (not (looking-at "var\\>")))
995 (indent-to (+ 4 stcol)))
996 (pascal-indent-declaration nil stpos edpos)))))
998 (defun pascal-indent-declaration (&optional arg start end)
999 "Indent current lines as declaration, lining up the `:'s or `='s."
1000 (let ((pos (point-marker)))
1001 (if (and (not (or arg start)) (not (pascal-declaration-beg)))
1003 (let ((lineup (if (or (looking-at "\\<var\\>\\|\\<record\\>") arg start)
1005 (stpos (if start start
1006 (forward-word 2) (backward-word 1) (point)))
1007 (edpos (set-marker (make-marker)
1009 (max (progn (pascal-declaration-end)
1015 ;; Indent lines in record block
1017 (while (<= (point) edpos)
1019 (delete-horizontal-space)
1020 (if (looking-at "end\\>")
1022 (indent-to (+ arg pascal-indent-level)))
1026 (setq ind (pascal-get-lineup-indent stpos edpos lineup))
1028 (while (and (<= (point) edpos) (not (eobp)))
1029 (if (search-forward lineup (pascal-get-end-of-line) 'move)
1031 (delete-horizontal-space)
1033 (if (not (looking-at lineup))
1034 (forward-line 1) ; No more indent if there is no : or =
1036 (delete-horizontal-space)
1038 ;; Indent record block
1039 (if (looking-at "record\\>")
1040 (pascal-indent-declaration (current-column)))
1041 (forward-line 1)))))
1043 ;; If arg - move point
1044 (if arg (forward-line -1)
1047 ; "Return the indent level that will line up several lines within the region
1048 ;from b to e nicely. The lineup string is str."
1049 (defun pascal-get-lineup-indent (b e str)
1052 (reg (concat str "\\|\\(\\<record\\>\\)")))
1054 ;; Get rightmost position
1055 (while (< (point) e)
1056 (if (re-search-forward reg (min e (pascal-get-end-of-line 2)) 'move)
1058 ;; Skip record blocks
1059 (if (match-beginning 1)
1060 (pascal-declaration-end)
1062 (goto-char (match-beginning 0))
1063 (skip-chars-backward " \t")
1064 (if (> (current-column) ind)
1065 (setq ind (current-column)))
1066 (goto-char (match-end 0))
1069 ;; In case no lineup was found
1072 ;; No lineup-string found
1075 (skip-chars-backward " \t")
1076 (1+ (current-column))))))
1083 (defvar pascal-str nil)
1084 (defvar pascal-all nil)
1085 (defvar pascal-pred nil)
1086 (defvar pascal-buffer-to-use nil)
1087 (defvar pascal-flag nil)
1089 (defun pascal-string-diff (str1 str2)
1090 "Return index of first letter where STR1 and STR2 differs."
1094 (if (or (> (1+ diff) (length str1))
1095 (> (1+ diff) (length str2)))
1097 (or (equal (aref str1 diff) (aref str2 diff))
1099 (setq diff (1+ diff))))))
1101 ;; Calculate all possible completions for functions if argument is `function',
1102 ;; completions for procedures if argument is `procedure' or both functions and
1103 ;; procedures otherwise.
1105 (defun pascal-func-completion (type)
1106 ;; Build regular expression for function/procedure names
1107 (if (string= pascal-str "")
1108 (setq pascal-str "[a-zA-Z_]"))
1109 (let ((pascal-str (concat (cond
1110 ((eq type 'procedure) "\\<\\(procedure\\)\\s +")
1111 ((eq type 'function) "\\<\\(function\\)\\s +")
1112 (t "\\<\\(function\\|procedure\\)\\s +"))
1113 "\\<\\(" pascal-str "[a-zA-Z0-9_.]*\\)\\>"))
1116 (if (not (looking-at "\\<\\(function\\|procedure\\)\\>"))
1117 (re-search-backward "\\<\\(function\\|procedure\\)\\>" nil t))
1120 ;; Search through all reachable functions
1121 (while (pascal-beg-of-defun)
1122 (if (re-search-forward pascal-str (pascal-get-end-of-line) t)
1123 (progn (setq match (buffer-substring (match-beginning 2)
1125 (if (or (null pascal-pred)
1126 (funcall pascal-pred match))
1127 (setq pascal-all (cons match pascal-all)))))
1128 (goto-char (match-beginning 0)))))
1130 (defun pascal-get-completion-decl ()
1131 ;; Macro for searching through current declaration (var, type or const)
1132 ;; for matches of `str' and adding the occurrence to `all'
1133 (let ((end (save-excursion (pascal-declaration-end)
1137 (while (< (point) end)
1138 (if (re-search-forward "[:=]" (pascal-get-end-of-line) t)
1139 ;; Traverse current line
1140 (while (and (re-search-backward
1141 (concat "\\((\\|\\<\\(var\\|type\\|const\\)\\>\\)\\|"
1143 (pascal-get-beg-of-line) t)
1144 (not (match-end 1)))
1145 (setq match (buffer-substring (match-beginning 0) (match-end 0)))
1146 (if (string-match (concat "\\<" pascal-str) match)
1147 (if (or (null pascal-pred)
1148 (funcall pascal-pred match))
1149 (setq pascal-all (cons match pascal-all))))))
1150 (if (re-search-forward "\\<record\\>" (pascal-get-end-of-line) t)
1151 (pascal-declaration-end)
1152 (forward-line 1)))))
1154 (defun pascal-type-completion ()
1155 "Calculate all possible completions for types."
1156 (let ((start (point))
1158 ;; Search for all reachable type declarations
1159 (while (or (pascal-beg-of-defun)
1160 (setq goon (not goon)))
1162 (if (and (< start (prog1 (save-excursion (pascal-end-of-defun)
1166 "\\<type\\>\\|\\<\\(begin\\|function\\|procedure\\)\\>"
1168 (not (match-end 1)))
1169 ;; Check current type declaration
1170 (pascal-get-completion-decl))))))
1172 (defun pascal-var-completion ()
1173 "Calculate all possible completions for variables (or constants)."
1174 (let ((start (point))
1176 ;; Search for all reachable var declarations
1177 (while (or (pascal-beg-of-defun)
1178 (setq goon (not goon)))
1180 (if (> start (prog1 (save-excursion (pascal-end-of-defun)
1182 () ; Declarations not reachable
1183 (if (search-forward "(" (pascal-get-end-of-line) t)
1184 ;; Check parameterlist
1185 (pascal-get-completion-decl))
1187 (while (>= (setq twice (1- twice)) 0)
1188 (cond ((and (re-search-forward
1189 (concat "\\<\\(var\\|const\\)\\>\\|"
1190 "\\<\\(begin\\|function\\|procedure\\)\\>")
1192 (not (match-end 2)))
1193 ;; Check var/const declarations
1194 (pascal-get-completion-decl))
1196 (setq twice 0)))))))))
1199 (defun pascal-keyword-completion (keyword-list)
1200 "Give list of all possible completions of keywords in KEYWORD-LIST."
1201 (mapcar '(lambda (s)
1202 (if (string-match (concat "\\<" pascal-str) s)
1203 (if (or (null pascal-pred)
1204 (funcall pascal-pred s))
1205 (setq pascal-all (cons s pascal-all)))))
1208 ;; Function passed to completing-read, try-completion or
1209 ;; all-completions to get completion on STR. If predicate is non-nil,
1210 ;; it must be a function to be called for every match to check if this
1211 ;; should really be a match. If flag is t, the function returns a list
1212 ;; of all possible completions. If it is nil it returns a string, the
1213 ;; longest possible completion, or t if STR is an exact match. If flag
1214 ;; is 'lambda, the function returns t if STR is an exact match, nil
1217 (defun pascal-completion (pascal-str pascal-pred pascal-flag)
1219 (let ((pascal-all nil))
1220 ;; Set buffer to use for searching labels. This should be set
1221 ;; within functions which use pascal-completions
1222 (set-buffer pascal-buffer-to-use)
1224 ;; Determine what should be completed
1225 (let ((state (car (pascal-calculate-indent))))
1226 (cond (;--Within a declaration or parameterlist
1227 (or (eq state 'declaration) (eq state 'paramlist)
1228 (and (eq state 'defun)
1230 (re-search-backward ")[ \t]*:"
1231 (pascal-get-beg-of-line) t))))
1232 (if (or (eq state 'paramlist) (eq state 'defun))
1233 (pascal-beg-of-defun))
1234 (pascal-type-completion)
1235 (pascal-keyword-completion pascal-type-keywords))
1236 (;--Starting a new statement
1237 (and (not (eq state 'contexp))
1239 (skip-chars-backward "a-zA-Z0-9_.")
1241 (or (looking-at pascal-nosemi-re)
1244 (looking-at "\\s *\\(;\\|:[^=]\\)")))))
1245 (save-excursion (pascal-var-completion))
1246 (pascal-func-completion 'procedure)
1247 (pascal-keyword-completion pascal-start-keywords))
1249 (save-excursion (pascal-var-completion))
1250 (pascal-func-completion 'function)
1251 (pascal-keyword-completion pascal-separator-keywords))))
1253 ;; Now we have built a list of all matches. Give response to caller
1254 (pascal-completion-response))))
1256 (defun pascal-completion-response ()
1257 (cond ((or (equal pascal-flag 'lambda) (null pascal-flag))
1258 ;; This was not called by all-completions
1259 (if (null pascal-all)
1260 ;; Return nil if there was no matching label
1262 ;; Get longest string common in the labels
1263 (let* ((elm (cdr pascal-all))
1264 (match (car pascal-all))
1265 (min (length match))
1267 (if (string= match pascal-str)
1268 ;; Return t if first match was an exact match
1270 (while (not (null elm))
1271 ;; Find longest common string
1272 (if (< (setq tmp (pascal-string-diff match (car elm))) min)
1275 (setq match (substring match 0 min))))
1276 ;; Terminate with match=t if this is an exact match
1277 (if (string= (car elm) pascal-str)
1281 (setq elm (cdr elm)))))
1282 ;; If this is a test just for exact match, return nil ot t
1283 (if (and (equal pascal-flag 'lambda) (not (equal match 't)))
1286 ;; If flag is t, this was called by all-completions. Return
1287 ;; list of all possible completions
1291 (defvar pascal-last-word-numb 0)
1292 (defvar pascal-last-word-shown nil)
1293 (defvar pascal-last-completions nil)
1295 (defun pascal-complete-word ()
1296 "Complete word at current point.
1297 \(See also `pascal-toggle-completions', `pascal-type-keywords',
1298 `pascal-start-keywords' and `pascal-separator-keywords'.)"
1300 (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
1301 (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))
1302 (pascal-str (buffer-substring b e))
1303 ;; The following variable is used in pascal-completion
1304 (pascal-buffer-to-use (current-buffer))
1305 (allcomp (if (and pascal-toggle-completions
1306 (string= pascal-last-word-shown pascal-str))
1307 pascal-last-completions
1308 (all-completions pascal-str 'pascal-completion)))
1309 (match (if pascal-toggle-completions
1311 pascal-str (mapcar '(lambda (elm)
1312 (cons elm 0)) allcomp)))))
1313 ;; Delete old string
1316 ;; Toggle-completions inserts whole labels
1317 (if pascal-toggle-completions
1319 ;; Update entry number in list
1320 (setq pascal-last-completions allcomp
1321 pascal-last-word-numb
1322 (if (>= pascal-last-word-numb (1- (length allcomp)))
1324 (1+ pascal-last-word-numb)))
1325 (setq pascal-last-word-shown (elt allcomp pascal-last-word-numb))
1326 ;; Display next match or same string if no match was found
1327 (if (not (null allcomp))
1328 (insert "" pascal-last-word-shown)
1329 (insert "" pascal-str)
1330 (message "(No match)")))
1331 ;; The other form of completion does not necessarily do that.
1333 ;; Insert match if found, or the original string if no match
1334 (if (or (null match) (equal match 't))
1335 (progn (insert "" pascal-str)
1336 (message "(No match)"))
1338 ;; Give message about current status of completion
1339 (cond ((equal match 't)
1340 (if (not (null (cdr allcomp)))
1341 (message "(Complete but not unique)")
1342 (message "(Sole completion)")))
1343 ;; Display buffer if the current completion didn't help
1344 ;; on completing the label.
1345 ((and (not (null (cdr allcomp))) (= (length pascal-str)
1347 (with-output-to-temp-buffer "*Completions*"
1348 (display-completion-list allcomp))
1349 ;; Wait for a keypress. Then delete *Completion* window
1350 (momentary-string-display "" (point))
1351 (delete-window (get-buffer-window (get-buffer "*Completions*")))
1354 (defun pascal-show-completions ()
1355 "Show all possible completions at current point."
1357 (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
1358 (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))
1359 (pascal-str (buffer-substring b e))
1360 ;; The following variable is used in pascal-completion
1361 (pascal-buffer-to-use (current-buffer))
1362 (allcomp (if (and pascal-toggle-completions
1363 (string= pascal-last-word-shown pascal-str))
1364 pascal-last-completions
1365 (all-completions pascal-str 'pascal-completion))))
1366 ;; Show possible completions in a temporary buffer.
1367 (with-output-to-temp-buffer "*Completions*"
1368 (display-completion-list allcomp))
1369 ;; Wait for a keypress. Then delete *Completion* window
1370 (momentary-string-display "" (point))
1371 (delete-window (get-buffer-window (get-buffer "*Completions*")))))
1374 (defun pascal-get-default-symbol ()
1375 "Return symbol around current point as a string."
1377 (buffer-substring (progn
1378 (skip-chars-backward " \t")
1379 (skip-chars-backward "a-zA-Z0-9_")
1382 (skip-chars-forward "a-zA-Z0-9_")
1385 (defun pascal-build-defun-re (str &optional arg)
1386 "Return function/procedure starting with STR as regular expression.
1387 With optional second arg non-nil, STR is the complete name of the instruction."
1389 (concat "^\\(function\\|procedure\\)[ \t]+\\(" str "\\)\\>")
1390 (concat "^\\(function\\|procedure\\)[ \t]+\\(" str "[a-zA-Z0-9_]*\\)\\>")))
1392 ;; Function passed to completing-read, try-completion or
1393 ;; all-completions to get completion on any function name. If
1394 ;; predicate is non-nil, it must be a function to be called for every
1395 ;; match to check if this should really be a match. If flag is t, the
1396 ;; function returns a list of all possible completions. If it is nil
1397 ;; it returns a string, the longest possible completion, or t if STR
1398 ;; is an exact match. If flag is 'lambda, the function returns t if
1399 ;; STR is an exact match, nil otherwise.
1401 (defun pascal-comp-defun (pascal-str pascal-pred pascal-flag)
1403 (let ((pascal-all nil)
1406 ;; Set buffer to use for searching labels. This should be set
1407 ;; within functions which use pascal-completions
1408 (set-buffer pascal-buffer-to-use)
1410 (let ((pascal-str pascal-str))
1411 ;; Build regular expression for functions
1412 (if (string= pascal-str "")
1413 (setq pascal-str (pascal-build-defun-re "[a-zA-Z_]"))
1414 (setq pascal-str (pascal-build-defun-re pascal-str)))
1415 (goto-char (point-min))
1417 ;; Build a list of all possible completions
1418 (while (re-search-forward pascal-str nil t)
1419 (setq match (buffer-substring (match-beginning 2) (match-end 2)))
1420 (if (or (null pascal-pred)
1421 (funcall pascal-pred match))
1422 (setq pascal-all (cons match pascal-all)))))
1424 ;; Now we have built a list of all matches. Give response to caller
1425 (pascal-completion-response))))
1427 (defun pascal-goto-defun ()
1428 "Move to specified Pascal function/procedure.
1429 The default is a name found in the buffer around point."
1431 (let* ((default (pascal-get-default-symbol))
1432 ;; The following variable is used in pascal-comp-function
1433 (pascal-buffer-to-use (current-buffer))
1434 (default (if (pascal-comp-defun default nil 'lambda)
1436 (label (if (not (string= default ""))
1437 ;; Do completion with default
1438 (completing-read (concat "Label: (default " default ") ")
1439 'pascal-comp-defun nil t "")
1440 ;; There is no default value. Complete without it
1441 (completing-read "Label: "
1442 'pascal-comp-defun nil t ""))))
1443 ;; If there was no response on prompt, use default value
1444 (if (string= label "")
1445 (setq label default))
1446 ;; Goto right place in buffer if label is not an empty string
1447 (or (string= label "")
1449 (goto-char (point-min))
1450 (re-search-forward (pascal-build-defun-re label t))
1451 (beginning-of-line)))))
1456 ;;; Pascal-outline-mode
1458 (defvar pascal-outline-map nil "Keymap used in Pascal Outline mode.")
1460 (if pascal-outline-map
1462 (if (boundp 'set-keymap-name)
1463 (set-keymap-name pascal-outline-map 'pascal-outline-map))
1464 (if (not (boundp 'set-keymap-parent))
1465 (setq pascal-outline-map (copy-keymap pascal-mode-map))
1466 (setq pascal-outline-map (make-sparse-keymap))
1467 (set-keymap-parent pascal-outline-map pascal-mode-map))
1468 (define-key pascal-outline-map "\M-\C-a" 'pascal-outline-prev-defun)
1469 (define-key pascal-outline-map "\M-\C-e" 'pascal-outline-next-defun)
1470 (define-key pascal-outline-map "\C-c\C-d" 'pascal-outline-goto-defun)
1471 (define-key pascal-outline-map "\C-c\C-s" 'pascal-show-all)
1472 (define-key pascal-outline-map "\C-c\C-h" 'pascal-hide-other-defuns))
1474 (defvar pascal-outline-mode nil "Non-nil while using Pascal Outline mode.")
1475 (make-variable-buffer-local 'pascal-outline-mode)
1476 (set-default 'pascal-outline-mode nil)
1477 (if (not (assoc 'pascal-outline-mode minor-mode-alist))
1478 (setq minor-mode-alist (append minor-mode-alist
1479 (list '(pascal-outline-mode " Outl")))))
1481 (defun pascal-outline (&optional arg)
1482 "Outline-line minor mode for Pascal mode.
1483 When in Pascal Outline mode, portions
1484 of the text being edited may be made invisible. \\<pascal-outline-map>
1486 Pascal Outline mode provides some additional commands.
1488 \\[pascal-outline-prev-defun]\
1489 \t- Move to previous function/procedure, hiding everything else.
1490 \\[pascal-outline-next-defun]\
1491 \t- Move to next function/procedure, hiding everything else.
1492 \\[pascal-outline-goto-defun]\
1493 \t- Goto function/procedure prompted for in minibuffer,
1494 \t hide all other functions.
1495 \\[pascal-show-all]\t- Show the whole buffer.
1496 \\[pascal-hide-other-defuns]\
1497 \t- Hide everything but the current function (function under the cursor).
1498 \\[pascal-outline]\t- Leave pascal-outline-mode."
1500 (setq pascal-outline-mode
1501 (if (null arg) (not pascal-outline-mode) t))
1502 (if (boundp 'redraw-mode-line)
1504 (if pascal-outline-mode
1506 (setq selective-display t)
1507 (use-local-map pascal-outline-map))
1509 (setq selective-display nil)
1511 (use-local-map pascal-mode-map))))
1513 (defun pascal-outline-change (b e pascal-flag)
1514 (let ((modp (buffer-modified-p)))
1516 (subst-char-in-region b e (if (= pascal-flag ?\n)
1517 ?\^M ?\n) pascal-flag)
1518 (set-buffer-modified-p modp))))
1520 (defun pascal-show-all ()
1521 "Show all of the text in the buffer."
1523 (pascal-outline-change (point-min) (point-max) ?\n))
1525 (defun pascal-hide-other-defuns ()
1526 "Show only the current defun."
1529 (let ((beg (progn (if (not (looking-at "\\(function\\|procedure\\)\\>"))
1530 (pascal-beg-of-defun))
1532 (end (progn (pascal-end-of-defun)
1534 (search-forward "\n\\|\^M" nil t)
1536 (opoint (point-min)))
1537 (goto-char (point-min))
1539 ;; Hide all functions before current function
1540 (while (re-search-forward "^\\(function\\|procedure\\)\\>" beg 'move)
1541 (pascal-outline-change opoint (1- (match-beginning 0)) ?\^M)
1542 (setq opoint (point))
1543 ;; Functions may be nested
1544 (if (> (progn (pascal-end-of-defun) (point)) beg)
1545 (goto-char opoint)))
1547 (pascal-outline-change opoint (1- beg) ?\^M))
1549 ;; Show current function
1550 (pascal-outline-change beg end ?\n)
1551 ;; Hide nested functions
1553 (while (re-search-forward "^\\(function\\|procedure\\)\\>" end 'move)
1554 (setq opoint (point))
1555 (pascal-end-of-defun)
1556 (pascal-outline-change opoint (point) ?\^M))
1561 ;; Hide all function after current function
1562 (while (re-search-forward "^\\(function\\|procedure\\)\\>" nil 'move)
1563 (pascal-outline-change opoint (1- (match-beginning 0)) ?\^M)
1564 (setq opoint (point))
1565 (pascal-end-of-defun))
1566 (pascal-outline-change opoint (point-max) ?\^M)
1568 ;; Hide main program
1569 (if (< (progn (forward-line -1) (point)) end)
1572 (pascal-end-of-defun)
1574 (pascal-outline-change (point) (point-max) ?\^M))))))
1576 (defun pascal-outline-next-defun ()
1577 "Move to next function/procedure, hiding all others."
1579 (pascal-end-of-defun)
1580 (pascal-hide-other-defuns))
1582 (defun pascal-outline-prev-defun ()
1583 "Move to previous function/procedure, hiding all others."
1585 (pascal-beg-of-defun)
1586 (pascal-hide-other-defuns))
1588 (defun pascal-outline-goto-defun ()
1589 "Move to specified function/procedure, hiding all others."
1592 (pascal-hide-other-defuns))
1595 ;;;###autoload(add-to-list 'auto-mode-alist '("\\.p\\(?:as\\)?\\'" . pascal-mode))
1597 ;;; pascal.el ends here