blob: fcbb3ae0fb7e4072982fb555f04e554843e84cdf (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
|
;;; delphi-mode-ench.el
(require 'compile)
(pushnew '("^\\([-a-zA-Z0-9\\.\\/_~]+\\)(\\([0-9]+\\),\\([0-9]+\\))\s\\([Ff]atal:\\|[Nn]ote:\\|[Ww]arning:\\|[Ee]rror:\\)\s\\(.*$\\)" 1 2 3)
compilation-error-regexp-alist)
(setq auto-mode-alist (cons '("\\.pas" . delphi-mode) auto-mode-alist))
(setq delphi-unit-sections
'(implementation program library package))
(defconst delphi-method-types-regexp
"\\(procedure\\|function\\|constructor\\|destructor\\)"
"Regular expression for delphi method types")
(defconst delphi-method-signature-regexp
;; like mymethod(myvar1:varType; myvar2:varType=defaultvalue):TReturnType
(concat
"\\("
(concat
;; mymethod
"[_a-zA-Z][_a-zA-Z0-9]*"
;; (myvar1:varType; myvar2:varType=defaultvalue)
"\\((.*)\\)?"
;; : TReturnType
"\\( *: *[_a-zA-Z][_a-zA-Z0-9]*\\)?")
"\\)")
"Signature of a delphi method")
(defconst delphi-class-declaration-regexp
;;like TMyClass = class(TParentClass)
"\\(?:^\\|[ \t]\\)[ \t]*\\([_a-zA-Z][_a-zA-Z0-9]*\\) *= *class"
"Class declaration regexp")
(defvar imenu--function-name-regexp-delphi
(concat
"^[ \t]*\\(function\\|procedure\\|constructor\\|destructor\\)[ \t]+"
"\\([_a-zA-Z][_a-zA-Z0-9]*\\.\\)?"
"\\([_a-zA-Z][_a-zA-Z0-9]*\\)")
"Re to get function/procedure names in Delphi.")
(defun delphi-get-classes ()
(save-excursion
(goto-char (point-min))
(let ((classes '()))
(while (re-search-forward delphi-class-declaration-regexp nil t)
(push (match-string-no-properties 1) classes))
classes)))
(defun delphi-in-string (&optional pos)
(delphi-is (delphi-token-kind (delphi-token-at (point))) delphi-strings))
(defun delphi-in-comment (&optional pos)
(delphi-is (delphi-token-kind (delphi-token-at (point))) delphi-comments))
(defun delphi-is-definition (&optional pos)
(let ((class (save-excursion (delphi-in-class-definition))))
(if class class
(if pos (goto-char pos))
(re-search-forward "\\(begin\\|implementation\\)" nil t)
(let ((match (match-string-no-properties 1)))
(if (equal match "implementation") 't 'nil)))))
(defun delphi-in-class-definition (&optional pos)
(if pos (goto-char pos))
(let ((break 't) (class nil) (open-blocks 0) (max-negative 0))
(while (and break
(re-search-backward (concat "\\(?:\\(?:^\\|[^_a-zA-Z0-9]\\)"
"\\(end\\|record\\|case\\|begin\\)"
"\\(?:$\\|[^_a-zA-Z0-9]\\)"
"\\|\\(?:^\\|[ \t]\\)"
"\\([_a-zA-Z][_a-zA-Z0-9]*\\)"
"[ \t]*=[ \t]*class\\)") nil t))
(let ((result (match-string-no-properties 1)))
(if (not (or (delphi-in-string) (delphi-in-comment)))
(cond ((equal result "end")
(setq open-blocks (+ open-blocks 1)))
((or
(or
(equal result "record")
(equal result "case")) (equal result "begin"))
(setq open-blocks (- open-blocks 1))
(setq max-negative (min open-blocks max-negative)))
('t (setq break nil)
(if (= open-blocks max-negative)
(setq class (match-string-no-properties 2))))))))
class)
)
(defun imenu--create-delphi-index (&optional regexp)
(let ((index-alist '())
(progress-prev-pos 0)
(case-fold-search t))
(goto-char (point-min))
(imenu-progress-message progress-prev-pos 0)
(save-match-data
(while (re-search-forward
(or regexp imenu--function-name-regexp-delphi)
'nil 't)
(imenu-progress-message progress-prev-pos)
(let ((pos (save-excursion
(beginning-of-line)
(if imenu-use-markers (point-marker) (point))))
(function-name (match-string-no-properties 3))
(class-name (match-string-no-properties 2)))
(let ((class-def (save-excursion (delphi-is-definition pos))))
(let ((class-name (if class-name (substring class-name 0 -1) class-def))
(content (let ((sub-alist (if (not (equal class-def 't))
(assoc class-def index-alist)
index-alist)))
(if (not (equal class-def 'nil))
(cond ((assoc "Definition" sub-alist)
(let ((alist (reverse (assoc "Definition" sub-alist))))
(setcdr (assoc "Definition" sub-alist)
(cdr (reverse (push (cons function-name pos) alist)))))
nil)
(t
(list "Definition" (cons function-name pos))))
(cons function-name pos)))))
(if content (cond
((not (or (equal class-name 'nil) (equal class-name 't)))
(cond ((assoc class-name index-alist)
(let ((alist (reverse (assoc class-name index-alist))))
(setcdr (assoc class-name index-alist)
(cdr (reverse (push content alist))))))
(t
(push (list class-name content) index-alist))
))
(t
(push content index-alist))))
)))))
(imenu-progress-message progress-prev-pos 100)
(setq index-alist (nreverse index-alist))
; remove class-name if only one class exists
(if (equal (length index-alist) 1) (setq index-alist (cdr (car index-alist))))
index-alist))
(defun delphi-method-jump ()
(cond ((save-excursion (delphi-is-definition)) (delphi-go-to-method-implementation))
('t (delphi-go-to-method-definition))))
(defun delphi-go-to-method-definition ()
"Move cursor to method definition of current edited method"
(interactive)
(re-search-backward (concat
delphi-method-types-regexp
" *"
"\\([_a-zA-Z][_a-zA-Z0-9]*\\)\\."
delphi-method-signature-regexp))
(let
((class (match-string 2))
(method (match-string 3)))
(message "%s %s" class method)
(re-search-backward (concat class " *= *class"))
(re-search-forward method)))
(defun delphi-go-to-method-implementation ()
"Move cursor to method implementation of method on current line"
(interactive)
(beginning-of-line)
(let (methodtype methodname class)
(re-search-forward (concat
delphi-method-types-regexp
" *"
delphi-method-signature-regexp))
(setq methodtype (match-string 1)
methodname (match-string 2))
(re-search-backward delphi-class-declaration-regexp)
(setq class (match-string 1))
(re-search-forward (concat methodtype " +" class "\\." methodname))))
(defun delphi-complete-method ()
"Create the method skeleton for method definition under cursor"
(interactive)
(beginning-of-line)
(let (methodtype methodname class)
(re-search-forward (concat
delphi-method-types-regexp
" *"
delphi-method-signature-regexp))
(setq methodtype (match-string 1)
methoddef (match-string 2))
(re-search-backward delphi-class-declaration-regexp)
(setq class (match-string 1))
(end-of-buffer)
(re-search-backward (concat
"\\("
delphi-method-types-regexp
" *"
class
"\\)\\|implementation"))
(next-line)
(re-search-forward (concat
delphi-method-types-regexp
"\\|\\(initialization\\|finalization\\|end\\.\\)"))
(previous-line)
(newline 2)
(previous-line 2)
(insert (concat methodtype " " class "." methoddef ";"))
(newline)
(insert "begin")
(newline 2)
(insert "end;")
(previous-line)))
;;key binding
(add-hook 'delphi-mode-hook
'(lambda ()
(define-key delphi-mode-map "\C-c\C-mi" 'delphi-go-to-method-implementation)
(define-key delphi-mode-map "\C-c\C-md" 'delphi-go-to-method-definition)
(define-key delphi-mode-map "\C-c\C-mc" 'delphi-complete-method)))
; hook if starting delphi-mode
(add-hook 'delphi-mode-hook
'(lambda ()
(setq comment-start "// ")
(require 'imenu)
(setq imenu-create-index-function
'imenu--create-delphi-index)
(imenu-add-menubar-index)))
|
