Commit | Line | Data |
---|---|---|
c4f268a1 | 1 | ;;; opascal.el --- major mode for editing Object Pascal source in Emacs -*- lexical-binding: t -*- |
70492703 | 2 | |
ab422c4d | 3 | ;; Copyright (C) 1998-1999, 2001-2013 Free Software Foundation, Inc. |
70492703 | 4 | |
c05423d4 CY |
5 | ;; Authors: Ray Blaak <blaak@infomatch.com>, |
6 | ;; Simon South <ssouth@member.fsf.org> | |
7 | ;; Maintainer: Simon South <ssouth@member.fsf.org> | |
70492703 KH |
8 | ;; Keywords: languages |
9 | ||
10 | ;; This file is part of GNU Emacs. | |
11 | ||
b1fc2b50 GM |
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. | |
70492703 | 16 | |
b1fc2b50 GM |
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. | |
70492703 | 21 | |
b1fc2b50 GM |
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/>. | |
70492703 KH |
24 | |
25 | ;;; Commentary: | |
26 | ||
c4f268a1 SM |
27 | ;; To enter OPascal mode when you find an Object Pascal source file, one must |
28 | ;; override the auto-mode-alist to associate OPascal with .pas (and .dpr and | |
29 | ;; .dpk) files. Emacs, by default, will otherwise enter Pascal mode. E.g. | |
70492703 | 30 | ;; |
c4f268a1 SM |
31 | ;; (autoload 'opascal-mode "opascal") |
32 | ;; (add-to-list 'auto-mode-alist | |
33 | ;; '("\\.\\(pas\\|dpr\\|dpk\\)\\'" . opascal-mode)) | |
70492703 | 34 | |
c4f268a1 | 35 | ;; When you have entered OPascal mode, you may get more info by pressing |
70492703 KH |
36 | ;; C-h m. |
37 | ||
c4f268a1 SM |
38 | ;; This OPascal mode implementation is fairly tolerant of syntax errors, |
39 | ;; relying as much as possible on the indentation of the previous statement. | |
40 | ;; This also makes it faster and simpler, since there is less searching for | |
41 | ;; properly constructed beginnings. | |
70492703 KH |
42 | |
43 | ;;; Code: | |
44 | ||
c4f268a1 SM |
45 | (defgroup opascal nil |
46 | "Major mode for editing OPascal source in Emacs." | |
47 | :version "24.4" | |
70492703 KH |
48 | :group 'languages) |
49 | ||
c4f268a1 | 50 | (defconst opascal-debug nil |
70492703 KH |
51 | "True if in debug mode.") |
52 | ||
c4f268a1 SM |
53 | (define-obsolete-variable-alias |
54 | 'delphi-search-path 'opascal-search-path "24.4") | |
55 | (defcustom opascal-search-path "." | |
fb7ada5f | 56 | "Directories to search when finding external units. |
5ba5fb81 JB |
57 | It is a list of directory strings. If only a single directory, |
58 | it can be a single string instead of a list. If a directory | |
59 | ends in \"...\" then that directory is recursively searched." | |
c4f268a1 | 60 | :type 'string) |
70492703 | 61 | |
c4f268a1 SM |
62 | (define-obsolete-variable-alias |
63 | 'delphi-indent-level 'opascal-indent-level "24.4") | |
64 | (defcustom opascal-indent-level 3 | |
65 | "Indentation of OPascal statements with respect to containing block. | |
5ba5fb81 | 66 | E.g. |
70492703 KH |
67 | |
68 | begin | |
69 | // This is an indent of 3. | |
70 | end;" | |
c4f268a1 | 71 | :type 'integer) |
70492703 | 72 | |
c4f268a1 SM |
73 | (define-obsolete-variable-alias |
74 | 'delphi-compound-block-indent 'opascal-compound-block-indent "24.4") | |
75 | (defcustom opascal-compound-block-indent 0 | |
fb7ada5f | 76 | "Extra indentation for blocks in compound statements. E.g. |
70492703 KH |
77 | |
78 | // block indent = 0 vs // block indent = 2 | |
79 | if b then if b then | |
80 | begin begin | |
81 | end else begin end | |
82 | end; else | |
83 | begin | |
84 | end;" | |
c4f268a1 | 85 | :type 'integer) |
70492703 | 86 | |
c4f268a1 SM |
87 | (define-obsolete-variable-alias |
88 | 'delphi-case-label-indent 'opascal-case-label-indent "24.4") | |
89 | (defcustom opascal-case-label-indent opascal-indent-level | |
fb7ada5f | 90 | "Extra indentation for case statement labels. E.g. |
70492703 KH |
91 | |
92 | // case indent = 0 vs // case indent = 3 | |
93 | case value of case value of | |
94 | v1: process_v1; v1: process_v1; | |
95 | v2: process_v2; v2: process_v2; | |
96 | else else | |
97 | process_else; process_else; | |
98 | end; end;" | |
c4f268a1 | 99 | :type 'integer) |
70492703 | 100 | |
c4f268a1 SM |
101 | (define-obsolete-variable-alias 'delphi-verbose 'opascal-verbose "24.4") |
102 | (defcustom opascal-verbose t ; nil | |
103 | "If true then OPascal token processing progress is reported to the user." | |
104 | :type 'boolean) | |
70492703 | 105 | |
c4f268a1 SM |
106 | (define-obsolete-variable-alias |
107 | 'delphi-tab-always-indents 'opascal-tab-always-indents "24.4") | |
108 | (defcustom opascal-tab-always-indents tab-always-indent | |
109 | "Non-nil means TAB in OPascal mode should always reindent the current line, | |
70492703 | 110 | regardless of where in the line point is when the TAB command is used." |
c4f268a1 SM |
111 | :type 'boolean) |
112 | ||
113 | (define-obsolete-variable-alias | |
114 | 'delphi-comment-face 'opascal-comment-face "24.4") | |
115 | (defcustom opascal-comment-face 'font-lock-comment-face | |
116 | "Face used to color OPascal comments." | |
117 | :type 'face) | |
118 | ||
119 | (define-obsolete-variable-alias | |
120 | 'delphi-string-face 'opascal-string-face "24.4") | |
121 | (defcustom opascal-string-face 'font-lock-string-face | |
122 | "Face used to color OPascal strings." | |
123 | :type 'face) | |
124 | ||
125 | (define-obsolete-variable-alias | |
126 | 'delphi-keyword-face 'opascal-keyword-face "24.4") | |
127 | (defcustom opascal-keyword-face 'font-lock-keyword-face | |
128 | "Face used to color OPascal keywords." | |
129 | :type 'face) | |
130 | ||
131 | (define-obsolete-variable-alias 'delphi-other-face 'opascal-other-face "24.4") | |
132 | (defcustom opascal-other-face nil | |
fb7ada5f | 133 | "Face used to color everything else." |
c4f268a1 | 134 | :type '(choice (const :tag "None" nil) face)) |
70492703 | 135 | |
c4f268a1 | 136 | (defconst opascal-directives |
70492703 KH |
137 | '(absolute abstract assembler automated cdecl default dispid dynamic |
138 | export external far forward index inline message name near nodefault | |
a1506d29 | 139 | overload override pascal private protected public published read readonly |
70492703 KH |
140 | register reintroduce resident resourcestring safecall stdcall stored |
141 | virtual write writeonly) | |
c4f268a1 | 142 | "OPascal4 directives.") |
70492703 | 143 | |
c4f268a1 | 144 | (defconst opascal-keywords |
70492703 KH |
145 | (append |
146 | '(;; Keywords. | |
147 | and array as asm at begin case class const constructor contains | |
148 | destructor dispinterface div do downto else end except exports | |
149 | file finalization finally for function goto if implementation implements | |
a1506d29 | 150 | in inherited initialization interface is label library mod nil not |
70492703 | 151 | of object on or out package packed procedure program property |
a1506d29 | 152 | raise record repeat requires result self set shl shr then threadvar |
70492703 KH |
153 | to try type unit uses until var while with xor |
154 | ||
155 | ;; These routines should be keywords, if Borland had the balls. | |
156 | break exit) | |
157 | ||
158 | ;; We want directives to look like keywords. | |
c4f268a1 SM |
159 | opascal-directives) |
160 | "OPascal4 keywords.") | |
70492703 | 161 | |
c4f268a1 | 162 | (defconst opascal-previous-terminators `(semicolon comma) |
70492703 KH |
163 | "Expression/statement terminators that denote a previous expression.") |
164 | ||
c4f268a1 | 165 | (defconst opascal-comments |
70492703 KH |
166 | '(comment-single-line comment-multi-line-1 comment-multi-line-2) |
167 | "Tokens that represent comments.") | |
168 | ||
c4f268a1 | 169 | (defconst opascal-strings |
70492703 KH |
170 | '(string double-quoted-string) |
171 | "Tokens that represent string literals.") | |
172 | ||
c4f268a1 | 173 | (defconst opascal-whitespace `(space newline ,@opascal-comments) |
70492703 KH |
174 | "Tokens that are considered whitespace.") |
175 | ||
c4f268a1 | 176 | (defconst opascal-routine-statements |
70492703 KH |
177 | '(procedure function constructor destructor property) |
178 | "Marks the start of a routine, or routine-ish looking expression.") | |
179 | ||
c4f268a1 | 180 | (defconst opascal-body-expr-statements '(if while for on) |
70492703 KH |
181 | "Statements that have either a single statement or a block as a body and also |
182 | are followed by an expression.") | |
183 | ||
c4f268a1 | 184 | (defconst opascal-expr-statements `(case ,@opascal-body-expr-statements) |
70492703 KH |
185 | "Expression statements contain expressions after their keyword.") |
186 | ||
c4f268a1 | 187 | (defconst opascal-body-statements `(else ,@opascal-body-expr-statements) |
70492703 KH |
188 | "Statements that have either a single statement or a block as a body.") |
189 | ||
c4f268a1 | 190 | (defconst opascal-expr-delimiters '(then do of) |
70492703 KH |
191 | "Expression delimiter tokens.") |
192 | ||
c4f268a1 | 193 | (defconst opascal-binary-ops |
70492703 | 194 | '(plus minus equals not-equals times divides div mod and or xor) |
c4f268a1 | 195 | "OPascal binary operations.") |
70492703 | 196 | |
c4f268a1 | 197 | (defconst opascal-visibilities '(public private protected published automated) |
70492703 KH |
198 | "Class visibilities.") |
199 | ||
c4f268a1 | 200 | (defconst opascal-block-statements |
06c24636 | 201 | '(begin try case repeat initialization finalization asm) |
70492703 KH |
202 | "Statements that contain multiple substatements.") |
203 | ||
c4f268a1 SM |
204 | (defconst opascal-mid-block-statements |
205 | `(except finally ,@opascal-visibilities) | |
70492703 KH |
206 | "Statements that mark mid sections of the enclosing block.") |
207 | ||
c4f268a1 | 208 | (defconst opascal-end-block-statements `(end until) |
70492703 KH |
209 | "Statements that end block sections.") |
210 | ||
c4f268a1 SM |
211 | (defconst opascal-match-block-statements |
212 | `(,@opascal-end-block-statements ,@opascal-mid-block-statements) | |
70492703 KH |
213 | "Statements that match the indentation of the parent block.") |
214 | ||
c4f268a1 | 215 | (defconst opascal-decl-sections '(type const var label resourcestring) |
70492703 KH |
216 | "Denotes the start of a declaration section.") |
217 | ||
c4f268a1 | 218 | (defconst opascal-interface-types '(dispinterface interface) |
c05423d4 CY |
219 | "Interface types.") |
220 | ||
c4f268a1 | 221 | (defconst opascal-class-types '(class object) |
70492703 KH |
222 | "Class types.") |
223 | ||
c4f268a1 SM |
224 | (defconst opascal-composite-types |
225 | `(,@opascal-class-types ,@opascal-interface-types record) | |
70492703 KH |
226 | "Types that contain declarations within them.") |
227 | ||
c4f268a1 | 228 | (defconst opascal-unit-sections |
70492703 KH |
229 | '(interface implementation program library package) |
230 | "Unit sections within which the indent is 0.") | |
231 | ||
c4f268a1 | 232 | (defconst opascal-use-clauses `(uses requires exports contains) |
70492703 KH |
233 | "Statements that refer to foreign symbols.") |
234 | ||
c4f268a1 SM |
235 | (defconst opascal-unit-statements |
236 | `(,@opascal-use-clauses ,@opascal-unit-sections initialization finalization) | |
70492703 KH |
237 | "Statements indented at level 0.") |
238 | ||
c4f268a1 SM |
239 | (defconst opascal-decl-delimiters |
240 | `(,@opascal-decl-sections ,@opascal-unit-statements | |
241 | ,@opascal-routine-statements) | |
70492703 KH |
242 | "Statements that a declaration statement should align with.") |
243 | ||
c4f268a1 SM |
244 | (defconst opascal-decl-matchers |
245 | `(begin ,@opascal-decl-sections) | |
70492703 KH |
246 | "Statements that should match to declaration statement indentation.") |
247 | ||
c4f268a1 SM |
248 | (defconst opascal-enclosing-statements |
249 | `(,@opascal-block-statements ,@opascal-mid-block-statements | |
250 | ,@opascal-decl-sections ,@opascal-use-clauses ,@opascal-routine-statements) | |
70492703 KH |
251 | "Delimits an enclosing statement.") |
252 | ||
c4f268a1 SM |
253 | (defconst opascal-previous-statements |
254 | `(,@opascal-unit-statements ,@opascal-routine-statements) | |
70492703 KH |
255 | "Delimits a previous statement.") |
256 | ||
c4f268a1 SM |
257 | (defconst opascal-previous-enclosing-statements |
258 | `(,@opascal-block-statements ,@opascal-mid-block-statements | |
259 | ,@opascal-decl-sections) | |
70492703 KH |
260 | "Delimits a previous enclosing statement.") |
261 | ||
c4f268a1 SM |
262 | (defconst opascal-begin-enclosing-tokens |
263 | `(,@opascal-block-statements ,@opascal-mid-block-statements) | |
70492703 KH |
264 | "Tokens that a begin token indents from.") |
265 | ||
c4f268a1 SM |
266 | (defconst opascal-begin-previous-tokens |
267 | `(,@opascal-decl-sections ,@opascal-routine-statements) | |
70492703 KH |
268 | "Tokens that a begin token aligns with, but only if not part of a nested |
269 | routine.") | |
270 | ||
c4f268a1 SM |
271 | (defconst opascal-space-chars "\000-\011\013- ") ; all except \n |
272 | (defconst opascal-non-space-chars (concat "^" opascal-space-chars)) | |
273 | (defconst opascal-spaces-re (concat "[" opascal-space-chars "]*")) | |
274 | (defconst opascal-leading-spaces-re (concat "^" opascal-spaces-re)) | |
275 | (defconst opascal-word-chars "a-zA-Z0-9_") | |
276 | ||
277 | (defmacro opascal-save-excursion (&rest forms) | |
70492703 KH |
278 | ;; Executes the forms such that any movements have no effect, including |
279 | ;; searches. | |
280 | `(save-excursion | |
c4f268a1 | 281 | (save-match-data |
70492703 KH |
282 | (let ((inhibit-point-motion-hooks t) |
283 | (deactivate-mark nil)) | |
284 | (progn ,@forms))))) | |
285 | ||
c4f268a1 | 286 | (defmacro opascal-save-state (&rest forms) |
70492703 KH |
287 | ;; Executes the forms such that any buffer modifications do not have any side |
288 | ;; effects beyond the buffer's actual content changes. | |
c4f268a1 SM |
289 | `(let ((opascal--ignore-changes t)) |
290 | (with-silent-modifications | |
291 | ,@forms))) | |
292 | ||
293 | (defsubst opascal-is (element in-set) | |
70492703 KH |
294 | ;; If the element is in the set, the element cdr is returned, otherwise nil. |
295 | (memq element in-set)) | |
296 | ||
c4f268a1 | 297 | (defun opascal-string-of (start end) |
70492703 KH |
298 | ;; Returns the buffer string from start to end. |
299 | (buffer-substring-no-properties start end)) | |
300 | ||
c4f268a1 | 301 | (defun opascal-looking-at-string (p s) |
70492703 KH |
302 | ;; True if point p marks the start of string s. s is not a regular |
303 | ;; expression. | |
304 | (let ((limit (+ p (length s)))) | |
305 | (and (<= limit (point-max)) | |
c4f268a1 | 306 | (string= s (opascal-string-of p limit))))) |
70492703 | 307 | |
c4f268a1 | 308 | (defun opascal-token-of (kind start end) |
70492703 KH |
309 | ;; Constructs a token from a kind symbol and its start/end points. |
310 | `[,kind ,start ,end]) | |
311 | ||
c4f268a1 | 312 | (defsubst opascal-token-kind (token) |
70492703 KH |
313 | ;; Returns the kind symbol of the token. |
314 | (if token (aref token 0) nil)) | |
315 | ||
c4f268a1 | 316 | (defun opascal-set-token-kind (token to-kind) |
70492703 KH |
317 | ;; Sets the kind symbol of the token. |
318 | (if token (aset token 0 to-kind))) | |
319 | ||
c4f268a1 | 320 | (defsubst opascal-token-start (token) |
70492703 KH |
321 | ;; Returns the start point of the token. |
322 | (if token (aref token 1) (point-min))) | |
323 | ||
c4f268a1 | 324 | (defsubst opascal-token-end (token) |
70492703 KH |
325 | ;; Returns the end point of the token. |
326 | (if token (aref token 2) (point-min))) | |
327 | ||
c4f268a1 | 328 | (defun opascal-set-token-start (token start) |
70492703 KH |
329 | ;; Sets the start point of the token. |
330 | (if token (aset token 1 start))) | |
331 | ||
c4f268a1 | 332 | (defun opascal-set-token-end (token end) |
70492703 KH |
333 | ;; Sets the end point of the token. |
334 | (if token (aset token 2 end))) | |
335 | ||
c4f268a1 | 336 | (defun opascal-token-string (token) |
70492703 KH |
337 | ;; Returns the string image of the token. |
338 | (if token | |
c4f268a1 | 339 | (opascal-string-of (opascal-token-start token) (opascal-token-end token)) |
70492703 KH |
340 | "")) |
341 | ||
c4f268a1 | 342 | (defun opascal-in-token (p token) |
70492703 | 343 | ;; Returns true if the point p is within the token's start/end points. |
c4f268a1 | 344 | (and (<= (opascal-token-start token) p) (< p (opascal-token-end token)))) |
70492703 | 345 | |
c4f268a1 | 346 | (defun opascal-column-of (p) |
70492703 KH |
347 | ;; Returns the column of the point p. |
348 | (save-excursion (goto-char p) (current-column))) | |
349 | ||
c4f268a1 | 350 | (defun opascal-face-of (token-kind) |
70492703 | 351 | ;; Returns the face property appropriate for the token kind. |
c4f268a1 SM |
352 | (cond ((opascal-is token-kind opascal-comments) opascal-comment-face) |
353 | ((opascal-is token-kind opascal-strings) opascal-string-face) | |
354 | ((opascal-is token-kind opascal-keywords) opascal-keyword-face) | |
355 | (opascal-other-face))) | |
70492703 | 356 | |
c4f268a1 | 357 | (defvar opascal-progress-last-reported-point nil |
70492703 KH |
358 | "The last point at which progress was reported.") |
359 | ||
c4f268a1 | 360 | (defconst opascal-parsing-progress-step 16384 |
70492703 | 361 | "Number of chars to process before the next parsing progress report.") |
c4f268a1 | 362 | (defconst opascal-scanning-progress-step 2048 |
70492703 | 363 | "Number of chars to process before the next scanning progress report.") |
c4f268a1 | 364 | (defconst opascal-fontifying-progress-step opascal-scanning-progress-step |
70492703 KH |
365 | "Number of chars to process before the next fontification progress report.") |
366 | ||
c4f268a1 | 367 | (defun opascal-progress-start () |
70492703 | 368 | ;; Initializes progress reporting. |
c4f268a1 | 369 | (setq opascal-progress-last-reported-point nil)) |
70492703 | 370 | |
c4f268a1 | 371 | (defun opascal-progress-done (&rest msgs) |
70492703 | 372 | ;; Finalizes progress reporting. |
c4f268a1 SM |
373 | (setq opascal-progress-last-reported-point nil) |
374 | (when opascal-verbose | |
70492703 KH |
375 | (if (null msgs) |
376 | (message "") | |
377 | (apply #'message msgs)))) | |
378 | ||
c4f268a1 | 379 | (defun opascal-step-progress (p desc step-size) |
70492703 KH |
380 | ;; If enough distance has elapsed since the last reported point, then report |
381 | ;; the current progress to the user. | |
c4f268a1 | 382 | (cond ((null opascal-progress-last-reported-point) |
70492703 | 383 | ;; This is the first progress step. |
c4f268a1 | 384 | (setq opascal-progress-last-reported-point p)) |
70492703 | 385 | |
c4f268a1 SM |
386 | ((and opascal-verbose |
387 | (>= (abs (- p opascal-progress-last-reported-point)) step-size)) | |
70492703 | 388 | ;; Report the percentage complete. |
c4f268a1 | 389 | (setq opascal-progress-last-reported-point p) |
70492703 KH |
390 | (message "%s %s ... %d%%" |
391 | desc (buffer-name) (/ (* 100 p) (point-max)))))) | |
392 | ||
c4f268a1 | 393 | (defun opascal-next-line-start (&optional from-point) |
70492703 KH |
394 | ;; Returns the first point of the next line. |
395 | (let ((curr-point (point)) | |
396 | (next nil)) | |
397 | (if from-point (goto-char from-point)) | |
398 | (end-of-line) | |
399 | (setq next (min (1+ (point)) (point-max))) | |
400 | (goto-char curr-point) | |
401 | next)) | |
402 | ||
c4f268a1 SM |
403 | (defvar opascal--ignore-changes t |
404 | "Internal flag to control if the OPascal mode responds to buffer changes. | |
405 | Defaults to t in case the `opascal-after-change' function is called on a | |
406 | non-OPascal buffer. Set to nil in OPascal buffers. To override, just do: | |
407 | (let ((opascal--ignore-changes t)) ...)") | |
e02f48d7 | 408 | |
c4f268a1 | 409 | (defun opascal-set-text-properties (from to properties) |
70492703 KH |
410 | ;; Like `set-text-properties', except we do not consider this to be a buffer |
411 | ;; modification. | |
c4f268a1 | 412 | (opascal-save-state |
70492703 KH |
413 | (set-text-properties from to properties))) |
414 | ||
c4f268a1 | 415 | (defun opascal-literal-kind (p) |
70492703 KH |
416 | ;; Returns the literal kind the point p is in (or nil if not in a literal). |
417 | (if (and (<= (point-min) p) (<= p (point-max))) | |
418 | (get-text-property p 'token))) | |
419 | ||
c4f268a1 | 420 | (defun opascal-literal-start-pattern (literal-kind) |
70492703 KH |
421 | ;; Returns the start pattern of the literal kind. |
422 | (cdr (assoc literal-kind | |
423 | '((comment-single-line . "//") | |
424 | (comment-multi-line-1 . "{") | |
425 | (comment-multi-line-2 . "(*") | |
426 | (string . "'") | |
427 | (double-quoted-string . "\""))))) | |
428 | ||
c4f268a1 | 429 | (defun opascal-literal-end-pattern (literal-kind) |
70492703 KH |
430 | ;; Returns the end pattern of the literal kind. |
431 | (cdr (assoc literal-kind | |
432 | '((comment-single-line . "\n") | |
433 | (comment-multi-line-1 . "}") | |
434 | (comment-multi-line-2 . "*)") | |
435 | (string . "'") | |
436 | (double-quoted-string . "\""))))) | |
437 | ||
c4f268a1 | 438 | (defun opascal-literal-stop-pattern (literal-kind) |
70492703 KH |
439 | ;; Returns the pattern that delimits end of the search for the literal kind. |
440 | ;; These are regular expressions. | |
441 | (cdr (assoc literal-kind | |
442 | '((comment-single-line . "\n") | |
443 | (comment-multi-line-1 . "}") | |
444 | (comment-multi-line-2 . "\\*)") | |
445 | ;; Strings cannot span lines. | |
446 | (string . "['\n]") | |
447 | (double-quoted-string . "[\"\n]"))))) | |
448 | ||
c4f268a1 | 449 | (defun opascal-is-literal-start (p) |
95c1652d | 450 | ;; True if the point p is at the start point of a (completed) literal. |
c4f268a1 SM |
451 | (let* ((kind (opascal-literal-kind p)) |
452 | (pattern (opascal-literal-start-pattern kind))) | |
70492703 | 453 | (or (null kind) ; Non-literals are considered as start points. |
c4f268a1 | 454 | (opascal-looking-at-string p pattern)))) |
70492703 | 455 | |
c4f268a1 | 456 | (defun opascal-is-literal-end (p) |
70492703 | 457 | ;; True if the point p is at the end point of a (completed) literal. |
c4f268a1 SM |
458 | (let* ((kind (opascal-literal-kind (1- p))) |
459 | (pattern (opascal-literal-end-pattern kind))) | |
70492703 KH |
460 | (or (null kind) ; Non-literals are considered as end points. |
461 | ||
c4f268a1 SM |
462 | (and (opascal-looking-at-string (- p (length pattern)) pattern) |
463 | (or (not (opascal-is kind opascal-strings)) | |
70492703 KH |
464 | ;; Special case: string delimiters are start/end ambiguous. |
465 | ;; We have an end only if there is some string content (at | |
466 | ;; least a starting delimiter). | |
c4f268a1 | 467 | (not (opascal-is-literal-end (1- p))))) |
a1506d29 | 468 | |
70492703 | 469 | ;; Special case: strings cannot span lines. |
c4f268a1 | 470 | (and (opascal-is kind opascal-strings) (eq ?\n (char-after (1- p))))))) |
70492703 | 471 | |
c4f268a1 | 472 | (defun opascal-is-stable-literal (p) |
70492703 KH |
473 | ;; True if the point p marks a stable point. That is, a point outside of a |
474 | ;; literal region, inside of a literal region, or adjacent to completed | |
475 | ;; literal regions. | |
c4f268a1 SM |
476 | (let ((at-start (opascal-is-literal-start p)) |
477 | (at-end (opascal-is-literal-end p))) | |
70492703 KH |
478 | (or (>= p (point-max)) |
479 | (and at-start at-end) | |
480 | (and (not at-start) (not at-end) | |
c4f268a1 | 481 | (eq (opascal-literal-kind (1- p)) (opascal-literal-kind p)))))) |
70492703 | 482 | |
c4f268a1 | 483 | (defun opascal-complete-literal (literal-kind limit) |
70492703 KH |
484 | ;; Continues the search for a literal's true end point and returns the |
485 | ;; point past the end pattern (if found) or the limit (if not found). | |
c4f268a1 | 486 | (let ((pattern (opascal-literal-stop-pattern literal-kind))) |
70492703 KH |
487 | (if (not (stringp pattern)) |
488 | (error "Invalid literal kind %S" literal-kind) | |
489 | ;; Search up to the limit. | |
490 | (re-search-forward pattern limit 'goto-limit-on-fail) | |
491 | (point)))) | |
492 | ||
c4f268a1 | 493 | (defun opascal-literal-text-properties (kind) |
70492703 KH |
494 | ;; Creates a list of text properties for the literal kind. |
495 | (if (and (boundp 'font-lock-mode) | |
496 | font-lock-mode) | |
c4f268a1 | 497 | (list 'token kind 'face (opascal-face-of kind) 'lazy-lock t) |
70492703 KH |
498 | (list 'token kind))) |
499 | ||
c4f268a1 | 500 | (defun opascal-parse-next-literal (limit) |
70492703 KH |
501 | ;; Searches for the next literal region (i.e. comment or string) and sets the |
502 | ;; the point to its end (or the limit, if not found). The literal region is | |
503 | ;; marked as such with a text property, to speed up tokenizing during face | |
504 | ;; coloring and indentation scanning. | |
505 | (let ((search-start (point))) | |
c4f268a1 | 506 | (cond ((not (opascal-is-literal-end search-start)) |
70492703 | 507 | ;; We are completing an incomplete literal. |
c4f268a1 SM |
508 | (let ((kind (opascal-literal-kind (1- search-start)))) |
509 | (opascal-complete-literal kind limit) | |
510 | (opascal-set-text-properties | |
511 | search-start (point) (opascal-literal-text-properties kind)))) | |
70492703 KH |
512 | |
513 | ((re-search-forward | |
514 | "\\(//\\)\\|\\({\\)\\|\\((\\*\\)\\|\\('\\)\\|\\(\"\\)" | |
515 | limit 'goto-limit-on-fail) | |
516 | ;; We found the start of a new literal. Find its end and mark it. | |
517 | (let ((kind (cond ((match-beginning 1) 'comment-single-line) | |
518 | ((match-beginning 2) 'comment-multi-line-1) | |
519 | ((match-beginning 3) 'comment-multi-line-2) | |
520 | ((match-beginning 4) 'string) | |
521 | ((match-beginning 5) 'double-quoted-string))) | |
522 | (start (match-beginning 0))) | |
c4f268a1 SM |
523 | (opascal-set-text-properties search-start start nil) |
524 | (opascal-complete-literal kind limit) | |
525 | (opascal-set-text-properties | |
526 | start (point) (opascal-literal-text-properties kind)))) | |
70492703 KH |
527 | |
528 | ;; Nothing found. Mark it as a non-literal. | |
c4f268a1 SM |
529 | ((opascal-set-text-properties search-start limit nil))) |
530 | (opascal-step-progress (point) "Parsing" opascal-parsing-progress-step))) | |
70492703 | 531 | |
c4f268a1 | 532 | (defun opascal-literal-token-at (p) |
70492703 | 533 | ;; Returns the literal token surrounding the point p, or nil if none. |
c4f268a1 | 534 | (let ((kind (opascal-literal-kind p))) |
70492703 KH |
535 | (when kind |
536 | (let ((start (previous-single-property-change (1+ p) 'token)) | |
537 | (end (next-single-property-change p 'token))) | |
c4f268a1 | 538 | (opascal-token-of kind (or start (point-min)) (or end (point-max))))))) |
70492703 | 539 | |
c4f268a1 | 540 | (defun opascal-point-token-at (p kind) |
70492703 | 541 | ;; Returns the single character token at the point p. |
c4f268a1 | 542 | (opascal-token-of kind p (1+ p))) |
70492703 | 543 | |
c4f268a1 | 544 | (defsubst opascal-char-token-at (p char kind) |
70492703 KH |
545 | ;; Returns the token at the point p that describes the specified character. |
546 | ;; If not actually over such a character, nil is returned. | |
547 | (when (eq char (char-after p)) | |
c4f268a1 | 548 | (opascal-token-of kind p (1+ p)))) |
70492703 | 549 | |
c4f268a1 | 550 | (defun opascal-charset-token-at (p charset kind) |
70492703 KH |
551 | ;; Returns the token surrounding point p that contains only members of the |
552 | ;; character set. | |
553 | (let ((currp (point)) | |
554 | (end nil) | |
70492703 KH |
555 | (token nil)) |
556 | (goto-char p) | |
557 | (when (> (skip-chars-forward charset) 0) | |
558 | (setq end (point)) | |
559 | (goto-char (1+ p)) | |
560 | (skip-chars-backward charset) | |
c4f268a1 | 561 | (setq token (opascal-token-of kind (point) end))) |
70492703 KH |
562 | (goto-char currp) |
563 | token)) | |
564 | ||
c4f268a1 | 565 | (defun opascal-space-token-at (p) |
70492703 KH |
566 | ;; If point p is surrounded by space characters, then return the token of the |
567 | ;; contiguous spaces. | |
c4f268a1 | 568 | (opascal-charset-token-at p opascal-space-chars 'space)) |
70492703 | 569 | |
c4f268a1 | 570 | (defun opascal-word-token-at (p) |
70492703 KH |
571 | ;; If point p is over a word (i.e. identifier characters), then return a word |
572 | ;; token. If the word is actually a keyword, then return the keyword token. | |
c4f268a1 | 573 | (let ((word (opascal-charset-token-at p opascal-word-chars 'word))) |
70492703 | 574 | (when word |
c4f268a1 | 575 | (let* ((word-image (downcase (opascal-token-string word))) |
70492703 KH |
576 | (keyword (intern-soft word-image))) |
577 | (when (and (or keyword (string= "nil" word-image)) | |
c4f268a1 SM |
578 | (opascal-is keyword opascal-keywords)) |
579 | (opascal-set-token-kind word keyword)) | |
70492703 KH |
580 | word)))) |
581 | ||
c4f268a1 | 582 | (defun opascal-explicit-token-at (p token-string kind) |
70492703 KH |
583 | ;; If point p is anywhere in the token string then returns the resulting |
584 | ;; token. | |
c4f268a1 SM |
585 | (let ((token (opascal-charset-token-at p token-string kind))) |
586 | (when (and token (string= token-string (opascal-token-string token))) | |
70492703 KH |
587 | token))) |
588 | ||
c4f268a1 | 589 | (defun opascal-token-at (p) |
70492703 KH |
590 | ;; Returns the token from parsing text at point p. |
591 | (when (and (<= (point-min) p) (<= p (point-max))) | |
c4f268a1 | 592 | (cond ((opascal-char-token-at p ?\n 'newline)) |
a11b38ee | 593 | |
c4f268a1 | 594 | ((opascal-literal-token-at p)) |
70492703 | 595 | |
c4f268a1 | 596 | ((opascal-space-token-at p)) |
70492703 | 597 | |
c4f268a1 | 598 | ((opascal-word-token-at p)) |
70492703 | 599 | |
c4f268a1 SM |
600 | ((opascal-char-token-at p ?\( 'open-group)) |
601 | ((opascal-char-token-at p ?\) 'close-group)) | |
602 | ((opascal-char-token-at p ?\[ 'open-group)) | |
603 | ((opascal-char-token-at p ?\] 'close-group)) | |
604 | ((opascal-char-token-at p ?\; 'semicolon)) | |
605 | ((opascal-char-token-at p ?. 'dot)) | |
606 | ((opascal-char-token-at p ?, 'comma)) | |
607 | ((opascal-char-token-at p ?= 'equals)) | |
608 | ((opascal-char-token-at p ?+ 'plus)) | |
609 | ((opascal-char-token-at p ?- 'minus)) | |
610 | ((opascal-char-token-at p ?* 'times)) | |
611 | ((opascal-char-token-at p ?/ 'divides)) | |
612 | ((opascal-char-token-at p ?: 'colon)) | |
70492703 | 613 | |
c4f268a1 | 614 | ((opascal-explicit-token-at p "<>" 'not-equals)) |
70492703 | 615 | |
c4f268a1 | 616 | ((opascal-point-token-at p 'punctuation))))) |
70492703 | 617 | |
c4f268a1 SM |
618 | (defun opascal-current-token () |
619 | ;; Returns the opascal source token under the current point. | |
620 | (opascal-token-at (point))) | |
70492703 | 621 | |
c4f268a1 | 622 | (defun opascal-next-token (token) |
70492703 KH |
623 | ;; Returns the token after the specified token. |
624 | (when token | |
c4f268a1 | 625 | (let ((next (opascal-token-at (opascal-token-end token)))) |
70492703 | 626 | (if next |
c4f268a1 SM |
627 | (opascal-step-progress (opascal-token-start next) "Scanning" |
628 | opascal-scanning-progress-step)) | |
70492703 KH |
629 | next))) |
630 | ||
c4f268a1 | 631 | (defun opascal-previous-token (token) |
70492703 KH |
632 | ;; Returns the token before the specified token. |
633 | (when token | |
c4f268a1 | 634 | (let ((previous (opascal-token-at (1- (opascal-token-start token))))) |
70492703 | 635 | (if previous |
c4f268a1 SM |
636 | (opascal-step-progress (opascal-token-start previous) "Scanning" |
637 | opascal-scanning-progress-step)) | |
70492703 KH |
638 | previous))) |
639 | ||
c4f268a1 | 640 | (defun opascal-next-visible-token (token) |
70492703 KH |
641 | ;; Returns the first non-space token after the specified token. |
642 | (let (next-token) | |
643 | (while (progn | |
c4f268a1 SM |
644 | (setq next-token (opascal-next-token token)) |
645 | (opascal-is (opascal-token-kind next-token) '(space newline)))) | |
70492703 KH |
646 | next-token)) |
647 | ||
c4f268a1 | 648 | (defun opascal-parse-region (from to) |
70492703 KH |
649 | ;; Parses the literal tokens in the region. The point is set to "to". |
650 | (save-restriction | |
651 | (widen) | |
652 | (goto-char from) | |
653 | (while (< (point) to) | |
c4f268a1 | 654 | (opascal-parse-next-literal to)))) |
70492703 | 655 | |
c4f268a1 | 656 | (defun opascal-parse-region-until-stable (from to) |
70492703 KH |
657 | ;; Parses at least the literal tokens in the region. After that, parsing |
658 | ;; continues as long as obsolete literal regions are encountered. The point | |
659 | ;; is set to the encountered stable point. | |
660 | (save-restriction | |
661 | (widen) | |
c4f268a1 SM |
662 | (opascal-parse-region from to) |
663 | (while (not (opascal-is-stable-literal (point))) | |
664 | (opascal-parse-next-literal (point-max))))) | |
665 | ||
666 | (defun opascal-fontify-region (from to &optional verbose) | |
667 | ;; Colors the text in the region according to OPascal rules. | |
668 | (opascal-save-excursion | |
669 | (opascal-save-state | |
70492703 | 670 | (let ((p from) |
c4f268a1 | 671 | (opascal-verbose verbose) |
70492703 | 672 | (token nil)) |
c4f268a1 | 673 | (opascal-progress-start) |
70492703 KH |
674 | (while (< p to) |
675 | ;; Color the token and move past it. | |
c4f268a1 | 676 | (setq token (opascal-token-at p)) |
a1506d29 | 677 | (add-text-properties |
c4f268a1 SM |
678 | (opascal-token-start token) (opascal-token-end token) |
679 | (list 'face (opascal-face-of (opascal-token-kind token)) 'lazy-lock t)) | |
680 | (setq p (opascal-token-end token)) | |
681 | (opascal-step-progress p "Fontifying" opascal-fontifying-progress-step)) | |
682 | (opascal-progress-done))))) | |
70492703 | 683 | |
c4f268a1 | 684 | (defun opascal-after-change (change-start change-end _old-length) |
70492703 | 685 | ;; Called when the buffer has changed. Reparses the changed region. |
c4f268a1 SM |
686 | (unless opascal--ignore-changes |
687 | (let ((opascal--ignore-changes t)) ; Prevent recursive calls. | |
688 | (opascal-save-excursion | |
689 | (opascal-progress-start) | |
70492703 KH |
690 | ;; Reparse at least from the token previous to the change to the end of |
691 | ;; line after the change. | |
c4f268a1 SM |
692 | (opascal-parse-region-until-stable |
693 | (opascal-token-start (opascal-token-at (1- change-start))) | |
70492703 | 694 | (progn (goto-char change-end) (end-of-line) (point))) |
c4f268a1 | 695 | (opascal-progress-done))))) |
70492703 | 696 | |
c4f268a1 | 697 | (defun opascal-group-start (from-token) |
70492703 | 698 | ;; Returns the token that denotes the start of the ()/[] group. |
c4f268a1 | 699 | (let ((token (opascal-previous-token from-token)) |
70492703 KH |
700 | (token-kind nil)) |
701 | (catch 'done | |
702 | (while token | |
c4f268a1 | 703 | (setq token-kind (opascal-token-kind token)) |
70492703 KH |
704 | (cond |
705 | ;; Skip over nested groups. | |
c4f268a1 | 706 | ((eq 'close-group token-kind) (setq token (opascal-group-start token))) |
70492703 | 707 | ((eq 'open-group token-kind) (throw 'done token))) |
c4f268a1 | 708 | (setq token (opascal-previous-token token))) |
70492703 KH |
709 | ;; Start not found. |
710 | nil))) | |
711 | ||
c4f268a1 | 712 | (defun opascal-group-end (from-token) |
70492703 | 713 | ;; Returns the token that denotes the end of the ()/[] group. |
c4f268a1 | 714 | (let ((token (opascal-next-token from-token)) |
70492703 KH |
715 | (token-kind nil)) |
716 | (catch 'done | |
717 | (while token | |
c4f268a1 | 718 | (setq token-kind (opascal-token-kind token)) |
70492703 KH |
719 | (cond |
720 | ;; Skip over nested groups. | |
c4f268a1 | 721 | ((eq 'open-group token-kind) (setq token (opascal-group-end token))) |
70492703 | 722 | ((eq 'close-group token-kind) (throw 'done token))) |
c4f268a1 | 723 | (setq token (opascal-next-token token))) |
70492703 KH |
724 | ;; end not found. |
725 | nil))) | |
726 | ||
c4f268a1 | 727 | (defun opascal-indent-of (token &optional offset) |
70492703 | 728 | ;; Returns the start column of the token, plus any offset. |
c4f268a1 | 729 | (let ((indent (+ (opascal-column-of (opascal-token-start token)) |
70492703 | 730 | (if offset offset 0)))) |
c4f268a1 SM |
731 | (when opascal-debug |
732 | (opascal-debug-log | |
70492703 KH |
733 | (concat "\n Indent of: %S %S" |
734 | "\n column: %d indent: %d offset: %d") | |
c4f268a1 SM |
735 | token (opascal-token-string token) |
736 | (opascal-column-of (opascal-token-start token)) | |
70492703 KH |
737 | indent (if offset offset 0))) |
738 | indent)) | |
739 | ||
c4f268a1 | 740 | (defun opascal-line-indent-of (from-token &optional offset &rest terminators) |
70492703 KH |
741 | ;; Returns the column of first non-space character on the token's line, plus |
742 | ;; any offset. We also stop if one of the terminators or an open ( or [ is | |
743 | ;; encountered. | |
c4f268a1 | 744 | (let ((token (opascal-previous-token from-token)) |
70492703 KH |
745 | (last-token from-token) |
746 | (kind nil)) | |
747 | (catch 'done | |
748 | (while token | |
c4f268a1 | 749 | (setq kind (opascal-token-kind token)) |
a1506d29 | 750 | (cond |
70492703 | 751 | ;; Skip over ()/[] groups. |
c4f268a1 | 752 | ((eq 'close-group kind) (setq token (opascal-group-start token))) |
70492703 KH |
753 | |
754 | ;; Stop at the beginning of the line or an open group. | |
c4f268a1 | 755 | ((opascal-is kind '(newline open-group)) (throw 'done nil)) |
70492703 KH |
756 | |
757 | ;; Stop at one of the specified terminators. | |
c4f268a1 SM |
758 | ((opascal-is kind terminators) (throw 'done nil))) |
759 | (unless (opascal-is kind opascal-whitespace) (setq last-token token)) | |
760 | (setq token (opascal-previous-token token)))) | |
761 | (opascal-indent-of last-token offset))) | |
70492703 | 762 | |
c4f268a1 SM |
763 | (defun opascal-stmt-line-indent-of (from-token &optional offset) |
764 | ;; Like `opascal-line-indent-of' except is also stops on a use clause, and | |
95c1652d | 765 | ;; colons that precede statements (i.e. case labels). |
c4f268a1 | 766 | (let ((token (opascal-previous-token from-token)) |
95c1652d RB |
767 | (last-token from-token) |
768 | (kind nil)) | |
769 | (catch 'done | |
770 | (while token | |
c4f268a1 | 771 | (setq kind (opascal-token-kind token)) |
a1506d29 | 772 | (cond |
95c1652d | 773 | ((and (eq 'colon kind) |
c4f268a1 SM |
774 | (opascal-is (opascal-token-kind last-token) |
775 | `(,@opascal-block-statements | |
776 | ,@opascal-expr-statements))) | |
95c1652d RB |
777 | ;; We hit a label followed by a statement. Indent to the statement. |
778 | (throw 'done nil)) | |
779 | ||
780 | ;; Skip over ()/[] groups. | |
c4f268a1 | 781 | ((eq 'close-group kind) (setq token (opascal-group-start token))) |
95c1652d | 782 | |
c4f268a1 | 783 | ((opascal-is kind `(newline open-group ,@opascal-use-clauses)) |
95c1652d RB |
784 | ;; Stop at the beginning of the line, an open group, or a use clause |
785 | (throw 'done nil))) | |
c4f268a1 SM |
786 | (unless (opascal-is kind opascal-whitespace) (setq last-token token)) |
787 | (setq token (opascal-previous-token token)))) | |
788 | (opascal-indent-of last-token offset))) | |
70492703 | 789 | |
c4f268a1 | 790 | (defun opascal-open-group-indent (token last-token &optional offset) |
70492703 | 791 | ;; Returns the indent relative to an unmatched ( or [. |
c4f268a1 | 792 | (when (eq 'open-group (opascal-token-kind token)) |
70492703 | 793 | (if last-token |
c4f268a1 | 794 | (opascal-indent-of last-token offset) |
70492703 | 795 | ;; There is nothing following the ( or [. Indent from its line. |
c4f268a1 | 796 | (opascal-stmt-line-indent-of token opascal-indent-level)))) |
70492703 | 797 | |
c4f268a1 | 798 | (defun opascal-composite-type-start (token last-token) |
c05423d4 CY |
799 | ;; Returns true (actually the last-token) if the pair equals (= class), (= |
800 | ;; dispinterface), (= interface), (= object), or (= record), and nil | |
801 | ;; otherwise. | |
c4f268a1 SM |
802 | (if (and (eq 'equals (opascal-token-kind token)) |
803 | (opascal-is (opascal-token-kind last-token) opascal-composite-types)) | |
70492703 KH |
804 | last-token)) |
805 | ||
c4f268a1 | 806 | (defun opascal-is-simple-class-type (at-token limit-token) |
70492703 KH |
807 | ;; True if at-token is the start of a simple class type. E.g. |
808 | ;; class of TClass; | |
809 | ;; class (TBaseClass); | |
810 | ;; class; | |
c4f268a1 | 811 | (when (opascal-is (opascal-token-kind at-token) opascal-class-types) |
70492703 KH |
812 | (catch 'done |
813 | ;; Scan until the semi colon. | |
c4f268a1 | 814 | (let ((token (opascal-next-token at-token)) |
70492703 | 815 | (token-kind nil) |
c4f268a1 SM |
816 | (limit (opascal-token-start limit-token))) |
817 | (while (and token (<= (opascal-token-start token) limit)) | |
818 | (setq token-kind (opascal-token-kind token)) | |
70492703 KH |
819 | (cond |
820 | ;; A semicolon delimits the search. | |
821 | ((eq 'semicolon token-kind) (throw 'done token)) | |
822 | ||
823 | ;; Skip over the inheritance list. | |
c4f268a1 | 824 | ((eq 'open-group token-kind) (setq token (opascal-group-end token))) |
70492703 KH |
825 | |
826 | ;; Only allow "of" and whitespace, and an identifier | |
c4f268a1 | 827 | ((opascal-is token-kind `(of word ,@opascal-whitespace))) |
70492703 KH |
828 | |
829 | ;; Otherwise we are not in a simple class declaration. | |
830 | ((throw 'done nil))) | |
c4f268a1 | 831 | (setq token (opascal-next-token token))))))) |
70492703 | 832 | |
c4f268a1 | 833 | (defun opascal-block-start (from-token &optional stop-on-class) |
70492703 | 834 | ;; Returns the token that denotes the start of the block. |
c4f268a1 | 835 | (let ((token (opascal-previous-token from-token)) |
70492703 KH |
836 | (last-token nil) |
837 | (token-kind nil)) | |
838 | (catch 'done | |
839 | (while token | |
c4f268a1 | 840 | (setq token-kind (opascal-token-kind token)) |
70492703 KH |
841 | (cond |
842 | ;; Skip over nested blocks. | |
c4f268a1 SM |
843 | ((opascal-is token-kind opascal-end-block-statements) |
844 | (setq token (opascal-block-start token))) | |
70492703 KH |
845 | |
846 | ;; Regular block start found. | |
c4f268a1 | 847 | ((opascal-is token-kind opascal-block-statements) |
2c6a779a SS |
848 | (throw 'done |
849 | ;; As a special case, when a "case" block appears | |
850 | ;; within a record declaration (to denote a variant | |
851 | ;; part), the record declaration should be considered | |
852 | ;; the enclosing block. | |
853 | (if (eq 'case token-kind) | |
854 | (let ((enclosing-token | |
c4f268a1 | 855 | (opascal-block-start token |
2c6a779a SS |
856 | 'stop-on-class))) |
857 | (if | |
858 | (eq 'record | |
c4f268a1 | 859 | (opascal-token-kind enclosing-token)) |
2c6a779a SS |
860 | (if stop-on-class |
861 | enclosing-token | |
c4f268a1 | 862 | (opascal-previous-token enclosing-token)) |
2c6a779a SS |
863 | token)) |
864 | token))) | |
70492703 KH |
865 | |
866 | ;; A class/record start also begins a block. | |
c4f268a1 | 867 | ((opascal-composite-type-start token last-token) |
70492703 KH |
868 | (throw 'done (if stop-on-class last-token token))) |
869 | ) | |
c4f268a1 | 870 | (unless (opascal-is token-kind opascal-whitespace) |
70492703 | 871 | (setq last-token token)) |
c4f268a1 | 872 | (setq token (opascal-previous-token token))) |
70492703 KH |
873 | ;; Start not found. |
874 | nil))) | |
875 | ||
c4f268a1 | 876 | (defun opascal-else-start (from-else) |
70492703 | 877 | ;; Returns the token of the if or case statement. |
c4f268a1 | 878 | (let ((token (opascal-previous-token from-else)) |
70492703 | 879 | (token-kind nil) |
e02f48d7 | 880 | (semicolon-count 0)) |
70492703 KH |
881 | (catch 'done |
882 | (while token | |
c4f268a1 | 883 | (setq token-kind (opascal-token-kind token)) |
70492703 KH |
884 | (cond |
885 | ;; Skip over nested groups. | |
c4f268a1 | 886 | ((eq 'close-group token-kind) (setq token (opascal-group-start token))) |
70492703 KH |
887 | |
888 | ;; Skip over any nested blocks. | |
c4f268a1 SM |
889 | ((opascal-is token-kind opascal-end-block-statements) |
890 | (setq token (opascal-block-start token))) | |
70492703 KH |
891 | |
892 | ((eq 'semicolon token-kind) | |
893 | ;; Semicolon means we are looking for an enclosing if, unless we | |
894 | ;; are in a case statement. Keep counts of the semicolons and decide | |
895 | ;; later. | |
896 | (setq semicolon-count (1+ semicolon-count))) | |
897 | ||
898 | ((and (eq 'if token-kind) (= semicolon-count 0)) | |
899 | ;; We only can match an if when there have been no intervening | |
900 | ;; semicolons. | |
901 | (throw 'done token)) | |
902 | ||
903 | ((eq 'case token-kind) | |
904 | ;; We have hit a case statement start. | |
905 | (throw 'done token))) | |
c4f268a1 | 906 | (setq token (opascal-previous-token token))) |
70492703 KH |
907 | ;; No if or case statement found. |
908 | nil))) | |
909 | ||
c4f268a1 | 910 | (defun opascal-comment-content-start (comment) |
70492703 | 911 | ;; Returns the point of the first non-space character in the comment. |
c4f268a1 SM |
912 | (let ((kind (opascal-token-kind comment))) |
913 | (when (opascal-is kind opascal-comments) | |
914 | (opascal-save-excursion | |
915 | (goto-char (+ (opascal-token-start comment) | |
916 | (length (opascal-literal-start-pattern kind)))) | |
917 | (skip-chars-forward opascal-space-chars) | |
70492703 KH |
918 | (point))))) |
919 | ||
c4f268a1 | 920 | (defun opascal-comment-block-start (comment) |
70492703 KH |
921 | ;; Returns the starting comment token of a contiguous // comment block. If |
922 | ;; the comment is multiline (i.e. {...} or (*...*)), the original comment is | |
923 | ;; returned. | |
c4f268a1 | 924 | (if (not (eq 'comment-single-line (opascal-token-kind comment))) |
70492703 KH |
925 | comment |
926 | ;; Scan until we run out of // comments. | |
927 | (let ((prev-comment comment) | |
e02f48d7 | 928 | (start-comment comment)) |
c4f268a1 | 929 | (while (let ((kind (opascal-token-kind prev-comment))) |
70492703 KH |
930 | (cond ((eq kind 'space)) |
931 | ((eq kind 'comment-single-line) | |
932 | (setq start-comment prev-comment)) | |
933 | (t nil))) | |
c4f268a1 | 934 | (setq prev-comment (opascal-previous-token prev-comment))) |
70492703 KH |
935 | start-comment))) |
936 | ||
c4f268a1 | 937 | (defun opascal-comment-block-end (comment) |
70492703 KH |
938 | ;; Returns the end comment token of a contiguous // comment block. If the |
939 | ;; comment is multiline (i.e. {...} or (*...*)), the original comment is | |
940 | ;; returned. | |
c4f268a1 | 941 | (if (not (eq 'comment-single-line (opascal-token-kind comment))) |
70492703 KH |
942 | comment |
943 | ;; Scan until we run out of // comments. | |
944 | (let ((next-comment comment) | |
e02f48d7 | 945 | (end-comment comment)) |
c4f268a1 | 946 | (while (let ((kind (opascal-token-kind next-comment))) |
70492703 KH |
947 | (cond ((eq kind 'space)) |
948 | ((eq kind 'comment-single-line) | |
949 | (setq end-comment next-comment)) | |
950 | (t nil))) | |
c4f268a1 | 951 | (setq next-comment (opascal-next-token next-comment))) |
70492703 KH |
952 | end-comment))) |
953 | ||
c4f268a1 | 954 | (defun opascal-on-first-comment-line (comment) |
70492703 KH |
955 | ;; Returns true if the current point is on the first line of the comment. |
956 | (save-excursion | |
c4f268a1 | 957 | (let ((comment-start (opascal-token-start comment)) |
70492703 KH |
958 | (current-point (point))) |
959 | (goto-char comment-start) | |
960 | (end-of-line) | |
961 | (and (<= comment-start current-point) (<= current-point (point)))))) | |
962 | ||
c4f268a1 | 963 | (defun opascal-comment-indent-of (comment) |
70492703 | 964 | ;; Returns the correct indentation for the comment. |
c4f268a1 | 965 | (let ((start-comment (opascal-comment-block-start comment))) |
70492703 | 966 | (if (and (eq start-comment comment) |
c4f268a1 | 967 | (opascal-on-first-comment-line comment)) |
70492703 | 968 | ;; Indent as a statement. |
c4f268a1 | 969 | (opascal-enclosing-indent-of comment) |
70492703 | 970 | (save-excursion |
c4f268a1 | 971 | (let ((kind (opascal-token-kind comment))) |
70492703 KH |
972 | (beginning-of-line) |
973 | (cond ((eq 'comment-single-line kind) | |
974 | ;; Indent to the first comment in the // block. | |
c4f268a1 | 975 | (opascal-indent-of start-comment)) |
70492703 | 976 | |
c4f268a1 SM |
977 | ((looking-at (concat opascal-leading-spaces-re |
978 | (opascal-literal-stop-pattern kind))) | |
70492703 | 979 | ;; Indent multi-line comment terminators to the comment start. |
c4f268a1 | 980 | (opascal-indent-of comment)) |
70492703 KH |
981 | |
982 | ;; Indent according to the comment's content start. | |
c4f268a1 | 983 | ((opascal-column-of (opascal-comment-content-start comment))))))) |
70492703 KH |
984 | )) |
985 | ||
c4f268a1 | 986 | (defun opascal-is-use-clause-end (at-token last-token last-colon from-kind) |
70492703 | 987 | ;; True if we are after the end of a uses type clause. |
a1506d29 | 988 | (when (and last-token |
70492703 | 989 | (not last-colon) |
c4f268a1 | 990 | (eq 'comma (opascal-token-kind at-token)) |
70492703 KH |
991 | (eq 'semicolon from-kind)) |
992 | ;; Scan for the uses statement, just to be sure. | |
c4f268a1 | 993 | (let ((token (opascal-previous-token at-token)) |
70492703 KH |
994 | (token-kind nil)) |
995 | (catch 'done | |
996 | (while token | |
c4f268a1 SM |
997 | (setq token-kind (opascal-token-kind token)) |
998 | (cond ((opascal-is token-kind opascal-use-clauses) | |
70492703 KH |
999 | (throw 'done t)) |
1000 | ||
1001 | ;; Whitespace, identifiers, strings, "in" keyword, and commas | |
1002 | ;; are allowed in use clauses. | |
c4f268a1 SM |
1003 | ((or (opascal-is token-kind '(word comma in newline)) |
1004 | (opascal-is token-kind opascal-whitespace) | |
1005 | (opascal-is token-kind opascal-strings))) | |
70492703 KH |
1006 | |
1007 | ;; Nothing else is. | |
1008 | ((throw 'done nil))) | |
c4f268a1 | 1009 | (setq token (opascal-previous-token token))) |
70492703 KH |
1010 | nil)))) |
1011 | ||
c4f268a1 | 1012 | (defun opascal-is-block-after-expr-statement (token) |
70492703 KH |
1013 | ;; Returns true if we have a block token trailing an expression delimiter (of |
1014 | ;; presumably an expression statement). | |
c4f268a1 SM |
1015 | (when (opascal-is (opascal-token-kind token) opascal-block-statements) |
1016 | (let ((previous (opascal-previous-token token)) | |
70492703 KH |
1017 | (previous-kind nil)) |
1018 | (while (progn | |
c4f268a1 | 1019 | (setq previous-kind (opascal-token-kind previous)) |
70492703 | 1020 | (eq previous-kind 'space)) |
c4f268a1 SM |
1021 | (setq previous (opascal-previous-token previous))) |
1022 | (or (opascal-is previous-kind opascal-expr-delimiters) | |
70492703 KH |
1023 | (eq previous-kind 'else))))) |
1024 | ||
c4f268a1 | 1025 | (defun opascal-previous-indent-of (from-token) |
70492703 | 1026 | ;; Returns the indentation of the previous statement of the token. |
c4f268a1 | 1027 | (let ((token (opascal-previous-token from-token)) |
70492703 | 1028 | (token-kind nil) |
c4f268a1 | 1029 | (from-kind (opascal-token-kind from-token)) |
70492703 | 1030 | (last-colon nil) |
2c6a779a | 1031 | (last-of nil) |
70492703 KH |
1032 | (last-token nil)) |
1033 | (catch 'done | |
1034 | (while token | |
c4f268a1 | 1035 | (setq token-kind (opascal-token-kind token)) |
70492703 KH |
1036 | (cond |
1037 | ;; An open ( or [ always is an indent point. | |
1038 | ((eq 'open-group token-kind) | |
c4f268a1 | 1039 | (throw 'done (opascal-open-group-indent token last-token))) |
70492703 KH |
1040 | |
1041 | ;; Skip over any ()/[] groups. | |
c4f268a1 | 1042 | ((eq 'close-group token-kind) (setq token (opascal-group-start token))) |
70492703 | 1043 | |
c4f268a1 SM |
1044 | ((opascal-is token-kind opascal-end-block-statements) |
1045 | (if (eq 'newline (opascal-token-kind (opascal-previous-token token))) | |
70492703 KH |
1046 | ;; We can stop at an end token that is right up against the |
1047 | ;; margin. | |
1048 | (throw 'done 0) | |
1049 | ;; Otherwise, skip over any nested blocks. | |
c4f268a1 | 1050 | (setq token (opascal-block-start token)))) |
70492703 KH |
1051 | |
1052 | ;; Special case: if we encounter a ", word;" then we assume that we | |
1053 | ;; are in some kind of uses clause, and thus indent to column 0. This | |
1054 | ;; works because no other constructs are known to have that form. | |
1055 | ;; This fixes the irritating case of having indents after a uses | |
1056 | ;; clause look like: | |
1057 | ;; uses | |
1058 | ;; someUnit, | |
1059 | ;; someOtherUnit; | |
1060 | ;; // this should be at column 0! | |
c4f268a1 | 1061 | ((opascal-is-use-clause-end token last-token last-colon from-kind) |
70492703 KH |
1062 | (throw 'done 0)) |
1063 | ||
1064 | ;; A previous terminator means we can stop. If we are on a directive, | |
1065 | ;; however, then we are not actually encountering a new statement. | |
1066 | ((and last-token | |
c4f268a1 SM |
1067 | (opascal-is token-kind opascal-previous-terminators) |
1068 | (not (opascal-is (opascal-token-kind last-token) | |
1069 | opascal-directives))) | |
1070 | (throw 'done (opascal-stmt-line-indent-of last-token 0))) | |
70492703 KH |
1071 | |
1072 | ;; Ignore whitespace. | |
c4f268a1 | 1073 | ((opascal-is token-kind opascal-whitespace)) |
70492703 | 1074 | |
2c6a779a SS |
1075 | ;; Remember any "of" we encounter, since that affects how we |
1076 | ;; indent to a case statement within a record declaration | |
1077 | ;; (i.e. a variant part). | |
1078 | ((eq 'of token-kind) | |
1079 | (setq last-of token)) | |
1080 | ||
1081 | ;; Remember any ':' we encounter (until we reach an "of"), | |
1082 | ;; since that affects how we indent to case statements in | |
1083 | ;; general. | |
1084 | ((eq 'colon token-kind) | |
1085 | (unless last-of (setq last-colon token))) | |
70492703 KH |
1086 | |
1087 | ;; A case statement delimits a previous statement. We indent labels | |
1088 | ;; specially. | |
1089 | ((eq 'case token-kind) | |
1090 | (throw 'done | |
c4f268a1 SM |
1091 | (if last-colon (opascal-line-indent-of last-colon) |
1092 | (opascal-line-indent-of token opascal-case-label-indent)))) | |
70492703 KH |
1093 | |
1094 | ;; If we are in a use clause then commas mark an enclosing rather than | |
1095 | ;; a previous statement. | |
c4f268a1 | 1096 | ((opascal-is token-kind opascal-use-clauses) |
70492703 KH |
1097 | (throw 'done |
1098 | (if (eq 'comma from-kind) | |
1099 | (if last-token | |
1100 | ;; Indent to first unit in use clause. | |
c4f268a1 | 1101 | (opascal-indent-of last-token) |
70492703 | 1102 | ;; Indent from use clause keyword. |
c4f268a1 | 1103 | (opascal-line-indent-of token opascal-indent-level)) |
70492703 | 1104 | ;; Indent to use clause keyword. |
c4f268a1 | 1105 | (opascal-line-indent-of token)))) |
70492703 | 1106 | |
06c24636 | 1107 | ;; Assembly sections always indent in from the asm keyword. |
a1506d29 | 1108 | ((eq token-kind 'asm) |
c4f268a1 | 1109 | (throw 'done (opascal-stmt-line-indent-of token opascal-indent-level))) |
06c24636 | 1110 | |
70492703 KH |
1111 | ;; An enclosing statement delimits a previous statement. |
1112 | ;; We try to use the existing indent of the previous statement, | |
1113 | ;; otherwise we calculate from the enclosing statement. | |
c4f268a1 | 1114 | ((opascal-is token-kind opascal-previous-enclosing-statements) |
06c24636 RB |
1115 | (throw 'done (if last-token |
1116 | ;; Otherwise indent to the last token | |
c4f268a1 | 1117 | (opascal-line-indent-of last-token) |
06c24636 | 1118 | ;; Just indent from the enclosing keyword |
c4f268a1 | 1119 | (opascal-line-indent-of token opascal-indent-level)))) |
70492703 KH |
1120 | |
1121 | ;; A class or record declaration also delimits a previous statement. | |
c4f268a1 | 1122 | ((opascal-composite-type-start token last-token) |
70492703 KH |
1123 | (throw |
1124 | 'done | |
c4f268a1 | 1125 | (if (opascal-is-simple-class-type last-token from-token) |
70492703 | 1126 | ;; c = class; or c = class of T; are previous statements. |
c4f268a1 | 1127 | (opascal-line-indent-of token) |
70492703 KH |
1128 | ;; Otherwise c = class ... or r = record ... are enclosing |
1129 | ;; statements. | |
c4f268a1 | 1130 | (opascal-line-indent-of last-token opascal-indent-level)))) |
70492703 KH |
1131 | |
1132 | ;; We have a definite previous statement delimiter. | |
c4f268a1 SM |
1133 | ((opascal-is token-kind opascal-previous-statements) |
1134 | (throw 'done (opascal-stmt-line-indent-of token 0))) | |
70492703 | 1135 | ) |
c4f268a1 | 1136 | (unless (opascal-is token-kind opascal-whitespace) |
70492703 | 1137 | (setq last-token token)) |
c4f268a1 | 1138 | (setq token (opascal-previous-token token))) |
70492703 KH |
1139 | ;; We ran out of tokens. Indent to column 0. |
1140 | 0))) | |
1141 | ||
c4f268a1 | 1142 | (defun opascal-section-indent-of (section-token) |
70492703 KH |
1143 | ;; Returns the indentation appropriate for begin/var/const/type/label |
1144 | ;; tokens. | |
c4f268a1 | 1145 | (let* ((token (opascal-previous-token section-token)) |
70492703 KH |
1146 | (token-kind nil) |
1147 | (last-token nil) | |
1148 | (nested-block-count 0) | |
1149 | (expr-delimited nil) | |
1150 | (last-terminator nil)) | |
1151 | (catch 'done | |
1152 | (while token | |
c4f268a1 | 1153 | (setq token-kind (opascal-token-kind token)) |
70492703 KH |
1154 | (cond |
1155 | ;; Always stop at unmatched ( or [. | |
1156 | ((eq token-kind 'open-group) | |
c4f268a1 | 1157 | (throw 'done (opascal-open-group-indent token last-token))) |
70492703 KH |
1158 | |
1159 | ;; Skip over any ()/[] groups. | |
c4f268a1 | 1160 | ((eq 'close-group token-kind) (setq token (opascal-group-start token))) |
70492703 | 1161 | |
c4f268a1 SM |
1162 | ((opascal-is token-kind opascal-end-block-statements) |
1163 | (if (eq 'newline (opascal-token-kind (opascal-previous-token token))) | |
70492703 KH |
1164 | ;; We can stop at an end token that is right up against the |
1165 | ;; margin. | |
1166 | (throw 'done 0) | |
1167 | ;; Otherwise, skip over any nested blocks. | |
c4f268a1 | 1168 | (setq token (opascal-block-start token) |
70492703 KH |
1169 | nested-block-count (1+ nested-block-count)))) |
1170 | ||
1171 | ;; Remember if we have encountered any forward routine declarations. | |
1172 | ((eq 'forward token-kind) | |
1173 | (setq nested-block-count (1+ nested-block-count))) | |
1174 | ||
1175 | ;; Mark the completion of a nested routine traversal. | |
c4f268a1 | 1176 | ((and (opascal-is token-kind opascal-routine-statements) |
70492703 KH |
1177 | (> nested-block-count 0)) |
1178 | (setq nested-block-count (1- nested-block-count))) | |
1179 | ||
1180 | ;; Remember if we have encountered any statement terminators. | |
1181 | ((eq 'semicolon token-kind) (setq last-terminator token)) | |
1182 | ||
1183 | ;; Remember if we have encountered any expression delimiters. | |
c4f268a1 | 1184 | ((opascal-is token-kind opascal-expr-delimiters) |
70492703 KH |
1185 | (setq expr-delimited token)) |
1186 | ||
1187 | ;; Enclosing body statements are delimiting. We indent the compound | |
1188 | ;; bodies specially. | |
1189 | ((and (not last-terminator) | |
c4f268a1 | 1190 | (opascal-is token-kind opascal-body-statements)) |
70492703 | 1191 | (throw 'done |
c4f268a1 | 1192 | (opascal-stmt-line-indent-of token opascal-compound-block-indent))) |
70492703 KH |
1193 | |
1194 | ;; An enclosing ":" means a label. | |
1195 | ((and (eq 'colon token-kind) | |
c4f268a1 SM |
1196 | (opascal-is (opascal-token-kind section-token) |
1197 | opascal-block-statements) | |
70492703 KH |
1198 | (not last-terminator) |
1199 | (not expr-delimited) | |
c4f268a1 | 1200 | (not (eq 'equals (opascal-token-kind last-token)))) |
70492703 | 1201 | (throw 'done |
c4f268a1 | 1202 | (opascal-stmt-line-indent-of token opascal-indent-level))) |
70492703 KH |
1203 | |
1204 | ;; Block and mid block tokens are always enclosing | |
c4f268a1 | 1205 | ((opascal-is token-kind opascal-begin-enclosing-tokens) |
70492703 | 1206 | (throw 'done |
c4f268a1 | 1207 | (opascal-stmt-line-indent-of token opascal-indent-level))) |
70492703 KH |
1208 | |
1209 | ;; Declaration sections and routines are delimiters, unless they | |
1210 | ;; are part of a nested routine. | |
c4f268a1 | 1211 | ((and (opascal-is token-kind opascal-decl-delimiters) |
70492703 | 1212 | (= 0 nested-block-count)) |
c4f268a1 | 1213 | (throw 'done (opascal-line-indent-of token 0))) |
70492703 KH |
1214 | |
1215 | ;; Unit statements mean we indent right to the left. | |
c4f268a1 | 1216 | ((opascal-is token-kind opascal-unit-statements) (throw 'done 0)) |
70492703 | 1217 | ) |
c4f268a1 | 1218 | (unless (opascal-is token-kind opascal-whitespace) |
70492703 | 1219 | (setq last-token token)) |
c4f268a1 | 1220 | (setq token (opascal-previous-token token))) |
70492703 KH |
1221 | ;; We ran out of tokens. Indent to column 0. |
1222 | 0))) | |
1223 | ||
c4f268a1 | 1224 | (defun opascal-enclosing-indent-of (from-token) |
70492703 | 1225 | ;; Returns the indentation offset from the enclosing statement of the token. |
c4f268a1 SM |
1226 | (let ((token (opascal-previous-token from-token)) |
1227 | (from-kind (opascal-token-kind from-token)) | |
70492703 KH |
1228 | (token-kind nil) |
1229 | (stmt-start nil) | |
a1506d29 | 1230 | (last-token nil) |
70492703 KH |
1231 | (equals-encountered nil) |
1232 | (before-equals nil) | |
1233 | (expr-delimited nil)) | |
1234 | (catch 'done | |
1235 | (while token | |
c4f268a1 | 1236 | (setq token-kind (opascal-token-kind token)) |
70492703 KH |
1237 | (cond |
1238 | ;; An open ( or [ always is an indent point. | |
1239 | ((eq 'open-group token-kind) | |
1240 | (throw 'done | |
c4f268a1 | 1241 | (opascal-open-group-indent |
70492703 | 1242 | token last-token |
c4f268a1 | 1243 | (if (opascal-is from-kind opascal-binary-ops) |
70492703 KH |
1244 | ;; Keep binary operations aligned with the open group. |
1245 | 0 | |
c4f268a1 | 1246 | opascal-indent-level)))) |
70492703 KH |
1247 | |
1248 | ;; Skip over any ()/[] groups. | |
c4f268a1 | 1249 | ((eq 'close-group token-kind) (setq token (opascal-group-start token))) |
70492703 KH |
1250 | |
1251 | ;; Skip over any nested blocks. | |
c4f268a1 SM |
1252 | ((opascal-is token-kind opascal-end-block-statements) |
1253 | (setq token (opascal-block-start token))) | |
70492703 KH |
1254 | |
1255 | ;; An expression delimiter affects indentation depending on whether | |
1256 | ;; the point is before or after it. Remember that we encountered one. | |
1257 | ;; Also remember the last encountered token, since if it exists it | |
1258 | ;; should be the actual indent point. | |
c4f268a1 | 1259 | ((opascal-is token-kind opascal-expr-delimiters) |
70492703 KH |
1260 | (setq expr-delimited token stmt-start last-token)) |
1261 | ||
1262 | ;; With a non-delimited expression statement we indent after the | |
1263 | ;; statement's keyword, unless we are on the delimiter itself. | |
1264 | ((and (not expr-delimited) | |
c4f268a1 | 1265 | (opascal-is token-kind opascal-expr-statements)) |
70492703 | 1266 | (throw 'done |
c4f268a1 | 1267 | (cond ((opascal-is from-kind opascal-expr-delimiters) |
70492703 | 1268 | ;; We are indenting a delimiter. Indent to the statement. |
c4f268a1 | 1269 | (opascal-stmt-line-indent-of token 0)) |
70492703 | 1270 | |
c4f268a1 | 1271 | ((and last-token (opascal-is from-kind opascal-binary-ops)) |
70492703 | 1272 | ;; Align binary ops with the expression. |
c4f268a1 | 1273 | (opascal-indent-of last-token)) |
70492703 KH |
1274 | |
1275 | (last-token | |
1276 | ;; Indent in from the expression. | |
c4f268a1 | 1277 | (opascal-indent-of last-token opascal-indent-level)) |
70492703 KH |
1278 | |
1279 | ;; Indent in from the statement's keyword. | |
c4f268a1 | 1280 | ((opascal-indent-of token opascal-indent-level))))) |
70492703 KH |
1281 | |
1282 | ;; A delimited case statement indents the label according to | |
1283 | ;; a special rule. | |
1284 | ((eq 'case token-kind) | |
1285 | (throw 'done | |
1286 | (if stmt-start | |
1287 | ;; We are not actually indenting to the case statement, | |
1288 | ;; but are within a label expression. | |
c4f268a1 SM |
1289 | (opascal-stmt-line-indent-of |
1290 | stmt-start opascal-indent-level) | |
70492703 | 1291 | ;; Indent from the case keyword. |
c4f268a1 SM |
1292 | (opascal-stmt-line-indent-of |
1293 | token opascal-case-label-indent)))) | |
70492703 KH |
1294 | |
1295 | ;; Body expression statements are enclosing. Indent from the | |
1296 | ;; statement's keyword, unless we have a non-block statement following | |
1297 | ;; it. | |
c4f268a1 | 1298 | ((opascal-is token-kind opascal-body-expr-statements) |
70492703 | 1299 | (throw 'done |
c4f268a1 SM |
1300 | (opascal-stmt-line-indent-of |
1301 | (or stmt-start token) opascal-indent-level))) | |
70492703 KH |
1302 | |
1303 | ;; An else statement is enclosing, but it doesn't have an expression. | |
1304 | ;; Thus we take into account last-token instead of stmt-start. | |
1305 | ((eq 'else token-kind) | |
c4f268a1 SM |
1306 | (throw 'done (opascal-stmt-line-indent-of |
1307 | (or last-token token) opascal-indent-level))) | |
70492703 KH |
1308 | |
1309 | ;; We indent relative to an enclosing declaration section. | |
c4f268a1 SM |
1310 | ((opascal-is token-kind opascal-decl-sections) |
1311 | (throw 'done (opascal-indent-of (if last-token last-token token) | |
1312 | opascal-indent-level))) | |
70492703 KH |
1313 | |
1314 | ;; In unit sections we indent right to the left. | |
c4f268a1 | 1315 | ((opascal-is token-kind opascal-unit-sections) |
c05423d4 CY |
1316 | (throw 'done |
1317 | ;; Handle specially the case of "interface", which can be used | |
1318 | ;; to start either a unit section or an interface definition. | |
c4f268a1 | 1319 | (if (opascal-is token-kind opascal-interface-types) |
c05423d4 CY |
1320 | (progn |
1321 | ;; Find the previous non-whitespace token. | |
1322 | (while (progn | |
1323 | (setq last-token token | |
c4f268a1 SM |
1324 | token (opascal-previous-token token) |
1325 | token-kind (opascal-token-kind token)) | |
c05423d4 | 1326 | (and token |
c4f268a1 SM |
1327 | (opascal-is token-kind |
1328 | opascal-whitespace)))) | |
c05423d4 CY |
1329 | ;; If this token is an equals sign, "interface" is being |
1330 | ;; used to start an interface definition and we should | |
1331 | ;; treat it as a composite type; otherwise, we should | |
1332 | ;; consider it the start of a unit section. | |
1333 | (if (and token (eq token-kind 'equals)) | |
c4f268a1 SM |
1334 | (opascal-line-indent-of last-token |
1335 | opascal-indent-level) | |
c05423d4 CY |
1336 | 0)) |
1337 | 0))) | |
70492703 KH |
1338 | |
1339 | ;; A previous terminator means we can stop. | |
c4f268a1 | 1340 | ((opascal-is token-kind opascal-previous-terminators) |
70492703 KH |
1341 | (throw 'done |
1342 | (cond ((and last-token | |
1343 | (eq 'comma token-kind) | |
c4f268a1 | 1344 | (opascal-is from-kind opascal-binary-ops)) |
70492703 | 1345 | ;; Align binary ops with the expression. |
c4f268a1 | 1346 | (opascal-indent-of last-token)) |
70492703 KH |
1347 | |
1348 | (last-token | |
1349 | ;; Indent in from the expression. | |
c4f268a1 | 1350 | (opascal-indent-of last-token opascal-indent-level)) |
70492703 | 1351 | |
5a89f0a7 | 1352 | ;; No enclosing expression; use the previous statement's |
70492703 | 1353 | ;; indent. |
c4f268a1 | 1354 | ((opascal-previous-indent-of token))))) |
70492703 KH |
1355 | |
1356 | ;; A block statement after an expression delimiter has its start | |
1357 | ;; column as the expression statement. E.g. | |
1358 | ;; if (a = b) | |
1359 | ;; and (a != c) then begin | |
1360 | ;; //... | |
1361 | ;; end; | |
1362 | ;; Remember it for when we encounter the expression statement start. | |
c4f268a1 | 1363 | ((opascal-is-block-after-expr-statement token) |
70492703 | 1364 | (throw 'done |
c4f268a1 | 1365 | (cond (last-token (opascal-indent-of last-token opascal-indent-level)) |
70492703 | 1366 | |
c4f268a1 | 1367 | ((+ (opascal-section-indent-of token) opascal-indent-level))))) |
70492703 | 1368 | |
06c24636 | 1369 | ;; Assembly sections always indent in from the asm keyword. |
a1506d29 | 1370 | ((eq token-kind 'asm) |
c4f268a1 | 1371 | (throw 'done (opascal-stmt-line-indent-of token opascal-indent-level))) |
06c24636 | 1372 | |
70492703 | 1373 | ;; Stop at an enclosing statement and indent from it. |
c4f268a1 SM |
1374 | ((opascal-is token-kind opascal-enclosing-statements) |
1375 | (throw 'done (opascal-stmt-line-indent-of | |
1376 | (or last-token token) opascal-indent-level))) | |
70492703 KH |
1377 | |
1378 | ;; A class/record declaration is also enclosing. | |
c4f268a1 | 1379 | ((opascal-composite-type-start token last-token) |
70492703 | 1380 | (throw 'done |
c4f268a1 | 1381 | (opascal-line-indent-of last-token opascal-indent-level))) |
70492703 KH |
1382 | |
1383 | ;; A ":" we indent relative to its line beginning. If we are in a | |
1384 | ;; parameter list, then stop also if we hit a ";". | |
1385 | ((and (eq token-kind 'colon) | |
1386 | (not expr-delimited) | |
c4f268a1 | 1387 | (not (opascal-is from-kind opascal-expr-delimiters)) |
70492703 KH |
1388 | (not equals-encountered) |
1389 | (not (eq from-kind 'equals))) | |
1390 | (throw 'done | |
1391 | (if last-token | |
c4f268a1 SM |
1392 | (opascal-indent-of last-token opascal-indent-level) |
1393 | (opascal-line-indent-of token opascal-indent-level 'semicolon)))) | |
70492703 KH |
1394 | |
1395 | ;; If the ":" was not processed above and we have token after the "=", | |
1396 | ;; then indent from the "=". Ignore :=, however. | |
1397 | ((and (eq token-kind 'colon) equals-encountered before-equals) | |
1398 | (cond | |
1399 | ;; Ignore binary ops for now. It would do, for example: | |
1400 | ;; val := 1 + 2 | |
1401 | ;; + 3; | |
1402 | ;; which is good, but also | |
1403 | ;; val := Foo | |
1404 | ;; (foo, args) | |
1405 | ;; + 2; | |
1406 | ;; which doesn't look right. | |
1407 | ;;;; Align binary ops with the before token. | |
c4f268a1 SM |
1408 | ;;((opascal-is from-kind opascal-binary-ops) |
1409 | ;;(throw 'done (opascal-indent-of before-equals 0))) | |
70492703 KH |
1410 | |
1411 | ;; Assignments (:=) we skip over to get a normal indent. | |
c4f268a1 | 1412 | ((eq (opascal-token-kind last-token) 'equals)) |
70492703 KH |
1413 | |
1414 | ;; Otherwise indent in from the equals. | |
a1506d29 | 1415 | ((throw 'done |
c4f268a1 | 1416 | (opascal-indent-of before-equals opascal-indent-level))))) |
70492703 KH |
1417 | |
1418 | ;; Remember any "=" we encounter if it has not already been processed. | |
a1506d29 | 1419 | ((eq token-kind 'equals) |
70492703 KH |
1420 | (setq equals-encountered token |
1421 | before-equals last-token)) | |
1422 | ) | |
c4f268a1 | 1423 | (unless (opascal-is token-kind opascal-whitespace) |
70492703 | 1424 | (setq last-token token)) |
c4f268a1 | 1425 | (setq token (opascal-previous-token token))) |
70492703 KH |
1426 | ;; We ran out of tokens. Indent to column 0. |
1427 | 0))) | |
1428 | ||
c4f268a1 | 1429 | (defun opascal-corrected-indentation () |
70492703 | 1430 | ;; Returns the corrected indentation for the current line. |
c4f268a1 SM |
1431 | (opascal-save-excursion |
1432 | (opascal-progress-start) | |
70492703 KH |
1433 | ;; Move to the first token on the line. |
1434 | (beginning-of-line) | |
c4f268a1 SM |
1435 | (skip-chars-forward opascal-space-chars) |
1436 | (let* ((token (opascal-current-token)) | |
1437 | (token-kind (opascal-token-kind token)) | |
70492703 KH |
1438 | (indent |
1439 | (cond ((eq 'close-group token-kind) | |
1440 | ;; Indent to the matching start ( or [. | |
c4f268a1 | 1441 | (opascal-indent-of (opascal-group-start token))) |
70492703 | 1442 | |
c4f268a1 | 1443 | ((opascal-is token-kind opascal-unit-statements) 0) |
70492703 | 1444 | |
c4f268a1 | 1445 | ((opascal-is token-kind opascal-comments) |
70492703 | 1446 | ;; In a comment. |
c4f268a1 | 1447 | (opascal-comment-indent-of token)) |
70492703 | 1448 | |
c4f268a1 | 1449 | ((opascal-is token-kind opascal-decl-matchers) |
70492703 | 1450 | ;; Use a previous section/routine's indent. |
c4f268a1 | 1451 | (opascal-section-indent-of token)) |
70492703 | 1452 | |
c4f268a1 | 1453 | ((opascal-is token-kind opascal-match-block-statements) |
70492703 | 1454 | ;; Use the block's indentation. |
a1506d29 | 1455 | (let ((block-start |
c4f268a1 | 1456 | (opascal-block-start token 'stop-on-class))) |
70492703 KH |
1457 | (cond |
1458 | ;; When trailing a body statement, indent to | |
1459 | ;; the statement's keyword. | |
c4f268a1 SM |
1460 | ((opascal-is-block-after-expr-statement block-start) |
1461 | (opascal-section-indent-of block-start)) | |
70492703 KH |
1462 | |
1463 | ;; Otherwise just indent to the block start. | |
c4f268a1 | 1464 | ((opascal-stmt-line-indent-of block-start 0))))) |
70492703 KH |
1465 | |
1466 | ((eq 'else token-kind) | |
1467 | ;; Find the start of the if or case statement. | |
c4f268a1 | 1468 | (opascal-stmt-line-indent-of (opascal-else-start token) 0)) |
70492703 KH |
1469 | |
1470 | ;; Otherwise indent in from enclosing statement. | |
c4f268a1 SM |
1471 | ((opascal-enclosing-indent-of |
1472 | (if token token (opascal-token-at (1- (point))))))))) | |
1473 | (opascal-progress-done) | |
70492703 KH |
1474 | indent))) |
1475 | ||
c4f268a1 | 1476 | (defun opascal-indent-line () |
5ba5fb81 JB |
1477 | "Indent the current line according to the current language construct. |
1478 | If before the indent, the point is moved to the indent." | |
70492703 | 1479 | (interactive) |
c4f268a1 | 1480 | (save-match-data |
70492703 | 1481 | (let ((marked-point (point-marker)) ; Maintain our position reliably. |
70492703 KH |
1482 | (line-start nil) |
1483 | (old-indent 0) | |
1484 | (new-indent 0)) | |
1485 | (beginning-of-line) | |
1486 | (setq line-start (point)) | |
c4f268a1 | 1487 | (skip-chars-forward opascal-space-chars) |
70492703 | 1488 | (setq old-indent (current-column)) |
c4f268a1 | 1489 | (setq new-indent (opascal-corrected-indentation)) |
70492703 KH |
1490 | (if (< marked-point (point)) |
1491 | ;; If before the indent column, then move to it. | |
1492 | (set-marker marked-point (point))) | |
1493 | ;; Advance our marked point after inserted spaces. | |
1494 | (set-marker-insertion-type marked-point t) | |
1495 | (when (/= old-indent new-indent) | |
1496 | (delete-region line-start (point)) | |
759570c0 | 1497 | (insert (make-string new-indent ?\s))) |
70492703 KH |
1498 | (goto-char marked-point) |
1499 | (set-marker marked-point nil)))) | |
1500 | ||
c4f268a1 SM |
1501 | (defvar opascal-mode-abbrev-table nil |
1502 | "Abbrev table in use in OPascal mode buffers.") | |
1503 | (define-abbrev-table 'opascal-mode-abbrev-table ()) | |
70492703 | 1504 | |
c4f268a1 | 1505 | (defmacro opascal-ensure-buffer (buffer-var buffer-name) |
70492703 KH |
1506 | ;; Ensures there exists a buffer of the specified name in the specified |
1507 | ;; variable. | |
1508 | `(when (not (buffer-live-p ,buffer-var)) | |
1509 | (setq ,buffer-var (get-buffer-create ,buffer-name)))) | |
1510 | ||
c4f268a1 | 1511 | (defun opascal-log-msg (to-buffer the-msg) |
70492703 KH |
1512 | ;; Writes a message to the end of the specified buffer. |
1513 | (with-current-buffer to-buffer | |
1514 | (save-selected-window | |
1515 | (switch-to-buffer-other-window to-buffer) | |
1516 | (goto-char (point-max)) | |
1902b5b6 | 1517 | (set-window-point (get-buffer-window to-buffer) (point)) |
70492703 KH |
1518 | (insert the-msg)))) |
1519 | ||
1520 | ;; Debugging helpers: | |
1521 | ||
c4f268a1 SM |
1522 | (defvar opascal-debug-buffer nil |
1523 | "Buffer to write OPascal mode debug messages to. Created on demand.") | |
70492703 | 1524 | |
c4f268a1 | 1525 | (defun opascal-debug-log (format-string &rest args) |
70492703 | 1526 | ;; Writes a message to the log buffer. |
c4f268a1 SM |
1527 | (when opascal-debug |
1528 | (opascal-ensure-buffer opascal-debug-buffer "*OPascal Debug Log*") | |
1529 | (opascal-log-msg opascal-debug-buffer | |
70492703 KH |
1530 | (concat (format-time-string "%H:%M:%S " (current-time)) |
1531 | (apply #'format (cons format-string args)) | |
1532 | "\n")))) | |
1533 | ||
c4f268a1 SM |
1534 | (defun opascal-debug-token-string (token) |
1535 | (let* ((image (opascal-token-string token)) | |
70492703 KH |
1536 | (has-newline (string-match "^\\([^\n]*\\)\n\\(.+\\)?$" image))) |
1537 | (when has-newline | |
1538 | (setq image (concat (match-string 1 image) | |
1539 | (if (match-beginning 2) "...")))) | |
1540 | image)) | |
1541 | ||
c4f268a1 | 1542 | (defun opascal-debug-show-current-token () |
70492703 | 1543 | (interactive) |
c4f268a1 SM |
1544 | (let ((token (opascal-current-token))) |
1545 | (opascal-debug-log "Token: %S %S" token (opascal-debug-token-string token)))) | |
70492703 | 1546 | |
c4f268a1 | 1547 | (defun opascal-debug-goto-point (p) |
70492703 KH |
1548 | (interactive "NGoto char: ") |
1549 | (goto-char p)) | |
1550 | ||
c4f268a1 | 1551 | (defun opascal-debug-goto-next-token () |
70492703 | 1552 | (interactive) |
c4f268a1 | 1553 | (goto-char (opascal-token-start (opascal-next-token (opascal-current-token))))) |
70492703 | 1554 | |
c4f268a1 | 1555 | (defun opascal-debug-goto-previous-token () |
70492703 KH |
1556 | (interactive) |
1557 | (goto-char | |
c4f268a1 | 1558 | (opascal-token-start (opascal-previous-token (opascal-current-token))))) |
70492703 | 1559 | |
c4f268a1 | 1560 | (defun opascal-debug-show-current-string (from to) |
70492703 | 1561 | (interactive "r") |
c4f268a1 | 1562 | (opascal-debug-log "String: %S" (buffer-substring from to))) |
70492703 | 1563 | |
c4f268a1 | 1564 | (defun opascal-debug-show-is-stable () |
70492703 | 1565 | (interactive) |
c4f268a1 SM |
1566 | (opascal-debug-log "stable: %S prev: %S next: %S" |
1567 | (opascal-is-stable-literal (point)) | |
1568 | (opascal-literal-kind (1- (point))) | |
1569 | (opascal-literal-kind (point)))) | |
70492703 | 1570 | |
c4f268a1 | 1571 | (defun opascal-debug-unparse-buffer () |
70492703 | 1572 | (interactive) |
c4f268a1 | 1573 | (opascal-set-text-properties (point-min) (point-max) nil)) |
70492703 | 1574 | |
c4f268a1 | 1575 | (defun opascal-debug-parse-region (from to) |
70492703 | 1576 | (interactive "r") |
c4f268a1 SM |
1577 | (let ((opascal-verbose t)) |
1578 | (opascal-save-excursion | |
1579 | (opascal-progress-start) | |
1580 | (opascal-parse-region from to) | |
1581 | (opascal-progress-done "Parsing done")))) | |
70492703 | 1582 | |
c4f268a1 | 1583 | (defun opascal-debug-parse-window () |
70492703 | 1584 | (interactive) |
c4f268a1 | 1585 | (opascal-debug-parse-region (window-start) (window-end))) |
70492703 | 1586 | |
c4f268a1 | 1587 | (defun opascal-debug-parse-buffer () |
70492703 | 1588 | (interactive) |
c4f268a1 | 1589 | (opascal-debug-parse-region (point-min) (point-max))) |
70492703 | 1590 | |
c4f268a1 | 1591 | (defun opascal-debug-fontify-window () |
70492703 | 1592 | (interactive) |
c4f268a1 | 1593 | (opascal-fontify-region (window-start) (window-end) t)) |
70492703 | 1594 | |
c4f268a1 | 1595 | (defun opascal-debug-fontify-buffer () |
70492703 | 1596 | (interactive) |
c4f268a1 | 1597 | (opascal-fontify-region (point-min) (point-max) t)) |
70492703 | 1598 | |
c4f268a1 | 1599 | (defun opascal-debug-tokenize-region (from to) |
70492703 | 1600 | (interactive) |
c4f268a1 SM |
1601 | (opascal-save-excursion |
1602 | (opascal-progress-start) | |
70492703 KH |
1603 | (goto-char from) |
1604 | (while (< (point) to) | |
c4f268a1 SM |
1605 | (goto-char (opascal-token-end (opascal-current-token))) |
1606 | (opascal-step-progress (point) "Tokenizing" opascal-scanning-progress-step)) | |
1607 | (opascal-progress-done "Tokenizing done"))) | |
70492703 | 1608 | |
c4f268a1 | 1609 | (defun opascal-debug-tokenize-buffer () |
70492703 | 1610 | (interactive) |
c4f268a1 | 1611 | (opascal-debug-tokenize-region (point-min) (point-max))) |
70492703 | 1612 | |
c4f268a1 | 1613 | (defun opascal-debug-tokenize-window () |
70492703 | 1614 | (interactive) |
c4f268a1 | 1615 | (opascal-debug-tokenize-region (window-start) (window-end))) |
70492703 | 1616 | |
c4f268a1 SM |
1617 | |
1618 | (defun opascal-tab () | |
07db5857 | 1619 | "Indent the region, when Transient Mark mode is enabled and the region is |
5ba5fb81 | 1620 | active. Otherwise, indent the current line or insert a TAB, depending on the |
c4f268a1 | 1621 | value of `opascal-tab-always-indents' and the current line position." |
70492703 | 1622 | (interactive) |
07db5857 SS |
1623 | (cond ((use-region-p) |
1624 | ;; If Transient Mark mode is enabled and the region is active, indent | |
1625 | ;; the entire region. | |
1626 | (indent-region (region-beginning) (region-end))) | |
c4f268a1 SM |
1627 | ((or opascal-tab-always-indents |
1628 | (save-excursion (skip-chars-backward opascal-space-chars) (bolp))) | |
07db5857 SS |
1629 | ;; Otherwise, if we are configured always to indent (regardless of the |
1630 | ;; point's position in the line) or we are before the first non-space | |
1631 | ;; character on the line, indent the line. | |
c4f268a1 | 1632 | (opascal-indent-line)) |
07db5857 SS |
1633 | (t |
1634 | ;; Otherwise, insert a tab character. | |
1635 | (insert "\t")))) | |
70492703 KH |
1636 | |
1637 | ||
c4f268a1 | 1638 | (defun opascal-is-directory (path) |
70492703 KH |
1639 | ;; True if the specified path is an existing directory. |
1640 | (let ((attributes (file-attributes path))) | |
1641 | (and attributes (car attributes)))) | |
1642 | ||
c4f268a1 | 1643 | (defun opascal-is-file (path) |
70492703 KH |
1644 | ;; True if the specified file exists as a file. |
1645 | (let ((attributes (file-attributes path))) | |
1646 | (and attributes (null (car attributes))))) | |
1647 | ||
c4f268a1 | 1648 | (defun opascal-search-directory (unit dir &optional recurse) |
70492703 KH |
1649 | ;; Searches for the unit in the specified directory. If recurse is true, then |
1650 | ;; the directory is recursively searched. File name comparison is done in a | |
1651 | ;; case insensitive manner. | |
c4f268a1 | 1652 | (when (opascal-is-directory dir) |
70492703 KH |
1653 | (let ((files (directory-files dir)) |
1654 | (unit-file (downcase unit))) | |
1655 | (catch 'done | |
1656 | ;; Search for the file. | |
c4f268a1 SM |
1657 | (dolist (file files) |
1658 | (let ((path (concat dir "/" file))) | |
1659 | (if (and (string= unit-file (downcase file)) | |
1660 | (opascal-is-file path)) | |
1661 | (throw 'done path)))) | |
70492703 KH |
1662 | |
1663 | ;; Not found. Search subdirectories. | |
1664 | (when recurse | |
c4f268a1 SM |
1665 | (dolist (subdir files) |
1666 | (unless (member subdir '("." "..")) | |
1667 | (let ((path (opascal-search-directory | |
1668 | unit (concat dir "/" subdir) recurse))) | |
1669 | (if path (throw 'done path)))))) | |
70492703 KH |
1670 | |
1671 | ;; Not found. | |
1672 | nil)))) | |
1673 | ||
1674 | ||
c4f268a1 | 1675 | (defun opascal-find-unit-in-directory (unit dir) |
70492703 KH |
1676 | ;; Searches for the unit in the specified directory. If the directory ends |
1677 | ;; in \"...\", then it is recursively searched. | |
1678 | (let ((dir-name dir) | |
1679 | (recurse nil)) | |
1680 | ;; Check if we need to recursively search the directory. | |
1681 | (if (string-match "^\\(.+\\)\\.\\.\\.$" dir-name) | |
1682 | (setq dir-name (match-string 1 dir-name) | |
1683 | recurse t)) | |
1684 | ;; Ensure the trailing slash is removed. | |
1685 | (if (string-match "^\\(.+\\)[\\\\/]$" dir-name) | |
1686 | (setq dir-name (match-string 1 dir-name))) | |
c4f268a1 | 1687 | (opascal-search-directory unit dir-name recurse))) |
70492703 | 1688 | |
c4f268a1 SM |
1689 | (defun opascal-find-unit-file (unit) |
1690 | ;; Finds the specified opascal source file according to `opascal-search-path'. | |
70492703 KH |
1691 | ;; If found, the full path is returned, otherwise nil is returned. |
1692 | (catch 'done | |
c4f268a1 SM |
1693 | (cond ((null opascal-search-path) |
1694 | (opascal-find-unit-in-directory unit ".")) | |
70492703 | 1695 | |
c4f268a1 SM |
1696 | ((stringp opascal-search-path) |
1697 | (opascal-find-unit-in-directory unit opascal-search-path)) | |
70492703 | 1698 | |
c4f268a1 SM |
1699 | ((dolist (dir opascal-search-path) |
1700 | (let ((file (opascal-find-unit-in-directory unit dir))) | |
1701 | (if file (throw 'done file)))))) | |
70492703 KH |
1702 | nil)) |
1703 | ||
c4f268a1 SM |
1704 | (defun opascal-find-unit (unit) |
1705 | "Find the specified OPascal source file according to `opascal-search-path'. | |
5ba5fb81 | 1706 | If no extension is specified, .pas is assumed. Creates a buffer for the unit." |
c4f268a1 | 1707 | (interactive "sOPascal unit name: ") |
70492703 KH |
1708 | (let* ((unit-file (if (string-match "^\\(.*\\)\\.[a-z]+$" unit) |
1709 | unit | |
1710 | (concat unit ".pas"))) | |
c4f268a1 | 1711 | (file (opascal-find-unit-file unit-file))) |
70492703 KH |
1712 | (if (null file) |
1713 | (error "unit not found: %s" unit-file) | |
1714 | (find-file file) | |
c4f268a1 SM |
1715 | (if (not (derived-mode-p 'opascal-mode)) |
1716 | (opascal-mode))) | |
70492703 KH |
1717 | file)) |
1718 | ||
c4f268a1 | 1719 | (defun opascal-find-current-def () |
70492703 KH |
1720 | "Find the definition of the identifier under the current point." |
1721 | (interactive) | |
c4f268a1 | 1722 | (error "opascal-find-current-def: not implemented yet")) |
70492703 | 1723 | |
c4f268a1 | 1724 | (defun opascal-find-current-xdef () |
70492703 KH |
1725 | "Find the definition of the identifier under the current point, searching |
1726 | in external units if necessary (as listed in the current unit's use clause). | |
1727 | The set of directories to search for a unit is specified by the global variable | |
c4f268a1 | 1728 | `opascal-search-path'." |
70492703 | 1729 | (interactive) |
c4f268a1 | 1730 | (error "opascal-find-current-xdef: not implemented yet")) |
70492703 | 1731 | |
c4f268a1 | 1732 | (defun opascal-find-current-body () |
70492703 KH |
1733 | "Find the body of the identifier under the current point, assuming |
1734 | it is a routine." | |
1735 | (interactive) | |
c4f268a1 | 1736 | (error "opascal-find-current-body: not implemented yet")) |
70492703 | 1737 | |
c4f268a1 | 1738 | (defun opascal-fill-comment () |
5ba5fb81 | 1739 | "Fill the text of the current comment, according to `fill-column'. |
70492703 KH |
1740 | An error is raised if not in a comment." |
1741 | (interactive) | |
1742 | (save-excursion | |
5b01aef2 | 1743 | (save-restriction |
c4f268a1 SM |
1744 | (let* ((comment (opascal-current-token)) |
1745 | (comment-kind (opascal-token-kind comment))) | |
1746 | (if (not (opascal-is comment-kind opascal-comments)) | |
70492703 | 1747 | (error "Not in a comment") |
c4f268a1 SM |
1748 | (let* ((start-comment (opascal-comment-block-start comment)) |
1749 | (end-comment (opascal-comment-block-end comment)) | |
1750 | (comment-start (opascal-token-start start-comment)) | |
1751 | (comment-end (opascal-token-end end-comment)) | |
1752 | (content-start (opascal-comment-content-start start-comment)) | |
1753 | (content-indent (opascal-column-of content-start)) | |
759570c0 | 1754 | (content-prefix (make-string content-indent ?\s)) |
c4f268a1 | 1755 | (content-prefix-re opascal-leading-spaces-re) |
70492703 KH |
1756 | (p nil) |
1757 | (marked-point (point-marker))) ; Maintain our position reliably. | |
1758 | (when (eq 'comment-single-line comment-kind) | |
1759 | ;; // style comments need more work. | |
1760 | (setq content-prefix | |
c4f268a1 | 1761 | (let ((comment-indent (opascal-column-of comment-start))) |
759570c0 | 1762 | (concat (make-string comment-indent ?\s) "//" |
70492703 | 1763 | (make-string (- content-indent comment-indent 2) |
759570c0 | 1764 | ?\s))) |
c4f268a1 | 1765 | content-prefix-re (concat opascal-leading-spaces-re |
70492703 | 1766 | "//" |
c4f268a1 SM |
1767 | opascal-spaces-re) |
1768 | comment-end (if (opascal-is-literal-end comment-end) | |
70492703 KH |
1769 | ;; Don't include the trailing newline. |
1770 | (1- comment-end) | |
1771 | comment-end))) | |
1772 | ||
1773 | ;; Advance our marked point after inserted spaces. | |
1774 | (set-marker-insertion-type marked-point t) | |
1775 | ||
1776 | ;; Ensure we can modify the buffer | |
1777 | (goto-char content-start) | |
1778 | (insert " ") | |
1779 | (delete-char -1) | |
1780 | ||
1781 | (narrow-to-region content-start comment-end) | |
1782 | ||
1783 | ;; Strip off the comment prefixes | |
1784 | (setq p (point-min)) | |
1785 | (while (when (< p (point-max)) | |
1786 | (goto-char p) | |
1787 | (re-search-forward content-prefix-re nil t)) | |
1788 | (replace-match "" nil nil) | |
1789 | (setq p (1+ (point)))) | |
1790 | ||
1791 | ;; add an extra line to prevent the fill from doing it for us. | |
1792 | (goto-char (point-max)) | |
1793 | (insert "\n") | |
1794 | ||
1795 | ;; Fill the comment contents. | |
1796 | (let ((fill-column (- fill-column content-indent))) | |
1797 | (fill-region (point-min) (point-max))) | |
1798 | ||
1799 | (goto-char (point-max)) | |
1800 | (delete-char -1) | |
1801 | ||
1802 | ;; Restore comment prefixes. | |
1803 | (goto-char (point-min)) | |
1804 | (end-of-line) ; Don't reset the first line. | |
1805 | (setq p (point)) | |
1806 | (while (when (< p (point-max)) | |
1807 | (goto-char p) | |
1808 | (re-search-forward "^" nil t)) | |
1809 | (replace-match content-prefix nil nil) | |
1810 | (setq p (1+ (point)))) | |
1811 | ||
1812 | (setq comment-end (point-max)) | |
1813 | (widen) | |
1814 | ||
1815 | ;; Restore our position | |
1816 | (goto-char marked-point) | |
1817 | (set-marker marked-point nil) | |
1818 | ||
1819 | ;; React to the entire fill change as a whole. | |
c4f268a1 SM |
1820 | (opascal-progress-start) |
1821 | (opascal-parse-region comment-start comment-end) | |
1822 | (opascal-progress-done))))))) | |
70492703 | 1823 | |
c4f268a1 | 1824 | (defun opascal-new-comment-line () |
5ba5fb81 JB |
1825 | "If in a // comment, do a newline, indented such that one is still in the |
1826 | comment block. If not in a // comment, just does a normal newline." | |
70492703 | 1827 | (interactive) |
c4f268a1 SM |
1828 | (let ((comment (opascal-current-token))) |
1829 | (if (not (eq 'comment-single-line (opascal-token-kind comment))) | |
70492703 | 1830 | ;; Not in a // comment. Just do the normal newline. |
c4f268a1 SM |
1831 | (newline) |
1832 | (let* ((start-comment (opascal-comment-block-start comment)) | |
1833 | (comment-start (opascal-token-start start-comment)) | |
1834 | (content-start (opascal-comment-content-start start-comment)) | |
70492703 | 1835 | (prefix |
c4f268a1 | 1836 | (concat (make-string (opascal-column-of comment-start) ?\s) "//" |
759570c0 | 1837 | (make-string (- content-start comment-start 2) ?\s)))) |
70492703 | 1838 | (delete-horizontal-space) |
c4f268a1 | 1839 | (insert "\n" prefix))))) |
70492703 | 1840 | |
c4f268a1 | 1841 | (defun opascal-match-token (token limit) |
70492703 KH |
1842 | ;; Sets the match region used by (match-string 0) and friends to the token's |
1843 | ;; region. Sets the current point to the end of the token (or limit). | |
1844 | (set-match-data nil) | |
1845 | (if token | |
c4f268a1 SM |
1846 | (let ((end (min (opascal-token-end token) limit))) |
1847 | (set-match-data (list (opascal-token-start token) end)) | |
70492703 KH |
1848 | (goto-char end) |
1849 | token))) | |
1850 | ||
c4f268a1 | 1851 | (defconst opascal-font-lock-defaults |
70492703 KH |
1852 | '(nil ; We have our own fontify routine, so keywords don't apply. |
1853 | t ; Syntactic fontification doesn't apply. | |
1854 | nil ; Don't care about case since we don't use regexps to find tokens. | |
1855 | nil ; Syntax alists don't apply. | |
1856 | nil ; Syntax begin movement doesn't apply | |
c4f268a1 SM |
1857 | (font-lock-fontify-region-function . opascal-fontify-region) |
1858 | (font-lock-verbose . opascal-fontifying-progress-step)) | |
1859 | "OPascal mode font-lock defaults. Syntactic fontification is ignored.") | |
70492703 | 1860 | |
c4f268a1 | 1861 | (defvar opascal-debug-mode-map |
70492703 | 1862 | (let ((kmap (make-sparse-keymap))) |
c4f268a1 SM |
1863 | (dolist (binding '(("n" opascal-debug-goto-next-token) |
1864 | ("p" opascal-debug-goto-previous-token) | |
1865 | ("t" opascal-debug-show-current-token) | |
1866 | ("T" opascal-debug-tokenize-buffer) | |
1867 | ("W" opascal-debug-tokenize-window) | |
1868 | ("g" opascal-debug-goto-point) | |
1869 | ("s" opascal-debug-show-current-string) | |
1870 | ("a" opascal-debug-parse-buffer) | |
1871 | ("w" opascal-debug-parse-window) | |
1872 | ("f" opascal-debug-fontify-window) | |
1873 | ("F" opascal-debug-fontify-buffer) | |
1874 | ("r" opascal-debug-parse-region) | |
1875 | ("c" opascal-debug-unparse-buffer) | |
1876 | ("x" opascal-debug-show-is-stable))) | |
1877 | (define-key kmap (car binding) (cadr binding))) | |
70492703 | 1878 | kmap) |
c4f268a1 | 1879 | "Keystrokes for OPascal mode debug commands.") |
70492703 | 1880 | |
c4f268a1 | 1881 | (defvar opascal-mode-map |
70492703 | 1882 | (let ((kmap (make-sparse-keymap))) |
c4f268a1 SM |
1883 | (dolist (binding |
1884 | (list ;; '("\C-cd" opascal-find-current-def) | |
1885 | ;; '("\C-cx" opascal-find-current-xdef) | |
1886 | ;; '("\C-cb" opascal-find-current-body) | |
1887 | '("\C-cu" opascal-find-unit) | |
1888 | '("\M-q" opascal-fill-comment) | |
1889 | '("\M-j" opascal-new-comment-line) | |
1890 | ;; Debug bindings: | |
1891 | (list "\C-c\C-d" opascal-debug-mode-map))) | |
1892 | (define-key kmap (car binding) (cadr binding))) | |
70492703 | 1893 | kmap) |
c4f268a1 | 1894 | "Keymap used in OPascal mode.") |
70492703 | 1895 | |
c4f268a1 | 1896 | (define-obsolete-variable-alias 'delphi-mode-hook 'opascal-mode-hook "24.4") |
70492703 | 1897 | ;;;###autoload |
c4f268a1 SM |
1898 | (define-obsolete-function-alias 'delphi-mode 'opascal-mode "24.4") |
1899 | ;;;###autoload | |
1900 | (define-derived-mode opascal-mode prog-mode "OPascal" | |
1901 | "Major mode for editing OPascal code. \\<opascal-mode-map> | |
1902 | \\[opascal-find-unit]\t- Search for a OPascal source file. | |
1903 | \\[opascal-fill-comment]\t- Fill the current comment. | |
1904 | \\[opascal-new-comment-line]\t- If in a // comment, do a new comment line. | |
70492703 | 1905 | |
5ba5fb81 | 1906 | \\[indent-region] also works for indenting a whole region. |
70492703 KH |
1907 | |
1908 | Customization: | |
1909 | ||
c4f268a1 SM |
1910 | `opascal-indent-level' (default 3) |
1911 | Indentation of OPascal statements with respect to containing block. | |
1912 | `opascal-compound-block-indent' (default 0) | |
70492703 | 1913 | Extra indentation for blocks in compound statements. |
c4f268a1 | 1914 | `opascal-case-label-indent' (default 0) |
70492703 | 1915 | Extra indentation for case statement labels. |
c4f268a1 SM |
1916 | `opascal-tab-always-indents' (default `tab-always-indents') |
1917 | Non-nil means TAB in OPascal mode should always reindent the current line, | |
70492703 | 1918 | regardless of where in the line point is when the TAB command is used. |
c4f268a1 | 1919 | `opascal-search-path' (default .) |
70492703 | 1920 | Directories to search when finding external units. |
c4f268a1 SM |
1921 | `opascal-verbose' (default nil) |
1922 | If true then OPascal token processing progress is reported to the user. | |
70492703 KH |
1923 | |
1924 | Coloring: | |
1925 | ||
c4f268a1 SM |
1926 | `opascal-comment-face' (default font-lock-comment-face) |
1927 | Face used to color OPascal comments. | |
1928 | `opascal-string-face' (default font-lock-string-face) | |
1929 | Face used to color OPascal strings. | |
1930 | `opascal-keyword-face' (default font-lock-keyword-face) | |
1931 | Face used to color OPascal keywords. | |
1932 | `opascal-other-face' (default nil) | |
70492703 KH |
1933 | Face used to color everything else. |
1934 | ||
c4f268a1 | 1935 | Turning on OPascal mode calls the value of the variable `opascal-mode-hook' |
5ba5fb81 | 1936 | with no args, if that value is non-nil." |
70492703 KH |
1937 | |
1938 | ;; Buffer locals: | |
c4f268a1 SM |
1939 | (setq-local indent-line-function #'opascal-indent-line) |
1940 | (setq-local comment-indent-function #'opascal-indent-line) | |
1941 | (setq-local case-fold-search t) | |
1942 | (setq-local opascal-progress-last-reported-point nil) | |
1943 | (setq-local opascal--ignore-changes nil) | |
1944 | (setq-local font-lock-defaults opascal-font-lock-defaults) | |
1945 | (setq-local tab-always-indent opascal-tab-always-indents) | |
1946 | ||
1947 | ;; FIXME: Use syntax-propertize-function to tokenize, maybe? | |
1948 | ||
70492703 KH |
1949 | ;; We need to keep track of changes to the buffer to determine if we need |
1950 | ;; to retokenize changed text. | |
c4f268a1 | 1951 | (add-hook 'after-change-functions #'opascal-after-change nil t) |
70492703 | 1952 | |
c4f268a1 SM |
1953 | (opascal-save-excursion |
1954 | (let ((opascal-verbose t)) | |
1955 | (opascal-progress-start) | |
1956 | (opascal-parse-region (point-min) (point-max)) | |
1957 | (opascal-progress-done)))) | |
e8af40ee | 1958 | |
c4f268a1 SM |
1959 | (provide 'opascal) |
1960 | ;;; opascal.el ends here |