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