1 ;;; pascal.el --- major mode for editing pascal source in Emacs
3 ;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
4 ;; 2003, 2004, 2005, 2006, 2007, 2008, 2009
5 ;; Free Software Foundation, Inc.
7 ;; Author: Espen Skoglund <esk@gnu.org>
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
30 ;; Emacs should enter Pascal mode when you find a Pascal source file.
31 ;; When you have entered Pascal mode, you may get more info by pressing
32 ;; C-h m. You may also get online help describing various functions by:
33 ;; C-h f <Name of function you want described>
35 ;; If you want to customize Pascal mode to fit you better, you may add
36 ;; these lines (the values of the variables presented here are the defaults):
38 ;; ;; User customization for Pascal mode
39 ;; (setq pascal-indent-level 3
40 ;; pascal-case-indent 2
41 ;; pascal-auto-newline nil
42 ;; pascal-tab-always-indent t
43 ;; pascal-auto-endcomments t
44 ;; pascal-auto-lineup '(all)
45 ;; pascal-toggle-completions nil
46 ;; pascal-type-keywords '("array" "file" "packed" "char"
47 ;; "integer" "real" "string" "record")
48 ;; pascal-start-keywords '("begin" "end" "function" "procedure"
49 ;; "repeat" "until" "while" "read" "readln"
50 ;; "reset" "rewrite" "write" "writeln")
51 ;; pascal-separator-keywords '("downto" "else" "mod" "div" "then"))
53 ;; KNOWN BUGS / BUGREPORTS
54 ;; =======================
55 ;; As far as I know, there are no bugs in the current version of this
56 ;; package. This may not be true however, since I never use this mode
57 ;; myself and therefore would never notice them anyway. If you do
58 ;; find any bugs, you may submit them to: esk@gnu.org as well as to
59 ;; bug-gnu-emacs@gnu.org.
64 "Major mode for editing Pascal source in Emacs."
65 :link
'(custom-group-link :tag
"Font Lock Faces group" font-lock-faces
)
68 (defvar pascal-mode-abbrev-table nil
69 "Abbrev table in use in Pascal-mode buffers.")
70 (define-abbrev-table 'pascal-mode-abbrev-table
())
72 (defvar pascal-mode-map
73 (let ((map (make-sparse-keymap)))
74 (define-key map
";" 'electric-pascal-semi-or-dot
)
75 (define-key map
"." 'electric-pascal-semi-or-dot
)
76 (define-key map
":" 'electric-pascal-colon
)
77 (define-key map
"=" 'electric-pascal-equal
)
78 (define-key map
"#" 'electric-pascal-hash
)
79 (define-key map
"\r" 'electric-pascal-terminate-line
)
80 (define-key map
"\t" 'electric-pascal-tab
)
81 (define-key map
"\M-\t" 'pascal-complete-word
)
82 (define-key map
"\M-?" 'pascal-show-completions
)
83 (define-key map
"\177" 'backward-delete-char-untabify
)
84 (define-key map
"\M-\C-h" 'pascal-mark-defun
)
85 (define-key map
"\C-c\C-b" 'pascal-insert-block
)
86 (define-key map
"\M-*" 'pascal-star-comment
)
87 (define-key map
"\C-c\C-c" 'pascal-comment-area
)
88 (define-key map
"\C-c\C-u" 'pascal-uncomment-area
)
89 (define-key map
"\M-\C-a" 'pascal-beg-of-defun
)
90 (define-key map
"\M-\C-e" 'pascal-end-of-defun
)
91 (define-key map
"\C-c\C-d" 'pascal-goto-defun
)
92 (define-key map
"\C-c\C-o" 'pascal-outline-mode
)
93 ;; A command to change the whole buffer won't be used terribly
94 ;; often, so no need for a key binding.
95 ;; (define-key map "\C-cd" 'pascal-downcase-keywords)
96 ;; (define-key map "\C-cu" 'pascal-upcase-keywords)
97 ;; (define-key map "\C-cc" 'pascal-capitalize-keywords)
99 "Keymap used in Pascal mode.")
101 (defvar pascal-imenu-generic-expression
102 '((nil "^[ \t]*\\(function\\|procedure\\)[ \t\n]+\\([a-zA-Z0-9_.:]+\\)" 2))
103 "Imenu expression for Pascal-mode. See `imenu-generic-expression'.")
105 (defvar pascal-keywords
106 '("and" "array" "begin" "case" "const" "div" "do" "downto" "else" "end"
107 "file" "for" "function" "goto" "if" "in" "label" "mod" "nil" "not" "of"
108 "or" "packed" "procedure" "program" "record" "repeat" "set" "then" "to"
109 "type" "until" "var" "while" "with"
110 ;; The following are not standard in pascal, but widely used.
111 "get" "put" "input" "output" "read" "readln" "reset" "rewrite" "write"
115 ;;; Regular expressions used to calculate indent, etc.
117 (defconst pascal-symbol-re
"\\<[a-zA-Z_][a-zA-Z_0-9.]*\\>")
118 (defconst pascal-beg-block-re
"\\<\\(begin\\|case\\|record\\|repeat\\)\\>")
119 (defconst pascal-end-block-re
"\\<\\(end\\|until\\)\\>")
120 (defconst pascal-declaration-re
"\\<\\(const\\|label\\|type\\|var\\)\\>")
121 (defconst pascal-progbeg-re
"\\<\\program\\>")
122 (defconst pascal-defun-re
"\\<\\(function\\|procedure\\|program\\)\\>")
123 (defconst pascal-sub-block-re
"\\<\\(if\\|else\\|for\\|while\\|with\\)\\>")
124 (defconst pascal-noindent-re
"\\<\\(begin\\|end\\|until\\|else\\)\\>")
125 (defconst pascal-nosemi-re
"\\<\\(begin\\|repeat\\|then\\|do\\|else\\)\\>")
126 (defconst pascal-autoindent-lines-re
127 "\\<\\(label\\|var\\|type\\|const\\|until\\|end\\|begin\\|repeat\\|else\\)\\>")
129 ;;; Strings used to mark beginning and end of excluded text
130 (defconst pascal-exclude-str-start
"{-----\\/----- EXCLUDED -----\\/-----")
131 (defconst pascal-exclude-str-end
" -----/\\----- EXCLUDED -----/\\-----}")
133 (defvar pascal-mode-syntax-table
134 (let ((st (make-syntax-table)))
135 (modify-syntax-entry ?
\\ "." st
)
136 (modify-syntax-entry ?\
( "()1" st
)
137 (modify-syntax-entry ?\
) ")(4" st
)
138 ;; This used to use comment-syntax `b'. But the only document I could
139 ;; find about the syntax of Pascal's comments said that (* ... } is
140 ;; a valid comment, just as { ... *) or (* ... *) or { ... }.
141 (modify-syntax-entry ?
* ". 23" st
)
142 (modify-syntax-entry ?
{ "<" st
)
143 (modify-syntax-entry ?
} ">" st
)
144 (modify-syntax-entry ?
+ "." st
)
145 (modify-syntax-entry ?-
"." st
)
146 (modify-syntax-entry ?
= "." st
)
147 (modify-syntax-entry ?%
"." st
)
148 (modify-syntax-entry ?
< "." st
)
149 (modify-syntax-entry ?
> "." st
)
150 (modify-syntax-entry ?
& "." st
)
151 (modify-syntax-entry ?|
"." st
)
152 (modify-syntax-entry ?_
"_" st
)
153 (modify-syntax-entry ?
\' "\"" st
)
155 "Syntax table in use in Pascal-mode buffers.")
159 (defconst pascal-font-lock-keywords
(purecopy
161 '("^[ \t]*\\(function\\|pro\\(cedure\\|gram\\)\\)\\>[ \t]*\\([a-z]\\)"
162 1 font-lock-keyword-face
)
163 '("^[ \t]*\\(function\\|pro\\(cedure\\|gram\\)\\)\\>[ \t]*\\([a-z][a-z0-9_]*\\)"
164 3 font-lock-function-name-face t
)
165 ; ("type" "const" "real" "integer" "char" "boolean" "var"
166 ; "record" "array" "file")
167 (cons (concat "\\<\\(array\\|boolean\\|c\\(har\\|onst\\)\\|file\\|"
168 "integer\\|re\\(al\\|cord\\)\\|type\\|var\\)\\>")
169 'font-lock-type-face
)
170 '("\\<\\(label\\|external\\|forward\\)\\>" . font-lock-constant-face
)
171 '("\\<\\([0-9]+\\)[ \t]*:" 1 font-lock-function-name-face
)
172 ; ("of" "to" "for" "if" "then" "else" "case" "while"
173 ; "do" "until" "and" "or" "not" "in" "with" "repeat" "begin" "end")
175 "and\\|begin\\|case\\|do\\|e\\(lse\\|nd\\)\\|for\\|i[fn]\\|"
176 "not\\|o[fr]\\|repeat\\|t\\(hen\\|o\\)\\|until\\|w\\(hile\\|ith\\)"
178 '("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?"
179 1 font-lock-keyword-face
)
180 '("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?"
181 2 font-lock-keyword-face t
)))
182 "Additional expressions to highlight in Pascal mode.")
183 (put 'pascal-mode
'font-lock-defaults
'(pascal-font-lock-keywords nil t
))
185 (defcustom pascal-indent-level
3
186 "*Indentation of Pascal statements with respect to containing block."
190 (defcustom pascal-case-indent
2
191 "*Indentation for case statements."
195 (defcustom pascal-auto-newline nil
196 "*Non-nil means automatically insert newlines in certain cases.
197 These include after semicolons and after the punctuation mark after an `end'."
201 (defcustom pascal-indent-nested-functions t
202 "*Non-nil means nested functions are indented."
206 (defcustom pascal-tab-always-indent t
207 "*Non-nil means TAB in Pascal mode should always reindent the current line.
208 If this is nil, TAB inserts a tab if it is at the end of the line
209 and follows non-whitespace text."
213 (defcustom pascal-auto-endcomments t
214 "*Non-nil means automatically insert comments after certain `end's.
215 Specifically, this is done after the ends of cases statements and functions.
216 The name of the function or case is included between the braces."
220 (defcustom pascal-auto-lineup
'(all)
221 "*List of contexts where auto lineup of :'s or ='s should be done.
222 Elements can be of type: 'paramlist', 'declaration' or 'case', which will
223 do auto lineup in parameterlist, declarations or case-statements
224 respectively. The word 'all' will do all lineups. '(case paramlist) for
225 instance will do lineup in case-statements and parameterlist, while '(all)
226 will do all lineups."
227 :type
'(set :extra-offset
8
228 (const :tag
"Everything" all
)
229 (const :tag
"Parameter lists" paramlist
)
230 (const :tag
"Decalrations" declaration
)
231 (const :tag
"Case statements" case
))
234 (defcustom pascal-toggle-completions nil
235 "*Non-nil means \\<pascal-mode-map>\\[pascal-complete-word] should try all possible completions one by one.
236 Repeated use of \\[pascal-complete-word] will show you all of them.
237 Normally, when there is more than one possible completion,
238 it displays a list of all possible completions."
242 (defcustom pascal-type-keywords
243 '("array" "file" "packed" "char" "integer" "real" "string" "record")
244 "*Keywords for types used when completing a word in a declaration or parmlist.
245 These include integer, real, char, etc.
246 The types defined within the Pascal program
247 are handled in another way, and should not be added to this list."
248 :type
'(repeat (string :tag
"Keyword"))
251 (defcustom pascal-start-keywords
252 '("begin" "end" "function" "procedure" "repeat" "until" "while"
253 "read" "readln" "reset" "rewrite" "write" "writeln")
254 "*Keywords to complete when standing at the first word of a statement.
255 These are keywords such as begin, repeat, until, readln.
256 The procedures and variables defined within the Pascal program
257 are handled in another way, and should not be added to this list."
258 :type
'(repeat (string :tag
"Keyword"))
261 (defcustom pascal-separator-keywords
262 '("downto" "else" "mod" "div" "then")
263 "*Keywords to complete when NOT standing at the first word of a statement.
264 These are keywords such as downto, else, mod, then.
265 Variables and function names defined within the Pascal program
266 are handled in another way, and should not be added to this list."
267 :type
'(repeat (string :tag
"Keyword"))
275 (defsubst pascal-get-beg-of-line
(&optional arg
)
277 (beginning-of-line arg
)
280 (defsubst pascal-get-end-of-line
(&optional arg
)
285 (defun pascal-declaration-end ()
287 (while (and (> nest
0)
289 "[:=]\\|\\(\\<record\\>\\)\\|\\(\\<end\\>\\)"
290 (save-excursion (end-of-line 2) (point)) t
))
291 (cond ((match-beginning 1) (setq nest
(1+ nest
)))
292 ((match-beginning 2) (setq nest
(1- nest
)))
293 ((looking-at "[^(\n]+)") (setq nest
0))))))
296 (defun pascal-declaration-beg ()
298 (while (and (> nest
0)
299 (re-search-backward "[:=]\\|\\<\\(type\\|var\\|label\\|const\\)\\>\\|\\(\\<record\\>\\)\\|\\(\\<end\\>\\)" (pascal-get-beg-of-line 0) t
))
300 (cond ((match-beginning 1) (setq nest
0))
301 ((match-beginning 2) (setq nest
(1- nest
)))
302 ((match-beginning 3) (setq nest
(1+ nest
)))))
306 (defsubst pascal-within-string
()
308 (nth 3 (parse-partial-sexp (pascal-get-beg-of-line) (point)))))
312 (defun pascal-mode ()
313 "Major mode for editing Pascal code. \\<pascal-mode-map>
314 TAB indents for Pascal code. Delete converts tabs to spaces as it moves back.
316 \\[pascal-complete-word] completes the word around current point with respect \
318 \\[pascal-show-completions] shows all possible completions at this point.
320 Other useful functions are:
322 \\[pascal-mark-defun]\t- Mark function.
323 \\[pascal-insert-block]\t- insert begin ... end;
324 \\[pascal-star-comment]\t- insert (* ... *)
325 \\[pascal-comment-area]\t- Put marked area in a comment, fixing nested comments.
326 \\[pascal-uncomment-area]\t- Uncomment an area commented with \
327 \\[pascal-comment-area].
328 \\[pascal-beg-of-defun]\t- Move to beginning of current function.
329 \\[pascal-end-of-defun]\t- Move to end of current function.
330 \\[pascal-goto-defun]\t- Goto function prompted for in the minibuffer.
331 \\[pascal-outline-mode]\t- Enter `pascal-outline-mode'.
333 Variables controlling indentation/edit style:
335 pascal-indent-level (default 3)
336 Indentation of Pascal statements with respect to containing block.
337 pascal-case-indent (default 2)
338 Indentation for case statements.
339 pascal-auto-newline (default nil)
340 Non-nil means automatically newline after semicolons and the punctuation
342 pascal-indent-nested-functions (default t)
343 Non-nil means nested functions are indented.
344 pascal-tab-always-indent (default t)
345 Non-nil means TAB in Pascal mode should always reindent the current line,
346 regardless of where in the line point is when the TAB command is used.
347 pascal-auto-endcomments (default t)
348 Non-nil means a comment { ... } is set after the ends which ends cases and
349 functions. The name of the function or case will be set between the braces.
350 pascal-auto-lineup (default t)
351 List of contexts where auto lineup of :'s or ='s should be done.
353 See also the user variables pascal-type-keywords, pascal-start-keywords and
354 pascal-separator-keywords.
356 Turning on Pascal mode calls the value of the variable pascal-mode-hook with
357 no args, if that value is non-nil."
359 (kill-all-local-variables)
360 (use-local-map pascal-mode-map
)
361 (setq major-mode
'pascal-mode
)
362 (setq mode-name
"Pascal")
363 (setq local-abbrev-table pascal-mode-abbrev-table
)
364 (set-syntax-table pascal-mode-syntax-table
)
365 (make-local-variable 'indent-line-function
)
366 (setq indent-line-function
'pascal-indent-line
)
367 (make-local-variable 'comment-indent-function
)
368 (setq comment-indent-function
'pascal-indent-comment
)
369 (make-local-variable 'parse-sexp-ignore-comments
)
370 (setq parse-sexp-ignore-comments nil
)
371 (make-local-variable 'blink-matching-paren-dont-ignore-comments
)
372 (setq blink-matching-paren-dont-ignore-comments t
)
373 (make-local-variable 'case-fold-search
)
374 (setq case-fold-search t
)
375 (make-local-variable 'comment-start
)
376 (setq comment-start
"{")
377 (make-local-variable 'comment-start-skip
)
378 (setq comment-start-skip
"(\\*+ *\\|{ *")
379 (make-local-variable 'comment-end
)
380 (setq comment-end
"}")
382 (make-local-variable 'font-lock-defaults
)
383 (setq font-lock-defaults
'(pascal-font-lock-keywords nil t
))
385 (make-local-variable 'imenu-generic-expression
)
386 (setq imenu-generic-expression pascal-imenu-generic-expression
)
387 (setq imenu-case-fold-search t
)
388 (run-mode-hooks 'pascal-mode-hook
))
393 ;;; Electric functions
395 (defun electric-pascal-terminate-line ()
396 "Terminate line and indent next line."
398 ;; First, check if current line should be indented
401 (skip-chars-forward " \t")
402 (if (looking-at pascal-autoindent-lines-re
)
403 (pascal-indent-line)))
404 (delete-horizontal-space) ; Removes trailing whitespaces
408 ;; Maybe we should set some endcomments
409 (if pascal-auto-endcomments
410 (pascal-set-auto-comments))
411 ;; Check if we shall indent inside comment
415 (skip-chars-forward " \t")
416 (cond ((looking-at "\\*[ \t]+)")
417 ;; Delete region between `*' and `)' if there is only whitespaces.
419 (delete-horizontal-space))
420 ((and (looking-at "(\\*\\|\\*[^)]")
422 (search-forward "*)" (pascal-get-end-of-line) t
))))
424 ;; If last line was a star comment line then this one shall be too.
430 (defun electric-pascal-semi-or-dot ()
431 "Insert `;' or `.' character and reindent the line."
433 (insert last-command-event
)
436 (pascal-indent-line))
437 (if pascal-auto-newline
438 (electric-pascal-terminate-line)))
440 (defun electric-pascal-colon ()
441 "Insert `:' and do all indentions except line indent on this line."
443 (insert last-command-event
)
444 ;; Do nothing if within string.
445 (if (pascal-within-string)
449 (pascal-indent-line))
450 (let ((pascal-tab-always-indent nil
))
451 (pascal-indent-command))))
453 (defun electric-pascal-equal ()
454 "Insert `=', and do indention if within type declaration."
456 (insert last-command-event
)
457 (if (eq (car (pascal-calculate-indent)) 'declaration
)
458 (let ((pascal-tab-always-indent nil
))
459 (pascal-indent-command))))
461 (defun electric-pascal-hash ()
462 "Insert `#', and indent to column 0 if this is a CPP directive."
464 (insert last-command-event
)
465 (if (save-excursion (beginning-of-line) (looking-at "^[ \t]*#"))
466 (save-excursion (beginning-of-line)
467 (delete-horizontal-space))))
469 (defun electric-pascal-tab ()
470 "Function called when TAB is pressed in Pascal mode."
472 ;; Do nothing if within a string or in a CPP directive.
473 (if (or (pascal-within-string)
475 (save-excursion (beginning-of-line) (eq (following-char) ?
#))))
477 ;; If pascal-tab-always-indent, indent the beginning of the line.
478 (if pascal-tab-always-indent
481 (pascal-indent-line))
483 (skip-chars-backward " \t")
487 (pascal-indent-command)))
492 ;;; Interactive functions
494 (defun pascal-insert-block ()
495 "Insert Pascal begin ... end; block in the code with right indentation."
498 (electric-pascal-terminate-line)
503 (pascal-indent-line)))
505 (defun pascal-star-comment ()
506 "Insert Pascal star comment at point."
510 (electric-pascal-terminate-line)
512 (electric-pascal-terminate-line)
513 (delete-horizontal-space)
517 (defun pascal-mark-defun ()
518 "Mark the current pascal function (or procedure).
519 This puts the mark at the end, and point at the beginning."
522 (pascal-end-of-defun)
524 (pascal-beg-of-defun)
525 (when (featurep 'xemacs
)
526 (zmacs-activate-region)))
528 (defun pascal-comment-area (start end
)
529 "Put the region into a Pascal comment.
530 The comments that are in this area are \"deformed\":
531 `*)' becomes `!(*' and `}' becomes `!{'.
532 These deformed comments are returned to normal if you use
533 \\[pascal-uncomment-area] to undo the commenting.
535 The commented area starts with `pascal-exclude-str-start', and ends with
536 `pascal-include-str-end'. But if you change these variables,
537 \\[pascal-uncomment-area] won't recognize the comments."
540 ;; Insert start and endcomments
542 (if (and (save-excursion (skip-chars-forward " \t") (eolp))
543 (not (save-excursion (skip-chars-backward " \t") (bolp))))
546 (insert pascal-exclude-str-end
)
551 (insert pascal-exclude-str-start
)
553 ;; Replace end-comments within commented area
556 (while (re-search-backward "\\*)" start t
)
557 (replace-match "!(*" t t
)))
559 (while (re-search-backward "}" start t
)
560 (replace-match "!{" t t
)))))
562 (defun pascal-uncomment-area ()
563 "Uncomment a commented area; change deformed comments back to normal.
564 This command does nothing if the pointer is not in a commented
565 area. See also `pascal-comment-area'."
568 (let ((start (point))
570 ;; Find the boundaries of the comment
572 (setq start
(progn (search-backward pascal-exclude-str-start nil t
)
574 (setq end
(progn (search-forward pascal-exclude-str-end nil t
)
576 ;; Check if we're really inside a comment
577 (if (or (equal start
(point)) (<= end
(point)))
578 (message "Not standing within commented area.")
585 (delete-region pos
(1+ (point))))
586 ;; Change comments back to normal
588 (while (re-search-backward "!{" start t
)
589 (replace-match "}" t t
)))
591 (while (re-search-backward "!(\\*" start t
)
592 (replace-match "*)" t t
)))
593 ;; Remove startcomment
598 (delete-region pos
(1+ (point)))))))))
600 (defun pascal-beg-of-defun ()
601 "Move backward to the beginning of the current function or procedure."
604 (if (not (looking-at (concat "\\s \\|\\s)\\|" pascal-defun-re
)))
606 (let ((nest 0) (max -
1) (func 0)
607 (reg (concat pascal-beg-block-re
"\\|"
608 pascal-end-block-re
"\\|"
610 (while (re-search-backward reg nil
'move
)
611 (cond ((let ((state (save-excursion
612 (parse-partial-sexp (point-min) (point)))))
613 (or (nth 3 state
) (nth 4 state
))) ; Inside string or comment
615 ((match-end 1) ; begin|case|record|repeat
616 (if (and (looking-at "\\<record\\>") (>= max
0))
617 (setq func
(1- func
)))
620 ((match-end 2) ; end|until
621 (if (and (= nest max
) (>= max
0))
622 (setq func
(1+ func
)))
623 (setq nest
(1- nest
)))
624 ((match-end 3) ; function|procedure
627 (setq func
(1- func
)))))))
630 (defun pascal-end-of-defun ()
631 "Move forward to the end of the current function or procedure."
633 (if (looking-at "\\s ")
635 (if (not (looking-at pascal-defun-re
))
636 (pascal-beg-of-defun))
638 (let ((nest 0) (func 1)
639 (reg (concat pascal-beg-block-re
"\\|"
640 pascal-end-block-re
"\\|"
642 (while (and (/= func
0)
643 (re-search-forward reg nil
'move
))
644 (cond ((let ((state (save-excursion
645 (parse-partial-sexp (point-min) (point)))))
646 (or (nth 3 state
) (nth 4 state
))) ; Inside string or comment
649 (setq nest
(1+ nest
))
651 (goto-char (match-beginning 0))
652 (looking-at "\\<record\\>"))
653 (setq func
(1+ func
))))
655 (setq nest
(1- nest
))
657 (setq func
(1- func
))))
659 (setq func
(1+ func
))))))
662 (defun pascal-end-of-statement ()
663 "Move forward to end of current statement."
665 (let ((parse-sexp-ignore-comments t
)
667 (regexp (concat "\\(" pascal-beg-block-re
"\\)\\|\\("
668 pascal-end-block-re
"\\)")))
669 (if (not (looking-at "[ \t\n]")) (forward-sexp -
1))
670 (or (looking-at pascal-beg-block-re
)
671 ;; Skip to end of statement
672 (setq pos
(catch 'found
675 (cond ((looking-at "[ \t]*;")
676 (skip-chars-forward "^;")
678 (throw 'found
(point)))
681 (looking-at pascal-beg-block-re
))
682 (goto-char (match-beginning 0))
685 (throw 'found
(point))))))))
687 ;; Skip a whole block
690 (re-search-forward regexp nil
'move
)
691 (setq nest
(if (match-end 1)
695 (throw 'found
(point)))
697 (throw 'found
(pascal-end-of-statement))))))
700 (defun pascal-downcase-keywords ()
701 "Downcase all Pascal keywords in the buffer."
703 (pascal-change-keywords 'downcase-word
))
705 (defun pascal-upcase-keywords ()
706 "Upcase all Pascal keywords in the buffer."
708 (pascal-change-keywords 'upcase-word
))
710 (defun pascal-capitalize-keywords ()
711 "Capitalize all Pascal keywords in the buffer."
713 (pascal-change-keywords 'capitalize-word
))
715 ;; Change the keywords according to argument.
716 (defun pascal-change-keywords (change-word)
718 (let ((keyword-re (concat "\\<\\("
719 (mapconcat 'identity pascal-keywords
"\\|")
721 (goto-char (point-min))
722 (while (re-search-forward keyword-re nil t
)
723 (funcall change-word -
1)))))
730 (defun pascal-set-auto-comments ()
731 "Insert `{ case }' or `{ NAME }' on this line if appropriate.
732 Insert `{ case }' if there is an `end' on the line which
733 ends a case block. Insert `{ NAME }' if there is an `end'
734 on the line which ends a function or procedure named NAME."
737 (skip-chars-forward " \t")
738 (if (and (looking-at "\\<end;")
741 (search-backward "{" (pascal-get-beg-of-line) t
))))
742 (let ((type (car (pascal-calculate-indent))))
743 (if (eq type
'declaration
)
746 ;; This is a case block
749 (delete-horizontal-space)
750 (insert " { case }"))
752 ;; Check if this is the end of a function
754 (while (not (or (looking-at pascal-defun-re
) (bobp)))
756 (cond ((looking-at pascal-beg-block-re
)
757 (setq nest
(1- nest
)))
758 ((looking-at pascal-end-block-re
)
759 (setq nest
(1+ nest
)))))
765 (delete-horizontal-space)
769 (setq b
(progn (pascal-beg-of-defun)
770 (skip-chars-forward "^ \t")
771 (skip-chars-forward " \t")
773 e
(progn (skip-chars-forward "a-zA-Z0-9_")
775 (insert-buffer-substring (current-buffer) b e
))
776 (insert " }"))))))))))
783 (defconst pascal-indent-alist
784 '((block .
(+ ind pascal-indent-level
))
785 (case .
(+ ind pascal-case-indent
))
786 (caseblock . ind
) (cpp .
0)
787 (declaration .
(+ ind pascal-indent-level
))
788 (paramlist .
(pascal-indent-paramlist t
))
789 (comment .
(pascal-indent-comment))
790 (defun . ind
) (contexp . ind
)
791 (unknown . ind
) (string .
0) (progbeg .
0)))
793 (defun pascal-indent-command ()
794 "Indent for special part of code."
795 (let* ((indent-str (pascal-calculate-indent))
796 (type (car indent-str
)))
797 (cond ((and (eq type
'paramlist
)
798 (or (memq 'all pascal-auto-lineup
)
799 (memq 'paramlist pascal-auto-lineup
)))
800 (pascal-indent-paramlist)
801 (pascal-indent-paramlist))
802 ((and (eq type
'declaration
)
803 (or (memq 'all pascal-auto-lineup
)
804 (memq 'declaration pascal-auto-lineup
)))
805 (pascal-indent-declaration))
806 ((and (eq type
'case
) (not (looking-at "^[ \t]*$"))
807 (or (memq 'all pascal-auto-lineup
)
808 (memq 'case pascal-auto-lineup
)))
809 (pascal-indent-case)))
810 (if (looking-at "[ \t]+$")
811 (skip-chars-forward " \t"))))
813 (defun pascal-indent-line ()
814 "Indent current line as a Pascal statement."
815 (let* ((indent-str (pascal-calculate-indent))
816 (type (car indent-str
))
817 (ind (car (cdr indent-str
))))
818 ;; Labels should not be indented.
819 (if (and (looking-at "^[0-9a-zA-Z]+[ \t]*:[^=]")
820 (not (eq type
'declaration
)))
821 (search-forward ":" nil t
))
822 (delete-horizontal-space)
823 (cond (; Some things should not be indented
824 (or (and (eq type
'declaration
) (looking-at pascal-declaration-re
))
827 (; Other things should have no extra indent
828 (looking-at pascal-noindent-re
)
830 (; Nested functions should be indented
831 (looking-at pascal-defun-re
)
832 (if (and pascal-indent-nested-functions
834 (indent-to (+ ind pascal-indent-level
))
836 (; But most lines are treated this way
837 (indent-to (eval (cdr (assoc type pascal-indent-alist
))))
840 (defun pascal-calculate-indent ()
841 "Calculate the indent of the current Pascal line.
842 Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
844 (let* ((parse-sexp-ignore-comments t
)
846 (state (save-excursion (parse-partial-sexp (point-min) (point))))
847 (nest 0) (par 0) (complete (looking-at "[ \t]*end\\>"))
848 (elsed (looking-at "[ \t]*else\\>")) (funccnt 0)
849 (did-func (looking-at "[ \t]*\\(procedure\\|function\\)\\>"))
850 (type (catch 'nesting
851 ;; Check if inside a string, comment or parenthesis
852 (cond ((nth 3 state
) (throw 'nesting
'string
))
853 ((nth 4 state
) (throw 'nesting
'comment
))
855 (goto-char (scan-lists (point) -
1 (car state
)))
856 (setq par
(1+ (current-column))))
857 ((save-excursion (beginning-of-line)
858 (eq (following-char) ?
#))
859 (throw 'nesting
'cpp
)))
860 ;; Loop until correct indent is found
863 (cond (;--Escape from case statements
864 (and (looking-at "[A-Za-z0-9]+[ \t]*:[^=]")
866 (save-excursion (skip-chars-backward " \t")
869 (end-of-line) (backward-sexp) (point))
871 (> (save-excursion (goto-char oldpos
)
875 (throw 'nesting
'caseblock
))
876 (;--Beginning of program
877 (looking-at pascal-progbeg-re
)
878 (throw 'nesting
'progbeg
))
879 (;--No known statements
881 (throw 'nesting
'progbeg
))
882 (;--Nest block outwards
883 (looking-at pascal-beg-block-re
)
885 (cond ((looking-at "case\\>")
886 (throw 'nesting
'case
))
887 ((looking-at "record\\>")
888 (throw 'nesting
'declaration
))
889 (t (throw 'nesting
'block
)))
890 (if (and (looking-at "record\\>") (= nest
1))
891 (setq funccnt
(1- funccnt
)))
892 (setq nest
(1- nest
))))
893 (;--Nest block inwards
894 (looking-at pascal-end-block-re
)
895 (if (and (looking-at "end\\s ")
896 elsed
(not complete
))
897 (throw 'nesting
'block
))
899 (setq funccnt
(1+ funccnt
)))
902 (;--Defun (or parameter list)
903 (and (looking-at pascal-defun-re
)
904 (progn (setq funccnt
(1- funccnt
)
906 (or (bolp) (< funccnt
0))))
907 ;; Prevent searching whole buffer
908 (if (and (bolp) (>= funccnt
0))
909 (throw 'nesting
'progbeg
))
911 (throw 'nesting
'defun
)
914 (while (re-search-forward
915 "\\(\\<record\\>\\)\\|\\<end\\>"
918 (setq n
(1+ n
)) (setq n
(1- n
))))
920 (throw 'nesting
'declaration
)
921 (throw 'nesting
'paramlist
)))))
923 (and (looking-at pascal-declaration-re
)
929 (looking-at "^[ \t]*$"))
930 (throw 'nesting
'unknown
)
931 (throw 'nesting
'declaration
)))
932 (;--If, else or while statement
934 (looking-at pascal-sub-block-re
))
935 (throw 'nesting
'block
))
936 (;--Found complete statement
937 (save-excursion (forward-sexp 1)
938 (= (following-char) ?\
;))
942 ;; Return type of block and indent level.
943 (if (> par
0) ; Unclosed Parenthesis
945 (list type
(pascal-indent-level))))))
947 (defun pascal-indent-level ()
948 "Return the indent-level the current statement has.
949 Do not count labels, case-statements or records."
952 (if (looking-at "[ \t]*[0-9a-zA-Z]+[ \t]*:[^=]")
953 (search-forward ":" nil t
)
954 (if (looking-at ".*=[ \t]*record\\>")
955 (search-forward "=" nil t
)))
956 (skip-chars-forward " \t")
959 (defun pascal-indent-comment ()
960 "Return indent for current comment."
962 (re-search-backward "\\((\\*\\)\\|{" nil t
)
963 (if (match-beginning 1)
964 (1+ (current-column))
967 (defun pascal-indent-case ()
968 "Indent within case statements."
969 (let ((savepos (point-marker))
973 (re-search-backward "\\<case\\>" nil t
)))
977 (while (< (point) end
)
978 (if (re-search-forward
979 "^[ \t]*[^ \t,:]+[ \t]*\\(,[ \t]*[^ \t,:]+[ \t]*\\)*:"
980 (marker-position end
) 'move
)
984 (delete-horizontal-space)
985 (if (> (current-column) ind
)
986 (setq ind
(current-column)))
987 (pascal-end-of-statement))))
989 ;; Indent all case statements
990 (while (< (point) end
)
991 (if (re-search-forward
992 "^[ \t]*[^][ \t,\\.:]+[ \t]*\\(,[ \t]*[^ \t,:]+[ \t]*\\)*:"
993 (marker-position end
) 'move
)
996 (if (/= (following-char) ?
:)
999 (delete-horizontal-space)
1001 (pascal-end-of-statement))
1002 (goto-char savepos
)))
1004 (defun pascal-indent-paramlist (&optional arg
)
1005 "Indent current line in parameterlist.
1006 If optional arg is non-nil, just return the
1007 indent of the current line in parameterlist."
1009 (let* ((oldpos (point))
1010 (stpos (progn (goto-char (scan-lists (point) -
1 1)) (point)))
1011 (stcol (1+ (current-column)))
1012 (edpos (progn (pascal-declaration-end)
1013 (search-backward ")" (pascal-get-beg-of-line) t
)
1015 (usevar (re-search-backward "\\<var\\>" stpos t
)))
1017 ;; If arg, just return indent
1020 (if (or (not usevar
) (looking-at "[ \t]*var\\>"))
1024 (delete-horizontal-space)
1025 (if (and usevar
(not (looking-at "var\\>")))
1026 (indent-to (+ 4 stcol
)))
1027 (pascal-indent-declaration nil stpos edpos
)))))
1029 (defun pascal-indent-declaration (&optional arg start end
)
1030 "Indent current lines as declaration, lining up the `:'s or `='s."
1031 (let ((pos (point-marker)))
1032 (if (and (not (or arg start
)) (not (pascal-declaration-beg)))
1034 (let ((lineup (if (or (looking-at "\\<var\\>\\|\\<record\\>") arg start
)
1036 (stpos (if start start
1037 (forward-word 2) (backward-word 1) (point)))
1038 (edpos (set-marker (make-marker)
1040 (max (progn (pascal-declaration-end)
1046 ;; Indent lines in record block
1048 (while (<= (point) edpos
)
1050 (delete-horizontal-space)
1051 (if (looking-at "end\\>")
1053 (indent-to (+ arg pascal-indent-level
)))
1057 (setq ind
(pascal-get-lineup-indent stpos edpos lineup
))
1059 (while (and (<= (point) edpos
) (not (eobp)))
1060 (if (search-forward lineup
(pascal-get-end-of-line) 'move
)
1062 (delete-horizontal-space)
1064 (if (not (looking-at lineup
))
1065 (forward-line 1) ; No more indent if there is no : or =
1067 (delete-horizontal-space)
1069 ;; Indent record block
1070 (if (looking-at "record\\>")
1071 (pascal-indent-declaration (current-column)))
1072 (forward-line 1)))))
1074 ;; If arg - move point
1075 (if arg
(forward-line -
1)
1078 ; "Return the indent level that will line up several lines within the region
1079 ;from b to e nicely. The lineup string is str."
1080 (defun pascal-get-lineup-indent (b e str
)
1083 (reg (concat str
"\\|\\(\\<record\\>\\)\\|" pascal-defun-re
)))
1085 ;; Get rightmost position
1086 (while (< (point) e
)
1087 (and (re-search-forward reg
(min e
(pascal-get-end-of-line 2)) 'move
)
1088 (cond ((match-beginning 1)
1089 ;; Skip record blocks
1090 (pascal-declaration-end))
1091 ((match-beginning 2)
1092 ;; We have entered a new procedure. Exit.
1095 (goto-char (match-beginning 0))
1096 (skip-chars-backward " \t")
1097 (if (> (current-column) ind
)
1098 (setq ind
(current-column)))
1099 (goto-char (match-end 0))
1102 ;; In case no lineup was found
1105 ;; No lineup-string found
1108 (skip-chars-backward " \t")
1109 (1+ (current-column))))))
1116 (defvar pascal-str nil
)
1117 (defvar pascal-all nil
)
1118 (defvar pascal-pred nil
)
1119 (defvar pascal-buffer-to-use nil
)
1120 (defvar pascal-flag nil
)
1122 (defun pascal-string-diff (str1 str2
)
1123 "Return index of first letter where STR1 and STR2 differs."
1127 (if (or (> (1+ diff
) (length str1
))
1128 (> (1+ diff
) (length str2
)))
1130 (or (equal (aref str1 diff
) (aref str2 diff
))
1132 (setq diff
(1+ diff
))))))
1134 ;; Calculate all possible completions for functions if argument is `function',
1135 ;; completions for procedures if argument is `procedure' or both functions and
1136 ;; procedures otherwise.
1138 (defun pascal-func-completion (type)
1139 ;; Build regular expression for function/procedure names
1140 (if (string= pascal-str
"")
1141 (setq pascal-str
"[a-zA-Z_]"))
1142 (let ((pascal-str (concat (cond
1143 ((eq type
'procedure
) "\\<\\(procedure\\)\\s +")
1144 ((eq type
'function
) "\\<\\(function\\)\\s +")
1145 (t "\\<\\(function\\|procedure\\)\\s +"))
1146 "\\<\\(" pascal-str
"[a-zA-Z0-9_.]*\\)\\>"))
1149 (if (not (looking-at "\\<\\(function\\|procedure\\)\\>"))
1150 (re-search-backward "\\<\\(function\\|procedure\\)\\>" nil t
))
1153 ;; Search through all reachable functions
1154 (while (pascal-beg-of-defun)
1155 (if (re-search-forward pascal-str
(pascal-get-end-of-line) t
)
1156 (progn (setq match
(buffer-substring (match-beginning 2)
1158 (if (or (null pascal-pred
)
1159 (funcall pascal-pred match
))
1160 (setq pascal-all
(cons match pascal-all
)))))
1161 (goto-char (match-beginning 0)))))
1163 (defun pascal-get-completion-decl ()
1164 ;; Macro for searching through current declaration (var, type or const)
1165 ;; for matches of `str' and adding the occurrence to `all'
1166 (let ((end (save-excursion (pascal-declaration-end)
1170 (while (< (point) end
)
1171 (if (re-search-forward "[:=]" (pascal-get-end-of-line) t
)
1172 ;; Traverse current line
1173 (while (and (re-search-backward
1174 (concat "\\((\\|\\<\\(var\\|type\\|const\\)\\>\\)\\|"
1176 (pascal-get-beg-of-line) t
)
1177 (not (match-end 1)))
1178 (setq match
(buffer-substring (match-beginning 0) (match-end 0)))
1179 (if (string-match (concat "\\<" pascal-str
) match
)
1180 (if (or (null pascal-pred
)
1181 (funcall pascal-pred match
))
1182 (setq pascal-all
(cons match pascal-all
))))))
1183 (if (re-search-forward "\\<record\\>" (pascal-get-end-of-line) t
)
1184 (pascal-declaration-end)
1185 (forward-line 1)))))
1187 (defun pascal-type-completion ()
1188 "Calculate all possible completions for types."
1189 (let ((start (point))
1191 ;; Search for all reachable type declarations
1192 (while (or (pascal-beg-of-defun)
1193 (setq goon
(not goon
)))
1195 (if (and (< start
(prog1 (save-excursion (pascal-end-of-defun)
1199 "\\<type\\>\\|\\<\\(begin\\|function\\|procedure\\)\\>"
1201 (not (match-end 1)))
1202 ;; Check current type declaration
1203 (pascal-get-completion-decl))))))
1205 (defun pascal-var-completion ()
1206 "Calculate all possible completions for variables (or constants)."
1207 (let ((start (point))
1209 ;; Search for all reachable var declarations
1210 (while (or (pascal-beg-of-defun)
1211 (setq goon
(not goon
)))
1213 (if (> start
(prog1 (save-excursion (pascal-end-of-defun)
1215 () ; Declarations not reachable
1216 (if (search-forward "(" (pascal-get-end-of-line) t
)
1217 ;; Check parameterlist
1218 (pascal-get-completion-decl))
1220 (while (>= (setq twice
(1- twice
)) 0)
1221 (cond ((and (re-search-forward
1222 (concat "\\<\\(var\\|const\\)\\>\\|"
1223 "\\<\\(begin\\|function\\|procedure\\)\\>")
1225 (not (match-end 2)))
1226 ;; Check var/const declarations
1227 (pascal-get-completion-decl))
1229 (setq twice
0)))))))))
1232 (defun pascal-keyword-completion (keyword-list)
1233 "Give list of all possible completions of keywords in KEYWORD-LIST."
1234 (mapcar '(lambda (s)
1235 (if (string-match (concat "\\<" pascal-str
) s
)
1236 (if (or (null pascal-pred
)
1237 (funcall pascal-pred s
))
1238 (setq pascal-all
(cons s pascal-all
)))))
1241 ;; Function passed to completing-read, try-completion or
1242 ;; all-completions to get completion on STR. If predicate is non-nil,
1243 ;; it must be a function to be called for every match to check if this
1244 ;; should really be a match. If flag is t, the function returns a list
1245 ;; of all possible completions. If it is nil it returns a string, the
1246 ;; longest possible completion, or t if STR is an exact match. If flag
1247 ;; is 'lambda, the function returns t if STR is an exact match, nil
1250 (defun pascal-completion (pascal-str pascal-pred pascal-flag
)
1252 (let ((pascal-all nil
))
1253 ;; Set buffer to use for searching labels. This should be set
1254 ;; within functions which use pascal-completions
1255 (set-buffer pascal-buffer-to-use
)
1257 ;; Determine what should be completed
1258 (let ((state (car (pascal-calculate-indent))))
1259 (cond (;--Within a declaration or parameterlist
1260 (or (eq state
'declaration
) (eq state
'paramlist
)
1261 (and (eq state
'defun
)
1263 (re-search-backward ")[ \t]*:"
1264 (pascal-get-beg-of-line) t
))))
1265 (if (or (eq state
'paramlist
) (eq state
'defun
))
1266 (pascal-beg-of-defun))
1267 (pascal-type-completion)
1268 (pascal-keyword-completion pascal-type-keywords
))
1269 (;--Starting a new statement
1270 (and (not (eq state
'contexp
))
1272 (skip-chars-backward "a-zA-Z0-9_.")
1274 (or (looking-at pascal-nosemi-re
)
1277 (looking-at "\\s *\\(;\\|:[^=]\\)")))))
1278 (save-excursion (pascal-var-completion))
1279 (pascal-func-completion 'procedure
)
1280 (pascal-keyword-completion pascal-start-keywords
))
1282 (save-excursion (pascal-var-completion))
1283 (pascal-func-completion 'function
)
1284 (pascal-keyword-completion pascal-separator-keywords
))))
1286 ;; Now we have built a list of all matches. Give response to caller
1287 (pascal-completion-response))))
1289 (defun pascal-completion-response ()
1290 (cond ((or (equal pascal-flag
'lambda
) (null pascal-flag
))
1291 ;; This was not called by all-completions
1292 (if (null pascal-all
)
1293 ;; Return nil if there was no matching label
1295 ;; Get longest string common in the labels
1296 (let* ((elm (cdr pascal-all
))
1297 (match (car pascal-all
))
1298 (min (length match
))
1300 (if (string= match pascal-str
)
1301 ;; Return t if first match was an exact match
1303 (while (not (null elm
))
1304 ;; Find longest common string
1305 (if (< (setq tmp
(pascal-string-diff match
(car elm
))) min
)
1308 (setq match
(substring match
0 min
))))
1309 ;; Terminate with match=t if this is an exact match
1310 (if (string= (car elm
) pascal-str
)
1314 (setq elm
(cdr elm
)))))
1315 ;; If this is a test just for exact match, return nil ot t
1316 (if (and (equal pascal-flag
'lambda
) (not (equal match
't
)))
1319 ;; If flag is t, this was called by all-completions. Return
1320 ;; list of all possible completions
1324 (defvar pascal-last-word-numb
0)
1325 (defvar pascal-last-word-shown nil
)
1326 (defvar pascal-last-completions nil
)
1328 (defun pascal-complete-word ()
1329 "Complete word at current point.
1330 \(See also `pascal-toggle-completions', `pascal-type-keywords',
1331 `pascal-start-keywords' and `pascal-separator-keywords'.)"
1333 (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
1334 (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))
1335 (pascal-str (buffer-substring b e
))
1336 ;; The following variable is used in pascal-completion
1337 (pascal-buffer-to-use (current-buffer))
1338 (allcomp (if (and pascal-toggle-completions
1339 (string= pascal-last-word-shown pascal-str
))
1340 pascal-last-completions
1341 (all-completions pascal-str
'pascal-completion
)))
1342 (match (if pascal-toggle-completions
1344 pascal-str
(mapcar '(lambda (elm)
1345 (cons elm
0)) allcomp
)))))
1346 ;; Delete old string
1349 ;; Toggle-completions inserts whole labels
1350 (if pascal-toggle-completions
1352 ;; Update entry number in list
1353 (setq pascal-last-completions allcomp
1354 pascal-last-word-numb
1355 (if (>= pascal-last-word-numb
(1- (length allcomp
)))
1357 (1+ pascal-last-word-numb
)))
1358 (setq pascal-last-word-shown
(elt allcomp pascal-last-word-numb
))
1359 ;; Display next match or same string if no match was found
1360 (if (not (null allcomp
))
1361 (insert "" pascal-last-word-shown
)
1362 (insert "" pascal-str
)
1363 (message "(No match)")))
1364 ;; The other form of completion does not necessarily do that.
1366 ;; Insert match if found, or the original string if no match
1367 (if (or (null match
) (equal match
't
))
1368 (progn (insert "" pascal-str
)
1369 (message "(No match)"))
1371 ;; Give message about current status of completion
1372 (cond ((equal match
't
)
1373 (if (not (null (cdr allcomp
)))
1374 (message "(Complete but not unique)")
1375 (message "(Sole completion)")))
1376 ;; Display buffer if the current completion didn't help
1377 ;; on completing the label.
1378 ((and (not (null (cdr allcomp
))) (= (length pascal-str
)
1380 (with-output-to-temp-buffer "*Completions*"
1381 (display-completion-list allcomp pascal-str
))
1382 ;; Wait for a keypress. Then delete *Completion* window
1383 (momentary-string-display "" (point))
1384 (delete-window (get-buffer-window (get-buffer "*Completions*")))
1387 (defun pascal-show-completions ()
1388 "Show all possible completions at current point."
1390 (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
1391 (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))
1392 (pascal-str (buffer-substring b e
))
1393 ;; The following variable is used in pascal-completion
1394 (pascal-buffer-to-use (current-buffer))
1395 (allcomp (if (and pascal-toggle-completions
1396 (string= pascal-last-word-shown pascal-str
))
1397 pascal-last-completions
1398 (all-completions pascal-str
'pascal-completion
))))
1399 ;; Show possible completions in a temporary buffer.
1400 (with-output-to-temp-buffer "*Completions*"
1401 (display-completion-list allcomp pascal-str
))
1402 ;; Wait for a keypress. Then delete *Completion* window
1403 (momentary-string-display "" (point))
1404 (delete-window (get-buffer-window (get-buffer "*Completions*")))))
1407 (defun pascal-get-default-symbol ()
1408 "Return symbol around current point as a string."
1410 (buffer-substring (progn
1411 (skip-chars-backward " \t")
1412 (skip-chars-backward "a-zA-Z0-9_")
1415 (skip-chars-forward "a-zA-Z0-9_")
1418 (defun pascal-build-defun-re (str &optional arg
)
1419 "Return function/procedure starting with STR as regular expression.
1420 With optional second arg non-nil, STR is the complete name of the instruction."
1422 (concat "^\\(function\\|procedure\\)[ \t]+\\(" str
"\\)\\>")
1423 (concat "^\\(function\\|procedure\\)[ \t]+\\(" str
"[a-zA-Z0-9_]*\\)\\>")))
1425 ;; Function passed to completing-read, try-completion or
1426 ;; all-completions to get completion on any function name. If
1427 ;; predicate is non-nil, it must be a function to be called for every
1428 ;; match to check if this should really be a match. If flag is t, the
1429 ;; function returns a list of all possible completions. If it is nil
1430 ;; it returns a string, the longest possible completion, or t if STR
1431 ;; is an exact match. If flag is 'lambda, the function returns t if
1432 ;; STR is an exact match, nil otherwise.
1434 (defun pascal-comp-defun (pascal-str pascal-pred pascal-flag
)
1436 (let ((pascal-all nil
)
1439 ;; Set buffer to use for searching labels. This should be set
1440 ;; within functions which use pascal-completions
1441 (set-buffer pascal-buffer-to-use
)
1443 (let ((pascal-str pascal-str
))
1444 ;; Build regular expression for functions
1445 (if (string= pascal-str
"")
1446 (setq pascal-str
(pascal-build-defun-re "[a-zA-Z_]"))
1447 (setq pascal-str
(pascal-build-defun-re pascal-str
)))
1448 (goto-char (point-min))
1450 ;; Build a list of all possible completions
1451 (while (re-search-forward pascal-str nil t
)
1452 (setq match
(buffer-substring (match-beginning 2) (match-end 2)))
1453 (if (or (null pascal-pred
)
1454 (funcall pascal-pred match
))
1455 (setq pascal-all
(cons match pascal-all
)))))
1457 ;; Now we have built a list of all matches. Give response to caller
1458 (pascal-completion-response))))
1460 (defun pascal-goto-defun ()
1461 "Move to specified Pascal function/procedure.
1462 The default is a name found in the buffer around point."
1464 (let* ((default (pascal-get-default-symbol))
1465 ;; The following variable is used in pascal-comp-function
1466 (pascal-buffer-to-use (current-buffer))
1467 (default (if (pascal-comp-defun default nil
'lambda
)
1469 (label (if (not (string= default
""))
1470 ;; Do completion with default
1471 (completing-read (concat "Label (default " default
"): ")
1472 'pascal-comp-defun
nil t
"")
1473 ;; There is no default value. Complete without it
1474 (completing-read "Label: "
1475 'pascal-comp-defun
nil t
""))))
1476 ;; If there was no response on prompt, use default value
1477 (if (string= label
"")
1478 (setq label default
))
1479 ;; Goto right place in buffer if label is not an empty string
1480 (or (string= label
"")
1482 (goto-char (point-min))
1483 (re-search-forward (pascal-build-defun-re label t
))
1484 (beginning-of-line)))))
1489 ;;; Pascal-outline-mode
1491 (defvar pascal-outline-map
1492 (let ((map (make-sparse-keymap)))
1493 (if (fboundp 'set-keymap-name
)
1494 (set-keymap-name pascal-outline-map
'pascal-outline-map
))
1495 (define-key map
"\M-\C-a" 'pascal-outline-prev-defun
)
1496 (define-key map
"\M-\C-e" 'pascal-outline-next-defun
)
1497 (define-key map
"\C-c\C-d" 'pascal-outline-goto-defun
)
1498 (define-key map
"\C-c\C-s" 'pascal-show-all
)
1499 (define-key map
"\C-c\C-h" 'pascal-hide-other-defuns
)
1501 "Keymap used in Pascal Outline mode.")
1503 (define-obsolete-function-alias 'pascal-outline
'pascal-outline-mode
"22.1")
1504 (define-minor-mode pascal-outline-mode
1505 "Outline-line minor mode for Pascal mode.
1506 When in Pascal Outline mode, portions
1507 of the text being edited may be made invisible. \\<pascal-outline-map>
1509 Pascal Outline mode provides some additional commands.
1511 \\[pascal-outline-prev-defun]\
1512 \t- Move to previous function/procedure, hiding everything else.
1513 \\[pascal-outline-next-defun]\
1514 \t- Move to next function/procedure, hiding everything else.
1515 \\[pascal-outline-goto-defun]\
1516 \t- Goto function/procedure prompted for in minibuffer,
1517 \t hide all other functions.
1518 \\[pascal-show-all]\t- Show the whole buffer.
1519 \\[pascal-hide-other-defuns]\
1520 \t- Hide everything but the current function (function under the cursor).
1521 \\[pascal-outline]\t- Leave pascal-outline-mode."
1522 :init-value nil
:lighter
" Outl" :keymap pascal-outline-map
1523 (add-to-invisibility-spec '(pascal . t
))
1524 (unless pascal-outline-mode
1527 (defun pascal-outline-change (b e pascal-flag
)
1529 ;; This used to use selective display so the boundaries used by the
1530 ;; callers didn't have to be precise, since it just looked for \n or \^M
1531 ;; and switched them.
1532 (goto-char b
) (setq b
(line-end-position))
1533 (goto-char e
) (setq e
(line-end-position)))
1535 ;; We could try and optimize this in the case where the region is
1536 ;; already hidden. But I'm not sure it's worth the trouble.
1537 (remove-overlays b e
'invisible
'pascal
)
1538 (when (eq pascal-flag ?\^M
)
1539 (let ((ol (make-overlay b e nil t nil
)))
1540 (overlay-put ol
'invisible
'pascal
)
1541 (overlay-put ol
'evaporate t
)))))
1543 (defun pascal-show-all ()
1544 "Show all of the text in the buffer."
1546 (pascal-outline-change (point-min) (point-max) ?
\n))
1548 (defun pascal-hide-other-defuns ()
1549 "Show only the current defun."
1552 (let ((beg (progn (if (not (looking-at "\\(function\\|procedure\\)\\>"))
1553 (pascal-beg-of-defun))
1555 (end (progn (pascal-end-of-defun)
1557 (search-forward "\n\\|\^M" nil t
)
1559 (opoint (point-min)))
1560 (goto-char (point-min))
1562 ;; Hide all functions before current function
1563 (while (re-search-forward "^\\(function\\|procedure\\)\\>" beg
'move
)
1564 (pascal-outline-change opoint
(1- (match-beginning 0)) ?\^M
)
1565 (setq opoint
(point))
1566 ;; Functions may be nested
1567 (if (> (progn (pascal-end-of-defun) (point)) beg
)
1568 (goto-char opoint
)))
1570 (pascal-outline-change opoint
(1- beg
) ?\^M
))
1572 ;; Show current function
1573 (pascal-outline-change beg end ?
\n)
1574 ;; Hide nested functions
1576 (while (re-search-forward "^\\(function\\|procedure\\)\\>" end
'move
)
1577 (setq opoint
(point))
1578 (pascal-end-of-defun)
1579 (pascal-outline-change opoint
(point) ?\^M
))
1584 ;; Hide all function after current function
1585 (while (re-search-forward "^\\(function\\|procedure\\)\\>" nil
'move
)
1586 (pascal-outline-change opoint
(1- (match-beginning 0)) ?\^M
)
1587 (setq opoint
(point))
1588 (pascal-end-of-defun))
1589 (pascal-outline-change opoint
(point-max) ?\^M
)
1591 ;; Hide main program
1592 (if (< (progn (forward-line -
1) (point)) end
)
1595 (pascal-end-of-defun)
1597 (pascal-outline-change (point) (point-max) ?\^M
))))))
1599 (defun pascal-outline-next-defun ()
1600 "Move to next function/procedure, hiding all others."
1602 (pascal-end-of-defun)
1603 (pascal-hide-other-defuns))
1605 (defun pascal-outline-prev-defun ()
1606 "Move to previous function/procedure, hiding all others."
1608 (pascal-beg-of-defun)
1609 (pascal-hide-other-defuns))
1611 (defun pascal-outline-goto-defun ()
1612 "Move to specified function/procedure, hiding all others."
1615 (pascal-hide-other-defuns))
1619 ;; arch-tag: 04535136-fd93-40b4-a505-c9bebdc051f5
1620 ;;; pascal.el ends here