aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1994-02-01 18:14:56 +0000
committerRichard M. Stallman1994-02-01 18:14:56 +0000
commitda4ce263a3d1a185f0c004260c90f55960ff9d32 (patch)
tree813be358e259aa44e84bc2260bf73d4cd8c54001
parente70991d4203e889c35806ec8f5890579d9f78f80 (diff)
downloademacs-da4ce263a3d1a185f0c004260c90f55960ff9d32.tar.gz
emacs-da4ce263a3d1a185f0c004260c90f55960ff9d32.zip
Many doc fixes.
(pascal-get-beg-of-line, pascal-get-end-of-line): Use defsubst. Renamed from get-... (pascal-within-string): Use defsubst. (delete-whitespaces): Function deleted; callers use delete-horizontal-space instead. (pascal-string-diff): Renamed from string-diff. Complete rewrite. Added an outline- minor-mode and completion.
-rw-r--r--lisp/progmodes/pascal.el1869
1 files changed, 1143 insertions, 726 deletions
diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el
index cf5d2589029..469c9c1a9ce 100644
--- a/lisp/progmodes/pascal.el
+++ b/lisp/progmodes/pascal.el
@@ -1,74 +1,65 @@
1;;; pascal.el - Major mode for editing pascal source in emacs. 1;;; pascal.el - Major mode for editing pascal source in emacs.
2 2
3;;; Copyright (C) 1993 Free Software Foundation, Inc. 3;;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
4 4
5;; Author: Espen Skoglund (espensk@stud.cs.uit.no) 5;;; Author: Espen Skoglund (espensk@stud.cs.uit.no)
6;; Keywords: languages 6;;; Keywords: languages
7 7
8;; This file is part of GNU Emacs. 8;;; This file is part of GNU Emacs.
9 9
10;; GNU Emacs is free software; you can redistribute it and/or modify 10;;; This program is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by 11;;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation; either version 2, or (at your option) 12;;; the Free Software Foundation; either version 2 of the License, or
13;; any later version. 13;;; (at your option) any later version.
14 14
15;; GNU Emacs is distributed in the hope that it will be useful, 15;;; This program is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details. 18;;; GNU General Public License for more details.
19 19
20;; You should have received a copy of the GNU General Public License 20;;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs; see the file COPYING. If not, write to 21;;; along with this program; if not, write to the Free Software
22;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 22;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
23 23
24;;; Commentary: 24;;; Commentary:
25 25
26;;; If you want to customize the pascal mode in your startup file, you
27;;; can add these lines to your .emacs file (and remove the ;s at the
28;;; beginning of the line):
29;;;
30;;; ;;; Pascal-mode custumization.
31;;; (autoload 'pascal-mode "pascal-mode" nil t)
32;;; (setq auto-mode-alist (append (list (cons "\\.p$" 'pascal-mode)
33;;; (cons "\\.pas$" 'pascal-mode))
34;;; auto-mode-alist))
35;;; (setq pascal-mode-hook '(lambda ()
36;;; ;; User specifications
37;;; (setq pascal-tab-always-indent t
38;;; pascal-auto-newline nil
39;;; pascal-auto-endcomments t
40;;; pascal-indent-level 3
41;;; pascal-continued-expr 1
42;;; pascal-label-offset -2
43;;; pascal-case-offset 2
44;;; pascal-typedecl-indent 10
45;;; pascal-vardecl-indent 20)))
46
47;;; USAGE 26;;; USAGE
48;;; ===== 27;;; =====
49;;; If you have modified your startup file as described above, emacs 28
50;;; should enter pascal-mode when you load a pascal source into emacs. 29;;; Emacs should enter Pascal mode when you find a Pascal source file.
51;;; If not, you will have to start pascal-mode manually: 30;;; When you have entered Pascal mode, you may get more info by pressing
52;;; M-x load-library pascal-mode
53;;; M-x pascal-mode
54;;; When you have entered pascal-mode, you may get more info by pressing
55;;; C-h m. You may also get online help describing various functions by: 31;;; C-h m. You may also get online help describing various functions by:
56;;; C-h d <Name of function you want described> 32;;; C-h f <Name of function you want described>
33
34;;; If you want to customize Pascal mode to fit you better, you may add
35;;; these lines (the values of the variables presented here are the defaults):
36;;;
37;;; ;; User customization for Pascal mode
38;;; (setq pascal-indent-level 3
39;;; pascal-case-indent 2
40;;; pascal-auto-newline nil
41;;; pascal-tab-always-indent t
42;;; pascal-auto-endcomments t
43;;; pascal-toggle-completions nil
44;;; pascal-type-keywords '("array" "file" "packed" "char"
45;;; "integer" "real" "string" "record")
46;;; pascal-start-keywords '("begin" "end" "function" "procedure"
47;;; "repeat" "until" "while" "read" "readln"
48;;; "reset" "rewrite" "write" "writeln")
49;;; pascal-seperator-keywords '("downto" "else" "mod" "div" "then"))
57 50
58;;; KNOWN BUGS / BUGREPORTS 51;;; KNOWN BUGS / BUGREPORTS
59;;; ======================= 52;;; =======================
60;;; As far as I know, there are no bugs in the current version of this 53;;; As far as I know, there are no bugs in the current version of this
61;;; package. This may not be true however, since I never use this mode 54;;; package. This may not be true however, since I never use this mode
62;;; myself and therefore would never notice them anyway. But if you DO 55;;; myself and therefore would never notice them anyway. If you do
63;;; find any bugd, you may submitt them to: espensk@stud.cs.uit.no 56;;; find any bugs, you may submit them to: espensk@stud.cs.uit.no
64 57;;; as well as to bug-gnu-emacs@prep.ai.mit.edu.
65;;; LCD Archive Entry: 58
66;;; pascal-mode|Espen Skoglund|espensk@stud.cs.uit.no| 59;;; Code:
67;;; Major mode for editing Pascal code|
68;;; 14-Sep-93|$Revision: 1.3 $|~/modes/pascal-mode.el.Z|
69 60
70(defconst pascal-mode-version "1.3" 61(defconst pascal-mode-version "2.1a"
71 "Version of this pascal mode.") 62 "Version of `pascal-mode.el'.")
72 63
73(defvar pascal-mode-abbrev-table nil 64(defvar pascal-mode-abbrev-table nil
74 "Abbrev table in use in Pascal-mode buffers.") 65 "Abbrev table in use in Pascal-mode buffers.")
@@ -76,37 +67,60 @@
76 67
77(defvar pascal-mode-map () 68(defvar pascal-mode-map ()
78 "Keymap used in Pascal mode.") 69 "Keymap used in Pascal mode.")
79(if (null pascal-mode-map) 70(if pascal-mode-map
80 (setq pascal-mode-map (make-sparse-keymap))) 71 ()
81 72 (setq pascal-mode-map (make-sparse-keymap))
82(define-key pascal-mode-map ";" 'electric-pascal-semi) 73 (define-key pascal-mode-map ";" 'electric-pascal-semi-or-dot)
83(define-key pascal-mode-map "." 'electric-pascal-dot) 74 (define-key pascal-mode-map "." 'electric-pascal-semi-or-dot)
84(define-key pascal-mode-map ":" 'electric-pascal-colon) 75 (define-key pascal-mode-map ":" 'electric-pascal-colon)
85(define-key pascal-mode-map "=" 'electric-pascal-equal) 76 (define-key pascal-mode-map "=" 'electric-pascal-equal)
86(define-key pascal-mode-map "\r" 'electric-pascal-terminate-line) 77 (define-key pascal-mode-map "\r" 'electric-pascal-terminate-line)
87(define-key pascal-mode-map "\t" 'electric-pascal-tab) 78 (define-key pascal-mode-map "\t" 'electric-pascal-tab)
88(define-key pascal-mode-map "\177" 'backward-delete-char-untabify) 79 (define-key pascal-mode-map "\e\t" 'pascal-complete-word)
89(define-key pascal-mode-map "\C-\M-a" 'pascal-backward-to-beginning-of-function) 80 (define-key pascal-mode-map "\e?" 'pascal-show-completions)
90(define-key pascal-mode-map "\C-\M-e" 'pascal-forward-to-end-of-function) 81 (define-key pascal-mode-map "\177" 'backward-delete-char-untabify)
91(define-key pascal-mode-map "\C-\M-h" 'pascal-mark-function) 82 (define-key pascal-mode-map "\e\C-h" 'pascal-mark-defun)
92(define-key pascal-mode-map "\C-c\C-b" 'pascal-insert-block) 83 (define-key pascal-mode-map "\C-cb" 'pascal-insert-block)
93(define-key pascal-mode-map "\C-c\C-c" 'pascal-comment-area) 84 (define-key pascal-mode-map "\M-*" 'pascal-star-comment)
94(define-key pascal-mode-map "\C-c\C-u" 'pascal-uncomment-area) 85 (define-key pascal-mode-map "\C-c\C-c" 'pascal-comment-area)
95(define-key pascal-mode-map "\M-*" 'pascal-star-comment) 86 (define-key pascal-mode-map "\C-c\C-u" 'pascal-uncomment-area)
96 87 (define-key pascal-mode-map "\e\C-a" 'pascal-beg-of-defun)
88 (define-key pascal-mode-map "\e\C-e" 'pascal-end-of-defun)
89 (define-key pascal-mode-map "\C-cg" 'pascal-goto-defun)
90 (define-key pascal-mode-map "\C-c\C-o" 'pascal-outline)
97;;; A command to change the whole buffer won't be used terribly 91;;; A command to change the whole buffer won't be used terribly
98;;; often, so no need for a key binding. 92;;; often, so no need for a key binding.
99;;;(define-key pascal-mode-map "\C-c\C-l" 'pascal-downcase-keywords) 93; (define-key pascal-mode-map "\C-cd" 'pascal-downcase-keywords)
100;;;(define-key pascal-mode-map "\C-c\C-u" 'pascal-upcase-keywords) 94; (define-key pascal-mode-map "\C-cu" 'pascal-upcase-keywords)
101;;;(define-key pascal-mode-map "\C-c\C-c" 'pascal-capitalize-keywords) 95; (define-key pascal-mode-map "\C-cc" 'pascal-capitalize-keywords)
102 96 )
103(defvar pascal-keywords '("and" "array" "begin" "case" "const" "div" "do" 97
104"downto" "else" "end" "file" "for" "function" "goto" "if" "in" "label" "mod" 98(defvar pascal-keywords
105"nil" "not" "of" "or" "packed" "procedure" "program" "record" "repeat" "set" 99 '("and" "array" "begin" "case" "const" "div" "do" "downto" "else" "end"
106"then" "to" "type" "until" "var" "while" "with" 100 "file" "for" "function" "goto" "if" "in" "label" "mod" "nil" "not" "of"
107;; The following are not standard in pascal, but widely used. 101 "or" "packed" "procedure" "program" "record" "repeat" "set" "then" "to"
108"get" "put" "input" "output" "read" "readln" "reset" "rewrite" "write" 102 "type" "until" "var" "while" "with"
109"writeln")) 103 ;; The following are not standard in pascal, but widely used.
104 "get" "put" "input" "output" "read" "readln" "reset" "rewrite" "write"
105 "writeln"))
106
107;;;
108;;; Regular expressions used to calculate indent, etc.
109;;;
110(defconst pascal-symbol-re "\\<[a-zA-Z_][a-zA-Z_0-9.]*\\>")
111(defconst pascal-beg-block-re "\\<\\(begin\\|case\\|record\\|repeat\\)\\>")
112(defconst pascal-end-block-re "\\<\\(end\\|until\\)\\>")
113(defconst pascal-declaration-re "\\<\\(const\\|label\\|type\\|var\\)\\>")
114(defconst pascal-defun-re "\\<\\(function\\|procedure\\|program\\)\\>")
115(defconst pascal-sub-block-re "\\<\\(if\\|else\\|while\\)\\>")
116(defconst pascal-noindent-re "\\<\\(begin\\|end\\|until\\)\\>")
117(defconst pascal-nosemi-re "\\<\\(begin\\|repeat\\|then\\|do\\|else\\)\\>")
118(defconst pascal-autoindent-lines-re
119 "\\<\\(label\\|var\\|type\\|const\\|until\\|end\\|begin\\|repeat\\|else\\)\\>")
120
121;;; Strings used to mark beginning and end of excluded text
122(defconst pascal-exclude-str-start "{-----\\/----- EXCLUDED -----\\/-----")
123(defconst pascal-exclude-str-end " -----/\\----- EXCLUDED -----/\\-----}")
110 124
111(defvar pascal-mode-syntax-table nil 125(defvar pascal-mode-syntax-table nil
112 "Syntax table in use in Pascal-mode buffers.") 126 "Syntax table in use in Pascal-mode buffers.")
@@ -114,82 +128,137 @@
114(if pascal-mode-syntax-table 128(if pascal-mode-syntax-table
115 () 129 ()
116 (setq pascal-mode-syntax-table (make-syntax-table)) 130 (setq pascal-mode-syntax-table (make-syntax-table))
117 (modify-syntax-entry ?\\ "\\" pascal-mode-syntax-table) 131 (modify-syntax-entry ?\\ "\\" pascal-mode-syntax-table)
118 (modify-syntax-entry ?( ". 1" pascal-mode-syntax-table) 132 (modify-syntax-entry ?( "()1" pascal-mode-syntax-table)
119 (modify-syntax-entry ?) ". 4" pascal-mode-syntax-table) 133 (modify-syntax-entry ?) ")(4" pascal-mode-syntax-table)
120 (modify-syntax-entry ?* ". 23" pascal-mode-syntax-table) 134 (modify-syntax-entry ?* ". 23" pascal-mode-syntax-table)
121 (modify-syntax-entry ?{ "<" pascal-mode-syntax-table) 135 (modify-syntax-entry ?{ "<" pascal-mode-syntax-table)
122 (modify-syntax-entry ?} ">" pascal-mode-syntax-table) 136 (modify-syntax-entry ?} ">" pascal-mode-syntax-table)
123 (modify-syntax-entry ?+ "." pascal-mode-syntax-table) 137 (modify-syntax-entry ?+ "." pascal-mode-syntax-table)
124 (modify-syntax-entry ?- "." pascal-mode-syntax-table) 138 (modify-syntax-entry ?- "." pascal-mode-syntax-table)
125 (modify-syntax-entry ?= "." pascal-mode-syntax-table) 139 (modify-syntax-entry ?= "." pascal-mode-syntax-table)
126 (modify-syntax-entry ?% "." pascal-mode-syntax-table) 140 (modify-syntax-entry ?% "." pascal-mode-syntax-table)
127 (modify-syntax-entry ?< "." pascal-mode-syntax-table) 141 (modify-syntax-entry ?< "." pascal-mode-syntax-table)
128 (modify-syntax-entry ?> "." pascal-mode-syntax-table) 142 (modify-syntax-entry ?> "." pascal-mode-syntax-table)
129 (modify-syntax-entry ?& "." pascal-mode-syntax-table) 143 (modify-syntax-entry ?& "." pascal-mode-syntax-table)
130 (modify-syntax-entry ?| "." pascal-mode-syntax-table) 144 (modify-syntax-entry ?| "." pascal-mode-syntax-table)
131 (modify-syntax-entry ?_ "w" pascal-mode-syntax-table) 145 (modify-syntax-entry ?_ "w" pascal-mode-syntax-table)
132 (modify-syntax-entry ?\' "\"" pascal-mode-syntax-table)) 146 (modify-syntax-entry ?\' "\"" pascal-mode-syntax-table))
133 147
134(defconst pascal-indent-level 3 148(defvar pascal-indent-level 3
135 "*Indentation of Pascal statements with respect to containing block.") 149 "*Indentation of Pascal statements with respect to containing block.")
136(defconst pascal-continued-expr 1 150(defvar pascal-case-indent 2
137 "*Indentation of line that is a continued expression.") 151 "*Indentation for case statements.")
138(defconst pascal-label-offset -1 152(defvar pascal-auto-newline nil
139 "*Offset of Pascal label lines, case statements and record lines. 153 "*Non-nil means automatically newline after simcolons and the punctation mark
140This is relative to usual indentation.") 154after an end.")
141(defconst pascal-case-offset 2 155(defvar pascal-tab-always-indent t
142 "*Indentation after case statements.") 156 "*Non-nil means TAB in Pascal mode should always reindent the current line,
143(defconst pascal-vardecl-indent 15 157regardless of where in the line point is when the TAB command is used.")
144 "*Indentation (from the beginning of line to `:' of the declaration.") 158(defvar pascal-auto-endcomments t
145(defconst pascal-typedecl-indent 10 159 "*Non-nil means a comment { ... } is set after the ends which ends cases and
146 "*Indentation (from the beginning of line to `=' of the declaration.") 160functions. The name of the function or case will be set between the braces.")
147(defconst pascal-auto-newline nil 161(defvar pascal-toggle-completions nil
148 "*Non-nil means automatically newline after semicolons and `end'.") 162 "*Non-nil means that \\<pascal-mode-map>\\[pascal-complete-label] should \
149(defconst pascal-tab-always-indent t 163not display a completion buffer when
150 "*Non-nil means TAB in Pascal mode should always reindent the current line. 164the label couldn't be completed, but instead toggle the possible completions
151It does so regardless of where in the line point is 165with repeated \\[pascal-complete-label]'s.")
152when the TAB command is used.") 166(defvar pascal-type-keywords
153(defconst pascal-auto-endcomments t 167 '("array" "file" "packed" "char" "integer" "real" "string" "record")
154 "*Non-nil means make a comment { ... } after the end for a case or function. 168 "*Keywords for types used when completing a word in a declaration or parmlist.
155The name of the function or case is put between the braces.") 169\(eg. integer, real, char.) The types defined within the Pascal program
170will be completed runtime, and should not be added to this list.")
171(defvar pascal-start-keywords
172 '("begin" "end" "function" "procedure" "repeat" "until" "while"
173 "read" "readln" "reset" "rewrite" "write" "writeln")
174 "*Keywords to complete when standing at the first word of a statement.
175\(eg. begin, repeat, until, readln.)
176The procedures and variables defined within the Pascal program
177will be completed runtime and should not be added to this list.")
178(defvar pascal-seperator-keywords
179 '("downto" "else" "mod" "div" "then")
180 "*Keywords to complete when NOT standing at the first word of a statement.
181\(eg. downto, else, mod, then.)
182Variables and function names defined within the
183Pascal program are completed runtime and should not be added to this list.")
184
185;;;
186;;; Macros
187;;;
188
189(defsubst pascal-get-beg-of-line (&optional arg)
190 (save-excursion
191 (beginning-of-line arg)
192 (point)))
193
194(defsubst pascal-get-end-of-line (&optional arg)
195 (save-excursion
196 (end-of-line arg)
197 (point)))
198
199(defun pascal-declaration-end ()
200 (let ((nest 1))
201 (while (and (> nest 0)
202 (re-search-forward
203 "[:=]\\|\\(\\<record\\>\\)\\|\\(\\<end\\>\\)"
204 (save-excursion (end-of-line 2) (point)) t))
205 (cond ((match-beginning 1) (setq nest (1+ nest)))
206 ((match-beginning 2) (setq nest (1- nest)))))))
207
208(defun pascal-declaration-beg ()
209 (let ((nest 1))
210 (while (and (> nest 0)
211 (re-search-backward "[:=]\\|\\<\\(type\\|var\\|label\\|const\\)\\>\\|\\(\\<record\\>\\)\\|\\(\\<end\\>\\)" (pascal-get-beg-of-line -0) t))
212 (cond ((match-beginning 1) (setq nest 0))
213 ((match-beginning 2) (setq nest (1- nest)))
214 ((match-beginning 3) (setq nest (1+ nest)))))
215 (= nest 0)))
216
217(defsubst pascal-within-string ()
218 (save-excursion
219 (nth 3 (parse-partial-sexp (pascal-get-beg-of-line) (point)))))
220
156 221
157;;;###autoload 222;;;###autoload
158(defun pascal-mode () 223(defun pascal-mode ()
159 "Major mode for editing Pascal code. 224 "Major mode for editing Pascal code. \\<pascal-mode-map>
160Tab indents for Pascal code. 225TAB indents for Pascal code. Delete converts tabs to spaces as it moves back.
161Delete converts tabs to spaces as it moves back. 226
162\\{pascal-mode-map} 227\\[pascal-complete-word] completes the word around current point with respect \
163Variables controlling indentation style: 228to position in code
164 pascal-tab-always-indent (default t) 229\\[pascal-show-completions] shows all possible completions at this point.
230
231Other useful functions are:
232
233\\[pascal-mark-defun]\t- Mark function.
234\\[pascal-insert-block]\t- insert begin ... end;
235\\[pascal-star-comment]\t- insert (* ... *)
236\\[pascal-comment-area]\t- Put marked area in a comment, fixing nested comments.
237\\[pascal-uncomment-area]\t- Uncomment an area commented with \
238\\[pascal-comment-area].
239\\[pascal-beg-of-defun]\t- Move to beginning of current function.
240\\[pascal-end-of-defun]\t- Move to end of current function.
241\\[pascal-goto-defun]\t- Goto function prompted for in the minibuffer.
242\\[pascal-outline]\t- Enter pascal-outline-mode (see also pascal-outline).
243
244Variables controlling indentation/edit style:
245
246 pascal-indent-level (default 3)
247 Indentation of Pascal statements with respect to containing block.
248 pascal-case-indent (default 2)
249 Indentation for case statements.
250 pascal-auto-newline (default nil)
251 Non-nil means automatically newline after simcolons and the punctation mark
252 after an end.
253 pascal-tab-always-indent (defualt t)
165 Non-nil means TAB in Pascal mode should always reindent the current line, 254 Non-nil means TAB in Pascal mode should always reindent the current line,
166 regardless of where in the line point is when the TAB command is used. 255 regardless of where in the line point is when the TAB command is used.
167 pascal-auto-newline (default nil) 256 pascal-auto-endcomments (default t)
168 Non-nil means automatically newline after semicolons and the punctation 257 Non-nil means a comment { ... } is set after the ends which ends cases and
169 mark after an end. 258 functions. The name of the function or case will be set between the braces.
170 pascal-auto-endcomments (default t) 259
171 Non-nil means automatically set name of function or `case' in braces after 260See also the user variables pascal-type-keywords, pascal-start-keywords and
172 after the `end' if this end ends a function or a case block. 261pascal-seperator-keywords.
173 pascal-indent-level (default 3)
174 Indentation of Pascal statements within surrounding block.
175 pascal-continued-expr (default 1)
176 Indentation of a line that is a continued expression.
177 pascal-typedecl-indent (default 10)
178 Indentation to the `=' in type declarations. (Or constant declarations.)
179 pascal-vardecl-indent (default 20)
180 Indentation to the `:' in var declarations.
181 pascal-label-offset (default -1)
182 Extra indentation for line that is a label, case statement or part of
183 a record block.
184 pascal-case-offset (default 2)
185 Extra indent to the `:' in case statements.
186
187The only auto indention this mode doesn't fully support is if there is a
188case within a type declaration. However, this is seldom used.
189
190When typing text, you should not worry about to get right indentions, they
191will be set when you hit return. The mode will also automatically delete the
192whitespaces between `*' and `)' when ending a starcomment.
193 262
194Turning on Pascal mode calls the value of the variable pascal-mode-hook with 263Turning on Pascal mode calls the value of the variable pascal-mode-hook with
195no args, if that value is non-nil." 264no args, if that value is non-nil."
@@ -202,26 +271,30 @@ no args, if that value is non-nil."
202 (set-syntax-table pascal-mode-syntax-table) 271 (set-syntax-table pascal-mode-syntax-table)
203 (make-local-variable 'indent-line-function) 272 (make-local-variable 'indent-line-function)
204 (setq indent-line-function 'pascal-indent-line) 273 (setq indent-line-function 'pascal-indent-line)
205 (setq comment-indent-hook 'pascal-indent-within-comment) 274 (setq comment-indent-function 'pascal-indent-comment)
206 (make-local-variable 'parse-sexp-ignore-comments) 275 (make-local-variable 'parse-sexp-ignore-comments)
207 (setq parse-sexp-ignore-comments t) 276 (setq parse-sexp-ignore-comments t)
208 (make-local-variable 'case-fold-search) 277 (make-local-variable 'case-fold-search)
209 (setq case-fold-search t) 278 (setq case-fold-search t)
210 (run-hooks 'pascal-mode-hook)) 279 (run-hooks 'pascal-mode-hook))
211 280
281
282
212;;; 283;;;
213;;; Electric functions 284;;; Electric functions
214;;; 285;;;
215
216(defun electric-pascal-terminate-line () 286(defun electric-pascal-terminate-line ()
217 "Terminate line and indent next line." 287 "Terminate line and indent next line."
218 (interactive) 288 (interactive)
289 ;; First, check if current line should be indented
219 (save-excursion 290 (save-excursion
220 (beginning-of-line) 291 (beginning-of-line)
221 (skip-chars-forward " \t") 292 (skip-chars-forward " \t")
222 (if (looking-at "until\\b\\|end\\(\\b\\|;\\|\\.\\)\\|begin\\b\\|repeat\\b\\|else\\b") 293 (if (looking-at pascal-autoindent-lines-re)
223 (pascal-indent-line))) 294 (pascal-indent-line)))
295 (delete-horizontal-space) ; Removes trailing whitespaces
224 (newline) 296 (newline)
297 ;; Indent next line
225 (pascal-indent-line) 298 (pascal-indent-line)
226 ;; Maybe we should set some endcomments 299 ;; Maybe we should set some endcomments
227 (if pascal-auto-endcomments 300 (if pascal-auto-endcomments
@@ -231,33 +304,22 @@ no args, if that value is non-nil."
231 (save-excursion 304 (save-excursion
232 (forward-line -1) 305 (forward-line -1)
233 (skip-chars-forward " \t") 306 (skip-chars-forward " \t")
234 (cond ((looking-at "\\*[ \t]*)") 307 (cond ((looking-at "\\*[ \t]+)")
235 ;; Delete region between `*' and `)' if there is only whitespaces. 308 ;; Delete region between `*' and `)' if there is only whitespaces.
236 (forward-char 1) 309 (forward-char 1)
237 (pascal-delete-whitespaces)) 310 (delete-horizontal-space))
238 ((and (looking-at "(\\*\\|\\*[^)]") 311 ((and (looking-at "(\\*\\|\\*[^)]")
239 (not (save-excursion 312 (not (save-excursion
240 (search-forward "*)" (pascal-get-end-of-line) t)))) 313 (search-forward "*)" (pascal-get-end-of-line) t))))
241 (setq setstar t)))) 314 (setq setstar t))))
242 ;; If last line was a star comment line then this one shall be too. 315 ;; If last line was a star comment line then this one shall be too.
243 (if setstar 316 (if (null setstar)
244 (progn 317 (pascal-indent-line)
245 (insert "*") 318 (insert "* "))))
246 (pascal-indent-command))
247 (pascal-indent-line))))
248 319
249(defun electric-pascal-semi ()
250 "Insert ; character and correct this line's indention."
251 (interactive)
252 (insert last-command-char)
253 (save-excursion
254 (beginning-of-line)
255 (pascal-indent-line))
256 (if pascal-auto-newline
257 (electric-pascal-terminate-line)))
258 320
259(defun electric-pascal-dot () 321(defun electric-pascal-semi-or-dot ()
260 "Insert a period and correct this line's indention." 322 "Insert `;' or `.' character and reindent the line."
261 (interactive) 323 (interactive)
262 (insert last-command-char) 324 (insert last-command-char)
263 (save-excursion 325 (save-excursion
@@ -267,48 +329,47 @@ no args, if that value is non-nil."
267 (electric-pascal-terminate-line))) 329 (electric-pascal-terminate-line)))
268 330
269(defun electric-pascal-colon () 331(defun electric-pascal-colon ()
270 "Insert : and do all indentions except line indent on this line." 332 "Insert `:' and do all indentions except line indent on this line."
271 (interactive) 333 (interactive)
272 (insert last-command-char) 334 (insert last-command-char)
273 ;; Do nothing of within string. 335 ;; Do nothing if within string.
274 (if (not (pascal-within-string)) 336 (if (pascal-within-string)
275 (progn 337 ()
276 (if (save-excursion 338 (save-excursion
277 (backward-char 2) 339 (beginning-of-line)
278 (looking-at "[0-9]")) 340 (pascal-indent-line))
279 (save-excursion 341 (let ((pascal-tab-always-indent nil))
280 (beginning-of-line) 342 (pascal-indent-command))))
281 (pascal-indent-line))) 343
282 (let ((pascal-tab-always-indent nil))
283 (pascal-indent-command)))))
284
285(defun electric-pascal-equal () 344(defun electric-pascal-equal ()
286 "Insert = and do indention if within type declaration." 345 "Insert `=', and do indention if within type declaration."
287 (interactive) 346 (interactive)
288 (insert last-command-char) 347 (insert last-command-char)
289 (if (eq (nth 1 (pascal-calculate-indent t)) 'decl) 348 (if (eq (car (pascal-calculate-indent)) 'declaration)
290 (let ((pascal-tab-always-indent nil)) 349 (let ((pascal-tab-always-indent nil))
291 (pascal-indent-command)))) 350 (pascal-indent-command))))
292 351
293(defun electric-pascal-tab () 352(defun electric-pascal-tab ()
294 "Function called when tab is pressed." 353 "Function called when TAB is pressed in Pascal mode."
295 (interactive) 354 (interactive)
296 ;; Do nothing if within a string. 355 ;; Do nothing if within a string.
297 (if (not (pascal-within-string)) 356 (if (pascal-within-string)
298 ;; If pascal-tab-always-indent is set then indent the beginning of 357 (insert "\t")
299 ;; the line. 358 ;; If pascal-tab-always-indent, indent the beginning of the line.
300 (progn 359 (if pascal-tab-always-indent
301 (if pascal-tab-always-indent 360 (save-excursion
302 (save-excursion 361 (beginning-of-line)
303 (beginning-of-line) 362 (pascal-indent-line))
304 (pascal-indent-line))) 363 (insert "\t"))
305 (pascal-indent-command)))) 364 (pascal-indent-command)))
365
366
306 367
307;;; 368;;;
308;;; Interactive functions 369;;; Interactive functions
309;;; 370;;;
310(defun pascal-insert-block () 371(defun pascal-insert-block ()
311 "Insert begin ... end; block in the code with right indents." 372 "Insert Pascal begin ... end; block in the code with right indentation."
312 (interactive) 373 (interactive)
313 (pascal-indent-line) 374 (pascal-indent-line)
314 (insert "begin") 375 (insert "begin")
@@ -320,35 +381,38 @@ no args, if that value is non-nil."
320 (pascal-indent-line))) 381 (pascal-indent-line)))
321 382
322(defun pascal-star-comment () 383(defun pascal-star-comment ()
323 "Insert star comment in the code." 384 "Insert Pascal star comment at point."
324 (interactive) 385 (interactive)
325 (pascal-indent-line) 386 (pascal-indent-line)
326 (insert "(*") 387 (insert "(*")
327 (electric-pascal-terminate-line) 388 (electric-pascal-terminate-line)
328 (save-excursion 389 (save-excursion
329 (electric-pascal-terminate-line) 390 (electric-pascal-terminate-line)
330 (pascal-delete-whitespaces) 391 (delete-horizontal-space)
331 (insert ")"))) 392 (insert ")"))
393 (insert " "))
332 394
333(defun pascal-mark-function () 395(defun pascal-mark-defun ()
334 "Mark the current pascal function (or procedure). 396 "Mark the current pascal function (or procedure).
335Put the mark at the end of the function, and point at the beginning." 397This puts the mark at the end, and point at the beginning."
336 (interactive) 398 (interactive)
337 (push-mark (point)) 399 (push-mark (point))
338 (pascal-forward-to-end-of-function) 400 (pascal-end-of-defun)
339 (push-mark (point)) 401 (push-mark (point))
340 (pascal-backward-to-beginning-of-function) 402 (pascal-beg-of-defun)
341 (zmacs-activate-region)) 403 (if (fboundp 'zmacs-activate-region)
404 (zmacs-activate-region)))
342 405
343(defun pascal-comment-area (start end) 406(defun pascal-comment-area (start end)
344 "Put the current region in a comment. 407 "Put the region into a Pascal comment.
345The comments that are in this area are 408The comments that are in this area are \"deformed\":
346be changed so that `*)' becomes `!(*' and `}' becomes `!{'. These will 409`*)' becomes `!(*' and `}' becomes `!{'.
347however be turned back to normal when the area is uncommented by pressing 410These deformed comments are returned to normal if you use
348\\[pascal-uncomment-area]. 411\\[pascal-uncomment-area] to undo the commenting.
349The commented area starts with: `{---\\/---EXCLUDED---\\/---' , and ends with: 412
350` ---/\\---EXCLUDED---/\\---}'. If these texts are changed, uncomment-area 413The commented area starts with `pascal-exclude-str-start', and ends with
351will not be able to recognize them." 414`pascal-include-str-end'. But if you change these variables,
415\\[pascal-uncomment-area] won't recognize the comments."
352 (interactive "r") 416 (interactive "r")
353 (save-excursion 417 (save-excursion
354 ;; Insert start and endcomments 418 ;; Insert start and endcomments
@@ -357,12 +421,12 @@ will not be able to recognize them."
357 (not (save-excursion (skip-chars-backward " \t") (bolp)))) 421 (not (save-excursion (skip-chars-backward " \t") (bolp))))
358 (forward-line 1) 422 (forward-line 1)
359 (beginning-of-line)) 423 (beginning-of-line))
360 (insert " ---/\\---EXCLUDED---/\\---}") 424 (insert pascal-exclude-str-end)
361 (setq end (point)) 425 (setq end (point))
362 (newline) 426 (newline)
363 (goto-char start) 427 (goto-char start)
364 (beginning-of-line) 428 (beginning-of-line)
365 (insert "{---\\/---EXCLUDED---\\/--- ") 429 (insert pascal-exclude-str-start)
366 (newline) 430 (newline)
367 ;; Replace end-comments within commented area 431 ;; Replace end-comments within commented area
368 (goto-char end) 432 (goto-char end)
@@ -374,9 +438,8 @@ will not be able to recognize them."
374 (replace-match "!{" t t))))) 438 (replace-match "!{" t t)))))
375 439
376(defun pascal-uncomment-area () 440(defun pascal-uncomment-area ()
377 "Uncomment a commented area. 441 "Uncomment a commented area; change deformed comments back to normal.
378Change all deformed comments in this area back to normal. 442This command does nothing if the pointer is not in a commented
379This function does nothing if the pointer is not in a commented
380area. See also `pascal-comment-area'." 443area. See also `pascal-comment-area'."
381 (interactive) 444 (interactive)
382 (save-excursion 445 (save-excursion
@@ -384,9 +447,9 @@ area. See also `pascal-comment-area'."
384 (end (point))) 447 (end (point)))
385 ;; Find the boundaries of the comment 448 ;; Find the boundaries of the comment
386 (save-excursion 449 (save-excursion
387 (setq start (progn (search-backward "{---\\/---EXCLUDED---\\/--" nil t) 450 (setq start (progn (search-backward pascal-exclude-str-start nil t)
388 (point))) 451 (point)))
389 (setq end (progn (search-forward "---/\\---EXCLUDED---/\\---}" nil t) 452 (setq end (progn (search-forward pascal-exclude-str-end nil t)
390 (point)))) 453 (point))))
391 ;; Check if we're really inside a comment 454 ;; Check if we're really inside a comment
392 (if (or (equal start (point)) (<= end (point))) 455 (if (or (equal start (point)) (<= end (point)))
@@ -412,569 +475,923 @@ area. See also `pascal-comment-area'."
412 (end-of-line) 475 (end-of-line)
413 (delete-region pos (1+ (point))))))))) 476 (delete-region pos (1+ (point)))))))))
414 477
415(defun pascal-backward-to-beginning-of-function () 478(defun pascal-beg-of-defun ()
416 "Move backwards to the beginning of this function or procedure." 479 "Move backward to the beginning of the current function or procedure."
417 (interactive) 480 (interactive)
418 ;; Check if this is a 481 (catch 'found
419 (if (save-excursion 482 (if (not (looking-at (concat "\\s \\|\\s)\\|" pascal-defun-re)))
420 (re-search-backward "\\<end" nil t) 483 (forward-sexp 1))
421 (looking-at "end\\.")) 484 (let ((nest 0) (max -1) (func 0)
422 (beginning-of-buffer) 485 (reg (concat pascal-beg-block-re "\\|"
423 (let ((nest-depth 0) (nest-max 0) 486 pascal-end-block-re "\\|"
424 (nest-noexit 1)) 487 pascal-defun-re)))
425 (beginning-of-line) 488 (while (re-search-backward reg nil 'move)
426 ;; First we find the max depth of the nesting 489 (cond ((let ((state (save-excursion
427 (save-excursion 490 (parse-partial-sexp (point-min) (point)))))
428 (while (not (or (bobp) (looking-at "function\\b\\|procedure\\b"))) 491 (or (nth 3 state) (nth 4 state))) ; Inside string or comment
429 (backward-sexp 1) 492 ())
430 (cond ((looking-at "begin\\b\\|\\case\\b\\|record\\b") 493 ((match-end 1) ; begin|case|record|repeat
431 (setq nest-depth (1+ nest-depth))) 494 (if (and (looking-at "\\<record\\>") (>= max 0))
432 ((looking-at "end\\(\\b\\|;\\|\\.\\)") 495 (setq func (1- func)))
433 (setq nest-depth (1- nest-depth)))) 496 (setq nest (1+ nest)
434 (setq nest-max (max nest-depth nest-max)))) 497 max (max nest max)))
435 ;; Then we can start searching 498 ((match-end 2) ; end|until
436 (setq nest-depth 0) 499 (if (and (= nest max) (>= max 0))
437 (while (not (or (bobp) (and (looking-at "function\\b\\|procedure\\b") 500 (setq func (1+ func)))
438 (zerop nest-noexit)))) 501 (setq nest (1- nest)))
439 (backward-sexp 1) 502 ((match-end 3) ; function|procedure
440 (cond ((looking-at "begin\\b\\|\\case\\b\\|record\\b") 503 (if (= 0 func)
441 (setq nest-depth (1+ nest-depth))) 504 (throw 'found t)
442 ((looking-at "end\\(\\b\\|;\\|\\.\\)") 505 (setq func (1- func)))))))
443 (if (equal nest-depth nest-max) 506 nil))
444 (setq nest-noexit (1+ nest-noexit))) 507
445 (setq nest-depth (1- nest-depth))) 508(defun pascal-end-of-defun ()
446 ((looking-at "function\\b\\|procedure\\b") 509 "Move forward to the end of the current function or procedure."
447 (setq nest-noexit (1- nest-noexit))))))))
448
449(defun pascal-forward-to-end-of-function ()
450 "Moves the point to the end of the function."
451 (interactive) 510 (interactive)
452 (if (not (looking-at "function\\b\\|procedure\\b")) 511 (if (looking-at "\\s ")
453 (pascal-backward-to-beginning-of-function)) 512 (forward-sexp 1))
454 (if (bobp) 513 (if (not (looking-at pascal-defun-re))
455 (end-of-buffer) 514 (pascal-beg-of-defun))
456 (progn 515 (forward-char 1)
457 (let ((nest-depth 0) 516 (let ((nest 0) (func 1)
458 (func-depth 1)) 517 (reg (concat pascal-beg-block-re "\\|"
459 (while (not (or (and (zerop nest-depth) (zerop func-depth)) (eobp))) 518 pascal-end-block-re "\\|"
460 (forward-sexp 2) 519 pascal-defun-re)))
461 (if (not (eobp)) 520 (while (and (/= func 0)
462 (progn 521 (re-search-forward reg nil 'move))
463 (backward-sexp 1) ; Move to the beginning of the next sexp 522 (cond ((let ((state (save-excursion
464 (cond ((looking-at "begin\\b\\|case\\b\\|record\\b") 523 (parse-partial-sexp (point-min) (point)))))
465 (setq nest-depth (1+ nest-depth))) 524 (or (nth 3 state) (nth 4 state))) ; Inside string or comment
466 ((looking-at "end\\(\\b\\|;\\|\\.\\)") 525 ())
467 (setq nest-depth (1- nest-depth)) 526 ((match-end 1)
468 (if (zerop nest-depth) 527 (setq nest (1+ nest))
469 (setq func-depth (1- func-depth)))) 528 (if (save-excursion
470 ((looking-at "function\\b\\|procedure\\b") 529 (goto-char (match-beginning 0))
471 (setq func-depth (1+ func-depth))))))) 530 (looking-at "\\<record\\>"))
472 (end-of-line))))) 531 (setq func (1+ func))))
532 ((match-end 2)
533 (setq nest (1- nest))
534 (if (= nest 0)
535 (setq func (1- func))))
536 ((match-end 3)
537 (setq func (1+ func))))))
538 (forward-line 1))
473 539
474(defun pascal-downcase-keywords () 540(defun pascal-downcase-keywords ()
475 "Makes all Pascal keywords in the buffer lowercase." 541 "Downcase all Pascal keywords in the buffer."
476 (interactive) 542 (interactive)
477 (pascal-change-keywords 'downcase-word)) 543 (pascal-change-keywords 'downcase-word))
478 544
479(defun pascal-upcase-keywords () 545(defun pascal-upcase-keywords ()
480 "Makes all Pascal keywords in the buffer uppercase." 546 "Upcase all Pascal keywords in the buffer."
481 (interactive) 547 (interactive)
482 (pascal-change-keywords 'upcase-word)) 548 (pascal-change-keywords 'upcase-word))
483 549
484(defun pascal-capitalize-keywords () 550(defun pascal-capitalize-keywords ()
485 "Makes all Pascal keywords in the buffer uppercase." 551 "Capitalize all Pascal keywords in the buffer."
486 (interactive) 552 (interactive)
487 (pascal-change-keywords 'capitalize-word)) 553 (pascal-change-keywords 'capitalize-word))
488 554
555;; Change the keywords according to argument.
489(defun pascal-change-keywords (change-word) 556(defun pascal-change-keywords (change-word)
490 "Change the keywords according to argument."
491 (save-excursion 557 (save-excursion
492 (beginning-of-buffer) 558 (let ((keyword-re (concat "\\<\\("
493 (while (re-search-forward (mapconcat 559 (mapconcat 'identity pascal-keywords "\\|")
494 'downcase pascal-keywords "\\>\\|\\<") nil t) 560 "\\)\\>")))
495 (funcall change-word -1)))) 561 (goto-char (point-min))
562 (while (re-search-forward keyword-re nil t)
563 (funcall change-word -1)))))
564
565
496 566
497;;; 567;;;
498;;; Other functions 568;;; Other functions
499;;; 569;;;
500(defun pascal-delete-whitespaces ()
501 "Deletes the whitespaces around the current point."
502 (interactive)
503 (let ((pos (progn (skip-chars-backward " \t") (point))))
504 (skip-chars-forward " \t")
505 (delete-region pos (point))))
506
507(defun pascal-get-beg-of-line ()
508 (save-excursion
509 (beginning-of-line)
510 (point)))
511
512(defun pascal-get-end-of-line ()
513 (save-excursion
514 (end-of-line)
515 (point)))
516
517(defun pascal-within-string ()
518 "Return t if within string; nil otherwise."
519 (and (save-excursion (search-backward "\"" (pascal-get-beg-of-line) t))
520 (save-excursion (not (search-backward "\"" (pascal-get-beg-of-line) t 2)))))
521
522(defun pascal-check-if-within-comment ()
523 "If within a comment, return the correct indent. Return nil otherwise."
524 (let ((comstart (point))
525 (comend (point)))
526 (save-excursion
527 (if (re-search-backward "(\\*\\|{" nil t)
528 (setq comstart (point))
529 (setq comstart 0)))
530 (save-excursion
531 (if (re-search-backward "\\*)\\|}" nil t)
532 (setq comend (point))
533 (setq comend 0)))
534 (if (< comend comstart)
535 (save-excursion
536 (goto-char comstart)
537 ;; Add 1 to indent if this is a starcomment
538 (if (looking-at "(\\*")
539 (1+ (current-column))
540 (current-column)))
541 nil)))
542 570
543(defun pascal-set-auto-comments () 571(defun pascal-set-auto-comments ()
544 "Put { case } or { FUNNAME } on this line if appropriate after `end'." 572 "Insert `{ case }' or `{ NAME }' on this line if appropriate.
573Insert `{ case }' if there is an `end' on the line which
574ends a case block. Insert `{ NAME }' if there is an `end'
575on the line which ends a function or procedure named NAME."
545 (save-excursion 576 (save-excursion
546 (forward-line -1) 577 (forward-line -1)
547 (skip-chars-forward " \t") 578 (skip-chars-forward " \t")
548 (if (and (looking-at "end\\(\>\\|;\\)") 579 (if (and (looking-at "\\<end;")
549 (not (save-excursion 580 (not (save-excursion
550 (end-of-line) 581 (end-of-line)
551 (search-backward "}" (pascal-get-beg-of-line) t)))) 582 (search-backward "{" (pascal-get-beg-of-line) t))))
552 (progn 583 (progn
553 (if (eq (nth 1 (pascal-calculate-indent)) 'case) 584 (if (eq (car (pascal-calculate-indent)) 'case)
554 ;; This is a case block 585 ;; This is a case block
555 (progn 586 (progn
556 (end-of-line) 587 (end-of-line)
557 (pascal-delete-whitespaces) 588 (delete-horizontal-space)
558 (insert " { case }")) 589 (insert " { case }"))
559 (let ((nest 1)) 590 (let ((nest 1))
560 ;; Check if this is the end of a function 591 ;; Check if this is the end of a function
561 (save-excursion 592 (save-excursion
562 (while (not (or (looking-at "function\\b\\|\\procedure\\b") 593 (while (not (or (looking-at pascal-defun-re) (bobp)))
563 (bobp)))
564 (backward-sexp 1) 594 (backward-sexp 1)
565 (cond ((looking-at "begin\\b\\|case\\b") 595 (cond ((looking-at pascal-beg-block-re)
566 (setq nest (1- nest))) 596 (setq nest (1- nest)))
567 ((looking-at "end\\(\\b\\|;\\|\\.\\)") 597 ((looking-at pascal-end-block-re)
568 (setq nest (1+ nest))))) 598 (setq nest (1+ nest)))))
569 (if (bobp) 599 (if (bobp)
570 (setq nest 1))) 600 (setq nest 1)))
571 (if (zerop nest) 601 (if (zerop nest)
572 (let ((last-command nil)) 602 (progn
573 ;; Find the function name and put it in braces
574 (save-excursion
575 (pascal-backward-to-beginning-of-function)
576 (skip-chars-forward "^ \t")
577 (skip-chars-forward " \t")
578 (copy-region-as-kill (point)
579 (save-excursion
580 (skip-chars-forward "a-zA-Z0-9_")
581 (point))))
582 (end-of-line) 603 (end-of-line)
583 (pascal-delete-whitespaces) 604 (delete-horizontal-space)
584 (insert " { ") 605 (insert " { ")
585 ;; We've filled up the kill ring, but hey, who cares? 606 (let (b e)
586 (yank) (rotate-yank-pointer 1) 607 (save-excursion
608 (setq b (progn (pascal-beg-of-defun)
609 (skip-chars-forward "^ \t")
610 (skip-chars-forward " \t")
611 (point))
612 e (progn (skip-chars-forward "a-zA-Z0-9_")
613 (point))))
614 (insert-buffer-substring (current-buffer) b e))
587 (insert " }"))))))))) 615 (insert " }")))))))))
588 616
617
618
589;;; 619;;;
590;;; Indent functions and calculation of indent 620;;; Indentation
591;;; 621;;;
622(defconst pascal-indent-alist
623 '((block . (+ ind pascal-indent-level))
624 (case . (+ ind pascal-case-indent))
625 (declaration . (+ ind pascal-indent-level))
626 (paramlist . (pascal-indent-paramlist t))
627 (comment . (pascal-indent-comment t))
628 (defun . ind) (contexp . ind)
629 (unknown . 0) (string . 0)))
630
592(defun pascal-indent-command () 631(defun pascal-indent-command ()
593 "Indent current line as Pascal code and/or indent within line." 632 "Indent for special part of code."
594 ;; Call pascal-indent-line. This does nothing if we're not at the 633 (let* ((indent-str (pascal-calculate-indent))
595 ;; beginning of the line. 634 (type (car indent-str))
596 (pascal-indent-line) 635 (ind (car (cdr indent-str))))
597 (let ((indent (pascal-calculate-indent t)) 636 (cond ((eq type 'paramlist)
598 (pos 0)) 637 (pascal-indent-paramlist)
599 (save-excursion 638 (pascal-indent-paramlist))
600 (cond ((or (eq (nth 1 indent) 'case) 639 ((eq type 'declaration)
601 (eq (nth 1 indent) 'record)) 640 (pascal-indent-declaration))
602 ;; Indent for case and record blocks 641 ((and (eq type 'case) (not (looking-at "^[ \t]*$")))
603 (beginning-of-line) 642 (pascal-indent-case)))
604 (if (search-forward ":" (pascal-get-end-of-line) t) 643 (if (looking-at "[ \t]+$")
605 (progn 644 (skip-chars-forward " \t"))))
606 ;; Indent before colon
607 (backward-char 1)
608 (pascal-delete-whitespaces)
609 (indent-to (max (pascal-find-leading-case-colon)
610 (1+ (current-column))))
611 ;; Indent after colon
612 (forward-char 1)
613 (pascal-delete-whitespaces)
614 (indent-to (1+ (current-column))))
615 ;; Indent if there is no colon
616 (progn
617 (beginning-of-line)
618 (skip-chars-forward " \t")
619 (if (not (eolp))
620 (progn
621 (skip-chars-forward "0-9a-zA-Z\"\'_;")
622 (pascal-delete-whitespaces)
623 (indent-to (max (pascal-find-leading-case-colon)
624 (1+ (current-column)))))))))
625 ((eq (nth 1 indent) 'decl)
626 ;; Indent for declarations
627 (let ((posii (pascal-get-beg-of-line)))
628 (re-search-backward "\\<\\(var\\|type\\|const\\|label\\)\\>"
629 nil t)
630 (cond ((looking-at "var\\b")
631 (pascal-declindent-middle-of-line
632 ":" posii pascal-vardecl-indent))
633 ((looking-at "type\\b\\|const\\b")
634 (pascal-declindent-middle-of-line
635 "=" posii pascal-typedecl-indent)))))
636 ((eq (nth 1 indent) 'function)
637 ;; Indent for parameterlist
638 ;; Done twice in case something has changed
639 (pascal-indent-parameter-list)
640 (pascal-indent-parameter-list))))
641 ;; Go to the end of a line if rest of line contains only whitespaces
642 (if (save-excursion (skip-chars-forward " \t") (eolp))
643 (end-of-line))))
644 645
645(defun pascal-indent-line () 646(defun pascal-indent-line ()
646 "Indent current line as Pascal code." 647 "Indent current line as a Pascal statement."
647 (let ((indent (list 0 nil)) 648 (let* ((indent-str (pascal-calculate-indent))
648 (comindent 0) 649 (type (car indent-str))
649 beg (point)) 650 (ind (car (cdr indent-str))))
650 (save-excursion 651 (if (looking-at "^[0-9a-zA-Z]+[ \t]*:[^=]")
651 (beginning-of-line) 652 (search-forward ":" nil t))
652 (setq indent (pascal-calculate-indent))) 653 (delete-horizontal-space)
653 ;; If we are inside a comment, do special indent. 654 ;; Some thing should not be indented
654 (if (setq comindent (pascal-check-if-within-comment)) 655 (if (or (and (eq type 'declaration) (looking-at pascal-declaration-re))
655 (pascal-indent-within-comment comindent) 656 (looking-at pascal-defun-re))
656 ;; Skip the rest if we're not standing on the beginning of a line. 657 ()
657 (if (save-excursion (skip-chars-backward " \t") (bolp)) 658 ;; Other things should have no extra indent
658 (progn 659 (if (looking-at pascal-noindent-re)
659 (beginning-of-line) 660 (indent-to ind)
660 (pascal-delete-whitespaces) 661 ;; But most lines are treated this way:
661 ;; When to skip the ekstra indent: 662 (indent-to (eval (cdr (assoc type pascal-indent-alist))))
662 ;; If we are standing at end or until. 663 ))))
663 ;; If we are in an if statement and standing at else, 664
664 ;; begin or repeat 665(defun pascal-calculate-indent ()
665 ;; If we are in a with, while or for statement and standing 666 "Calculate the indent of the current Pascal line.
666 ;; at begin or end. 667Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
667 (cond ((or (or (looking-at "end\\b\\|until\\b") 668 (save-excursion
668 (not (nth 1 indent))) 669 (let* ((oldpos (point))
669 (and (eq (nth 1 indent) 'if) 670 (state (save-excursion (parse-partial-sexp (point-min) (point))))
670 (looking-at "begin\\b\\|\\repeat\\b\\|else\\b")) 671 (nest 0) (par 0) (complete nil) (blocked nil)
671 (and (eq (nth 1 indent) 'whilewith) 672 (type (catch 'nesting
672 (looking-at "begin\\b\\|\\repeat\\b"))) 673 ;; Check if inside a string, comment or parenthesis
673 (indent-to (car indent))) 674 (cond ((nth 3 state) (throw 'nesting 'string))
674 ;; Continued expression 675 ((nth 4 state) (throw 'nesting 'comment))
675 ((eq (nth 1 indent) 'contexp) 676 ((> (car state) 0)
676 (indent-to (+ (car indent) pascal-continued-expr))) 677 (goto-char (scan-lists (point) -1 (car state)))
677 ;; If this is a part of a case or record block, 678 (setq par (1+ (current-column)))))
678 ;; then modify the indent level. 679 ;; Loop until correct indent is found
679 ((or (eq (nth 1 indent) 'case) 680 (while t
680 (eq (nth 1 indent) 'record)) 681 (backward-sexp 1)
681 (indent-to (+ (car indent) pascal-indent-level 682 (cond (;--Nest block outwards
682 pascal-label-offset))) 683 (looking-at pascal-beg-block-re)
683 ;; If this is a label - don't indent. 684 (if (= nest 0)
684 ((looking-at "[0-9]*:") 685 (cond ((looking-at "case\\>")
685 (skip-chars-forward "0-9:") 686 (setq blocked t)
686 (pascal-delete-whitespaces) 687 (throw 'nesting 'case))
687 (indent-to (+ (car indent) pascal-indent-level))) 688 ((looking-at "record\\>")
688 ;; If this is insde a parameter list, do special indent 689 (throw 'nesting 'declaration))
689 ((eq (nth 1 indent) 'function) 690 (t (setq blocked t)
690 (pascal-indent-parameter-list)) 691 (throw 'nesting 'block)))
691 ;; All other indents are set normaly. 692 (setq nest (1- nest))))
692 (t 693 (;--Nest block inwards
693 (indent-to (+ (car indent) pascal-indent-level))))))))) 694 (looking-at pascal-end-block-re)
694 695 (setq complete t
695(defun pascal-calculate-indent (&optional arg) 696 nest (1+ nest)))
696 "Search backward in code to find the right indent level. 697 (;--Defun (or parameter list)
697Return a list containing: 698 (looking-at pascal-defun-re)
6981. Indent level 699 (if (= 0 par)
6992. The indent keyword (begin, case etc.), or nil if backtracking failed. 700 (throw 'nesting 'defun)
700If arg is non-nil, we do not search for continued expressions." 701 (setq par 0)
701 (let ((pascal-nest-depth 1) 702 (let ((n 0))
702 (oldpos (save-excursion (forward-line -1) (end-of-line) (point))) 703 (while (re-search-forward
703 (samepos (point)) (if-is-set t) 704 "\\(\\<record\\>\\)\\|\\<end\\>"
704 (return-struct (list 0 nil)) (pos 0) 705 oldpos t)
705 (contexpr nil) (after-contexpr (not arg)) 706 (if (match-end 1)
706 (case-fold-search t)) 707 (setq n (1+ n)) (setq n (1- n))))
707 (save-excursion 708 (if (> n 0)
708 (while (and (not (zerop pascal-nest-depth)) 709 (throw 'nesting 'declaration)
709 (not (bobp))) 710 (throw 'nesting 'paramlist)))))
710 (progn 711 (;--Declaration part
711 (backward-sexp 1) 712 (looking-at pascal-declaration-re)
712 (if (save-excursion 713 (if (or blocked
713 (setq pos (point)) 714 (save-excursion
714 (end-of-line) 715 (goto-char oldpos)
715 (search-backward ";" pos t)) 716 (forward-line -1)
716 (setq if-is-set nil 717 (looking-at "^[ \t]*$")))
717 after-contexpr nil)) 718 (throw 'nesting 'unknown)
718 (if (looking-at "then\\b\\|end\\b\\|else\\b\\|do\\b") 719 (throw 'nesting 'declaration)))
719 (setq after-contexpr nil)) 720 (;--If, else or while statement
720 721 (and (not complete)
721 (cond ((looking-at "begin\\b\\|case\\b\\|record\\b\\|repeat\\b") 722 (looking-at pascal-sub-block-re))
722 (setq pascal-nest-depth (1- pascal-nest-depth))) 723 (throw 'nesting 'block))
723 ;; 724 (;--Found complete statement
724 ;; END | UNTIL 725 (save-excursion (forward-sexp 1)
725 ((looking-at "end\\(\\b\\|;\\|\\.\\)\\|until\\b") 726 (= (following-char) ?\;))
726 (setq if-is-set nil) 727 (setq complete t))
727 (if after-contexpr 728 (;--No known statements
728 (setq pascal-nest-depth 0 729 (bobp)
729 contexpr t) 730 (throw 'nesting 'unknown))
730 (setq pascal-nest-depth (1+ pascal-nest-depth)))) 731 )))))
731 ;; 732 ;; Return type of block and indent level.
732 ;; IF | ELSE | WITH | WHILE | FOR 733 (if (> par 0) ; Unclosed Parenthesis
733 ;; LABEL | CONST | TYPE | FUNCTION | PROCEDURE 734 (list 'contexp par)
734 ((or (and (looking-at "if\\b\\|else\\b\\|with\\b\\|while\\b\\|for\\b") 735 (list type (pascal-indent-level))))))
735 if-is-set) 736
736 (looking-at "label\\b\\|const\\b\\|type\\b\\|function\\b\\|procedure\\b")) 737(defun pascal-indent-level ()
737 (setq pascal-nest-depth 0)) 738 "Return the indent-level the current statement has.
738 ;; 739Do not count labels, case-statements or records."
739 ;; VAR
740 ((looking-at "var\\b")
741 ;; A `var' can be in a declaration part or parameter part
742 (let ((stpos 0) (edpos 0))
743 (save-excursion
744 (if (not (re-search-backward
745 "\\<\\(function\\|procedure\\)\\>" nil t))
746 (beginning-of-buffer))
747 (setq stpos (save-excursion
748 (search-forward "(" nil t) (point)))
749 (setq edpos (save-excursion
750 (search-forward ")" nil t) (point))))
751 (cond ((or (= stpos edpos) (< samepos stpos)
752 (and (> (point) edpos) (> edpos stpos)))
753 ;; This is really a declaration block!!
754 nil)
755 ((and (>= samepos stpos) (or (< samepos edpos)
756 (> stpos edpos)))
757 ;; Hmm... part of a parameter
758 (re-search-backward
759 "\\<\\(function\\|procedure\\)\\>" nil t))
760 (t
761 ;; This is just after a parameter declaration
762 (forward-char 1)))
763 ;; We'll quit anyway
764 (setq pascal-nest-depth 0)))
765 ;;
766 ;; CONTINUED EXPRESSIONS
767 (after-contexpr
768 (save-excursion
769 ;; First, we have to be at the begining of a line
770 (if (and (progn (skip-chars-backward " \t") (bolp))
771 ;; Blank lines don't count
772 (not (progn (skip-chars-forward " \t") (eolp)))
773 ;; But nonblank without ';' do
774 (not (search-forward ";" (pascal-get-end-of-line) t)))
775 (save-excursion
776 (forward-line -1)
777 (end-of-line)
778 (backward-sexp 1)
779 (if (or (looking-at "\\(do\\|then\\|of\\\|begin\\|repeat\\|else\\)\\>")
780 (progn
781 (skip-chars-forward "^; " (pascal-get-end-of-line))
782 (equal (char-to-string (following-char))
783 ";")))
784 (setq pascal-nest-depth 0))
785 (setq contexpr t)))))
786 )))
787 (cond (contexpr
788 (setq return-struct (list (pascal-lstart-col) 'contexp)))
789 ((looking-at "begin\\b")
790 (setq return-struct (list (pascal-lstart-col) 'begin)))
791 ((looking-at "else\\b")
792 (setq return-struct (list (save-excursion
793 (re-search-backward "if\\b" nil t)
794 (pascal-lstart-col)) 'if))
795 ;; Indent line in case this is a multiple if
796 (beginning-of-line)
797 (pascal-delete-whitespaces)
798 (indent-to (car return-struct)))
799 ((looking-at "if\\b")
800 (if (save-excursion
801 (narrow-to-region (pascal-get-beg-of-line) (point))
802 (backward-sexp 1)
803 (widen)
804 (looking-at "else\\b"))
805 ;; Indent line if this is a multiple if
806 (progn
807 (beginning-of-line)
808 (pascal-delete-whitespaces)
809 (indent-to (save-excursion
810 (re-search-backward "if\\b" nil t)
811 (pascal-lstart-col)))))
812 ;; This could be a continued expression
813 (if (and after-contexpr
814 (not (save-excursion (re-search-forward
815 "then\\b" (pascal-get-end-of-line) t))))
816 (setq return-struct (list (pascal-lstart-col) 'contexp))
817 (setq return-struct (list (pascal-lstart-col) 'if))))
818 ((looking-at "repeat\\b")
819 (setq return-struct (list (pascal-lstart-col) 'repeat)))
820 ((looking-at "case\\b")
821 (setq return-struct (list (current-column) 'case)))
822 ((looking-at "record\\b")
823 (setq return-struct (list (current-column) 'record)))
824 ((looking-at "while\\b\\|with\\b\\|for\\b")
825 ;; This could ba a continued expression
826 (if (and after-contexpr
827 (not (save-excursion (re-search-forward
828 "do\\b" (pascal-get-end-of-line) t))))
829 (setq return-struct (list (pascal-lstart-col) 'contexp))
830 (setq return-struct (list (current-column) 'whilewith))))
831 ((looking-at "procedure\\b\\|function\\b")
832 ;; Make sure that this is a function with parameters, and
833 ;; that we are actually standing inside the paranthesis.
834 (let ((spos (save-excursion
835 (search-forward "(" samepos t) (point)))
836 (epos (save-excursion
837 (search-forward ")" samepos t) (point))))
838 (if (and (>= samepos spos) (or (< samepos epos)
839 (> spos epos)))
840 (setq return-struct (list 0 'function))
841 (setq return-struct (list 0 nil)))))
842 ((looking-at "var\\b\\|label\\b\\|const\\b\\|type\\b")
843 ;; Are we really in the declaration part?(Check for blank lines)
844 (if (< oldpos (point))
845 (setq return-struct (list 0 'decl))
846 (if (save-excursion
847 (not (re-search-forward "^[ \t]*$" oldpos t)))
848 (setq return-struct (list 0 'decl))
849 (setq return-struct (list 0 nil)))))
850 (t
851 (setq return-struct (list 0 nil))))
852 return-struct)))
853
854(defun pascal-lstart-col ()
855 "Return the column of the beginning of the first command on the line."
856 (save-excursion 740 (save-excursion
857 (beginning-of-line) 741 (beginning-of-line)
858 (skip-chars-forward ":0-9") 742 (if (looking-at "[ \t]*[0-9a-zA-Z]+[ \t]*:[^=]")
743 (search-forward ":" nil t)
744 (if (looking-at ".*=[ \t]*record\\>")
745 (search-forward "=" nil t)))
859 (skip-chars-forward " \t") 746 (skip-chars-forward " \t")
860 (current-column))) 747 (current-column)))
861 748
862(defun pascal-indent-parameter-list () 749(defun pascal-indent-comment (&optional arg)
863 "Indent this line as part of a parameter list in a function." 750 "Indent current line as comment.
864 (let ((indents (pascal-get-highest-indents-in-parameterlist)) 751If optional arg is non-nil, just return the
865 (pos 0)) 752column number the line should be indented to."
866 (if (not (progn (beginning-of-line) 753 (let* ((stcol (save-excursion
867 (search-forward "(" (pascal-get-end-of-line) t))) 754 (re-search-backward "(\\*\\|{" nil t)
868 (progn (beginning-of-line) 755 (1+ (current-column)))))
869 (skip-chars-forward " \t"))) 756 (if arg stcol
870 ;; Indent region in front of var 757 (delete-horizontal-space)
871 (skip-chars-forward " \t") 758 (indent-to stcol))))
872 (pascal-delete-whitespaces) 759
873 (indent-to (nth 0 indents)) 760(defun pascal-indent-case ()
874 (if (looking-at "var\\b") 761 "Indent within case statements."
875 (forward-char 3)) 762 (skip-chars-forward ": \t")
876 ;; Indent parameternames 763 (let ((end (prog1 (point-marker)
877 (pascal-delete-whitespaces) 764 (re-search-backward "\\<case\\>" nil t)))
878 (indent-to (nth 1 indents)) 765 (beg (point))
879 (if (not (save-excursion (skip-chars-forward " \t") (eolp))) 766 (ind 0))
880 (progn 767 ;; Get right indent
881 ;; Indent colon 768 (while (< (point) (marker-position end))
882 (if (search-forward ":" (pascal-get-end-of-line) t) 769 (if (re-search-forward "^[ \t]*\\([^ \t]+\\)[ \t]*:"
883 (backward-char 1) 770 (marker-position end) 'move)
884 (end-of-line)) 771 (goto-char (match-end 1)))
885 (pascal-delete-whitespaces) 772 (delete-horizontal-space)
886 (indent-to (nth 2 indents)) 773 (if (> (current-column) ind)
887 ;; Indent after colon 774 (setq ind (current-column)))
888 (if (equal (following-char) ?:) 775 (beginning-of-line 2))
889 (progn 776 (goto-char beg)
890 (forward-char 1) 777 ;; Indent all case statements
891 (pascal-delete-whitespaces) 778 (while (< (point) (marker-position end))
892 (indent-to (+ 2 (nth 2 indents))))))))) 779 (if (re-search-forward "^[ \t]*[^ \t]+[ \t]*:"
893 780 (marker-position end) 'move)
894;; Get the indents to use in a parameterlist. 781 (forward-char -1))
895;; Returns: 782 (indent-to (1+ ind))
896;; 1. Indent to the beginning of the line. 783 (if (/= (following-char) ?:)
897;; 2. Indent to the beginning of the parameter names. 784 ()
898;; 3. Indent to the right colon position." 785 (forward-char 1)
899(defun pascal-get-highest-indents-in-parameterlist () 786 (delete-horizontal-space)
787 (insert " ")))))
788
789(defun pascal-indent-paramlist (&optional arg)
790 "Indent current line in parameterlist.
791If optional arg is non-nil, just return the
792indent of the current line in parameterlist."
900 (save-excursion 793 (save-excursion
901 (let ((start (progn 794 (let* ((oldpos (point))
902 (re-search-backward 795 (stpos (progn (goto-char (scan-lists (point) -1 1)) (point)))
903 "\\<\\(function\\|procedure\\)\\>" nil t) 796 (stcol (1+ (current-column)))
904 (search-forward "(") 797 (edpos (progn (pascal-declaration-end)
905 (current-column))) 798 (search-backward ")" (pascal-get-beg-of-line) t)
906 (arglength 0) (vardecl nil) (done nil)) 799 (point)))
907 (while (not (or done (eobp))) 800 (usevar (re-search-backward "\\<var\\>" stpos t)))
908 (beginning-of-line) 801 (if arg (progn
909 (if (save-excursion 802 ;; If arg, just return indent
910 (re-search-forward "\\<var\\>" (pascal-get-end-of-line) t)) 803 (goto-char oldpos)
911 (setq vardecl t)) 804 (beginning-of-line)
912 (if (not (re-search-forward ":" (pascal-get-end-of-line) t)) 805 (if (or (not usevar) (looking-at "[ \t]*var\\>"))
913 (setq done t)) 806 stcol (+ 4 stcol)))
914 (skip-chars-backward ": \t") 807 (goto-char stpos)
915 (setq arglength (max arglength (current-column))) 808 (forward-char 1)
916 (forward-line 1)) 809 (delete-horizontal-space)
917 (if vardecl 810 (if (and usevar (not (looking-at "var\\>")))
918 (list start (+ start 4) (1+ arglength)) 811 (indent-to (+ 4 stcol)))
919 (list start start (1+ arglength)))))) 812 (pascal-indent-declaration nil stpos edpos)))))
920 813
921(defun pascal-declindent-middle-of-line (declkey endpos defaultindent) 814(defun pascal-indent-declaration (&optional arg start end)
922 "Indent declaration line." 815 "Indent current lines as declaration, lining up the `:'s or `='s."
923 (let ((decindent 0)) 816 (let ((pos (point-marker)))
924 (if (search-forward declkey endpos t) 817 (if (and (not (or arg start)) (not (pascal-declaration-beg)))
925 (setq decindent (1- (current-column))) 818 ()
926 (setq decindent defaultindent)) 819 (let ((lineup (if (or (looking-at "\\<var\\>\\|\\<record\\>") arg start)
927 (goto-char endpos) 820 ":" "="))
928 (end-of-line) 821 (stpos (if start start
929 (if (save-excursion (search-backward declkey endpos t)) 822 (forward-word 2) (backward-word 1) (point)))
930 (progn (search-backward declkey) (skip-chars-backward " \t")) 823 (edpos (set-marker (make-marker)
931 (skip-chars-backward " \t")) 824 (if end end
932 (pascal-delete-whitespaces) 825 (max (progn (pascal-declaration-end)
933 (indent-to (max decindent (1+ (current-column)))) 826 (point))
934 ;; Indent after `declkey' 827 pos))))
935 (if (looking-at declkey) 828 ind)
936 (progn 829
937 (forward-char 1) 830 (goto-char stpos)
938 (pascal-delete-whitespaces) 831 ;; Indent lines in record block
939 (indent-to (1+ (current-column))))))) 832 (if arg
833 (while (<= (point) (marker-position edpos))
834 (beginning-of-line)
835 (delete-horizontal-space)
836 (if (looking-at "end\\>")
837 (indent-to arg)
838 (indent-to (+ arg pascal-indent-level)))
839 (forward-line 1)))
840
841 ;; Do lineup
842 (setq ind (pascal-get-lineup-indent stpos edpos lineup))
843 (goto-char stpos)
844 (while (<= (point) (marker-position edpos))
845 (if (search-forward lineup (pascal-get-end-of-line) 'move)
846 (forward-char -1))
847 (delete-horizontal-space)
848 (indent-to ind)
849 (if (not (looking-at lineup))
850 (forward-line 1) ; No more indent if there is no : or =
851 (forward-char 1)
852 (delete-horizontal-space)
853 (insert " ")
854 ;; Indent record block
855 (if (looking-at "record\\>")
856 (pascal-indent-declaration (current-column)))
857 (forward-line 1)))))
858
859 ;; If arg - move point
860 (if arg (forward-line -1)
861 (goto-char (marker-position pos)))))
862
863; "Return the indent level that will line up several lines within the region
864;from b to e nicely. The lineup string is str."
865(defun pascal-get-lineup-indent (b e str)
866 (save-excursion
867 (let ((ind 0)
868 (reg (concat str "\\|\\(\\<record\\>\\)"))
869 nest)
870 (goto-char b)
871 ;; Get rightmost position
872 (while (< (point) e)
873 (setq nest 1)
874 (if (re-search-forward reg (min e (pascal-get-end-of-line 2)) 'move)
875 ;; Skip record blocks
876 (if (match-beginning 1)
877 (pascal-declaration-end)
878 (save-excursion
879 (goto-char (match-beginning 0))
880 (skip-chars-backward " \t")
881 (if (> (current-column) ind)
882 (setq ind (current-column)))))))
883 ;; In case no lineup was found
884 (if (> ind 0)
885 (1+ ind)
886 ;; No lineup-string found
887 (goto-char b)
888 (end-of-line)
889 (skip-chars-backward " \t")
890 (1+ (current-column))))))
891
892
893
894;;;
895;;; Completion
896;;;
897(defun pascal-string-diff (str1 str2)
898 "Return index of first letter where STR1 and STR2 differs."
899 (catch 'done
900 (let ((diff 0))
901 (while t
902 (if (or (> (1+ diff) (length str1))
903 (> (1+ diff) (length str2)))
904 (throw 'done diff))
905 (or (equal (aref str1 diff) (aref str2 diff))
906 (throw 'done diff))
907 (setq diff (1+ diff))))))
908
909;; Calculate all possible completions for functions if argument is `function',
910;; completions for procedures if argument is `procedure' or both functions and
911;; procedures otherwise.
912
913(defun pascal-func-completion (type)
914 ;; Build regular expression for function/procedure names
915 (if (string= str "")
916 (setq str "[a-zA-Z_]"))
917 (let ((str (concat (cond ((eq type 'procedure) "\\<\\(procedure\\)\\s +")
918 ((eq type 'function) "\\<\\(function\\)\\s +")
919 (t "\\<\\(function\\|procedure\\)\\s +"))
920 "\\<\\(" str "[a-zA-Z0-9_.]*\\)\\>"))
921 match)
940 922
941(defun pascal-indent-within-comment (indent) 923 (if (not (looking-at "\\<\\(function\\|procedure\\)\\>"))
942 "Indent comments and/or indent text within comment." 924 (re-search-backward "\\<\\(function\\|procedure\\)\\>" nil t))
943 (progn 925 (forward-char 1)
944 ;; If we are at the beginning of the line, then we indent this line. 926
945 (if (save-excursion (skip-chars-backward " \t") (bolp)) 927 ;; Search through all reachable functions
928 (while (pascal-beg-of-defun)
929 (if (re-search-forward str (pascal-get-end-of-line) t)
930 (progn (setq match (buffer-substring (match-beginning 2)
931 (match-end 2)))
932 (if (or (null predicate)
933 (funcall prdicate match))
934 (setq all (cons match all)))))
935 (goto-char (match-beginning 0)))))
936
937(defun pascal-get-completion-decl ()
938 ;; Macro for searching through current declaration (var, type or const)
939 ;; for matches of `str' and adding the occurence tp `all'
940 (let ((end (save-excursion (pascal-declaration-end)
941 (point)))
942 match)
943 ;; Traverse lines
944 (while (< (point) end)
945 (if (re-search-forward "[:=]" (pascal-get-end-of-line) t)
946 ;; Traverse current line
947 (while (and (re-search-backward
948 (concat "\\((\\|\\<\\(var\\|type\\|const\\)\\>\\)\\|"
949 pascal-symbol-re)
950 (pascal-get-beg-of-line) t)
951 (not (match-end 1)))
952 (setq match (buffer-substring (match-beginning 0) (match-end 0)))
953 (if (string-match (concat "\\<" str) match)
954 (if (or (null predicate)
955 (funcall predicate match))
956 (setq all (cons match all))))))
957 (if (re-search-forward "\\<record\\>" (pascal-get-end-of-line) t)
958 (pascal-declaration-end)
959 (forward-line 1)))))
960
961(defun pascal-type-completion ()
962 "Calculate all possible completions for types."
963 (let ((start (point))
964 goon)
965 ;; Search for all reachable type declarations
966 (while (or (pascal-beg-of-defun)
967 (setq goon (not goon)))
968 (save-excursion
969 (if (and (< start (prog1 (save-excursion (pascal-end-of-defun)
970 (point))
971 (forward-char 1)))
972 (re-search-forward
973 "\\<type\\>\\|\\<\\(begin\\|function\\|proceudre\\)\\>"
974 start t)
975 (not (match-end 1)))
976 ;; Check current type declaration
977 (pascal-get-completion-decl))))))
978
979(defun pascal-var-completion ()
980 "Calculate all possible completions for variables (or constants)."
981 (let ((start (point))
982 goon twice)
983 ;; Search for all reachable var declarations
984 (while (or (pascal-beg-of-defun)
985 (setq goon (not goon)))
986 (save-excursion
987 (if (> start (prog1 (save-excursion (pascal-end-of-defun)
988 (point))))
989 () ; Declarations not reacable
990 (if (search-forward "(" (pascal-get-end-of-line) t)
991 ;; Check parameterlist
992 (pascal-get-completion-decl))
993 (setq twice 2)
994 (while (>= (setq twice (1- twice)) 0)
995 (cond ((and (re-search-forward
996 (concat "\\<\\(var\\|const\\)\\>\\|"
997 "\\<\\(begin\\|function\\|procedure\\)\\>")
998 start t)
999 (not (match-end 2)))
1000 ;; Check var/const declarations
1001 (pascal-get-completion-decl))
1002 ((match-end 2)
1003 (setq twice 0)))))))))
1004
1005
1006(defun pascal-keyword-completion (keyword-list)
1007 "Give list of all possible completions of keywords in KEYWORD-LIST."
1008 (mapcar '(lambda (s)
1009 (if (string-match (concat "\\<" str) s)
1010 (if (or (null predicate)
1011 (funcall predicate s))
1012 (setq all (cons s all)))))
1013 keyword-list))
1014
1015;; Function passed to completing-read, try-completion or
1016;; all-completions to get completion on STR. If predicate is non-nil,
1017;; it must be a function to be called for every match to check if this
1018;; should really be a match. If flag is t, the function returns a list
1019;; of all possible completions. If it is nil it returns a string, the
1020;; longest possible completion, or t if STR is an exact match. If flag
1021;; is 'lambda, the function returns t if STR is an exact match, nil
1022;; otherwise.
1023
1024(defun pascal-completion (str predicate flag)
1025 (save-excursion
1026 (let ((all nil))
1027 ;; Set buffer to use for searching labels. This should be set
1028 ;; within functins which use pascal-completions
1029 (set-buffer buffer-to-use)
1030
1031 ;; Determine what should be completed
1032 (let ((state (car (pascal-calculate-indent))))
1033 (cond (;--Within a declaration or parameterlist
1034 (or (eq state 'declaration) (eq state 'paramlist)
1035 (and (eq state 'defun)
1036 (save-excursion
1037 (re-search-backward ")[ \t]*:" (pascal-get-beg-of-line) t))))
1038 (if (or (eq state 'paramlist) (eq state 'defun))
1039 (pascal-beg-of-defun))
1040 (pascal-type-completion)
1041 (pascal-keyword-completion pascal-type-keywords))
1042 (;--Starting a new statement
1043 (and (not (eq state 'contexp))
1044 (save-excursion
1045 (skip-chars-backward "a-zA-Z0-9_.")
1046 (backward-sexp 1)
1047 (or (looking-at pascal-nosemi-re)
1048 (progn
1049 (forward-sexp 1)
1050 (looking-at "\\s *\\(;\\|:[^=]\\)")))))
1051 (save-excursion (pascal-var-completion))
1052 (pascal-func-completion 'procedure)
1053 (pascal-keyword-completion pascal-start-keywords))
1054 (t;--Anywhere else
1055 (save-excursion (pascal-var-completion))
1056 (pascal-func-completion 'function)
1057 (pascal-keyword-completion pascal-seperator-keywords))))
1058
1059 ;; Now we have built a list of all matches. Give response to caller
1060 (pascal-completion-response))))
1061
1062(defun pascal-completion-response ()
1063 (cond ((or (equal flag 'lambda) (null flag))
1064 ;; This was not called by all-completions
1065 (if (null all)
1066 ;; Return nil if there was no matching label
1067 nil
1068 ;; Get longest string common in the labels
1069 (let* ((elm (cdr all))
1070 (match (car all))
1071 (min (length match))
1072 exact tmp)
1073 (if (string= match str)
1074 ;; Return t if first match was an exact match
1075 (setq match t)
1076 (while (not (null elm))
1077 ;; Find longest common string
1078 (if (< (setq tmp (pascal-string-diff match (car elm))) min)
1079 (progn
1080 (setq min tmp)
1081 (setq match (substring match 0 min))))
1082 ;; Terminate with match=t if this is an exact match
1083 (if (string= (car elm) str)
1084 (progn
1085 (setq match t)
1086 (setq elm nil))
1087 (setq elm (cdr elm)))))
1088 ;; If this is a test just for exact match, return nil ot t
1089 (if (and (equal flag 'lambda) (not (equal match 't)))
1090 nil
1091 match))))
1092 ;; If flag is t, this was called by all-completions. Return
1093 ;; list of all possible completions
1094 (flag
1095 all)))
1096
1097(defvar pascal-last-word-numb 0)
1098(defvar pascal-last-word-shown nil)
1099(defvar pascal-last-completions nil)
1100
1101(defun pascal-complete-word ()
1102 "Complete word at current point.
1103\(See also `pascal-toggle-completions', `pascal-type-keywords',
1104`pascal-start-keywords' and `pascal-seperator-keywords'.)"
1105 (interactive)
1106 (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
1107 (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))
1108 (str (buffer-substring b e))
1109 ;; The following variable is used in pascal-completion
1110 (buffer-to-use (current-buffer))
1111 (allcomp (if (and pascal-toggle-completions
1112 (string= pascal-last-word-shown str))
1113 pascal-last-completions
1114 (all-completions str 'pascal-completion)))
1115 (match (if pascal-toggle-completions
1116 "" (try-completion
1117 str (mapcar '(lambda (elm) (cons elm 0)) allcomp)))))
1118 ;; Delete old string
1119 (delete-region b e)
1120
1121 ;; Toggle-completions inserts whole labels
1122 (if pascal-toggle-completions
946 (progn 1123 (progn
947 (beginning-of-line) 1124 ;; Update entry number in list
948 (pascal-delete-whitespaces) 1125 (setq pascal-last-completions allcomp
949 (indent-to indent)) 1126 pascal-last-word-numb
950 ;; Do nothing if we're not in a star comment. 1127 (if (>= pascal-last-word-numb (1- (length allcomp)))
951 (if (save-excursion 1128 0
952 (beginning-of-line) 1129 (1+ pascal-last-word-numb)))
953 (skip-chars-forward " \t") 1130 (setq pascal-last-word-shown (elt allcomp pascal-last-word-numb))
954 (looking-at "\\*\\|(\\*")) 1131 ;; Display next match or same string if no match was found
955 (save-excursion 1132 (if (not (null allcomp))
956 (beginning-of-line) 1133 (insert "" pascal-last-word-shown)
957 (search-forward "*") 1134 (insert "" str)
958 (pascal-delete-whitespaces) 1135 (message "(No match)")))
959 (indent-to (+ (current-column) 2))))))) 1136 ;; The other form of completion does not necessarly do that.
960 1137
961(defun pascal-find-leading-case-colon () 1138 ;; Insert match if found, or the original string if no match
962 "Return hpos of first colon after the case-of or record line. 1139 (if (or (null match) (equal match 't))
963If there's no such line, use the place where it ought to be." 1140 (progn (insert "" str)
964 (let ((pos (save-excursion 1141 (message "(No match)"))
965 (beginning-of-line) 1142 (insert "" match))
966 (skip-chars-forward " \t") 1143 ;; Give message about current status of completion
967 (point)))) 1144 (cond ((equal match 't)
968 (save-excursion 1145 (if (not (null (cdr allcomp)))
969 (re-search-backward "\\<\\(case\\|record\\)\\>") 1146 (message "(Complete but not unique)")
970 (forward-line 1) 1147 (message "(Sole completion)")))
971 (skip-chars-forward " \t") 1148 ;; Display buffer if the current completion didn't help
972 (if (not (eq pos (point))) 1149 ;; on completing the label.
1150 ((and (not (null (cdr allcomp))) (= (length str) (length match)))
1151 (with-output-to-temp-buffer "*Completions*"
1152 (display-completion-list allcomp))
1153 ;; Wait for a keypress. Then delete *Completion* window
1154 (momentary-string-display "" (point))
1155 (delete-window (get-buffer-window (get-buffer "*Completions*")))
1156 )))))
1157
1158(defun pascal-show-completions ()
1159 "Show all possible completions at current point."
1160 (interactive)
1161 (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
1162 (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))
1163 (str (buffer-substring b e))
1164 ;; The following variable is used in pascal-completion
1165 (buffer-to-use (current-buffer))
1166 (allcomp (if (and pascal-toggle-completions
1167 (string= pascal-last-word-shown str))
1168 pascal-last-completions
1169 (all-completions str 'pascal-completion))))
1170 ;; Show possible completions in a temporary buffer.
1171 (with-output-to-temp-buffer "*Completions*"
1172 (display-completion-list allcomp))
1173 ;; Wait for a keypress. Then delete *Completion* window
1174 (momentary-string-display "" (point))
1175 (delete-window (get-buffer-window (get-buffer "*Completions*")))))
1176
1177
1178(defun pascal-get-default-symbol ()
1179 "Return symbol around current point as a string."
1180 (save-excursion
1181 (buffer-substring (progn
1182 (skip-chars-backward " \t")
1183 (skip-chars-backward "a-zA-Z0-9_")
1184 (point))
1185 (progn
1186 (skip-chars-forward "a-zA-Z0-9_")
1187 (point)))))
1188
1189(defun pascal-build-defun-re (str &optional arg)
1190 "Return function/procedure starting with STR as regular expression.
1191With optional second arg non-nil, STR is the complete name of the instruction."
1192 (if arg
1193 (concat "^\\(function\\|procedure\\)[ \t]+\\(" str "\\)\\>")
1194 (concat "^\\(function\\|procedure\\)[ \t]+\\(" str "[a-zA-Z0-9_]*\\)\\>")))
1195
1196;; Function passed to completing-read, try-completion or
1197;; all-completions to get completion on any function name. If
1198;; predicate is non-nil, it must be a function to be called for every
1199;; match to check if this should really be a match. If flag is t, the
1200;; function returns a list of all possible completions. If it is nil
1201;; it returns a string, the longest possible completion, or t if STR
1202;; is an exact match. If flag is 'lambda, the function returns t if
1203;; STR is an exact match, nil otherwise.
1204
1205(defun pascal-comp-defun (str predicate flag)
1206 (save-excursion
1207 (let ((all nil)
1208 match)
1209
1210 ;; Set buffer to use for searching labels. This should be set
1211 ;; within functins which use pascal-completions
1212 (set-buffer buffer-to-use)
1213
1214 (let ((str str))
1215 ;; Build regular expression for functions
1216 (if (string= str "")
1217 (setq str (pascal-build-defun-re "[a-zA-Z_]"))
1218 (setq str (pascal-build-defun-re str)))
1219 (goto-char (point-min))
1220
1221 ;; Build a list of all possible completions
1222 (while (re-search-forward str nil t)
1223 (setq match (buffer-substring (match-beginning 2) (match-end 2)))
1224 (if (or (null predicate)
1225 (funcall predicate match))
1226 (setq all (cons match all)))))
1227
1228 ;; Now we have built a list of all matches. Give response to caller
1229 (pascal-completion-response))))
1230
1231(defun pascal-goto-defun ()
1232 "Move to specified Pascal function/procedure.
1233The default is a name found in the buffer around point."
1234 (interactive)
1235 (let* ((default (pascal-get-default-symbol))
1236 ;; The following variable is used in pascal-comp-function
1237 (buffer-to-use (current-buffer))
1238 (default (if (pascal-comp-defun default nil 'lambda)
1239 default ""))
1240 (label (if (not (string= default ""))
1241 ;; Do completion with default
1242 (completing-read (concat "Label: (default " default ") ")
1243 'pascal-comp-defun nil t "")
1244 ;; There is no default value. Complete without it
1245 (completing-read "Label: "
1246 'pascal-comp-defun nil t ""))))
1247 ;; If there was no response on prompt, use default value
1248 (if (string= label "")
1249 (setq label default))
1250 ;; Goto right place in buffer if label is not an empty string
1251 (or (string= label "")
1252 (progn
1253 (goto-char (point-min))
1254 (re-search-forward (pascal-build-defun-re label t))
1255 (beginning-of-line)))))
1256
1257
1258
1259;;;
1260;;; Pascal-outline-mode
1261;;;
1262(defvar pascal-outline-map nil "Keymap used in Pascal Outline mode.")
1263
1264(if pascal-outline-map
1265 nil
1266 (if (boundp 'set-keymap-name)
1267 (set-keymap-name pascal-outline-map 'pascal-outline-map))
1268 (if (not (boundp 'set-keymap-parent))
1269 (setq pascal-outline-map (copy-keymap pascal-mode-map))
1270 (setq pascal-outline-map (make-sparse-keymap))
1271 (set-keymap-parent pascal-outline-map pascal-mode-map))
1272 (define-key pascal-outline-map "\e\C-a" 'pascal-outline-prev-defun)
1273 (define-key pascal-outline-map "\e\C-e" 'pascal-outline-next-defun)
1274 (define-key pascal-outline-map "\C-cg" 'pascal-outline-goto-defun)
1275 (define-key pascal-outline-map "\C-c\C-s" 'pascal-show-all)
1276 (define-key pascal-outline-map "\C-c\C-h" 'pascal-hide-other-defuns))
1277
1278(defvar pascal-outline-mode nil "Non-nil while using Pascal Outline mode.")
1279(make-variable-buffer-local 'pascal-outline-mode)
1280(set-default 'pascal-outline-mode nil)
1281(if (not (assoc 'pascal-outline-mode minor-mode-alist))
1282 (setq minor-mode-alist (append minor-mode-alist
1283 (list '(pascal-outline-mode " Outl")))))
1284
1285(defun pascal-outline (&optional arg)
1286 "Outline-line minor mode for Pascal mode.
1287When in Pascal Outline mode, portions
1288of the text being edited may be made invisible. \\<pascal-outline-map>
1289
1290Pascal Outline mode provides some additional commands.
1291
1292\\[pascal-outline-prev-defun]\
1293\t- Move to previous function/procedure, hiding everything else.
1294\\[pascal-outline-next-defun]\
1295\t- Move to next function/procedure, hiding everything else.
1296\\[pascal-outline-goto-defun]\
1297\t- Goto function/procedure prompted for in minibuffer,
1298\t hide all other functions.
1299\\[pascal-show-all]\t- Show the whole buffer.
1300\\[pascal-hide-other-defuns]\
1301\t- Hide everything but the current function (function under the cursor).
1302\\[pascal-outline]\t- Leave pascal-outline-mode."
1303 (interactive "P")
1304 (setq pascal-outline-mode
1305 (if (null arg) (not pascal-outline-mode) t))
1306 (if (boundp 'redraw-mode-line)
1307 (redraw-mode-line))
1308 (if pascal-outline-mode
1309 (progn
1310 (setq selective-display t)
1311 (use-local-map pascal-outline-map))
1312 (progn
1313 (setq selective-display nil)
1314 (pascal-show-all)
1315 (use-local-map pascal-mode-map))))
1316
1317(defun pascal-outline-change (b e flag)
1318 (let ((modp (buffer-modified-p)))
1319 (unwind-protect
1320 (subst-char-in-region b e (if (= flag ?\n) ?\^M ?\n) flag)
1321 (set-buffer-modified-p modp))))
1322
1323(defun pascal-show-all ()
1324 "Show all of the text in the buffer."
1325 (interactive)
1326 (pascal-outline-change (point-min) (point-max) ?\n))
1327
1328(defun pascal-hide-other-defuns ()
1329 "Show only the current defun."
1330 (interactive)
1331 (save-excursion
1332 (let ((beg (progn (if (not (looking-at "\\(function\\|procedure\\)\\>"))
1333 (pascal-beg-of-defun))
1334 (point)))
1335 (end (progn (pascal-end-of-defun)
1336 (backward-sexp 1)
1337 (search-forward "\n\\|\^M" nil t)
1338 (point)))
1339 (opoint (point-min)))
1340 (goto-char (point-min))
1341
1342 ;; Hide all functions before current function
1343 (while (re-search-forward "^\\(function\\|procedure\\)\\>" beg 'move)
1344 (pascal-outline-change opoint (1- (match-beginning 0)) ?\^M)
1345 (setq opoint (point))
1346 ;; Functions may be nested
1347 (if (> (progn (pascal-end-of-defun) (point)) beg)
1348 (goto-char opoint)))
1349 (if (> beg opoint)
1350 (pascal-outline-change opoint (1- beg) ?\^M))
1351
1352 ;; Show current function
1353 (pascal-outline-change beg end ?\n)
1354 ;; Hide nested functions
1355 (forward-char 1)
1356 (while (re-search-forward "^\\(function\\|procedure\\)\\>" end 'move)
1357 (setq opoint (point))
1358 (pascal-end-of-defun)
1359 (pascal-outline-change opoint (point) ?\^M))
1360
1361 (goto-char end)
1362 (setq opoint end)
1363
1364 ;; Hide all function after current function
1365 (while (re-search-forward "^\\(function\\|procedure\\)\\>" nil 'move)
1366 (pascal-outline-change opoint (1- (match-beginning 0)) ?\^M)
1367 (setq opoint (point))
1368 (pascal-end-of-defun))
1369 (pascal-outline-change opoint (point-max) ?\^M)
1370
1371 ;; Hide main program
1372 (if (< (progn (forward-line -1) (point)) end)
973 (progn 1373 (progn
974 (search-forward ":" (pascal-get-end-of-line) t) 1374 (goto-char beg)
975 (1- (current-column))) 1375 (pascal-end-of-defun)
976 (+ (current-column) pascal-case-offset))))) 1376 (backward-sexp 1)
1377 (pascal-outline-change (point) (point-max) ?\^M))))))
977 1378
978(provide 'pascal) 1379(defun pascal-outline-next-defun ()
1380 "Move to next function/procedure, hiding all others."
1381 (interactive)
1382 (pascal-end-of-defun)
1383 (pascal-hide-other-defuns))
1384
1385(defun pascal-outline-prev-defun ()
1386 "Move to previous function/procedure, hiding all others."
1387 (interactive)
1388 (pascal-beg-of-defun)
1389 (pascal-hide-other-defuns))
1390
1391(defun pascal-outline-goto-defun ()
1392 "Move to specified function/procedure, hiding all others."
1393 (interactive)
1394 (pascal-goto-defun)
1395 (pascal-hide-other-defuns))
979 1396
980;; pascal.el ends here. 1397;;; pascal.el ends here