(provide 'delphi)
(defconst delphi-version
(let ((revision "$Revision: 1.1.1.1 $"))
(string-match ": \\([^ ]+\\)" revision)
(match-string 1 revision))
"Version of this delphi mode.")
(eval-and-compile
(or (fboundp 'when)
(defmacro when (test &rest body)
`(if ,test (progn ,@body))))
(or (fboundp 'unless)
(defmacro unless (test &rest body)
`(if (not ,test) (progn ,@body))))
(or (fboundp 'defgroup)
(defmacro defgroup (group val docs &rest group-attributes)
`(defvar ,group ,val ,docs)))
(or (fboundp 'defcustom)
(defmacro defcustom (val-name val docs &rest custom-attributes)
`(defvar ,val-name ,val ,docs)))
(or (fboundp 'cadr)
(defmacro cadr (list) `(car (cdr ,list))))
(or (fboundp 'cddr)
(defmacro cddr (list) `(cdr (cdr ,list))))
(or (fboundp 'with-current-buffer)
(defmacro with-current-buffer (buf &rest forms)
`(save-excursion (set-buffer ,buf) ,@forms)))
)
(defgroup delphi nil
"Major mode for editing Delphi source in Emacs"
:version "21.1"
:group 'languages)
(defconst delphi-debug nil
"True if in debug mode.")
(defcustom delphi-search-path "."
"*Directories to search when finding external units. It is a list of
directory strings. If only a single directory, it can be a single
string instead of a list. If a directory ends in \"...\" then that
directory is recursively searched."
:type 'string
:group 'delphi)
(defcustom delphi-indent-level 3
"*Indentation of Delphi statements with respect to containing block. E.g.
begin
// This is an indent of 3.
end;"
:type 'integer
:group 'delphi)
(defcustom delphi-compound-block-indent 0
"*Extra indentation for blocks in compound statements. E.g.
// block indent = 0 vs // block indent = 2
if b then if b then
begin begin
end else begin end
end; else
begin
end;"
:type 'integer
:group 'delphi)
(defcustom delphi-case-label-indent delphi-indent-level
"*Extra indentation for case statement labels. E.g.
// case indent = 0 vs // case indent = 3
case value of case value of
v1: process_v1; v1: process_v1;
v2: process_v2; v2: process_v2;
else else
process_else; process_else;
end; end;"
:type 'integer
:group 'delphi)
(defcustom delphi-verbose t "*If true then delphi token processing progress is reported to the user."
:type 'boolean
:group 'delphi)
(defcustom delphi-tab-always-indents t
"*Non-nil means TAB in Delphi mode should always reindent the current line,
regardless of where in the line point is when the TAB command is used."
:type 'boolean
:group 'delphi)
(defcustom delphi-newline-always-indents t
"*Non-nil means NEWLINE in Delphi mode should always reindent the current
line, insert a blank line and move to the default indent column of the blank
line. If nil, then no indentation occurs, and NEWLINE does the usual
behaviour. This is useful when one needs to do customized indentation that
differs from the default."
:type 'boolean
:group 'delphi)
(defcustom delphi-comment-face 'font-lock-comment-face
"*Face used to color delphi comments."
:type 'face
:group 'delphi)
(defcustom delphi-string-face 'font-lock-string-face
"*Face used to color delphi strings."
:type 'face
:group 'delphi)
(defcustom delphi-keyword-face 'font-lock-keyword-face
"*Face used to color delphi keywords."
:type 'face
:group 'delphi)
(defcustom delphi-other-face nil
"*Face used to color everything else."
:type 'face
:group 'delphi)
(defconst delphi-directives
'(absolute abstract assembler automated cdecl default dispid dynamic
export external far forward index inline message name near nodefault
overload override pascal private protected public published read readonly
register reintroduce resident resourcestring safecall stdcall stored
virtual write writeonly)
"Delphi4 directives.")
(defconst delphi-keywords
(append
'( and array as asm at begin case class const constructor contains
destructor dispinterface div do downto else end except exports
file finalization finally for function goto if implementation implements
in inherited initialization interface is label library mod nil not
of object on or out package packed procedure program property
raise record repeat requires result self set shl shr then threadvar
to try type unit uses until var while with xor
break exit)
delphi-directives)
"Delphi4 keywords.")
(defconst delphi-previous-terminators `(semicolon comma)
"Expression/statement terminators that denote a previous expression.")
(defconst delphi-comments
'(comment-single-line comment-multi-line-1 comment-multi-line-2)
"Tokens that represent comments.")
(defconst delphi-strings
'(string double-quoted-string)
"Tokens that represent string literals.")
(defconst delphi-whitespace `(space newline ,@delphi-comments)
"Tokens that are considered whitespace.")
(defconst delphi-routine-statements
'(procedure function constructor destructor property)
"Marks the start of a routine, or routine-ish looking expression.")
(defconst delphi-body-expr-statements '(if while for on)
"Statements that have either a single statement or a block as a body and also
are followed by an expression.")
(defconst delphi-expr-statements `(case ,@delphi-body-expr-statements)
"Expression statements contain expressions after their keyword.")
(defconst delphi-body-statements `(else ,@delphi-body-expr-statements)
"Statements that have either a single statement or a block as a body.")
(defconst delphi-expr-delimiters '(then do of)
"Expression delimiter tokens.")
(defconst delphi-binary-ops
'(plus minus equals not-equals times divides div mod and or xor)
"Delphi binary operations.")
(defconst delphi-visibilities '(public private protected published automated)
"Class visibilities.")
(defconst delphi-block-statements
'(begin try case repeat initialization finalization asm)
"Statements that contain multiple substatements.")
(defconst delphi-mid-block-statements
`(except finally ,@delphi-visibilities)
"Statements that mark mid sections of the enclosing block.")
(defconst delphi-end-block-statements `(end until)
"Statements that end block sections.")
(defconst delphi-match-block-statements
`(,@delphi-end-block-statements ,@delphi-mid-block-statements)
"Statements that match the indentation of the parent block.")
(defconst delphi-decl-sections '(type const var label resourcestring)
"Denotes the start of a declaration section.")
(defconst delphi-class-types '(class object)
"Class types.")
(defconst delphi-composite-types `(,@delphi-class-types record)
"Types that contain declarations within them.")
(defconst delphi-unit-sections
'(interface implementation program library package)
"Unit sections within which the indent is 0.")
(defconst delphi-use-clauses `(uses requires exports contains)
"Statements that refer to foreign symbols.")
(defconst delphi-unit-statements
`(,@delphi-use-clauses ,@delphi-unit-sections initialization finalization)
"Statements indented at level 0.")
(defconst delphi-decl-delimiters
`(,@delphi-decl-sections ,@delphi-unit-statements
,@delphi-routine-statements)
"Statements that a declaration statement should align with.")
(defconst delphi-decl-matchers
`(begin ,@delphi-decl-sections)
"Statements that should match to declaration statement indentation.")
(defconst delphi-enclosing-statements
`(,@delphi-block-statements ,@delphi-mid-block-statements
,@delphi-decl-sections ,@delphi-use-clauses ,@delphi-routine-statements)
"Delimits an enclosing statement.")
(defconst delphi-previous-statements
`(,@delphi-unit-statements ,@delphi-routine-statements)
"Delimits a previous statement.")
(defconst delphi-previous-enclosing-statements
`(,@delphi-block-statements ,@delphi-mid-block-statements
,@delphi-decl-sections)
"Delimits a previous enclosing statement.")
(defconst delphi-begin-enclosing-tokens
`(,@delphi-block-statements ,@delphi-mid-block-statements)
"Tokens that a begin token indents from.")
(defconst delphi-begin-previous-tokens
`(,@delphi-decl-sections ,@delphi-routine-statements)
"Tokens that a begin token aligns with, but only if not part of a nested
routine.")
(defconst delphi-space-chars "\000-\011\013- ") (defconst delphi-non-space-chars (concat "^" delphi-space-chars))
(defconst delphi-spaces-re (concat "[" delphi-space-chars "]*"))
(defconst delphi-leading-spaces-re (concat "^" delphi-spaces-re))
(defconst delphi-word-chars "a-zA-Z0-9_")
(defmacro delphi-save-match-data (&rest forms)
`(let ((data (match-data)))
(unwind-protect
(progn ,@forms)
(set-match-data data))))
(defmacro delphi-save-excursion (&rest forms)
`(save-excursion
(delphi-save-match-data
(let ((inhibit-point-motion-hooks t)
(deactivate-mark nil))
(progn ,@forms)))))
(defmacro delphi-save-state (&rest forms)
`(let ((delphi-ignore-changes t)
(old-supersession-threat
(symbol-function 'ask-user-about-supersession-threat))
(buffer-read-only nil)
(inhibit-read-only t)
(buffer-undo-list t)
(before-change-functions nil)
(after-change-functions nil)
(modified (buffer-modified-p)))
(fset 'ask-user-about-supersession-threat (lambda (fn)))
(unwind-protect
(progn ,@forms)
(set-buffer-modified-p modified)
(fset 'ask-user-about-supersession-threat old-supersession-threat))))
(defsubst delphi-is (element in-set)
(memq element in-set))
(defun delphi-string-of (start end)
(buffer-substring-no-properties start end))
(defun delphi-looking-at-string (p s)
(let ((limit (+ p (length s))))
(and (<= limit (point-max))
(string= s (delphi-string-of p limit)))))
(defun delphi-token-of (kind start end)
`[,kind ,start ,end])
(defsubst delphi-token-kind (token)
(if token (aref token 0) nil))
(defun delphi-set-token-kind (token to-kind)
(if token (aset token 0 to-kind)))
(defsubst delphi-token-start (token)
(if token (aref token 1) (point-min)))
(defsubst delphi-token-end (token)
(if token (aref token 2) (point-min)))
(defun delphi-set-token-start (token start)
(if token (aset token 1 start)))
(defun delphi-set-token-end (token end)
(if token (aset token 2 end)))
(defun delphi-token-string (token)
(if token
(delphi-string-of (delphi-token-start token) (delphi-token-end token))
""))
(defun delphi-in-token (p token)
(and (<= (delphi-token-start token) p) (< p (delphi-token-end token))))
(defun delphi-column-of (p)
(save-excursion (goto-char p) (current-column)))
(defun delphi-face-of (token-kind)
(cond ((delphi-is token-kind delphi-comments) delphi-comment-face)
((delphi-is token-kind delphi-strings) delphi-string-face)
((delphi-is token-kind delphi-keywords) delphi-keyword-face)
(delphi-other-face)))
(defvar delphi-progress-last-reported-point nil
"The last point at which progress was reported.")
(defconst delphi-parsing-progress-step 16384
"Number of chars to process before the next parsing progress report.")
(defconst delphi-scanning-progress-step 2048
"Number of chars to process before the next scanning progress report.")
(defconst delphi-fontifying-progress-step delphi-scanning-progress-step
"Number of chars to process before the next fontification progress report.")
(defun delphi-progress-start ()
(setq delphi-progress-last-reported-point nil))
(defun delphi-progress-done (&rest msgs)
(setq delphi-progress-last-reported-point nil)
(when delphi-verbose
(if (null msgs)
(message "")
(apply #'message msgs))))
(defun delphi-step-progress (p desc step-size)
(cond ((null delphi-progress-last-reported-point)
(setq delphi-progress-last-reported-point p))
((and delphi-verbose
(>= (abs (- p delphi-progress-last-reported-point)) step-size))
(setq delphi-progress-last-reported-point p)
(message "%s %s ... %d%%"
desc (buffer-name) (/ (* 100 p) (point-max))))))
(defun delphi-next-line-start (&optional from-point)
(let ((curr-point (point))
(next nil))
(if from-point (goto-char from-point))
(end-of-line)
(setq next (min (1+ (point)) (point-max)))
(goto-char curr-point)
next))
(defun delphi-set-text-properties (from to properties)
(delphi-save-state
(set-text-properties from to properties)))
(defun delphi-literal-kind (p)
(if (and (<= (point-min) p) (<= p (point-max)))
(get-text-property p 'token)))
(defun delphi-literal-start-pattern (literal-kind)
(cdr (assoc literal-kind
'((comment-single-line . "//")
(comment-multi-line-1 . "{")
(comment-multi-line-2 . "(*")
(string . "'")
(double-quoted-string . "\"")))))
(defun delphi-literal-end-pattern (literal-kind)
(cdr (assoc literal-kind
'((comment-single-line . "\n")
(comment-multi-line-1 . "}")
(comment-multi-line-2 . "*)")
(string . "'")
(double-quoted-string . "\"")))))
(defun delphi-literal-stop-pattern (literal-kind)
(cdr (assoc literal-kind
'((comment-single-line . "\n")
(comment-multi-line-1 . "}")
(comment-multi-line-2 . "\\*)")
(string . "['\n]")
(double-quoted-string . "[\"\n]")))))
(defun delphi-is-literal-start (p)
(let* ((kind (delphi-literal-kind p))
(pattern (delphi-literal-start-pattern kind)))
(or (null kind) (delphi-looking-at-string p pattern))))
(defun delphi-is-literal-end (p)
(let* ((kind (delphi-literal-kind (1- p)))
(pattern (delphi-literal-end-pattern kind)))
(or (null kind)
(and (delphi-looking-at-string (- p (length pattern)) pattern)
(or (not (delphi-is kind delphi-strings))
(not (delphi-is-literal-end (1- p)))))
(and (delphi-is kind delphi-strings) (eq ?\n (char-after (1- p)))))))
(defun delphi-is-stable-literal (p)
(let ((at-start (delphi-is-literal-start p))
(at-end (delphi-is-literal-end p)))
(or (>= p (point-max))
(and at-start at-end)
(and (not at-start) (not at-end)
(eq (delphi-literal-kind (1- p)) (delphi-literal-kind p))))))
(defun delphi-complete-literal (literal-kind limit)
(let ((pattern (delphi-literal-stop-pattern literal-kind)))
(if (not (stringp pattern))
(error "Invalid literal kind %S" literal-kind)
(re-search-forward pattern limit 'goto-limit-on-fail)
(point))))
(defun delphi-literal-text-properties (kind)
(if (and (boundp 'font-lock-mode)
font-lock-mode)
(list 'token kind 'face (delphi-face-of kind) 'lazy-lock t)
(list 'token kind)))
(defun delphi-parse-next-literal (limit)
(let ((search-start (point)))
(cond ((not (delphi-is-literal-end search-start))
(let ((kind (delphi-literal-kind (1- search-start))))
(delphi-complete-literal kind limit)
(delphi-set-text-properties
search-start (point) (delphi-literal-text-properties kind))))
((re-search-forward
"\\(//\\)\\|\\({\\)\\|\\((\\*\\)\\|\\('\\)\\|\\(\"\\)"
limit 'goto-limit-on-fail)
(let ((kind (cond ((match-beginning 1) 'comment-single-line)
((match-beginning 2) 'comment-multi-line-1)
((match-beginning 3) 'comment-multi-line-2)
((match-beginning 4) 'string)
((match-beginning 5) 'double-quoted-string)))
(start (match-beginning 0)))
(delphi-set-text-properties search-start start nil)
(delphi-complete-literal kind limit)
(delphi-set-text-properties
start (point) (delphi-literal-text-properties kind))))
((delphi-set-text-properties search-start limit nil)))
(delphi-step-progress (point) "Parsing" delphi-parsing-progress-step)))
(defun delphi-literal-token-at (p)
(let ((kind (delphi-literal-kind p)))
(when kind
(let ((start (previous-single-property-change (1+ p) 'token))
(end (next-single-property-change p 'token)))
(delphi-token-of kind (or start (point-min)) (or end (point-max)))))))
(defun delphi-point-token-at (p kind)
(delphi-token-of kind p (1+ p)))
(defsubst delphi-char-token-at (p char kind)
(when (eq char (char-after p))
(delphi-token-of kind p (1+ p))))
(defun delphi-charset-token-at (p charset kind)
(let ((currp (point))
(end nil)
(start nil)
(token nil))
(goto-char p)
(when (> (skip-chars-forward charset) 0)
(setq end (point))
(goto-char (1+ p))
(skip-chars-backward charset)
(setq token (delphi-token-of kind (point) end)))
(goto-char currp)
token))
(defun delphi-space-token-at (p)
(delphi-charset-token-at p delphi-space-chars 'space))
(defun delphi-word-token-at (p)
(let ((word (delphi-charset-token-at p delphi-word-chars 'word)))
(when word
(let* ((word-image (downcase (delphi-token-string word)))
(keyword (intern-soft word-image)))
(when (and (or keyword (string= "nil" word-image))
(delphi-is keyword delphi-keywords))
(delphi-set-token-kind word keyword))
word))))
(defun delphi-explicit-token-at (p token-string kind)
(let ((token (delphi-charset-token-at p token-string kind)))
(when (and token (string= token-string (delphi-token-string token)))
token)))
(defun delphi-token-at (p)
(when (and (<= (point-min) p) (<= p (point-max)))
(cond ((delphi-literal-token-at p))
((delphi-space-token-at p))
((delphi-word-token-at p))
((delphi-char-token-at p ?\( 'open-group))
((delphi-char-token-at p ?\) 'close-group))
((delphi-char-token-at p ?\[ 'open-group))
((delphi-char-token-at p ?\] 'close-group))
((delphi-char-token-at p ?\n 'newline))
((delphi-char-token-at p ?\ ((delphi-char-token-at p ?. 'dot))
((delphi-char-token-at p ?, 'comma))
((delphi-char-token-at p ?= 'equals))
((delphi-char-token-at p ?+ 'plus))
((delphi-char-token-at p ?- 'minus))
((delphi-char-token-at p ?* 'times))
((delphi-char-token-at p ?/ 'divides))
((delphi-char-token-at p ?: 'colon))
((delphi-explicit-token-at p "<>" 'not-equals))
((delphi-point-token-at p 'punctuation)))))
(defun delphi-current-token ()
(delphi-token-at (point)))
(defun delphi-next-token (token)
(when token
(let ((next (delphi-token-at (delphi-token-end token))))
(if next
(delphi-step-progress (delphi-token-start next) "Scanning"
delphi-scanning-progress-step))
next)))
(defun delphi-previous-token (token)
(when token
(let ((previous (delphi-token-at (1- (delphi-token-start token)))))
(if previous
(delphi-step-progress (delphi-token-start previous) "Scanning"
delphi-scanning-progress-step))
previous)))
(defun delphi-next-visible-token (token)
(let (next-token)
(while (progn
(setq next-token (delphi-next-token token))
(delphi-is (delphi-token-kind next-token) '(space newline))))
next-token))
(defun delphi-parse-region (from to)
(save-restriction
(widen)
(goto-char from)
(while (< (point) to)
(delphi-parse-next-literal to))))
(defun delphi-parse-region-until-stable (from to)
(save-restriction
(widen)
(delphi-parse-region from to)
(while (not (delphi-is-stable-literal (point)))
(delphi-parse-next-literal (point-max)))))
(defun delphi-fontify-region (from to &optional verbose)
(delphi-save-excursion
(delphi-save-state
(let ((p from)
(delphi-verbose verbose)
(token nil))
(delphi-progress-start)
(while (< p to)
(setq token (delphi-token-at p))
(add-text-properties
(delphi-token-start token) (delphi-token-end token)
(list 'face (delphi-face-of (delphi-token-kind token)) 'lazy-lock t))
(setq p (delphi-token-end token))
(delphi-step-progress p "Fontifying" delphi-fontifying-progress-step))
(delphi-progress-done)))))
(defconst delphi-ignore-changes t
"Internal flag to control if the delphi-mode responds to buffer changes.
Defaults to t in case the delphi-after-change function is called on a
non-delphi buffer. Set to nil in a delphi buffer. To override, just do:
(let ((delphi-ignore-changes t)) ...)")
(defun delphi-after-change (change-start change-end old-length)
(unless delphi-ignore-changes
(let ((delphi-ignore-changes t)) (delphi-save-excursion
(delphi-progress-start)
(delphi-parse-region-until-stable
(delphi-token-start (delphi-token-at (1- change-start)))
(progn (goto-char change-end) (end-of-line) (point)))
(delphi-progress-done)))))
(defun delphi-group-start (from-token)
(let ((token (delphi-previous-token from-token))
(token-kind nil))
(catch 'done
(while token
(setq token-kind (delphi-token-kind token))
(cond
((eq 'close-group token-kind) (setq token (delphi-group-start token)))
((eq 'open-group token-kind) (throw 'done token)))
(setq token (delphi-previous-token token)))
nil)))
(defun delphi-group-end (from-token)
(let ((token (delphi-next-token from-token))
(token-kind nil))
(catch 'done
(while token
(setq token-kind (delphi-token-kind token))
(cond
((eq 'open-group token-kind) (setq token (delphi-group-end token)))
((eq 'close-group token-kind) (throw 'done token)))
(setq token (delphi-next-token token)))
nil)))
(defun delphi-indent-of (token &optional offset)
(let ((indent (+ (delphi-column-of (delphi-token-start token))
(if offset offset 0))))
(when delphi-debug
(delphi-debug-log
(concat "\n Indent of: %S %S"
"\n column: %d indent: %d offset: %d")
token (delphi-token-string token)
(delphi-column-of (delphi-token-start token))
indent (if offset offset 0)))
indent))
(defun delphi-line-indent-of (from-token &optional offset &rest terminators)
(let ((token (delphi-previous-token from-token))
(last-token from-token)
(kind nil))
(catch 'done
(while token
(setq kind (delphi-token-kind token))
(cond
((eq 'close-group kind) (setq token (delphi-group-start token)))
((delphi-is kind '(newline open-group)) (throw 'done nil))
((delphi-is kind terminators) (throw 'done nil)))
(unless (delphi-is kind delphi-whitespace) (setq last-token token))
(setq token (delphi-previous-token token))))
(delphi-indent-of last-token offset)))
(defun delphi-stmt-line-indent-of (from-token &optional offset)
(let ((token (delphi-previous-token from-token))
(last-token from-token)
(kind nil))
(catch 'done
(while token
(setq kind (delphi-token-kind token))
(cond
((and (eq 'colon kind)
(delphi-is (delphi-token-kind last-token)
`(,@delphi-block-statements
,@delphi-expr-statements)))
(throw 'done nil))
((eq 'close-group kind) (setq token (delphi-group-start token)))
((delphi-is kind `(newline open-group ,@delphi-use-clauses))
(throw 'done nil)))
(unless (delphi-is kind delphi-whitespace) (setq last-token token))
(setq token (delphi-previous-token token))))
(delphi-indent-of last-token offset)))
(defun delphi-open-group-indent (token last-token &optional offset)
(when (eq 'open-group (delphi-token-kind token))
(if last-token
(delphi-indent-of last-token offset)
(delphi-stmt-line-indent-of token delphi-indent-level))))
(defun delphi-composite-type-start (token last-token)
(if (and (eq 'equals (delphi-token-kind token))
(delphi-is (delphi-token-kind last-token) delphi-composite-types))
last-token))
(defun delphi-is-simple-class-type (at-token limit-token)
(when (delphi-is (delphi-token-kind at-token) delphi-class-types)
(catch 'done
(let ((token (delphi-next-token at-token))
(token-kind nil)
(limit (delphi-token-start limit-token)))
(while (and token (<= (delphi-token-start token) limit))
(setq token-kind (delphi-token-kind token))
(cond
((eq 'semicolon token-kind) (throw 'done token))
((eq 'open-group token-kind) (setq token (delphi-group-end token)))
((delphi-is token-kind `(of word ,@delphi-whitespace)))
((throw 'done nil)))
(setq token (delphi-next-token token)))))))
(defun delphi-block-start (from-token &optional stop-on-class)
(let ((token (delphi-previous-token from-token))
(last-token nil)
(token-kind nil))
(catch 'done
(while token
(setq token-kind (delphi-token-kind token))
(cond
((delphi-is token-kind delphi-end-block-statements)
(setq token (delphi-block-start token)))
((delphi-is token-kind delphi-block-statements) (throw 'done token))
((delphi-composite-type-start token last-token)
(throw 'done (if stop-on-class last-token token)))
)
(unless (delphi-is token-kind delphi-whitespace)
(setq last-token token))
(setq token (delphi-previous-token token)))
nil)))
(defun delphi-else-start (from-else)
(let ((token (delphi-previous-token from-else))
(token-kind nil)
(semicolon-count 0)
(if-count 0))
(catch 'done
(while token
(setq token-kind (delphi-token-kind token))
(cond
((eq 'close-group token-kind) (setq token (delphi-group-start token)))
((delphi-is token-kind delphi-end-block-statements)
(setq token (delphi-block-start token)))
((eq 'semicolon token-kind)
(setq semicolon-count (1+ semicolon-count)))
((and (eq 'if token-kind) (= semicolon-count 0))
(throw 'done token))
((eq 'case token-kind)
(throw 'done token)))
(setq token (delphi-previous-token token)))
nil)))
(defun delphi-comment-content-start (comment)
(let ((kind (delphi-token-kind comment)))
(when (delphi-is kind delphi-comments)
(delphi-save-excursion
(goto-char (+ (delphi-token-start comment)
(length (delphi-literal-start-pattern kind))))
(skip-chars-forward delphi-space-chars)
(point)))))
(defun delphi-comment-block-start (comment)
(if (not (eq 'comment-single-line (delphi-token-kind comment)))
comment
(let ((prev-comment comment)
(start-comment comment)
(kind nil))
(while (let ((kind (delphi-token-kind prev-comment)))
(cond ((eq kind 'space))
((eq kind 'comment-single-line)
(setq start-comment prev-comment))
(t nil)))
(setq prev-comment (delphi-previous-token prev-comment)))
start-comment)))
(defun delphi-comment-block-end (comment)
(if (not (eq 'comment-single-line (delphi-token-kind comment)))
comment
(let ((next-comment comment)
(end-comment comment)
(kind nil))
(while (let ((kind (delphi-token-kind next-comment)))
(cond ((eq kind 'space))
((eq kind 'comment-single-line)
(setq end-comment next-comment))
(t nil)))
(setq next-comment (delphi-next-token next-comment)))
end-comment)))
(defun delphi-on-first-comment-line (comment)
(save-excursion
(let ((comment-start (delphi-token-start comment))
(current-point (point)))
(goto-char comment-start)
(end-of-line)
(and (<= comment-start current-point) (<= current-point (point))))))
(defun delphi-comment-indent-of (comment)
(let ((start-comment (delphi-comment-block-start comment)))
(if (and (eq start-comment comment)
(delphi-on-first-comment-line comment))
(delphi-enclosing-indent-of comment)
(save-excursion
(let ((kind (delphi-token-kind comment)))
(beginning-of-line)
(cond ((eq 'comment-single-line kind)
(delphi-indent-of start-comment))
((looking-at (concat delphi-leading-spaces-re
(delphi-literal-stop-pattern kind)))
(delphi-indent-of comment))
((delphi-column-of (delphi-comment-content-start comment)))))))
))
(defun delphi-is-use-clause-end (at-token last-token last-colon from-kind)
(when (and last-token
(not last-colon)
(eq 'comma (delphi-token-kind at-token))
(eq 'semicolon from-kind))
(let ((token (delphi-previous-token at-token))
(token-kind nil))
(catch 'done
(while token
(setq token-kind (delphi-token-kind token))
(cond ((delphi-is token-kind delphi-use-clauses)
(throw 'done t))
((or (delphi-is token-kind '(word comma in newline))
(delphi-is token-kind delphi-whitespace)
(delphi-is token-kind delphi-strings)))
((throw 'done nil)))
(setq token (delphi-previous-token token)))
nil))))
(defun delphi-is-block-after-expr-statement (token)
(when (delphi-is (delphi-token-kind token) delphi-block-statements)
(let ((previous (delphi-previous-token token))
(previous-kind nil))
(while (progn
(setq previous-kind (delphi-token-kind previous))
(eq previous-kind 'space))
(setq previous (delphi-previous-token previous)))
(or (delphi-is previous-kind delphi-expr-delimiters)
(eq previous-kind 'else)))))
(defun delphi-previous-indent-of (from-token)
(let ((token (delphi-previous-token from-token))
(token-kind nil)
(from-kind (delphi-token-kind from-token))
(last-colon nil)
(last-token nil))
(catch 'done
(while token
(setq token-kind (delphi-token-kind token))
(cond
((eq 'open-group token-kind)
(throw 'done (delphi-open-group-indent token last-token)))
((eq 'close-group token-kind) (setq token (delphi-group-start token)))
((delphi-is token-kind delphi-end-block-statements)
(if (eq 'newline (delphi-token-kind (delphi-previous-token token)))
(throw 'done 0)
(setq token (delphi-block-start token))))
((delphi-is-use-clause-end token last-token last-colon from-kind)
(throw 'done 0))
((and last-token
(delphi-is token-kind delphi-previous-terminators)
(not (delphi-is (delphi-token-kind last-token)
delphi-directives)))
(throw 'done (delphi-stmt-line-indent-of last-token 0)))
((delphi-is token-kind delphi-whitespace))
((eq 'colon token-kind) (setq last-colon token))
((eq 'case token-kind)
(throw 'done
(if last-colon (delphi-line-indent-of last-colon)
(delphi-line-indent-of token delphi-case-label-indent))))
((delphi-is token-kind delphi-use-clauses)
(throw 'done
(if (eq 'comma from-kind)
(if last-token
(delphi-indent-of last-token)
(delphi-line-indent-of token delphi-indent-level))
(delphi-line-indent-of token))))
((eq token-kind 'asm)
(throw 'done (delphi-stmt-line-indent-of token delphi-indent-level)))
((delphi-is token-kind delphi-previous-enclosing-statements)
(throw 'done (if last-token
(delphi-line-indent-of last-token)
(delphi-line-indent-of token delphi-indent-level))))
((delphi-composite-type-start token last-token)
(throw
'done
(if (delphi-is-simple-class-type last-token from-token)
(delphi-line-indent-of token)
(delphi-line-indent-of last-token delphi-indent-level))))
((delphi-is token-kind delphi-previous-statements)
(throw 'done (delphi-stmt-line-indent-of token 0)))
)
(unless (delphi-is token-kind delphi-whitespace)
(setq last-token token))
(setq token (delphi-previous-token token)))
0)))
(defun delphi-section-indent-of (section-token)
(let* ((token (delphi-previous-token section-token))
(token-kind nil)
(last-token nil)
(nested-block-count 0)
(expr-delimited nil)
(last-terminator nil))
(catch 'done
(while token
(setq token-kind (delphi-token-kind token))
(cond
((eq token-kind 'open-group)
(throw 'done (delphi-open-group-indent token last-token)))
((eq 'close-group token-kind) (setq token (delphi-group-start token)))
((delphi-is token-kind delphi-end-block-statements)
(if (eq 'newline (delphi-token-kind (delphi-previous-token token)))
(throw 'done 0)
(setq token (delphi-block-start token)
nested-block-count (1+ nested-block-count))))
((eq 'forward token-kind)
(setq nested-block-count (1+ nested-block-count)))
((and (delphi-is token-kind delphi-routine-statements)
(> nested-block-count 0))
(setq nested-block-count (1- nested-block-count)))
((eq 'semicolon token-kind) (setq last-terminator token))
((delphi-is token-kind delphi-expr-delimiters)
(setq expr-delimited token))
((and (not last-terminator)
(delphi-is token-kind delphi-body-statements))
(throw 'done
(delphi-stmt-line-indent-of token delphi-compound-block-indent)))
((and (eq 'colon token-kind)
(delphi-is (delphi-token-kind section-token)
delphi-block-statements)
(not last-terminator)
(not expr-delimited)
(not (eq 'equals (delphi-token-kind last-token))))
(throw 'done
(delphi-stmt-line-indent-of token delphi-indent-level)))
((delphi-is token-kind delphi-begin-enclosing-tokens)
(throw 'done
(delphi-stmt-line-indent-of token delphi-indent-level)))
((and (delphi-is token-kind delphi-decl-delimiters)
(= 0 nested-block-count))
(throw 'done (delphi-line-indent-of token 0)))
((delphi-is token-kind delphi-unit-statements) (throw 'done 0))
)
(unless (delphi-is token-kind delphi-whitespace)
(setq last-token token))
(setq token (delphi-previous-token token)))
0)))
(defun delphi-enclosing-indent-of (from-token)
(let ((token (delphi-previous-token from-token))
(from-kind (delphi-token-kind from-token))
(token-kind nil)
(stmt-start nil)
(last-token nil)
(equals-encountered nil)
(before-equals nil)
(expr-delimited nil))
(catch 'done
(while token
(setq token-kind (delphi-token-kind token))
(cond
((eq 'open-group token-kind)
(throw 'done
(delphi-open-group-indent
token last-token
(if (delphi-is from-kind delphi-binary-ops)
0
delphi-indent-level))))
((eq 'close-group token-kind) (setq token (delphi-group-start token)))
((delphi-is token-kind delphi-end-block-statements)
(setq token (delphi-block-start token)))
((delphi-is token-kind delphi-expr-delimiters)
(setq expr-delimited token stmt-start last-token))
((and (not expr-delimited)
(delphi-is token-kind delphi-expr-statements))
(throw 'done
(cond ((delphi-is from-kind delphi-expr-delimiters)
(delphi-stmt-line-indent-of token 0))
((and last-token (delphi-is from-kind delphi-binary-ops))
(delphi-indent-of last-token))
(last-token
(delphi-indent-of last-token delphi-indent-level))
((delphi-indent-of token delphi-indent-level)))))
((eq 'case token-kind)
(throw 'done
(if stmt-start
(delphi-stmt-line-indent-of
stmt-start delphi-indent-level)
(delphi-stmt-line-indent-of
token delphi-case-label-indent))))
((delphi-is token-kind delphi-body-expr-statements)
(throw 'done
(delphi-stmt-line-indent-of
(or stmt-start token) delphi-indent-level)))
((eq 'else token-kind)
(throw 'done (delphi-stmt-line-indent-of
(or last-token token) delphi-indent-level)))
((delphi-is token-kind delphi-decl-sections)
(throw 'done (delphi-indent-of (if last-token last-token token)
delphi-indent-level)))
((delphi-is token-kind delphi-unit-sections) (throw 'done 0))
((delphi-is token-kind delphi-previous-terminators)
(throw 'done
(cond ((and last-token
(eq 'comma token-kind)
(delphi-is from-kind delphi-binary-ops))
(delphi-indent-of last-token))
(last-token
(delphi-indent-of last-token delphi-indent-level))
((delphi-previous-indent-of token)))))
((delphi-is-block-after-expr-statement token)
(throw 'done
(cond (last-token (delphi-indent-of last-token delphi-indent-level))
((+ (delphi-section-indent-of token) delphi-indent-level)))))
((eq token-kind 'asm)
(throw 'done (delphi-stmt-line-indent-of token delphi-indent-level)))
((delphi-is token-kind delphi-enclosing-statements)
(throw 'done (delphi-stmt-line-indent-of
(or last-token token) delphi-indent-level)))
((delphi-composite-type-start token last-token)
(throw 'done
(delphi-line-indent-of last-token delphi-indent-level)))
((and (eq token-kind 'colon)
(not expr-delimited)
(not (delphi-is from-kind delphi-expr-delimiters))
(not equals-encountered)
(not (eq from-kind 'equals)))
(throw 'done
(if last-token
(delphi-indent-of last-token delphi-indent-level)
(delphi-line-indent-of token delphi-indent-level 'semicolon))))
((and (eq token-kind 'colon) equals-encountered before-equals)
(cond
((eq (delphi-token-kind last-token) 'equals))
((throw 'done
(delphi-indent-of before-equals delphi-indent-level)))))
((eq token-kind 'equals)
(setq equals-encountered token
before-equals last-token))
)
(unless (delphi-is token-kind delphi-whitespace)
(setq last-token token))
(setq token (delphi-previous-token token)))
0)))
(defun delphi-corrected-indentation ()
(delphi-save-excursion
(delphi-progress-start)
(beginning-of-line)
(skip-chars-forward delphi-space-chars)
(let* ((token (delphi-current-token))
(token-kind (delphi-token-kind token))
(indent
(cond ((eq 'close-group token-kind)
(delphi-indent-of (delphi-group-start token)))
((delphi-is token-kind delphi-unit-statements) 0)
((delphi-is token-kind delphi-comments)
(delphi-comment-indent-of token))
((delphi-is token-kind delphi-decl-matchers)
(delphi-section-indent-of token))
((delphi-is token-kind delphi-match-block-statements)
(let ((block-start
(delphi-block-start token 'stop-on-class)))
(cond
((delphi-is-block-after-expr-statement block-start)
(delphi-section-indent-of block-start))
((delphi-stmt-line-indent-of block-start 0)))))
((eq 'else token-kind)
(delphi-stmt-line-indent-of (delphi-else-start token) 0))
((delphi-enclosing-indent-of
(if token token (delphi-token-at (1- (point)))))))))
(delphi-progress-done)
indent)))
(defun delphi-indent-line ()
"Indent the current line according to the current language construct. If
before the indent, the point is moved to the indent."
(interactive)
(delphi-save-match-data
(let ((marked-point (point-marker)) (new-point nil)
(line-start nil)
(old-indent 0)
(new-indent 0))
(beginning-of-line)
(setq line-start (point))
(skip-chars-forward delphi-space-chars)
(setq old-indent (current-column))
(setq new-indent (delphi-corrected-indentation))
(if (< marked-point (point))
(set-marker marked-point (point)))
(set-marker-insertion-type marked-point t)
(when (/= old-indent new-indent)
(delete-region line-start (point))
(insert (make-string new-indent ?\ )))
(goto-char marked-point)
(set-marker marked-point nil))))
(defvar delphi-mode-abbrev-table nil
"Abbrev table in use in delphi-mode buffers.")
(define-abbrev-table 'delphi-mode-abbrev-table ())
(defmacro delphi-ensure-buffer (buffer-var buffer-name)
`(when (not (buffer-live-p ,buffer-var))
(setq ,buffer-var (get-buffer-create ,buffer-name))))
(defun delphi-log-msg (to-buffer the-msg)
(with-current-buffer to-buffer
(save-selected-window
(switch-to-buffer-other-window to-buffer)
(goto-char (point-max))
(set-window-dot (get-buffer-window to-buffer) (point))
(insert the-msg))))
(defvar delphi-debug-buffer nil
"Buffer to write delphi-mode debug messages to. Created on demand.")
(defun delphi-debug-log (format-string &rest args)
(when delphi-debug
(delphi-ensure-buffer delphi-debug-buffer "*Delphi Debug Log*")
(delphi-log-msg delphi-debug-buffer
(concat (format-time-string "%H:%M:%S " (current-time))
(apply #'format (cons format-string args))
"\n"))))
(defun delphi-debug-token-string (token)
(let* ((image (delphi-token-string token))
(has-newline (string-match "^\\([^\n]*\\)\n\\(.+\\)?$" image)))
(when has-newline
(setq image (concat (match-string 1 image)
(if (match-beginning 2) "..."))))
image))
(defun delphi-debug-show-current-token ()
(interactive)
(let ((token (delphi-current-token)))
(delphi-debug-log "Token: %S %S" token (delphi-debug-token-string token))))
(defun delphi-debug-goto-point (p)
(interactive "NGoto char: ")
(goto-char p))
(defun delphi-debug-goto-next-token ()
(interactive)
(goto-char (delphi-token-start (delphi-next-token (delphi-current-token)))))
(defun delphi-debug-goto-previous-token ()
(interactive)
(goto-char
(delphi-token-start (delphi-previous-token (delphi-current-token)))))
(defun delphi-debug-show-current-string (from to)
(interactive "r")
(delphi-debug-log "String: %S" (buffer-substring from to)))
(defun delphi-debug-show-is-stable ()
(interactive)
(delphi-debug-log "stable: %S prev: %S next: %S"
(delphi-is-stable-literal (point))
(delphi-literal-kind (1- (point)))
(delphi-literal-kind (point))))
(defun delphi-debug-unparse-buffer ()
(interactive)
(delphi-set-text-properties (point-min) (point-max) nil))
(defun delphi-debug-parse-region (from to)
(interactive "r")
(let ((delphi-verbose t))
(delphi-save-excursion
(delphi-progress-start)
(delphi-parse-region from to)
(delphi-progress-done "Parsing done"))))
(defun delphi-debug-parse-window ()
(interactive)
(delphi-debug-parse-region (window-start) (window-end)))
(defun delphi-debug-parse-buffer ()
(interactive)
(delphi-debug-parse-region (point-min) (point-max)))
(defun delphi-debug-fontify-window ()
(interactive)
(delphi-fontify-region (window-start) (window-end) t))
(defun delphi-debug-fontify-buffer ()
(interactive)
(delphi-fontify-region (point-min) (point-max) t))
(defun delphi-debug-tokenize-region (from to)
(interactive)
(delphi-save-excursion
(delphi-progress-start)
(goto-char from)
(while (< (point) to)
(goto-char (delphi-token-end (delphi-current-token)))
(delphi-step-progress (point) "Tokenizing" delphi-scanning-progress-step))
(delphi-progress-done "Tokenizing done")))
(defun delphi-debug-tokenize-buffer ()
(interactive)
(delphi-debug-tokenize-region (point-min) (point-max)))
(defun delphi-debug-tokenize-window ()
(interactive)
(delphi-debug-tokenize-region (window-start) (window-end)))
(defun delphi-newline ()
"Terminate the current line with a newline and indent the next, unless
`delphi-newline-always-indents' is nil, in which case no reindenting occurs."
(interactive)
(delete-horizontal-space)
(newline)
(when delphi-newline-always-indents
(save-excursion
(previous-line 1)
(delphi-indent-line))
(delphi-indent-line)))
(defun delphi-tab ()
"Indent the current line or insert a TAB, depending on the value of
`delphi-tab-always-indents' and the current line position."
(interactive)
(if (or delphi-tab-always-indents (save-excursion (skip-chars-backward delphi-space-chars) (bolp)))
(delphi-indent-line)
(insert "\t")))
(defun delphi-is-directory (path)
(let ((attributes (file-attributes path)))
(and attributes (car attributes))))
(defun delphi-is-file (path)
(let ((attributes (file-attributes path)))
(and attributes (null (car attributes)))))
(defun delphi-search-directory (unit dir &optional recurse)
(when (delphi-is-directory dir)
(let ((files (directory-files dir))
(unit-file (downcase unit)))
(catch 'done
(mapcar #'(lambda (file)
(let ((path (concat dir "/" file)))
(if (and (string= unit-file (downcase file))
(delphi-is-file path))
(throw 'done path))))
files)
(when recurse
(mapcar #'(lambda (subdir)
(unless (member subdir '("." ".."))
(let ((path (delphi-search-directory
unit (concat dir "/" subdir) recurse)))
(if path (throw 'done path)))))
files))
nil))))
(defun delphi-find-unit-in-directory (unit dir)
(let ((dir-name dir)
(recurse nil))
(if (string-match "^\\(.+\\)\\.\\.\\.$" dir-name)
(setq dir-name (match-string 1 dir-name)
recurse t))
(if (string-match "^\\(.+\\)[\\\\/]$" dir-name)
(setq dir-name (match-string 1 dir-name)))
(delphi-search-directory unit dir-name recurse)))
(defun delphi-find-unit-file (unit)
(catch 'done
(cond ((null delphi-search-path)
(delphi-find-unit-in-directory unit "."))
((stringp delphi-search-path)
(delphi-find-unit-in-directory unit delphi-search-path))
((mapcar
#'(lambda (dir)
(let ((file (delphi-find-unit-in-directory unit dir)))
(if file (throw 'done file))))
delphi-search-path)))
nil))
(defun delphi-find-unit (unit)
"Finds the specified delphi source file according to `delphi-search-path'.
If no extension is specified, .pas is assumed. Creates a buffer for the unit."
(interactive "sDelphi unit name: ")
(let* ((unit-file (if (string-match "^\\(.*\\)\\.[a-z]+$" unit)
unit
(concat unit ".pas")))
(file (delphi-find-unit-file unit-file)))
(if (null file)
(error "unit not found: %s" unit-file)
(find-file file)
(if (not (eq major-mode 'delphi-mode))
(delphi-mode)))
file))
(defun delphi-find-current-def ()
"Find the definition of the identifier under the current point."
(interactive)
(error "delphi-find-current-def: not implemented yet"))
(defun delphi-find-current-xdef ()
"Find the definition of the identifier under the current point, searching
in external units if necessary (as listed in the current unit's use clause).
The set of directories to search for a unit is specified by the global variable
delphi-search-path."
(interactive)
(error "delphi-find-current-xdef: not implemented yet"))
(defun delphi-find-current-body ()
"Find the body of the identifier under the current point, assuming
it is a routine."
(interactive)
(error "delphi-find-current-body: not implemented yet"))
(defun delphi-fill-comment ()
"Fills the text of the current comment, according to `fill-column'.
An error is raised if not in a comment."
(interactive)
(save-excursion
(let* ((comment (delphi-current-token))
(comment-kind (delphi-token-kind comment)))
(if (not (delphi-is comment-kind delphi-comments))
(error "Not in a comment")
(let* ((start-comment (delphi-comment-block-start comment))
(end-comment (delphi-comment-block-end comment))
(comment-start (delphi-token-start start-comment))
(comment-end (delphi-token-end end-comment))
(content-start (delphi-comment-content-start start-comment))
(content-indent (delphi-column-of content-start))
(content-prefix (make-string content-indent ?\ ))
(content-prefix-re delphi-leading-spaces-re)
(p nil)
(marked-point (point-marker))) (when (eq 'comment-single-line comment-kind)
(setq content-prefix
(let ((comment-indent (delphi-column-of comment-start)))
(concat (make-string comment-indent ?\ ) "//"
(make-string (- content-indent comment-indent 2)
?\ )))
content-prefix-re (concat delphi-leading-spaces-re
"//"
delphi-spaces-re)
comment-end (if (delphi-is-literal-end comment-end)
(1- comment-end)
comment-end)))
(set-marker-insertion-type marked-point t)
(goto-char content-start)
(insert " ")
(delete-char -1)
(narrow-to-region content-start comment-end)
(setq p (point-min))
(while (when (< p (point-max))
(goto-char p)
(re-search-forward content-prefix-re nil t))
(replace-match "" nil nil)
(setq p (1+ (point))))
(goto-char (point-max))
(insert "\n")
(let ((fill-column (- fill-column content-indent)))
(fill-region (point-min) (point-max)))
(goto-char (point-max))
(delete-char -1)
(goto-char (point-min))
(end-of-line) (setq p (point))
(while (when (< p (point-max))
(goto-char p)
(re-search-forward "^" nil t))
(replace-match content-prefix nil nil)
(setq p (1+ (point))))
(setq comment-end (point-max))
(widen)
(goto-char marked-point)
(set-marker marked-point nil)
(delphi-progress-start)
(delphi-parse-region comment-start comment-end)
(delphi-progress-done))))))
(defun delphi-new-comment-line ()
"If in a // comment, does a newline, indented such that one is still in the
comment block. If not in a // comment, just does a normal newline."
(interactive)
(let ((comment (delphi-current-token)))
(if (not (eq 'comment-single-line (delphi-token-kind comment)))
(delphi-newline)
(let* ((start-comment (delphi-comment-block-start comment))
(comment-start (delphi-token-start start-comment))
(content-start (delphi-comment-content-start start-comment))
(prefix
(concat (make-string (delphi-column-of comment-start) ?\ ) "//"
(make-string (- content-start comment-start 2) ?\ ))))
(delete-horizontal-space)
(newline)
(insert prefix)))))
(defun delphi-match-token (token limit)
(set-match-data nil)
(if token
(let ((end (min (delphi-token-end token) limit)))
(set-match-data (list (delphi-token-start token) end))
(goto-char end)
token)))
(defconst delphi-font-lock-defaults
'(nil t nil nil nil (font-lock-fontify-region-function . delphi-fontify-region)
(font-lock-verbose . delphi-fontifying-progress-step))
"Delphi mode font-lock defaults. Syntactic fontification is ignored.")
(defvar delphi-debug-mode-map
(let ((kmap (make-sparse-keymap)))
(mapcar #'(lambda (binding) (define-key kmap (car binding) (cadr binding)))
'(("n" delphi-debug-goto-next-token)
("p" delphi-debug-goto-previous-token)
("t" delphi-debug-show-current-token)
("T" delphi-debug-tokenize-buffer)
("W" delphi-debug-tokenize-window)
("g" delphi-debug-goto-point)
("s" delphi-debug-show-current-string)
("a" delphi-debug-parse-buffer)
("w" delphi-debug-parse-window)
("f" delphi-debug-fontify-window)
("F" delphi-debug-fontify-buffer)
("r" delphi-debug-parse-region)
("c" delphi-debug-unparse-buffer)
("x" delphi-debug-show-is-stable)
))
kmap)
"Keystrokes for delphi-mode debug commands.")
(defvar delphi-mode-map
(let ((kmap (make-sparse-keymap)))
(mapcar #'(lambda (binding) (define-key kmap (car binding) (cadr binding)))
(list '("\r" delphi-newline)
'("\t" delphi-tab)
'("\177" backward-delete-char-untabify)
'("\C-cu" delphi-find-unit)
'("\M-q" delphi-fill-comment)
'("\M-j" delphi-new-comment-line)
(list "\C-c\C-d" delphi-debug-mode-map)))
kmap)
"Keymap used in Delphi mode.")
(defconst delphi-mode-syntax-table (make-syntax-table)
"Delphi mode's syntax table. It is just a standard syntax table.
This is ok since we do our own keyword/comment/string face coloring.")
(defun delphi-mode (&optional skip-initial-parsing)
"Major mode for editing Delphi code. \\<delphi-mode-map>
\\[delphi-tab]\t- Indents the current line for Delphi code.
\\[delphi-find-unit]\t- Search for a Delphi source file.
\\[delphi-fill-comment]\t- Fill the current comment.
\\[delphi-new-comment-line]\t- If in a // comment, do a new comment line.
M-x indent-region also works for indenting a whole region.
Customization:
`delphi-indent-level' (default 3)
Indentation of Delphi statements with respect to containing block.
`delphi-compound-block-indent' (default 0)
Extra indentation for blocks in compound statements.
`delphi-case-label-indent' (default 0)
Extra indentation for case statement labels.
`delphi-tab-always-indents' (default t)
Non-nil means TAB in Delphi mode should always reindent the current line,
regardless of where in the line point is when the TAB command is used.
`delphi-newline-always-indents' (default t)
Non-nil means NEWLINE in Delphi mode should always reindent the current
line, insert a blank line and move to the default indent column of the
blank line.
`delphi-search-path' (default .)
Directories to search when finding external units.
`delphi-verbose' (default nil)
If true then delphi token processing progress is reported to the user.
Coloring:
`delphi-comment-face' (default font-lock-comment-face)
Face used to color delphi comments.
`delphi-string-face' (default font-lock-string-face)
Face used to color delphi strings.
`delphi-keyword-face' (default font-lock-keyword-face)
Face used to color delphi keywords.
`delphi-other-face' (default nil)
Face used to color everything else.
Turning on Delphi mode calls the value of the variable delphi-mode-hook with
no args, if that value is non-nil."
(interactive)
(kill-all-local-variables)
(use-local-map delphi-mode-map)
(setq major-mode 'delphi-mode)
(setq mode-name "Delphi")
(setq local-abbrev-table delphi-mode-abbrev-table)
(set-syntax-table delphi-mode-syntax-table)
(mapcar #'(lambda (var)
(let ((var-symb (car var))
(var-val (cadr var)))
(make-local-variable var-symb)
(set var-symb var-val)))
(list '(indent-line-function delphi-indent-line)
'(comment-indent-function delphi-indent-line)
'(case-fold-search t)
'(delphi-progress-last-reported-point nil)
'(delphi-ignore-changes nil)
(list 'font-lock-defaults delphi-font-lock-defaults)))
(make-local-hook 'after-change-functions)
(add-hook 'after-change-functions 'delphi-after-change nil t)
(widen)
(unless skip-initial-parsing
(delphi-save-excursion
(let ((delphi-verbose t))
(delphi-progress-start)
(delphi-parse-region (point-min) (point-max))
(delphi-progress-done))))
(run-hooks 'delphi-mode-hook))