-
Notifications
You must be signed in to change notification settings - Fork 1
/
eassist.el
422 lines (371 loc) · 18.3 KB
/
eassist.el
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
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
;;; eassist.el --- EmacsAssist, C/C++/Java/Python/ELisp method/function navigator.
;; Copyright (C) 2006, 2007, 2010 Anton V. Belyaev
;; 2013 Yuan Liu
;; Author: Anton V. Belyaev <anton.belyaev at the gmail.com>
;; Yuan Liu <xiaolang001 at the gmail.com>
;; This file is *NOT* part of GNU Emacs.
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of
;; the License, or (at your option) any later version.
;; This program is distributed in the hope that it will be
;; useful, but WITHOUT ANY WARRANTY; without even the implied
;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE. See the GNU General Public License for more details.
;; You should have received a copy of the GNU General Public
;; License along with this program; if not, write to the Free
;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
;; MA 02111-1307 USA
;; Version: 0.10
;; CEDET CVS Version: $Id: eassist.el,v 1.7 2010/02/08 23:29:59 zappo Exp $
;; Compatibility: Emacs 22, 23 or 24, CEDET 1.0pre4
;;; Commentary:
;; Contains some useful functions features for C/C++ developers similar to
;; those from VisualAssist. Remember that convenient M-o, M-g and M-m?
;; 1) Method navigation.
;; When eassist-list-methods called when c/c++ body file buffer is active
;; a new buffer is shown, containing list of methods and functions in the
;; format: return type, class, method name. You can select the method
;; moving to its line and press ENTER to jump to the method. You also can
;; type a string in the buffer and method list will be reduced to those
;; which contain the string as a substring. Nice highlight is implemented.
;; This function is recommended to be bound to M-m in c-mode.
;; 2) Header <-> Body file switch.
;; You can easily switch between body (c, cpp, cc...) and its corresponding
;; header file (h, hpp...) using eassist-switch-h-cpp. The counterpart file
;; is first searched in opened buffers and if there is no match the file is
;; searched in the same directory. You can adjust body to header correspondence
;; customizing eassist-header-switches variable.
;; This function is recommended to be bound to M-o in c-mode.
;; EmacsAssist uses Semantic (http://cedet.sourceforge.net/semantic.shtml)
;; EmacsAssist is a part of CEDET project (current CVS version of CEDET contains
;; EmacsAssist)
;; EmacsAssist works with current (22) and development (23) versions of Emacs and
;; does not work with version 21.
;; EmacsAssist works with CEDET 1.0pre4 and subsequent CVS versions of CEDET.
;; EmacsAssist has a page at Emacs Wiki, where you can always find the latest
;; version: http://www.emacswiki.org/cgi-bin/wiki/EAssist
;; Usage:
;; 1) Install CEDET package for Emacs (if you don't have CEDET already).
;; 2) Add convenient keymaps for fast EmacsAssist calls in c-mode and (or) python-mode
;; and for lisp:
;;
;; (defun my-c-mode-common-hook ()
;; (define-key c-mode-base-map (kbd "M-o") 'eassist-switch-h-cpp)
;; (define-key c-mode-base-map (kbd "M-m") 'eassist-list-methods))
;; (add-hook 'c-mode-common-hook 'my-c-mode-common-hook)
;;
;; (defun my-python-mode-hook ()
;; (define-key python-mode-map (kbd "M-m") 'eassist-list-methods))
;; (add-hook 'python-mode-hook 'my-python-mode-hook)
;;
;; (define-key lisp-mode-shared-map (kbd "M-m") 'eassist-list-methods)
;;
;; 3) Open any C++ file with class definition, press M-m. Try to type
;; any method name.
;; 4) Open any .cpp file. Press M-o. If there is .h or .hpp file in the
;; same folder, it will be opened.
;;; Changelog:
;; 27 mar 2006 -- v0.1 Initial version created.
;; 29 mar 2006 -- v0.2 Code is more readable now.
;; Thanks to Thien-Thi Nguyen for code review!
;; 17 apr 2006 -- v0.3 Added Java and Python support. Coloring based on faces.
;; Multiple string matching.
;; 12 sep 2006 -- v0.4 Fixed ELisp code handling. Reduced string matching to function name only.
;; 23 feb 2007 -- v0.5 Added (require 'semantic) to fix possible issues.
;; Thanks to Damien Deville for the patch.
;; 13 mar 2007 -- v0.6 Added documentation to functions.
;; Thanks to Eric Ludlam for CHECKDOC tool suggestion.
;; 23 jun 2007 -- v0.7 EAssist is now a part of CEDET project.
;; Added autoload cookies for some vars and funs.
;; 29 aug 2007 -- v0.8 "M-o" function now tries first to use already opened buffers
;; and if there are no counterparts, tries to search them in the
;; current directory.
;; Thanks to Alekseenko Dimitry for great feature suggestion.
;; 23 feb 2008 -- v0.9 "M-m" buffer comes up with current function highlighted.
;; Thanks to Christoph Conrad for great suggestions and patches.
;;
;; 26 mar 2013 -- v0.10 Fix bug of `eassist-list-methods' the nested namespace appear in c++ files. By Yuan.Liu
;;; Code:
(require 'semantic)
;; ================================== My STRING utils ========================
(defun eassist-string-without-last (string n)
"This function truncates from the STRING last N characters."
(substring string 0 (max 0(- (length string) n))))
(defun eassist-string-ends-with (string end)
"Check whether STRING ends with END substring."
(string= end (substring string (- (length end)))))
;; ================================== My STRING utils end ====================
;; ================================== CPP-H switch ===========================
;;;###autoload
(defvar eassist-header-switches '(("h" . ("cpp" "cc" "c"))
("hpp" . ("cpp" "cc"))
("cpp" . ("h" "hpp"))
("c" . ("h"))
("C" . ("H"))
("H" . ("C" "CPP" "CC"))
("cc" . ("h" "hpp")))
"This variable defines possible switches for `eassist-switch-h-cpp' function.
Its format is list of (from . (to1 to2 to3...)) elements. From and toN are
strings which are extentions of the files.")
;;;###autoload
(defun eassist-switch-h-cpp ()
"Switch header and body file according to `eassist-header-switches' var.
The current buffer's file name extention is searched in
`eassist-header-switches' variable to find out extention for file's counterpart,
for example *.hpp <--> *.cpp."
(interactive)
(let* ((ext (file-name-extension (buffer-file-name)))
(base-name (eassist-string-without-last (buffer-name) (length ext)))
(base-path (eassist-string-without-last (buffer-file-name) (length ext)))
(count-ext (cdr (find-if (lambda (i) (string= (car i) ext)) eassist-header-switches))))
(cond
(count-ext
(unless
(or
(loop for b in (mapcar (lambda (i) (concat base-name i)) count-ext)
when (bufferp (get-buffer b)) return
(if (get-buffer-window b)
(switch-to-buffer-other-window b)
(if (get-buffer-window b t)
(switch-to-buffer-other-frame b)
(switch-to-buffer b))))
(loop for c in (mapcar (lambda (count-ext) (concat base-path count-ext)) count-ext)
when (file-exists-p c) return (find-file c)))
(message "There is no corresponding pair (header or body) file.")))
(t
(message "It is not a header or body file! See eassist-header-switches variable.")))))
;; ================================== CPP-H switch end =========================
;; ================================== Method navigator =========================
(defvar eassist-current-tag nil
"Current Semantic tag in source buffer.")
(defvar eassist-buffer nil
"Buffer used to selecting tags in EAssist.")
(defvar eassist-names-column nil
"Column used when selecting tags in EAssist.")
(defvar eassist-methods nil
"Collection of methods used when searching for current selection.")
(defvar eassist-actual-methods nil
"Collection of actual methods used when searching for current selection.")
(defvar eassist-search-string nil
"The current search string during a search.")
(defvar eassist-overlays nil
"List of active overlays.")
(defun eassist-function-tags ()
"Return all function tags from the current buffer using Semantic API.
The function first gets all toplevel function tags from the current buffer.
Then it searches for all toplevel type tags and gets all function tags that
are children to toplevel type tags. Secondlevel function (member) tags are
annotated (without side effect) with :parent attribute to have the same
structure as toplevel function tags."
(nconc
;; for C++/C
(semantic-find-tags-by-class 'function (semantic-something-to-tag-table eassist-buffer))
;; for Java and Python: getting classes and then methods for each class.
;; Adding parent property for each method, beacause semantic does not provide parents for
;; methods which are inside body of the class. This is true for Java class methods,
;; for C++ header definitions and for Python class methods.
(mapcan
(lambda (type)
(mapcar
(lambda (tag) (semantic-tag-put-attribute-no-side-effect tag :parent (semantic-tag-name type)))
(semantic-find-tags-by-class 'function (semantic-tag-type-members type))))
(semantic-find-tags-by-class 'type (semantic-something-to-tag-table eassist-buffer)))))
(defun eassist-function-tags-recursive (buffer)
"Same as `eassist-function-tags', recursively call when meet type(namespace in c++)"
(nconc
;; for C++/C
(semantic-find-tags-by-class 'function (semantic-something-to-tag-table buffer))
;; for Java and Python: getting classes and then methods for each class.
;; Adding parent property for each method, beacause semantic does not provide parents for
;; methods which are inside body of the class. This is true for Java class methods,
;; for C++ header definitions and for Python class methods.
(mapcan
(lambda (type)
(mapcar
(lambda (tag)
(semantic-tag-put-attribute-no-side-effect
tag :parent (concat (semantic-tag-name type)
(let ((parent-local (semantic-tag-get-attribute tag :parent)))
(if parent-local
(concat "::" parent-local))))))
(let (function-buffer variable-buffer type-buffer)
(nconc (if (setq function-buffer (semantic-find-tags-by-class 'function (semantic-tag-type-members type)))
(mapcar
(lambda (func)
(semantic-tag-put-attribute-no-side-effect func :parent nil))
function-buffer))
(if (setq type-buffer (semantic-find-tags-by-class 'type (semantic-tag-type-members type)))
(eassist-function-tags-recursive type-buffer))))))
(semantic-find-tags-by-class 'type (semantic-something-to-tag-table buffer)))))
(defun eassist-car-if-list (thing)
"Return car of THING if it is a list or THING itself, if not."
(cond ((listp thing) (car thing))
(t thing)))
(defun eassist-function-string-triplet (f)
"Return a list of three strings, representing type, parent and name of tag F."
(list
(eassist-car-if-list (semantic-tag-type f))
(semantic-tag-function-parent f)
(semantic-tag-name f)))
(defun eassist-format-triplets (f)
"Return a list of formatted (whitespaces, faces, delimeters) methods/function.
F - list of triplets of tag type, parent and name."
(let ((return-width (reduce 'max (mapcar 'length (mapcar 'car f)) :initial-value 0))
(class-width (reduce 'max (mapcar 'length (mapcar 'cadr f)) :initial-value 0))
(name-width (reduce 'max (mapcar 'length (mapcar 'caddr f)) :initial-value 0)))
(setq eassist-names-column (+ return-width class-width 4))
(mapcar
(lambda (tri)
(let ((retrn (car tri))
(class (cadr tri))
(name (caddr tri)))
(setq retrn (if retrn (propertize retrn 'face 'font-lock-type-face) ""))
(if class
;; (setq class (propertize class 'face 'font-lock-type-face)))
(setq class (propertize class 'face 'font-lock-constant-face)))
(setq name (propertize name 'face 'font-lock-function-name-face))
(cond
(class (format (format "%%%ds %%%ds :: %%s\n" return-width class-width) retrn class name))
(t (format (format "%%%ds %%%ds %%s\n" return-width class-width) retrn "" name)))))
f)))
;;;###autoload
(defun eassist-list-methods ()
"Show method/function list of current buffer in a newly created buffer.
This function is recommended to be bound to some convinient hotkey."
(interactive)
(setq eassist-buffer (current-buffer))
(setq eassist-current-tag (semantic-current-tag))
(switch-to-buffer (get-buffer-create (concat (buffer-name (current-buffer)) " method list")) t)
(eassist-mode))
(defun eassist-jump-to-method ()
"Jump to a method/function, corresponding the current line in method buffer.
When called standing on a line of method/function list, it closes the list
buffer and sets the point to a method/function, corresponding the line."
(interactive)
(let ((method-record (nth (1- (line-number-at-pos)) eassist-actual-methods)))
(cond
(method-record
(kill-buffer (current-buffer))
(switch-to-buffer eassist-buffer t)
(goto-char (eassist-method-position method-record))
(recenter))
(t (message "The line does not contain method description!")))))
(defun eassist-matches-all (string substrings)
"Return non-nil if STRING contain each of SUBSTRINGS as a substring."
(reduce (lambda (prev part) (and prev (string-match part string))) substrings :initial-value t))
(defun eassist-search-string-updated ()
"Update method/function list according to search string."
(message eassist-search-string)
(setq eassist-actual-methods
(remove-if-not
(lambda (elt) (eassist-matches-all (eassist-method-name elt) (split-string eassist-search-string)))
eassist-methods))
(erase-buffer)
(dolist (i eassist-overlays)
(delete-overlay i))
(setq eassist-overlays nil)
(loop for i in (mapcar 'eassist-method-full-line eassist-actual-methods)
with pos = 1
with strings = (split-string eassist-search-string)
do
(insert i)
(dolist (j strings)
(let ((p (string-match j i eassist-names-column)))
(when p
(push (make-overlay (+ pos p) (+ pos p (length j))) eassist-overlays)
(overlay-put (car eassist-overlays) 'face '(background-color . "yellow")))))
(setq pos (+ pos (length i))))
(goto-line (/ (count-lines (point-min) (point-max)) 2)))
(defun eassist-key-pressed (key)
"Called when KEY is pressed."
(setq eassist-search-string (concat eassist-search-string (char-to-string key)))
(eassist-search-string-updated))
(defun eassist-backspace-pressed ()
"Called when Backspace is pressed."
(interactive)
(setq eassist-search-string (eassist-string-without-last eassist-search-string 1))
(eassist-search-string-updated))
(defun eassist-make-key-function (key)
"Return a function for KEY."
`(lambda () (interactive) (eassist-key-pressed ,key)))
(defun eassist-key-itself (map key)
"Maps in the MAP KEY to its function."
(define-key map (char-to-string key) (eassist-make-key-function key)))
(defun eassist-escape ()
"Kill method list buffer."
(interactive)
(kill-buffer (current-buffer))
(switch-to-buffer eassist-buffer))
(defvar eassist-mode-map
(let ((map (make-sparse-keymap)))
(suppress-keymap map)
(do ((k (string-to-char "a") (+ 1 k))) ((> k (string-to-char "z")))
(define-key
map
(read-kbd-macro (char-to-string k))
(eassist-make-key-function k)))
(do ((k (string-to-char "A") (+ 1 k))) ((> k (string-to-char "Z")))
(define-key
map
(read-kbd-macro (char-to-string k))
(eassist-make-key-function k)))
(do ((k (string-to-char "0") (+ 1 k))) ((> k (string-to-char "9")))
(define-key
map
(read-kbd-macro (char-to-string k))
(eassist-make-key-function k)))
(dolist (k (string-to-list "=><&!"))
(define-key
map
(read-kbd-macro (char-to-string k))
(eassist-make-key-function k)))
(eassist-key-itself map (string-to-char " "))
(eassist-key-itself map (string-to-char "_"))
(define-key map (kbd "<RET>") 'eassist-jump-to-method)
(define-key map (kbd "<backspace>") 'eassist-backspace-pressed)
(define-key map (kbd "<ESC>") 'eassist-escape)
map)
"Keymap for `eassist-mode'.")
(defstruct eassist-method
(full-line)
(name)
(position)
(tag))
(defun eassist-mode-init ()
"Initialize method/function list mode."
(make-local-variable 'eassist-search-string) ;; current method search string
(make-local-variable 'eassist-methods) ;; list of eassist-method structures
(make-local-variable 'eassist-actual-methods) ;; subset of eassist-methods that contain eassist-search string in the name string
(make-local-variable 'eassist-names-column) ;; this is the column where method name fields starts
(make-local-variable 'eassist-overlays) ;; overlays used to highligh search string matches in method names
(setq eassist-overlays nil)
(setq eassist-search-string "")
(setq eassist-methods
(let* ((method-tags (eassist-function-tags-recursive eassist-buffer))
(method-triplets (mapcar 'eassist-function-string-triplet method-tags)))
(mapcar* '(lambda (full-line name position tag)
(make-eassist-method :full-line full-line :name name :position position :tag tag))
(eassist-format-triplets method-triplets)
(mapcar 'caddr method-triplets)
(mapcar 'semantic-tag-start method-tags)
method-tags)))
(eassist-search-string-updated)
;; Set current line corresponding to the current function/method if any
(let ((line (position-if
(lambda (item) (eq eassist-current-tag (eassist-method-tag item)))
eassist-methods)))
(when line
(goto-line (1+ line))))
;;(setq b1 (current-buffer))
;;(setq ov1 (make-overlay 1 30 b1))
;;(overlay-put ov1 'face '(background-color . "yellow"))
(hl-line-mode))
(define-derived-mode eassist-mode nil "Eassist methods"
"EmacsAssist method selection mode.
\\{eassist-mode-map}
Turning on Text mode runs the normal hook `eassist-mode-hook'."
(eassist-mode-init))
;; ================================== Method navigator end ======================
(provide 'eassist)
;;; eassist.el ends here