38 |
;; (add-hook 'delphi-mode-hook 'turn-on-font-lock) |
;; (add-hook 'delphi-mode-hook 'turn-on-font-lock) |
39 |
|
|
40 |
;; If font-lock is not loaded by default, you might have to do: |
;; If font-lock is not loaded by default, you might have to do: |
41 |
;; |
;; |
42 |
;; (autoload 'font-lock-mode "font-lock") |
;; (autoload 'font-lock-mode "font-lock") |
43 |
;; (autoload 'turn-on-font-lock "font-lock") |
;; (autoload 'turn-on-font-lock "font-lock") |
44 |
;; (setq font-lock-support-mode 'lazy-lock-mode) |
;; (setq font-lock-support-mode 'lazy-lock-mode) |
187 |
(defconst delphi-directives |
(defconst delphi-directives |
188 |
'(absolute abstract assembler automated cdecl default dispid dynamic |
'(absolute abstract assembler automated cdecl default dispid dynamic |
189 |
export external far forward index inline message name near nodefault |
export external far forward index inline message name near nodefault |
190 |
overload override pascal private protected public published read readonly |
overload override pascal private protected public published read readonly |
191 |
register reintroduce resident resourcestring safecall stdcall stored |
register reintroduce resident resourcestring safecall stdcall stored |
192 |
virtual write writeonly) |
virtual write writeonly) |
193 |
"Delphi4 directives.") |
"Delphi4 directives.") |
198 |
and array as asm at begin case class const constructor contains |
and array as asm at begin case class const constructor contains |
199 |
destructor dispinterface div do downto else end except exports |
destructor dispinterface div do downto else end except exports |
200 |
file finalization finally for function goto if implementation implements |
file finalization finally for function goto if implementation implements |
201 |
in inherited initialization interface is label library mod nil not |
in inherited initialization interface is label library mod nil not |
202 |
of object on or out package packed procedure program property |
of object on or out package packed procedure program property |
203 |
raise record repeat requires result self set shl shr then threadvar |
raise record repeat requires result self set shl shr then threadvar |
204 |
to try type unit uses until var while with xor |
to try type unit uses until var while with xor |
205 |
|
|
206 |
;; These routines should be keywords, if Borland had the balls. |
;; These routines should be keywords, if Borland had the balls. |
248 |
(defconst delphi-visibilities '(public private protected published automated) |
(defconst delphi-visibilities '(public private protected published automated) |
249 |
"Class visibilities.") |
"Class visibilities.") |
250 |
|
|
251 |
(defconst delphi-block-statements |
(defconst delphi-block-statements |
252 |
'(begin try case repeat initialization finalization asm) |
'(begin try case repeat initialization finalization asm) |
253 |
"Statements that contain multiple substatements.") |
"Statements that contain multiple substatements.") |
254 |
|
|
526 |
;; We have an end only if there is some string content (at |
;; We have an end only if there is some string content (at |
527 |
;; least a starting delimiter). |
;; least a starting delimiter). |
528 |
(not (delphi-is-literal-end (1- p))))) |
(not (delphi-is-literal-end (1- p))))) |
529 |
|
|
530 |
;; Special case: strings cannot span lines. |
;; Special case: strings cannot span lines. |
531 |
(and (delphi-is kind delphi-strings) (eq ?\n (char-after (1- p))))))) |
(and (delphi-is kind delphi-strings) (eq ?\n (char-after (1- p))))))) |
532 |
|
|
568 |
;; We are completing an incomplete literal. |
;; We are completing an incomplete literal. |
569 |
(let ((kind (delphi-literal-kind (1- search-start)))) |
(let ((kind (delphi-literal-kind (1- search-start)))) |
570 |
(delphi-complete-literal kind limit) |
(delphi-complete-literal kind limit) |
571 |
(delphi-set-text-properties |
(delphi-set-text-properties |
572 |
search-start (point) (delphi-literal-text-properties kind)))) |
search-start (point) (delphi-literal-text-properties kind)))) |
573 |
|
|
574 |
((re-search-forward |
((re-search-forward |
583 |
(start (match-beginning 0))) |
(start (match-beginning 0))) |
584 |
(delphi-set-text-properties search-start start nil) |
(delphi-set-text-properties search-start start nil) |
585 |
(delphi-complete-literal kind limit) |
(delphi-complete-literal kind limit) |
586 |
(delphi-set-text-properties |
(delphi-set-text-properties |
587 |
start (point) (delphi-literal-text-properties kind)))) |
start (point) (delphi-literal-text-properties kind)))) |
588 |
|
|
589 |
;; Nothing found. Mark it as a non-literal. |
;; Nothing found. Mark it as a non-literal. |
735 |
(while (< p to) |
(while (< p to) |
736 |
;; Color the token and move past it. |
;; Color the token and move past it. |
737 |
(setq token (delphi-token-at p)) |
(setq token (delphi-token-at p)) |
738 |
(add-text-properties |
(add-text-properties |
739 |
(delphi-token-start token) (delphi-token-end token) |
(delphi-token-start token) (delphi-token-end token) |
740 |
(list 'face (delphi-face-of (delphi-token-kind token)) 'lazy-lock t)) |
(list 'face (delphi-face-of (delphi-token-kind token)) 'lazy-lock t)) |
741 |
(setq p (delphi-token-end token)) |
(setq p (delphi-token-end token)) |
756 |
(delphi-progress-start) |
(delphi-progress-start) |
757 |
;; Reparse at least from the token previous to the change to the end of |
;; Reparse at least from the token previous to the change to the end of |
758 |
;; line after the change. |
;; line after the change. |
759 |
(delphi-parse-region-until-stable |
(delphi-parse-region-until-stable |
760 |
(delphi-token-start (delphi-token-at (1- change-start))) |
(delphi-token-start (delphi-token-at (1- change-start))) |
761 |
(progn (goto-char change-end) (end-of-line) (point))) |
(progn (goto-char change-end) (end-of-line) (point))) |
762 |
(delphi-progress-done))))) |
(delphi-progress-done))))) |
814 |
(catch 'done |
(catch 'done |
815 |
(while token |
(while token |
816 |
(setq kind (delphi-token-kind token)) |
(setq kind (delphi-token-kind token)) |
817 |
(cond |
(cond |
818 |
;; Skip over ()/[] groups. |
;; Skip over ()/[] groups. |
819 |
((eq 'close-group kind) (setq token (delphi-group-start token))) |
((eq 'close-group kind) (setq token (delphi-group-start token))) |
820 |
|
|
836 |
(catch 'done |
(catch 'done |
837 |
(while token |
(while token |
838 |
(setq kind (delphi-token-kind token)) |
(setq kind (delphi-token-kind token)) |
839 |
(cond |
(cond |
840 |
((and (eq 'colon kind) |
((and (eq 'colon kind) |
841 |
(delphi-is (delphi-token-kind last-token) |
(delphi-is (delphi-token-kind last-token) |
842 |
`(,@delphi-block-statements |
`(,@delphi-block-statements |
843 |
,@delphi-expr-statements))) |
,@delphi-expr-statements))) |
844 |
;; We hit a label followed by a statement. Indent to the statement. |
;; We hit a label followed by a statement. Indent to the statement. |
845 |
(throw 'done nil)) |
(throw 'done nil)) |
916 |
((delphi-composite-type-start token last-token) |
((delphi-composite-type-start token last-token) |
917 |
(throw 'done (if stop-on-class last-token token))) |
(throw 'done (if stop-on-class last-token token))) |
918 |
) |
) |
919 |
(unless (delphi-is token-kind delphi-whitespace) |
(unless (delphi-is token-kind delphi-whitespace) |
920 |
(setq last-token token)) |
(setq last-token token)) |
921 |
(setq token (delphi-previous-token token))) |
(setq token (delphi-previous-token token))) |
922 |
;; Start not found. |
;; Start not found. |
1037 |
|
|
1038 |
(defun delphi-is-use-clause-end (at-token last-token last-colon from-kind) |
(defun delphi-is-use-clause-end (at-token last-token last-colon from-kind) |
1039 |
;; True if we are after the end of a uses type clause. |
;; True if we are after the end of a uses type clause. |
1040 |
(when (and last-token |
(when (and last-token |
1041 |
(not last-colon) |
(not last-colon) |
1042 |
(eq 'comma (delphi-token-kind at-token)) |
(eq 'comma (delphi-token-kind at-token)) |
1043 |
(eq 'semicolon from-kind)) |
(eq 'semicolon from-kind)) |
1148 |
(delphi-line-indent-of token)))) |
(delphi-line-indent-of token)))) |
1149 |
|
|
1150 |
;; Assembly sections always indent in from the asm keyword. |
;; Assembly sections always indent in from the asm keyword. |
1151 |
((eq token-kind 'asm) |
((eq token-kind 'asm) |
1152 |
(throw 'done (delphi-stmt-line-indent-of token delphi-indent-level))) |
(throw 'done (delphi-stmt-line-indent-of token delphi-indent-level))) |
1153 |
|
|
1154 |
;; An enclosing statement delimits a previous statement. |
;; An enclosing statement delimits a previous statement. |
1236 |
|
|
1237 |
;; An enclosing ":" means a label. |
;; An enclosing ":" means a label. |
1238 |
((and (eq 'colon token-kind) |
((and (eq 'colon token-kind) |
1239 |
(delphi-is (delphi-token-kind section-token) |
(delphi-is (delphi-token-kind section-token) |
1240 |
delphi-block-statements) |
delphi-block-statements) |
1241 |
(not last-terminator) |
(not last-terminator) |
1242 |
(not expr-delimited) |
(not expr-delimited) |
1270 |
(from-kind (delphi-token-kind from-token)) |
(from-kind (delphi-token-kind from-token)) |
1271 |
(token-kind nil) |
(token-kind nil) |
1272 |
(stmt-start nil) |
(stmt-start nil) |
1273 |
(last-token nil) |
(last-token nil) |
1274 |
(equals-encountered nil) |
(equals-encountered nil) |
1275 |
(before-equals nil) |
(before-equals nil) |
1276 |
(expr-delimited nil)) |
(expr-delimited nil)) |
1329 |
(if stmt-start |
(if stmt-start |
1330 |
;; We are not actually indenting to the case statement, |
;; We are not actually indenting to the case statement, |
1331 |
;; but are within a label expression. |
;; but are within a label expression. |
1332 |
(delphi-stmt-line-indent-of |
(delphi-stmt-line-indent-of |
1333 |
stmt-start delphi-indent-level) |
stmt-start delphi-indent-level) |
1334 |
;; Indent from the case keyword. |
;; Indent from the case keyword. |
1335 |
(delphi-stmt-line-indent-of |
(delphi-stmt-line-indent-of |
1336 |
token delphi-case-label-indent)))) |
token delphi-case-label-indent)))) |
1337 |
|
|
1338 |
;; Body expression statements are enclosing. Indent from the |
;; Body expression statements are enclosing. Indent from the |
1340 |
;; it. |
;; it. |
1341 |
((delphi-is token-kind delphi-body-expr-statements) |
((delphi-is token-kind delphi-body-expr-statements) |
1342 |
(throw 'done |
(throw 'done |
1343 |
(delphi-stmt-line-indent-of |
(delphi-stmt-line-indent-of |
1344 |
(or stmt-start token) delphi-indent-level))) |
(or stmt-start token) delphi-indent-level))) |
1345 |
|
|
1346 |
;; An else statement is enclosing, but it doesn't have an expression. |
;; An else statement is enclosing, but it doesn't have an expression. |
1388 |
((+ (delphi-section-indent-of token) delphi-indent-level))))) |
((+ (delphi-section-indent-of token) delphi-indent-level))))) |
1389 |
|
|
1390 |
;; Assembly sections always indent in from the asm keyword. |
;; Assembly sections always indent in from the asm keyword. |
1391 |
((eq token-kind 'asm) |
((eq token-kind 'asm) |
1392 |
(throw 'done (delphi-stmt-line-indent-of token delphi-indent-level))) |
(throw 'done (delphi-stmt-line-indent-of token delphi-indent-level))) |
1393 |
|
|
1394 |
;; Stop at an enclosing statement and indent from it. |
;; Stop at an enclosing statement and indent from it. |
1426 |
;; + 2; |
;; + 2; |
1427 |
;; which doesn't look right. |
;; which doesn't look right. |
1428 |
;;;; Align binary ops with the before token. |
;;;; Align binary ops with the before token. |
1429 |
;;((delphi-is from-kind delphi-binary-ops) |
;;((delphi-is from-kind delphi-binary-ops) |
1430 |
;;(throw 'done (delphi-indent-of before-equals 0))) |
;;(throw 'done (delphi-indent-of before-equals 0))) |
1431 |
|
|
1432 |
;; Assignments (:=) we skip over to get a normal indent. |
;; Assignments (:=) we skip over to get a normal indent. |
1433 |
((eq (delphi-token-kind last-token) 'equals)) |
((eq (delphi-token-kind last-token) 'equals)) |
1434 |
|
|
1435 |
;; Otherwise indent in from the equals. |
;; Otherwise indent in from the equals. |
1436 |
((throw 'done |
((throw 'done |
1437 |
(delphi-indent-of before-equals delphi-indent-level))))) |
(delphi-indent-of before-equals delphi-indent-level))))) |
1438 |
|
|
1439 |
;; Remember any "=" we encounter if it has not already been processed. |
;; Remember any "=" we encounter if it has not already been processed. |
1440 |
((eq token-kind 'equals) |
((eq token-kind 'equals) |
1441 |
(setq equals-encountered token |
(setq equals-encountered token |
1442 |
before-equals last-token)) |
before-equals last-token)) |
1443 |
) |
) |
1473 |
|
|
1474 |
((delphi-is token-kind delphi-match-block-statements) |
((delphi-is token-kind delphi-match-block-statements) |
1475 |
;; Use the block's indentation. |
;; Use the block's indentation. |
1476 |
(let ((block-start |
(let ((block-start |
1477 |
(delphi-block-start token 'stop-on-class))) |
(delphi-block-start token 'stop-on-class))) |
1478 |
(cond |
(cond |
1479 |
;; When trailing a body statement, indent to |
;; When trailing a body statement, indent to |