1 ;;; pascal.el --- major mode for editing pascal source in Emacs -*- lexical-binding: t -*-
3 ;; Copyright (C) 1993-2014 Free Software Foundation, Inc.
5 ;; Author: Espen Skoglund <esk@gnu.org>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
28 ;; Emacs should enter Pascal mode when you find a Pascal source file.
29 ;; When you have entered Pascal mode, you may get more info by pressing
30 ;; C-h m. You may also get online help describing various functions by:
31 ;; C-h f <Name of function you want described>
33 ;; If you want to customize Pascal mode to fit you better, you may add
34 ;; these lines (the values of the variables presented here are the defaults):
36 ;; ;; User customization for Pascal mode
37 ;; (setq pascal-indent-level 3
38 ;; pascal-case-indent 2
39 ;; pascal-auto-newline nil
40 ;; pascal-tab-always-indent t
41 ;; pascal-auto-endcomments t
42 ;; pascal-auto-lineup '(all)
43 ;; pascal-type-keywords '("array" "file" "packed" "char"
44 ;; "integer" "real" "string" "record")
45 ;; pascal-start-keywords '("begin" "end" "function" "procedure"
46 ;; "repeat" "until" "while" "read" "readln"
47 ;; "reset" "rewrite" "write" "writeln")
48 ;; pascal-separator-keywords '("downto" "else" "mod" "div" "then"))
50 ;; KNOWN BUGS / BUGREPORTS
51 ;; =======================
52 ;; As far as I know, there are no bugs in the current version of this
53 ;; package. This may not be true however, since I never use this mode
54 ;; myself and therefore would never notice them anyway. If you do
55 ;; find any bugs, you may submit them to: esk@gnu.org as well as to
56 ;; bug-gnu-emacs@gnu.org.
62 "Major mode for editing Pascal source in Emacs."
63 :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
66 (defvar pascal-mode-abbrev-table nil
67 "Abbrev table in use in Pascal mode buffers.")
68 (define-abbrev-table 'pascal-mode-abbrev-table ())
70 (defvar pascal-mode-map
71 (let ((map (make-sparse-keymap)))
72 (define-key map ";" 'electric-pascal-semi-or-dot)
73 (define-key map "." 'electric-pascal-semi-or-dot)
74 (define-key map ":" 'electric-pascal-colon)
75 (define-key map "=" 'electric-pascal-equal)
76 (define-key map "#" 'electric-pascal-hash)
77 ;; These are user preferences, so not to set by default.
78 ;;(define-key map "\r" 'electric-pascal-terminate-line)
79 ;;(define-key map "\t" 'electric-pascal-tab)
80 (define-key map "\M-\t" 'completion-at-point)
81 (define-key map "\M-?" 'completion-help-at-point)
82 (define-key map "\177" 'backward-delete-char-untabify)
83 (define-key map "\M-\C-h" 'pascal-mark-defun)
84 (define-key map "\C-c\C-b" 'pascal-insert-block)
85 (define-key map "\M-*" 'pascal-star-comment)
86 (define-key map "\C-c\C-c" 'pascal-comment-area)
87 (define-key map "\C-c\C-u" 'pascal-uncomment-area)
88 (define-key map "\M-\C-a" 'pascal-beg-of-defun)
89 (define-key map "\M-\C-e" 'pascal-end-of-defun)
90 (define-key map "\C-c\C-d" 'pascal-goto-defun)
91 (define-key map "\C-c\C-o" 'pascal-outline-mode)
92 ;; A command to change the whole buffer won't be used terribly
93 ;; often, so no need for a key binding.
94 ;; (define-key map "\C-cd" 'pascal-downcase-keywords)
95 ;; (define-key map "\C-cu" 'pascal-upcase-keywords)
96 ;; (define-key map "\C-cc" 'pascal-capitalize-keywords)
98 "Keymap used in Pascal mode.")
100 (defvar pascal-imenu-generic-expression
101 '((nil "^[ \t]*\\(function\\|procedure\\)[ \t\n]+\\([a-zA-Z0-9_.:]+\\)" 2))
102 "Imenu expression for Pascal mode. See `imenu-generic-expression'.")
104 (defvar pascal-keywords
105 '("and" "array" "begin" "case" "const" "div" "do" "downto" "else" "end"
106 "file" "for" "function" "goto" "if" "in" "label" "mod" "nil" "not" "of"
107 "or" "packed" "procedure" "program" "record" "repeat" "set" "then" "to"
108 "type" "until" "var" "while" "with"
109 ;; The following are not standard in pascal, but widely used.
110 "get" "put" "input" "output" "read" "readln" "reset" "rewrite" "write"
114 ;;; Regular expressions used to calculate indent, etc.
116 (defconst pascal-symbol-re "\\<[a-zA-Z_][a-zA-Z_0-9.]*\\>")
117 (defconst pascal-beg-block-re "\\<\\(begin\\|case\\|record\\|repeat\\)\\>")
118 (defconst pascal-end-block-re "\\<\\(end\\|until\\)\\>")
119 (defconst pascal-declaration-re "\\<\\(const\\|label\\|type\\|var\\)\\>")
120 (defconst pascal-progbeg-re "\\<\\program\\>")
121 (defconst pascal-defun-re "\\<\\(function\\|procedure\\|program\\)\\>")
122 (defconst pascal-sub-block-re "\\<\\(if\\|else\\|for\\|while\\|with\\)\\>")
123 (defconst pascal-noindent-re "\\<\\(begin\\|end\\|until\\|else\\)\\>")
124 (defconst pascal-nosemi-re "\\<\\(begin\\|repeat\\|then\\|do\\|else\\)\\>")
125 (defconst pascal-autoindent-lines-re
126 "\\<\\(label\\|var\\|type\\|const\\|until\\|end\\|begin\\|repeat\\|else\\)\\>")
128 ;;; Strings used to mark beginning and end of excluded text
129 (defconst pascal-exclude-str-start "{-----\\/----- EXCLUDED -----\\/-----"
130 "String used to mark beginning of excluded text.")
131 (defconst pascal-exclude-str-end " -----/\\----- EXCLUDED -----/\\-----}"
132 "String used to mark end of excluded text.")
134 (defvar pascal-mode-syntax-table
135 (let ((st (make-syntax-table)))
136 (modify-syntax-entry ?\\ "." st)
137 (modify-syntax-entry ?\( "()1" st)
138 (modify-syntax-entry ?\) ")(4" st)
139 ;; This used to use comment-syntax `b'. But the only document I could
140 ;; find about the syntax of Pascal's comments said that (* ... } is
141 ;; a valid comment, just as { ... *) or (* ... *) or { ... }.
142 (modify-syntax-entry ?* ". 23" st)
143 ;; Allow //...\n comments as accepted by Free Pascal (bug#13585).
144 (modify-syntax-entry ?/ ". 12c" st)
145 (modify-syntax-entry ?\n "> c" st)
146 (modify-syntax-entry ?{ "<" st)
147 (modify-syntax-entry ?} ">" st)
148 (modify-syntax-entry ?+ "." st)
149 (modify-syntax-entry ?- "." st)
150 (modify-syntax-entry ?= "." st)
151 (modify-syntax-entry ?% "." st)
152 (modify-syntax-entry ?< "." st)
153 (modify-syntax-entry ?> "." st)
154 (modify-syntax-entry ?& "." st)
155 (modify-syntax-entry ?| "." st)
156 (modify-syntax-entry ?_ "_" st)
157 (modify-syntax-entry ?\' "\"" st)
159 "Syntax table in use in Pascal-mode buffers.")
163 (defconst pascal-font-lock-keywords
164 `(("\\_<\\(function\\|pro\\(cedure\\|gram\\)\\)[ \t]+\\([[:alpha:]][[:alnum:]_]*\\)"
165 (1 font-lock-keyword-face)
166 (3 font-lock-function-name-face))
167 ;; ("type" "const" "real" "integer" "char" "boolean" "var"
168 ;; "record" "array" "file")
169 (,(concat "\\<\\(array\\|boolean\\|c\\(har\\|onst\\)\\|file\\|"
170 "integer\\|re\\(al\\|cord\\)\\|type\\|var\\)\\>")
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")
177 "and\\|begin\\|case\\|do\\|e\\(lse\\|nd\\)\\|for\\|i[fn]\\|"
178 "not\\|o[fr]\\|repeat\\|t\\(hen\\|o\\)\\|until\\|w\\(hile\\|ith\\)"
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.")
186 (defconst pascal--syntax-propertize
187 (syntax-propertize-rules
188 ;; The syntax-table settings are too coarse and end up treating /* and (/
189 ;; as comment starters. Fix it here by removing the "2" from the syntax
190 ;; of the second char of such sequences.
191 ("/\\(\\*\\)" (1 ". 3b"))
192 ("(\\(\\/\\)" (1 (prog1 ". 1c" (forward-char -1) nil)))
193 ;; Pascal uses '' and "" rather than \' and \" to escape quotes.
194 ("''\\|\"\"" (0 (if (save-excursion
195 (nth 3 (syntax-ppss (match-beginning 0))))
196 (string-to-syntax ".")
197 ;; In case of 3 or more quotes in a row, only advance
198 ;; one quote at a time.
202 (defcustom pascal-indent-level 3
203 "Indentation of Pascal statements with respect to containing block."
207 (defcustom pascal-case-indent 2
208 "Indentation for case statements."
212 (defcustom pascal-auto-newline nil
213 "Non-nil means automatically insert newlines in certain cases.
214 These include after semicolons and after the punctuation mark after an `end'."
218 (defcustom pascal-indent-nested-functions t
219 "Non-nil means nested functions are indented."
223 (defcustom pascal-tab-always-indent t
224 "Non-nil means TAB in Pascal mode should always reindent the current line.
225 If this is nil, TAB inserts a tab if it is at the end of the line
226 and follows non-whitespace text."
230 (defcustom pascal-auto-endcomments t
231 "Non-nil means automatically insert comments after certain `end's.
232 Specifically, this is done after the ends of case statements and functions.
233 The name of the function or case is included between the braces."
237 (defcustom pascal-auto-lineup '(all)
238 "List of contexts where auto lineup of :'s or ='s should be done.
239 Elements can be of type: 'paramlist', 'declaration' or 'case', which will
240 do auto lineup in parameterlist, declarations or case-statements
241 respectively. The word 'all' will do all lineups. '(case paramlist) for
242 instance will do lineup in case-statements and parameterlist, while '(all)
243 will do all lineups."
244 :type '(set :extra-offset 8
245 (const :tag "Everything" all)
246 (const :tag "Parameter lists" paramlist)
247 (const :tag "Declarations" declaration)
248 (const :tag "Case statements" case))
251 (defvar pascal-toggle-completions nil
252 "If non-nil, `pascal-complete-word' tries all possible completions.
253 Repeated use of \\[pascal-complete-word] then shows all
254 completions in turn, instead of displaying a list of all possible
256 (make-obsolete-variable 'pascal-toggle-completions
257 'completion-cycle-threshold "24.1")
259 (defcustom pascal-type-keywords
260 '("array" "file" "packed" "char" "integer" "real" "string" "record")
261 "Keywords for types used when completing a word in a declaration or parmlist.
262 These include integer, real, char, etc.
263 The types defined within the Pascal program
264 are handled in another way, and should not be added to this list."
265 :type '(repeat (string :tag "Keyword"))
268 (defcustom pascal-start-keywords
269 '("begin" "end" "function" "procedure" "repeat" "until" "while"
270 "read" "readln" "reset" "rewrite" "write" "writeln")
271 "Keywords to complete when standing at the first word of a statement.
272 These are keywords such as begin, repeat, until, readln.
273 The procedures and variables defined within the Pascal program
274 are handled in another way, and should not be added to this list."
275 :type '(repeat (string :tag "Keyword"))
278 (defcustom pascal-separator-keywords
279 '("downto" "else" "mod" "div" "then")
280 "Keywords to complete when NOT standing at the first word of a statement.
281 These are keywords such as downto, else, mod, then.
282 Variables and function names defined within the Pascal program
283 are handled in another way, and should not be added to this list."
284 :type '(repeat (string :tag "Keyword"))
292 (defun pascal-declaration-end ()
294 (while (and (> nest 0)
296 "[:=]\\|\\(\\<record\\>\\)\\|\\(\\<end\\>\\)"
298 (cond ((match-beginning 1) (setq nest (1+ nest)))
299 ((match-beginning 2) (setq nest (1- nest)))
300 ((looking-at "[^(\n]+)") (setq nest 0))))))
303 (defun pascal-declaration-beg ()
305 (while (and (> nest 0)
306 (re-search-backward "[:=]\\|\\<\\(type\\|var\\|label\\|const\\)\\>\\|\\(\\<record\\>\\)\\|\\(\\<end\\>\\)" (point-at-bol 0) t))
307 (cond ((match-beginning 1) (setq nest 0))
308 ((match-beginning 2) (setq nest (1- nest)))
309 ((match-beginning 3) (setq nest (1+ nest)))))
313 (defsubst pascal-within-string ()
314 (nth 3 (parse-partial-sexp (point-at-bol) (point))))
318 (define-derived-mode pascal-mode prog-mode "Pascal"
319 "Major mode for editing Pascal code.\\<pascal-mode-map>
320 TAB indents for Pascal code. Delete converts tabs to spaces as it moves back.
322 \\[completion-at-point] completes the word around current point with respect \
324 \\[completion-help-at-point] shows all possible completions at this point.
326 Other useful functions are:
328 \\[pascal-mark-defun]\t- Mark function.
329 \\[pascal-insert-block]\t- insert begin ... end;
330 \\[pascal-star-comment]\t- insert (* ... *)
331 \\[pascal-comment-area]\t- Put marked area in a comment, fixing nested comments.
332 \\[pascal-uncomment-area]\t- Uncomment an area commented with \
333 \\[pascal-comment-area].
334 \\[pascal-beg-of-defun]\t- Move to beginning of current function.
335 \\[pascal-end-of-defun]\t- Move to end of current function.
336 \\[pascal-goto-defun]\t- Goto function prompted for in the minibuffer.
337 \\[pascal-outline-mode]\t- Enter `pascal-outline-mode'.
339 Variables controlling indentation/edit style:
341 `pascal-indent-level' (default 3)
342 Indentation of Pascal statements with respect to containing block.
343 `pascal-case-indent' (default 2)
344 Indentation for case statements.
345 `pascal-auto-newline' (default nil)
346 Non-nil means automatically newline after semicolons and the punctuation
348 `pascal-indent-nested-functions' (default t)
349 Non-nil means nested functions are indented.
350 `pascal-tab-always-indent' (default t)
351 Non-nil means TAB in Pascal mode should always reindent the current line,
352 regardless of where in the line point is when the TAB command is used.
353 `pascal-auto-endcomments' (default t)
354 Non-nil means a comment { ... } is set after the ends which ends cases and
355 functions. The name of the function or case will be set between the braces.
356 `pascal-auto-lineup' (default t)
357 List of contexts where auto lineup of :'s or ='s should be done.
359 See also the user variables `pascal-type-keywords', `pascal-start-keywords' and
360 `pascal-separator-keywords'."
361 (setq-local local-abbrev-table pascal-mode-abbrev-table)
362 (setq-local indent-line-function 'pascal-indent-line)
363 (setq-local comment-indent-function 'pascal-indent-comment)
364 (setq-local parse-sexp-ignore-comments nil)
365 (setq-local blink-matching-paren-dont-ignore-comments t)
366 (setq-local case-fold-search t)
367 (setq-local comment-start "{")
368 (setq-local comment-start-skip "(\\*+ *\\|{ *")
369 (setq-local comment-end "}")
370 (add-hook 'completion-at-point-functions 'pascal-completions-at-point nil t)
372 (setq-local font-lock-defaults '(pascal-font-lock-keywords nil t))
373 (setq-local syntax-propertize-function pascal--syntax-propertize)
375 (setq-local imenu-generic-expression pascal-imenu-generic-expression)
376 (setq-local imenu-case-fold-search t)
377 ;; Pascal-mode's own hide/show support.
378 (add-to-invisibility-spec '(pascal . t)))
383 ;;; Electric functions
385 (defun electric-pascal-terminate-line ()
386 "Terminate line and indent next line."
388 ;; First, check if current line should be indented
391 (skip-chars-forward " \t")
392 (if (looking-at pascal-autoindent-lines-re)
393 (pascal-indent-line)))
394 (delete-horizontal-space) ; Removes trailing whitespaces
398 ;; Maybe we should set some endcomments
399 (if pascal-auto-endcomments
400 (pascal-set-auto-comments))
401 ;; Check if we shall indent inside comment
405 (skip-chars-forward " \t")
406 (cond ((looking-at "\\*[ \t]+)")
407 ;; Delete region between `*' and `)' if there is only whitespaces.
409 (delete-horizontal-space))
410 ((and (looking-at "(\\*\\|\\*[^)]")
411 (not (save-excursion (search-forward "*)" (point-at-eol) t))))
413 ;; If last line was a star comment line then this one shall be too.
419 (defun electric-pascal-semi-or-dot ()
420 "Insert `;' or `.' character and reindent the line."
422 (insert last-command-event)
425 (pascal-indent-line))
426 (if pascal-auto-newline
427 (electric-pascal-terminate-line)))
429 (defun electric-pascal-colon ()
430 "Insert `:' and do all indentations except line indent on this line."
432 (insert last-command-event)
433 ;; Do nothing if within string.
434 (if (pascal-within-string)
438 (pascal-indent-line))
439 (let ((pascal-tab-always-indent nil))
440 (pascal-indent-command))))
442 (defun electric-pascal-equal ()
443 "Insert `=', and do indentation if within type declaration."
445 (insert last-command-event)
446 (if (eq (car (pascal-calculate-indent)) 'declaration)
447 (let ((pascal-tab-always-indent nil))
448 (pascal-indent-command))))
450 (defun electric-pascal-hash ()
451 "Insert `#', and indent to column 0 if this is a CPP directive."
453 (insert last-command-event)
454 (if (save-excursion (beginning-of-line) (looking-at "^[ \t]*#"))
455 (save-excursion (beginning-of-line)
456 (delete-horizontal-space))))
458 (defun electric-pascal-tab ()
459 "Function called when TAB is pressed in Pascal mode."
461 ;; Do nothing if within a string or in a CPP directive.
462 (if (or (pascal-within-string)
464 (save-excursion (beginning-of-line) (eq (following-char) ?#))))
466 ;; If pascal-tab-always-indent, indent the beginning of the line.
467 (if pascal-tab-always-indent
470 (pascal-indent-line))
472 (skip-chars-backward " \t")
476 (pascal-indent-command)))
481 ;;; Interactive functions
483 (defvar pascal--extra-indent 0)
485 (defun pascal-insert-block ()
486 "Insert Pascal begin ... end; block in the code with right indentation."
489 (electric-pascal-terminate-line)
494 (pascal-indent-line)))
496 (defun pascal-star-comment ()
497 "Insert Pascal star comment at point."
501 (electric-pascal-terminate-line)
503 (electric-pascal-terminate-line)
504 (delete-horizontal-space)
508 (defun pascal-mark-defun ()
509 "Mark the current Pascal function (or procedure).
510 This puts the mark at the end, and point at the beginning."
513 (pascal-end-of-defun)
515 (pascal-beg-of-defun)
516 (when (featurep 'xemacs)
517 (zmacs-activate-region)))
519 (defun pascal-comment-area (start end)
520 "Put the region into a Pascal comment.\\<pascal-mode-map>
521 The comments that are in this area are \"deformed\":
522 `*)' becomes `!(*' and `}' becomes `!{'.
523 These deformed comments are returned to normal if you use
524 \\[pascal-uncomment-area] to undo the commenting.
526 The commented area starts with `pascal-exclude-str-start', and ends
527 with `pascal-exclude-str-end'. But if you change these variables,
528 \\[pascal-uncomment-area] won't recognize the comments."
531 ;; Insert start and endcomments
533 (if (and (save-excursion (skip-chars-forward " \t") (eolp))
534 (not (save-excursion (skip-chars-backward " \t") (bolp))))
537 (insert pascal-exclude-str-end)
542 (insert pascal-exclude-str-start)
544 ;; Replace end-comments within commented area
547 (while (re-search-backward "\\*)" start t)
548 (replace-match "!(*" t t)))
550 (while (re-search-backward "}" start t)
551 (replace-match "!{" t t)))))
553 (defun pascal-uncomment-area ()
554 "Uncomment a commented area; change deformed comments back to normal.
555 This command does nothing if the pointer is not in a commented area.
556 See also `pascal-comment-area'."
559 (let ((start (point))
561 ;; Find the boundaries of the comment
563 (setq start (progn (search-backward pascal-exclude-str-start nil t)
565 (setq end (progn (search-forward pascal-exclude-str-end nil t)
567 ;; Check if we're really inside a comment
568 (if (or (equal start (point)) (<= end (point)))
569 (message "Not standing within commented area.")
576 (delete-region pos (1+ (point))))
577 ;; Change comments back to normal
579 (while (re-search-backward "!{" start t)
580 (replace-match "}" t t)))
582 (while (re-search-backward "!(\\*" start t)
583 (replace-match "*)" t t)))
584 ;; Remove startcomment
589 (delete-region pos (1+ (point)))))))))
591 (defun pascal-beg-of-defun ()
592 "Move backward to the beginning of the current function or procedure."
595 (if (not (looking-at (concat "\\s \\|\\s)\\|" pascal-defun-re)))
597 (let ((nest 0) (max -1) (func 0)
598 (reg (concat pascal-beg-block-re "\\|"
599 pascal-end-block-re "\\|"
601 (while (re-search-backward reg nil 'move)
602 (cond ((let ((state (save-excursion
603 (parse-partial-sexp (point-min) (point)))))
604 (or (nth 3 state) (nth 4 state))) ; Inside string or comment
606 ((match-end 1) ; begin|case|record|repeat
607 (if (and (looking-at "\\<record\\>") (>= max 0))
608 (setq func (1- func)))
611 ((match-end 2) ; end|until
612 (if (and (= nest max) (>= max 0))
613 (setq func (1+ func)))
614 (setq nest (1- nest)))
615 ((match-end 3) ; function|procedure
618 (setq func (1- func)))))))
621 (defun pascal-end-of-defun ()
622 "Move forward to the end of the current function or procedure."
624 (if (looking-at "\\s ")
626 (if (not (looking-at pascal-defun-re))
627 (pascal-beg-of-defun))
629 (let ((nest 0) (func 1)
630 (reg (concat pascal-beg-block-re "\\|"
631 pascal-end-block-re "\\|"
633 (while (and (/= func 0)
634 (re-search-forward reg nil 'move))
635 (cond ((let ((state (save-excursion
636 (parse-partial-sexp (point-min) (point)))))
637 (or (nth 3 state) (nth 4 state))) ; Inside string or comment
640 (setq nest (1+ nest))
642 (goto-char (match-beginning 0))
643 (looking-at "\\<record\\>"))
644 (setq func (1+ func))))
646 (setq nest (1- nest))
648 (setq func (1- func))))
650 (setq func (1+ func))))))
653 (defun pascal-end-of-statement ()
654 "Move forward to end of current statement."
656 (let ((parse-sexp-ignore-comments t)
658 (regexp (concat "\\(" pascal-beg-block-re "\\)\\|\\("
659 pascal-end-block-re "\\)")))
660 (if (not (looking-at "[ \t\n]")) (forward-sexp -1))
661 (or (looking-at pascal-beg-block-re)
662 ;; Skip to end of statement
663 (setq pos (catch 'found
666 (cond ((looking-at "[ \t]*;")
667 (skip-chars-forward "^;")
669 (throw 'found (point)))
672 (looking-at pascal-beg-block-re))
673 (goto-char (match-beginning 0))
676 (throw 'found (point))))))))
678 ;; Skip a whole block
681 (re-search-forward regexp nil 'move)
682 (setq nest (if (match-end 1)
686 (throw 'found (point)))
688 (throw 'found (pascal-end-of-statement))))))
691 (defun pascal-downcase-keywords ()
692 "Downcase all Pascal keywords in the buffer."
694 (pascal-change-keywords 'downcase-word))
696 (defun pascal-upcase-keywords ()
697 "Upcase all Pascal keywords in the buffer."
699 (pascal-change-keywords 'upcase-word))
701 (defun pascal-capitalize-keywords ()
702 "Capitalize all Pascal keywords in the buffer."
704 (pascal-change-keywords 'capitalize-word))
706 ;; Change the keywords according to argument.
707 (defun pascal-change-keywords (change-word)
709 (let ((keyword-re (concat "\\<\\("
710 (mapconcat 'identity pascal-keywords "\\|")
712 (goto-char (point-min))
713 (while (re-search-forward keyword-re nil t)
714 (funcall change-word -1)))))
721 (defun pascal-set-auto-comments ()
722 "Insert `{ case }' or `{ NAME }' on this line if appropriate.
723 Insert `{ case }' if there is an `end' on the line which
724 ends a case block. Insert `{ NAME }' if there is an `end'
725 on the line which ends a function or procedure named NAME."
728 (skip-chars-forward " \t")
729 (if (and (looking-at "\\<end;")
732 (search-backward "{" (point-at-bol) t))))
733 (let ((type (car (pascal-calculate-indent))))
734 (if (eq type 'declaration)
737 ;; This is a case block
740 (delete-horizontal-space)
741 (insert " { case }"))
743 ;; Check if this is the end of a function
745 (while (not (or (looking-at pascal-defun-re) (bobp)))
747 (cond ((looking-at pascal-beg-block-re)
748 (setq nest (1- nest)))
749 ((looking-at pascal-end-block-re)
750 (setq nest (1+ nest)))))
756 (delete-horizontal-space)
760 (setq b (progn (pascal-beg-of-defun)
761 (skip-chars-forward "^ \t")
762 (skip-chars-forward " \t")
764 e (progn (skip-chars-forward "a-zA-Z0-9_")
766 (insert-buffer-substring (current-buffer) b e))
767 (insert " }"))))))))))
774 (defconst pascal-indent-alist
775 '((block . (+ pascal--extra-indent pascal-indent-level))
776 (case . (+ pascal--extra-indent pascal-case-indent))
777 (caseblock . pascal--extra-indent) (cpp . 0)
778 (declaration . (+ pascal--extra-indent pascal-indent-level))
779 (paramlist . (pascal-indent-paramlist t))
780 (comment . (pascal-indent-comment))
781 (defun . pascal--extra-indent) (contexp . pascal--extra-indent)
782 (unknown . pascal--extra-indent) (string . 0) (progbeg . 0)))
784 (defun pascal-indent-command ()
785 "Indent for special part of code."
786 (let* ((indent-str (pascal-calculate-indent))
787 (type (car indent-str)))
788 (cond ((and (eq type 'paramlist)
789 (or (memq 'all pascal-auto-lineup)
790 (memq 'paramlist pascal-auto-lineup)))
791 (pascal-indent-paramlist)
792 (pascal-indent-paramlist))
793 ((and (eq type 'declaration)
794 (or (memq 'all pascal-auto-lineup)
795 (memq 'declaration pascal-auto-lineup)))
796 (pascal-indent-declaration))
797 ((and (eq type 'case) (not (looking-at "^[ \t]*$"))
798 (or (memq 'all pascal-auto-lineup)
799 (memq 'case pascal-auto-lineup)))
800 (pascal-indent-case)))
801 (if (looking-at "[ \t]+$")
802 (skip-chars-forward " \t"))))
804 (defun pascal-indent-line ()
805 "Indent current line as a Pascal statement."
806 (let* ((indent-str (pascal-calculate-indent))
807 (type (car indent-str))
808 (pascal--extra-indent (car (cdr indent-str))))
809 ;; Labels should not be indented.
810 (if (and (looking-at "^[0-9a-zA-Z]+[ \t]*:[^=]")
811 (not (eq type 'declaration)))
812 (search-forward ":" nil t))
813 (delete-horizontal-space)
814 (cond (; Some things should not be indented
815 (or (and (eq type 'declaration) (looking-at pascal-declaration-re))
818 (; Other things should have no extra indent
819 (looking-at pascal-noindent-re)
820 (indent-to pascal--extra-indent))
821 (; Nested functions should be indented
822 (looking-at pascal-defun-re)
823 (if (and pascal-indent-nested-functions
825 (indent-to (+ pascal--extra-indent pascal-indent-level))
826 (indent-to pascal--extra-indent)))
827 (; But most lines are treated this way
828 (indent-to (eval (cdr (assoc type pascal-indent-alist))))
831 (defun pascal-calculate-indent ()
832 "Calculate the indent of the current Pascal line.
833 Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
835 (let* ((parse-sexp-ignore-comments t)
837 (state (save-excursion (parse-partial-sexp (point-min) (point))))
838 (nest 0) (par 0) (complete (looking-at "[ \t]*end\\>"))
839 (elsed (looking-at "[ \t]*else\\>")) (funccnt 0)
840 (did-func (looking-at "[ \t]*\\(procedure\\|function\\)\\>"))
841 (type (catch 'nesting
842 ;; Check if inside a string, comment or parenthesis
843 (cond ((nth 3 state) (throw 'nesting 'string))
844 ((nth 4 state) (throw 'nesting 'comment))
846 (goto-char (scan-lists (point) -1 (car state)))
847 (setq par (1+ (current-column))))
848 ((save-excursion (beginning-of-line)
849 (eq (following-char) ?#))
850 (throw 'nesting 'cpp)))
851 ;; Loop until correct indent is found
854 (cond (;--Escape from case statements
855 (and (looking-at "[A-Za-z0-9]+[ \t]*:[^=]")
857 (save-excursion (skip-chars-backward " \t")
860 (end-of-line) (backward-sexp) (point))
862 (> (save-excursion (goto-char oldpos)
866 (throw 'nesting 'caseblock))
867 (;--Beginning of program
868 (looking-at pascal-progbeg-re)
869 (throw 'nesting 'progbeg))
870 (;--No known statements
872 (throw 'nesting 'progbeg))
873 (;--Nest block outwards
874 (looking-at pascal-beg-block-re)
876 (cond ((looking-at "case\\>")
877 (throw 'nesting 'case))
878 ((looking-at "record\\>")
879 (throw 'nesting 'declaration))
880 (t (throw 'nesting 'block)))
881 (if (and (looking-at "record\\>") (= nest 1))
882 (setq funccnt (1- funccnt)))
883 (setq nest (1- nest))))
884 (;--Nest block inwards
885 (looking-at pascal-end-block-re)
886 (if (and (looking-at "end\\s ")
887 elsed (not complete))
888 (throw 'nesting 'block))
890 (setq funccnt (1+ funccnt)))
893 (;--Defun (or parameter list)
894 (and (looking-at pascal-defun-re)
895 (progn (setq funccnt (1- funccnt)
897 (or (bolp) (< funccnt 0))))
898 ;; Prevent searching whole buffer
899 (if (and (bolp) (>= funccnt 0))
900 (throw 'nesting 'progbeg))
902 (throw 'nesting 'defun)
905 (while (re-search-forward
906 "\\(\\<record\\>\\)\\|\\<end\\>"
909 (setq n (1+ n)) (setq n (1- n))))
911 (throw 'nesting 'declaration)
912 (throw 'nesting 'paramlist)))))
914 (and (looking-at pascal-declaration-re)
920 (looking-at "^[ \t]*$"))
921 (throw 'nesting 'unknown)
922 (throw 'nesting 'declaration)))
923 (;--If, else or while statement
925 (looking-at pascal-sub-block-re))
926 (throw 'nesting 'block))
927 (;--Found complete statement
928 (save-excursion (forward-sexp 1)
929 (= (following-char) ?\;))
933 ;; Return type of block and indent level.
934 (if (> par 0) ; Unclosed Parenthesis
936 (list type (pascal-indent-level))))))
938 (defun pascal-indent-level ()
939 "Return the indent-level the current statement has.
940 Do not count labels, case statements or records."
943 (if (looking-at "[ \t]*[0-9a-zA-Z]+[ \t]*:[^=]")
944 (search-forward ":" nil t)
945 (if (looking-at ".*=[ \t]*record\\>")
946 (search-forward "=" nil t)))
947 (skip-chars-forward " \t")
950 (defun pascal-indent-comment ()
951 "Return indent for current comment."
953 (re-search-backward "\\((\\*\\)\\|{" nil t)
954 (if (match-beginning 1)
955 (1+ (current-column))
958 (defun pascal-indent-case ()
959 "Indent within case statements."
960 (let ((savepos (point-marker))
964 (re-search-backward "\\<case\\>" nil t)))
966 (pascal--extra-indent 0))
968 (while (< (point) end)
969 (if (re-search-forward
970 "^[ \t]*[^ \t,:]+[ \t]*\\(,[ \t]*[^ \t,:]+[ \t]*\\)*:"
971 (marker-position end) 'move)
975 (delete-horizontal-space)
976 (if (> (current-column) pascal--extra-indent)
977 (setq pascal--extra-indent (current-column)))
978 (pascal-end-of-statement))))
980 ;; Indent all case statements
981 (while (< (point) end)
982 (if (re-search-forward
983 "^[ \t]*[^][ \t,\\.:]+[ \t]*\\(,[ \t]*[^ \t,:]+[ \t]*\\)*:"
984 (marker-position end) 'move)
986 (indent-to (1+ pascal--extra-indent))
987 (if (/= (following-char) ?:)
990 (delete-horizontal-space)
992 (pascal-end-of-statement))
993 (goto-char savepos)))
995 (defun pascal-indent-paramlist (&optional arg)
996 "Indent current line in parameterlist.
997 If optional ARG is non-nil, just return the
998 indent of the current line in parameterlist."
1000 (let* ((oldpos (point))
1001 (stpos (progn (goto-char (scan-lists (point) -1 1)) (point)))
1002 (stcol (1+ (current-column)))
1003 (edpos (progn (pascal-declaration-end)
1004 (search-backward ")" (point-at-bol) t)
1006 (usevar (re-search-backward "\\<var\\>" stpos t)))
1008 ;; If arg, just return indent
1011 (if (or (not usevar) (looking-at "[ \t]*var\\>"))
1015 (delete-horizontal-space)
1016 (if (and usevar (not (looking-at "var\\>")))
1017 (indent-to (+ 4 stcol)))
1018 (pascal-indent-declaration nil stpos edpos)))))
1020 (defun pascal-indent-declaration (&optional arg start end)
1021 "Indent current lines as declaration, lining up the `:'s or `='s."
1022 (let ((pos (point-marker)))
1023 (if (and (not (or arg start)) (not (pascal-declaration-beg)))
1025 (let ((lineup (if (or (looking-at "\\<var\\>\\|\\<record\\>") arg start)
1027 (stpos (if start start
1028 (forward-word 2) (backward-word 1) (point)))
1029 (edpos (set-marker (make-marker)
1031 (max (progn (pascal-declaration-end)
1034 pascal--extra-indent)
1037 ;; Indent lines in record block
1039 (while (<= (point) edpos)
1041 (delete-horizontal-space)
1042 (if (looking-at "end\\>")
1044 (indent-to (+ arg pascal-indent-level)))
1048 (setq pascal--extra-indent (pascal-get-lineup-indent stpos edpos lineup))
1050 (while (and (<= (point) edpos) (not (eobp)))
1051 (if (search-forward lineup (point-at-eol) 'move)
1053 (delete-horizontal-space)
1054 (indent-to pascal--extra-indent)
1055 (if (not (looking-at lineup))
1056 (forward-line 1) ; No more indent if there is no : or =
1058 (delete-horizontal-space)
1060 ;; Indent record block
1061 (if (looking-at "record\\>")
1062 (pascal-indent-declaration (current-column)))
1063 (forward-line 1)))))
1065 ;; If arg - move point
1066 (if arg (forward-line -1)
1069 ; "Return the indent level that will line up several lines within the region
1070 ;from b to e nicely. The lineup string is str."
1071 (defun pascal-get-lineup-indent (b e str)
1073 (let ((pascal--extra-indent 0)
1074 (reg (concat str "\\|\\(\\<record\\>\\)\\|" pascal-defun-re)))
1076 ;; Get rightmost position
1077 (while (< (point) e)
1078 (and (re-search-forward reg (min e (point-at-eol 2)) 'move)
1079 (cond ((match-beginning 1)
1080 ;; Skip record blocks
1081 (pascal-declaration-end))
1082 ((match-beginning 2)
1083 ;; We have entered a new procedure. Exit.
1086 (goto-char (match-beginning 0))
1087 (skip-chars-backward " \t")
1088 (if (> (current-column) pascal--extra-indent)
1089 (setq pascal--extra-indent (current-column)))
1090 (goto-char (match-end 0))
1093 ;; In case no lineup was found
1094 (if (> pascal--extra-indent 0)
1095 (1+ pascal--extra-indent)
1096 ;; No lineup-string found
1099 (skip-chars-backward " \t")
1100 (1+ (current-column))))))
1107 (defun pascal-string-diff (str1 str2)
1108 "Return index of first letter where STR1 and STR2 differs."
1112 (if (or (> (1+ diff) (length str1))
1113 (> (1+ diff) (length str2)))
1115 (or (equal (aref str1 diff) (aref str2 diff))
1117 (setq diff (1+ diff))))))
1119 ;; Calculate all possible completions for functions if argument is `function',
1120 ;; completions for procedures if argument is `procedure' or both functions and
1121 ;; procedures otherwise.
1123 (defun pascal-func-completion (type pascal-str)
1124 ;; Build regular expression for function/procedure names
1126 (if (string= pascal-str "")
1127 (setq pascal-str "[a-zA-Z_]"))
1128 (let ((pascal-str (concat (cond
1129 ((eq type 'procedure) "\\<\\(procedure\\)\\s +")
1130 ((eq type 'function) "\\<\\(function\\)\\s +")
1131 (t "\\<\\(function\\|procedure\\)\\s +"))
1132 "\\<\\(" pascal-str "[a-zA-Z0-9_.]*\\)\\>"))
1136 (if (not (looking-at "\\<\\(function\\|procedure\\)\\>"))
1137 (re-search-backward "\\<\\(function\\|procedure\\)\\>" nil t))
1140 ;; Search through all reachable functions
1141 (while (pascal-beg-of-defun)
1142 (if (re-search-forward pascal-str (point-at-eol) t)
1143 (progn (setq match (buffer-substring (match-beginning 2)
1145 (push match pascal-all)))
1146 (goto-char (match-beginning 0)))
1150 (defun pascal-get-completion-decl (pascal-str)
1151 ;; Macro for searching through current declaration (var, type or const)
1152 ;; for matches of `str' and adding the occurrence to `all'
1153 (let ((end (save-excursion (pascal-declaration-end)
1158 (while (< (point) end)
1159 (if (re-search-forward "[:=]" (point-at-eol) t)
1160 ;; Traverse current line
1161 (while (and (re-search-backward
1162 (concat "\\((\\|\\<\\(var\\|type\\|const\\)\\>\\)\\|"
1165 (not (match-end 1)))
1166 (setq match (buffer-substring (match-beginning 0) (match-end 0)))
1167 (if (string-match (concat "\\<" pascal-str) match)
1168 (push match pascal-all))))
1169 (if (re-search-forward "\\<record\\>" (point-at-eol) t)
1170 (pascal-declaration-end)
1175 (defun pascal-type-completion (pascal-str)
1176 "Calculate all possible completions for types."
1177 (let ((start (point))
1180 ;; Search for all reachable type declarations
1181 (while (or (pascal-beg-of-defun)
1182 (setq goon (not goon)))
1184 (if (and (< start (prog1 (save-excursion (pascal-end-of-defun)
1188 "\\<type\\>\\|\\<\\(begin\\|function\\|procedure\\)\\>"
1190 (not (match-end 1)))
1191 ;; Check current type declaration
1193 (nconc (pascal-get-completion-decl pascal-str)
1198 (defun pascal-var-completion (prefix)
1199 "Calculate all possible completions for variables (or constants)."
1201 (let ((start (point))
1204 ;; Search for all reachable var declarations
1205 (while (or (pascal-beg-of-defun)
1206 (setq goon (not goon)))
1208 (if (> start (prog1 (save-excursion (pascal-end-of-defun)
1210 () ; Declarations not reachable
1211 (if (search-forward "(" (point-at-eol) t)
1212 ;; Check parameterlist
1213 ;; FIXME: pascal-get-completion-decl doesn't understand
1214 ;; the var declarations in parameter lists :-(
1216 (nconc (pascal-get-completion-decl prefix)
1219 (while (>= (setq twice (1- twice)) 0)
1221 ((and (re-search-forward
1222 (concat "\\<\\(var\\|const\\)\\>\\|"
1223 "\\<\\(begin\\|function\\|procedure\\)\\>")
1225 (not (match-end 2)))
1226 ;; Check var/const declarations
1228 (nconc (pascal-get-completion-decl prefix)
1231 (setq twice 0)))))))
1235 (defun pascal-keyword-completion (keyword-list pascal-str)
1236 "Give list of all possible completions of keywords in KEYWORD-LIST."
1237 (let ((pascal-all ()))
1238 (dolist (s keyword-list)
1239 (if (string-match (concat "\\<" pascal-str) s)
1240 (push s pascal-all)))
1243 ;; Function passed to completing-read, try-completion or
1244 ;; all-completions to get completion on STR. If predicate is non-nil,
1245 ;; it must be a function to be called for every match to check if this
1246 ;; should really be a match. If flag is t, the function returns a list
1247 ;; of all possible completions. If it is nil it returns a string, the
1248 ;; longest possible completion, or t if STR is an exact match. If flag
1249 ;; is 'lambda, the function returns t if STR is an exact match, nil
1252 (defvar pascal-completion-cache nil)
1254 (defun pascal-completion (pascal-str pascal-pred pascal-flag)
1255 (let ((all (car pascal-completion-cache)))
1256 ;; Check the cache's freshness.
1257 (unless (and pascal-completion-cache
1258 (string-prefix-p (nth 1 pascal-completion-cache) pascal-str)
1259 (eq (current-buffer) (nth 2 pascal-completion-cache))
1260 (eq (field-beginning) (nth 3 pascal-completion-cache)))
1261 (let ((state (car (pascal-calculate-indent))))
1263 ;; Determine what should be completed
1265 ( ;--Within a declaration or parameterlist
1266 (or (eq state 'declaration) (eq state 'paramlist)
1267 (and (eq state 'defun)
1269 (re-search-backward ")[ \t]*:" (point-at-bol) t))))
1270 (if (or (eq state 'paramlist) (eq state 'defun))
1271 (pascal-beg-of-defun))
1273 (pascal-type-completion pascal-str)
1274 (pascal-keyword-completion pascal-type-keywords pascal-str)))
1275 ( ;--Starting a new statement
1276 (and (not (eq state 'contexp))
1278 (skip-chars-backward "a-zA-Z0-9_.")
1280 (or (looking-at pascal-nosemi-re)
1283 (looking-at "\\s *\\(;\\|:[^=]\\)")))))
1285 (pascal-var-completion pascal-str)
1286 (pascal-func-completion 'procedure pascal-str)
1287 (pascal-keyword-completion pascal-start-keywords pascal-str)))
1290 (pascal-var-completion pascal-str)
1291 (pascal-func-completion 'function pascal-str)
1292 (pascal-keyword-completion pascal-separator-keywords
1295 (setq pascal-completion-cache
1296 (list all pascal-str (current-buffer) (field-beginning)))))
1298 ;; Now we have built a list of all matches. Give response to caller
1299 (complete-with-action pascal-flag all pascal-str pascal-pred)))
1301 (defvar pascal-last-word-numb 0)
1302 (defvar pascal-last-word-shown nil)
1303 (defvar pascal-last-completions nil)
1305 (defun pascal-completions-at-point ()
1306 (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
1307 (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point))))
1309 (list b e #'pascal-completion))))
1311 (define-obsolete-function-alias 'pascal-complete-word
1312 'completion-at-point "24.1")
1314 (define-obsolete-function-alias 'pascal-show-completions
1315 'completion-help-at-point "24.1")
1318 (defun pascal-get-default-symbol ()
1319 "Return symbol around current point as a string."
1321 (buffer-substring (progn
1322 (skip-chars-backward " \t")
1323 (skip-chars-backward "a-zA-Z0-9_")
1326 (skip-chars-forward "a-zA-Z0-9_")
1329 (defun pascal-build-defun-re (str &optional arg)
1330 "Return function/procedure starting with STR as regular expression.
1331 With optional second arg non-nil, STR is the complete name of the instruction."
1333 (concat "^\\(function\\|procedure\\)[ \t]+\\(" str "\\)\\>")
1334 (concat "^\\(function\\|procedure\\)[ \t]+\\(" str "[a-zA-Z0-9_]*\\)\\>")))
1336 ;; Function passed to completing-read, try-completion or
1337 ;; all-completions to get completion on any function name. If
1338 ;; predicate is non-nil, it must be a function to be called for every
1339 ;; match to check if this should really be a match. If flag is t, the
1340 ;; function returns a list of all possible completions. If it is nil
1341 ;; it returns a string, the longest possible completion, or t if STR
1342 ;; is an exact match. If flag is 'lambda, the function returns t if
1343 ;; STR is an exact match, nil otherwise.
1345 (defun pascal-comp-defun (pascal-str pascal-pred pascal-flag)
1347 (let ((pascal-all nil))
1349 ;; Build regular expression for functions
1350 (let ((pascal-str (pascal-build-defun-re (if (string= pascal-str "")
1353 (goto-char (point-min))
1355 ;; Build a list of all possible completions
1356 (while (re-search-forward pascal-str nil t)
1357 (push (match-string 2) pascal-all)))
1359 ;; Now we have built a list of all matches. Give response to caller
1360 (complete-with-action pascal-flag pascal-all pascal-str pascal-pred))))
1362 (defun pascal-goto-defun ()
1363 "Move to specified Pascal function/procedure.
1364 The default is a name found in the buffer around point."
1366 (let* ((default (pascal-get-default-symbol))
1367 (default (if (pascal-comp-defun default nil 'lambda)
1370 ;; Do completion with default.
1371 (completing-read (if (not (string= default ""))
1372 (concat "Label (default " default "): ")
1374 ;; Complete with the defuns found in the
1376 (let ((buf (current-buffer)))
1378 (with-current-buffer buf
1379 (pascal-comp-defun s p a))))
1381 ;; If there was no response on prompt, use default value.
1382 (if (string= label "")
1383 (setq label default))
1384 ;; Goto right place in buffer if label is not an empty string.
1385 (or (string= label "")
1387 (goto-char (point-min))
1388 (re-search-forward (pascal-build-defun-re label t))
1389 (beginning-of-line)))))
1394 ;;; Pascal-outline-mode
1396 (defvar pascal-outline-map
1397 (let ((map (make-sparse-keymap)))
1398 (if (fboundp 'set-keymap-name)
1399 (set-keymap-name pascal-outline-map 'pascal-outline-map))
1400 (define-key map "\M-\C-a" 'pascal-outline-prev-defun)
1401 (define-key map "\M-\C-e" 'pascal-outline-next-defun)
1402 (define-key map "\C-c\C-d" 'pascal-outline-goto-defun)
1403 (define-key map "\C-c\C-s" 'pascal-show-all)
1404 (define-key map "\C-c\C-h" 'pascal-hide-other-defuns)
1406 "Keymap used in Pascal Outline mode.")
1408 (define-obsolete-function-alias 'pascal-outline 'pascal-outline-mode "22.1")
1409 (define-minor-mode pascal-outline-mode
1410 "Outline-line minor mode for Pascal mode.
1411 With a prefix argument ARG, enable the mode if ARG is positive,
1412 and disable it otherwise. If called from Lisp, enable the mode
1413 if ARG is omitted or nil.
1415 When enabled, portions of the text being edited may be made
1416 invisible.\\<pascal-outline-map>
1418 Pascal Outline mode provides some additional commands.
1420 \\[pascal-outline-prev-defun]\
1421 \t- Move to previous function/procedure, hiding everything else.
1422 \\[pascal-outline-next-defun]\
1423 \t- Move to next function/procedure, hiding everything else.
1424 \\[pascal-outline-goto-defun]\
1425 \t- Goto function/procedure prompted for in minibuffer,
1426 \t hide all other functions.
1427 \\[pascal-show-all]\t- Show the whole buffer.
1428 \\[pascal-hide-other-defuns]\
1429 \t- Hide everything but the current function (function under the cursor).
1430 \\[pascal-outline]\t- Leave Pascal Outline mode."
1431 :init-value nil :lighter " Outl" :keymap pascal-outline-map
1432 (add-to-invisibility-spec '(pascal . t))
1433 (unless pascal-outline-mode
1436 (defun pascal-outline-change (b e hide)
1438 ;; We could try and optimize this in the case where the region is
1439 ;; already hidden. But I'm not sure it's worth the trouble.
1440 (remove-overlays b e 'invisible 'pascal)
1442 (let ((ol (make-overlay b e nil t nil)))
1443 (overlay-put ol 'invisible 'pascal)
1444 (overlay-put ol 'evaporate t)))))
1446 (defun pascal-show-all ()
1447 "Show all of the text in the buffer."
1449 (pascal-outline-change (point-min) (point-max) nil))
1451 (defun pascal-hide-other-defuns ()
1452 "Show only the current defun."
1455 (let ((beg (progn (if (not (looking-at "\\(function\\|procedure\\)\\>"))
1456 (pascal-beg-of-defun))
1457 (line-beginning-position)))
1458 (end (progn (pascal-end-of-defun)
1460 (line-beginning-position 2)))
1461 (opoint (point-min)))
1465 (goto-char (point-min))
1467 ;; Hide all functions before current function
1468 (while (re-search-forward "^[ \t]*\\(function\\|procedure\\)\\>"
1470 (pascal-outline-change opoint (line-end-position 0) t)
1471 (setq opoint (line-end-position))
1472 ;; Functions may be nested
1473 (if (> (progn (pascal-end-of-defun) (point)) beg)
1474 (goto-char opoint)))
1476 (pascal-outline-change opoint (1- beg) t))
1478 ;; Show current function
1479 (pascal-outline-change (1- beg) end nil)
1480 ;; Hide nested functions
1482 (while (re-search-forward "^\\(function\\|procedure\\)\\>" end 'move)
1483 (setq opoint (line-end-position))
1484 (pascal-end-of-defun)
1485 (pascal-outline-change opoint (line-end-position) t))
1490 ;; Hide all function after current function
1491 (while (re-search-forward "^\\(function\\|procedure\\)\\>" nil 'move)
1492 (pascal-outline-change opoint (line-end-position 0) t)
1493 (setq opoint (line-end-position))
1494 (pascal-end-of-defun))
1495 (pascal-outline-change opoint (point-max) t)
1497 ;; Hide main program
1498 (if (< (progn (forward-line -1) (point)) end)
1501 (pascal-end-of-defun)
1503 (pascal-outline-change (line-end-position) (point-max) t))))))
1505 (defun pascal-outline-next-defun ()
1506 "Move to next function/procedure, hiding all others."
1508 (pascal-end-of-defun)
1509 (pascal-hide-other-defuns))
1511 (defun pascal-outline-prev-defun ()
1512 "Move to previous function/procedure, hiding all others."
1514 (pascal-beg-of-defun)
1515 (pascal-hide-other-defuns))
1517 (defun pascal-outline-goto-defun ()
1518 "Move to specified function/procedure, hiding all others."
1521 (pascal-hide-other-defuns))
1525 ;;; pascal.el ends here