mirror of https://github.com/Chizi123/.emacs.d.git

Chizi123
2018-11-19 a4b9172aefa91861b587831e06f55b1e19f3f3be
commit | author | age
5cb5f7 1 ;;; srefactor.el --- A refactoring tool based on Semantic parser framework
C 2 ;;
3 ;; Filename: srefactor.el
4 ;; Description: A refactoring tool based on Semantic parser framework
5 ;; Author: Tu, Do Hoang <tuhdo1710@gmail.com>
6 ;; URL      : https://github.com/tuhdo/semantic-refactor
7 ;; Maintainer: Tu, Do Hoang
8 ;; Created: Wed Feb 11 21:25:51 2015 (+0700)
9 ;; Version: 0.3
10 ;; Package-Requires: ((emacs "24.4"))
11 ;; Last-Updated: Wed Feb 11 21:25:51 2015 (+0700)
12 ;;           By: Tu, Do Hoang
13 ;;     Update #: 1
14 ;; URL:
15 ;; Doc URL:
16 ;; Keywords: c, languages, tools
17 ;; Compatibility: GNU Emacs: 24.3+
18 ;;
19 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
20 ;;
21 ;;; Commentary:
22 ;;
23 ;; Semantic is a package that provides a framework for writing
24 ;; parsers. Parsing is a process of analyzing source code based on
25 ;; programming language syntax. This package relies on Semantic for
26 ;; analyzing source code and uses its results to perform smart code
27 ;; refactoring that based on code structure of the analyzed language,
28 ;; instead of plain text structure.
29 ;;
30 ;; To use this package, user only needs to use this single command:
31 ;; `srefactor-refactor-at-point'
32 ;;
33 ;; This package includes the following features:
34 ;;
35 ;; - Context-sensitive menu: when user runs the command, a menu
36 ;; appears and offer refactoring choices based on current scope of
37 ;; semantic tag. For example, if the cursor is inside a class, the
38 ;; menu lists choices such as generate function implementations for
39 ;; the class, generate class getters/setters... Each menu item also
40 ;; includes its own set of options, such as perform a refactoring
41 ;; option in current file or other file.
42 ;;
43 ;; - Generate class implementation: From the header file, all function
44 ;; prototypes of a class can be generated into corresponding empty
45 ;; function implementation in a source file. The generated function
46 ;; implementations also include all of their (nested) parents as
47 ;; prefix in the names, if any. If the class is a template, then the
48 ;; generated functions also includes all templates declarations and in
49 ;; the parent prefix properly.
50 ;;
51 ;; - Generate function implementation: Since all function
52 ;; implementations can be generated a class, this feature should be
53 ;; present.
54 ;;
55 ;; - Generate function prototype: When the cursor is in a function
56 ;; implementation, a function prototype can be generated and placed in
57 ;; a selected file. When the prototype is moved into, its prefix is
58 ;; stripped.
59 ;;
60 ;; - Convert function to function pointer: Any function can be
61 ;; converted to a function pointer with typedef. The converted
62 ;; function pointer can also be placed as a parameter of a function.
63 ;; In this case, all the parameter names of the function pointer is
64 ;; stripped.
65 ;;
66 ;; - Move semantic units: any meaningful tags recognized by Semantic
67 ;; (class, function, variable, namespace...) can be moved relative to
68 ;; other tags in current file or any other file.
69 ;;
70 ;; - Extract function: select a region and turn it into a function,
71 ;; with relevant variables turned into function parameters and
72 ;; preserve full type information.
73 ;;
74 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
75 ;;
76 ;; This program is free software: you can redistribute it and/or modify
77 ;; it under the terms of the GNU General Public License as published by
78 ;; the Free Software Foundation, either version 3 of the License, or (at
79 ;; your option) any later version.
80 ;;
81 ;; This program is distributed in the hope that it will be useful, but
82 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
83 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
84 ;; General Public License for more details.
85 ;;
86 ;; You should have received a copy of the GNU General Public License
87 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
88 ;;
89 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
90 ;;
91 ;;; Code:
92
93 (require 'cl-lib)
94 (require 'cc-mode)
95 (require 'semantic)
96 (require 'semantic/tag-ls)
97 (require 'semantic/bovine/c)
98 (require 'semantic/format)
99 (require 'semantic/doc)
100 (require 'srecode/semantic)
101 (require 'srefactor-ui)
102
103 (if (not (version< emacs-version "24.4"))
104     (require 'subr-x)
105   (defun string-empty-p (string)
106     "Check whether STRING is empty."
107     (string= string ""))
108
109   (defun string-trim-left (string)
110     "Remove leading whitespace from STRING."
111     (if (string-match "\\`[ \t\n\r]+" string)
112         (replace-match "" t t string)
113       string))
114
115   (defun string-trim-right (string)
116     "Remove trailing whitespace from STRING."
117     (if (string-match "[ \t\n\r]+\\'" string)
118         (replace-match "" t t string)
119       string)))
120
121 (when (version< emacs-version "25")
122   (defalias 'semantic-documentation-comment-preceding-tag 'semantic-documentation-comment-preceeding-tag))
123
124 (defvar srefactor--current-local-var nil
125   "Current local variable at point")
126 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
127 ;; User options
128 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
129 (defcustom srefactor--getter-prefix "get_"
130   "Prefix for inserting getter."
131   :group 'srefactor)
132
133 (defcustom srefactor--setter-prefix "set_"
134   "Prefix for inserting getter."
135   :group 'srefactor)
136
137 (defcustom srefactor--getter-setter-removal-prefix ""
138   "Prefix for removing getter and setter."
139   :group 'srefactor)
140
141 (defcustom srefactor--getter-setter-capitalize-p nil
142   "Whether getter and setter should be capitalized."
143   :group 'srefactor
144   :type 'boolean)
145
146 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
147 ;; Developer Options
148 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
149
150 (defvar srefactor-use-srecode-p nil
151   "Use experimental SRecode tag insertion ")
152
153 ;; MACROS
154 (defmacro srefactor--is-proto (type)
155   `(eq ,type 'gen-func-proto))
156
157 (defmacro srefactor--add-menu-item (label operation-type file-options)
158   `(add-to-list 'menu-item-list (list ,label
159                                       ',operation-type
160                                       ,file-options)))
161 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
162 ;; Commands - only one currently
163 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
164
165 ;;;###autoload
166 (defun srefactor-refactor-at-point ()
167   "Offer contextual menu with actions based on current tag in scope.
168
169 Each menu item added returns a token for what type of refactoring
170 to perform."
171   (interactive)
172   (let* ((semanticdb-find-default-throttle '(file))
173          (refresh (semantic-parse-changes-default))
174          (srefactor--file-options (srefactor-ui--return-option-list 'file))
175          (tag (srefactor--copy-tag))
176          (menu (make-instance 'srefactor-ui-menu :name "menu"))
177          menu-item-list)
178     (setq srefactor--current-local-var (srefactor--menu-add-rename-local-p))
179     (when (srefactor--menu-add-function-implementation-p tag)
180       (srefactor--add-menu-item "Generate Function Implementation (Other file)"
181                                 gen-func-impl
182                                 srefactor--file-options))
183     (when (srefactor--menu-add-function-proto-p tag)
184       (srefactor--add-menu-item  "Generate Function Prototype (Other file)"
185                                  gen-func-proto
186                                  srefactor--file-options))
187     (when (srefactor--menu-add-function-pointer-p tag)
188       (srefactor--add-menu-item "Generate Function Pointer (Current file)"
189                                 gen-func-ptr
190                                 srefactor--file-options))
191     (when (srefactor--menu-add-getters-setters-p tag)
192       (srefactor--add-menu-item  "Generate Getters and Setters (Current file)"
193                                  gen-getters-setters
194                                  srefactor--file-options))
195     (when (srefactor--menu-add-getter-setter-p tag)
196       (srefactor--add-menu-item  "Generate Setter (Current file)"
197                                  gen-setter
198                                  srefactor--file-options)
199       (srefactor--add-menu-item  "Generate Getter (Current file)"
200                                  gen-getter
201                                  srefactor--file-options)
202       (srefactor--add-menu-item  "Generate Getter and Setter (Current file)"
203                                  gen-getter-setter
204                                  srefactor--file-options))
205     (when srefactor--current-local-var
206       (setq tag srefactor--current-local-var)
207       (srefactor--add-menu-item  "Rename local variable (Current file)"
208                                  rename-local-var
209                                  '("(Current file)")))
210     (when (srefactor--menu-add-move-p)
211       (srefactor--add-menu-item  "Move (Current file)"
212                                  move
213                                  srefactor--file-options))
214     (when (region-active-p)
215       (srefactor--add-menu-item  "Extract function (Current file)"
216                                  extract-function
217                                  nil))
218     (oset menu :items menu-item-list)
219     (oset menu :action #'srefactor-ui--refactor-action)
220     (oset menu :context tag)
221     (oset menu :shortcut-p t)
222     (srefactor-ui-create-menu menu)))
223
224 (defun srefactor--tag-filter (predicate tag-classes-or-names tags)
225   "Filter TAGS based on PREDICATE that satisfies TAG-CLASSES-OR-NAMES.
226
227 TAG-CLASSES-OR-NAMES can be a list of Semantic tag classes, or a
228 list of Semantic tag names, but not both.
229
230 Based on the type of list passed above, either use
231 `semantic-tag-class' or `semantic-tag-name' as PREDICATE."
232   (let (l)
233     (dolist (tag tags l)
234       (when (member (funcall predicate tag) tag-classes-or-names)
235         (setq l (cons tag l))))))
236
237 (defun srefactor--c-tag-start-with-comment (tag)
238   (save-excursion
239     (goto-char (semantic-tag-start tag))
240     (if (and (search-backward-regexp "/\\*" nil t)
241              (semantic-documentation-comment-preceding-tag tag)
242              (looking-at "^[ ]*\\/\\*"))
243         (progn
244           (beginning-of-line)
245           (point))
246       (semantic-tag-start tag))))
247
248 (defun srefactor--copy-tag ()
249   "Take the current tag, and place it in the tag ring."
250   (semantic-fetch-tags)
251   (let ((ft (semantic-current-tag)))
252     (when ft
253       (ring-insert senator-tag-ring ft)
254       (semantic-tag-set-bounds ft
255                                (srefactor--c-tag-start-with-comment ft)
256                                (semantic-tag-end ft))
257       (kill-ring-save (semantic-tag-start ft)
258                       (semantic-tag-end ft))
259       (when (called-interactively-p 'interactive)
260         (message "Use C-y to yank text.  \
261 Use `senator-yank-tag' for prototype insert.")))
262     ft))
263
264 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
265 ;; High level functions that select action to make
266 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
267 (defun srefactor--refactor-based-on-tag-class (operation &optional file-option)
268   "Refactor based on current tag in context.
269
270 OPERATION is a refactoring type user selected from the menu.
271 FILE-OPTION is a file destination associated with OPERATION."
272   (let* ((refactor-tag (srefactor--copy-tag))
273          (class (semantic-tag-class refactor-tag)))
274     (cond
275      ((eq class 'function)
276       (cond
277        ((eq operation 'extract-function)
278         (srefactor--extract-region 'function))
279        ((eq operation 'rename-local-var)
280         (let* ((local-var (srefactor--tag-at-point))
281                (function-tag (semantic-current-tag))
282                (search-start (semantic-tag-start function-tag))
283                (search-end (semantic-tag-end function-tag))
284                prompt)
285           (unwind-protect
286               (condition-case nil
287                   (let ((tag-occurrences (srefactor--collect-tag-occurrences local-var
288                                                                              search-start
289                                                                              search-end)))
290                     (srefactor--highlight-tag local-var tag-occurrences refactor-tag 'match)
291                     (setq prompt (format "Replace (%s) with: " (semantic-tag-name local-var)))
292                     (srefactor--rename-local-var local-var
293                                                  tag-occurrences
294                                                  refactor-tag
295                                                  (read-from-minibuffer prompt)))
296                 (error nil))
297             (remove-overlays))))
298        (t
299         (let ((other-file (srefactor--select-file file-option)))
300           (srefactor--refactor-tag (srefactor--contextual-open-file other-file)
301                                    refactor-tag
302                                    operation
303                                    t)))))
304      ((eq class 'type)
305       (cond
306        ((eq operation 'gen-getters-setters)
307         (srefactor-insert-class-getters-setters refactor-tag file-option)
308         (message "Getter and setter generated."))
309        ((eq operation 'move)
310         (let ((other-file (srefactor--select-file file-option)))
311           (srefactor--refactor-tag (srefactor--contextual-open-file other-file)
312                                    refactor-tag
313                                    operation
314                                    t)))
315        (t (srefactor--refactor-type (srefactor--contextual-open-file
316                                      (srefactor--select-file file-option))
317                                     refactor-tag))))
318      ((eq class 'variable)
319       (cond
320        ((eq operation 'gen-getter-setter)
321         (let ((buffer (srefactor--contextual-open-file (srefactor--select-file file-option))))
322           (srefactor--variable-insert-getter-setter t t refactor-tag buffer))
323         (message "Getter and setter generated."))
324        ((eq operation 'gen-getter)
325         (let ((buffer (srefactor--contextual-open-file (srefactor--select-file file-option))))
326           (srefactor--variable-insert-getter-setter t nil refactor-tag buffer))
327         (message "Getter generated."))
328        ((eq operation 'gen-setter)
329         (let ((buffer (srefactor--contextual-open-file (srefactor--select-file file-option))))
330           (srefactor--variable-insert-getter-setter nil t refactor-tag buffer))
331         (message "Setter generated."))
332        ((eq operation 'move)
333         (let ((other-file (srefactor--select-file file-option)))
334           (srefactor--refactor-tag (srefactor--contextual-open-file other-file)
335                                    refactor-tag
336                                    operation
337                                    t)))
338        (t nil)))
339      ((eq class 'package)
340       (message "FIXME: 'package refactoring is not yet implemented."))
341      ((eq class 'include)
342       (message "FIXME: 'include refactoring is not yet implemented."))
343      ((eq class 'label)
344       (message "FIXME: 'label refactoring is not yet implemented."))
345      (t))))
346
347 (defun srefactor--select-file (option)
348   "Return a file based on OPTION selected by a user."
349   (let ((projectile-func-list '(projectile-get-other-files
350                                 projectile-current-project-files
351                                 projectile-project-root
352                                 projectile-find-file))
353         other-files file l)
354     (when (and (featurep 'projectile)
355              (cl-reduce (lambda (acc f)
356                           (and (fboundp f) acc))
357                         projectile-func-list
358                         :initial-value t))
359         (cond
360          ((string-equal option "(Other file)")
361           (condition-case nil
362               (progn
363                 (setq other-files (projectile-get-other-files (buffer-file-name)
364                                                               (projectile-current-project-files)
365                                                               nil))
366                 (setq l (length other-files))
367                 (setq file (concat (projectile-project-root)
368                                    (cond ((> l 1)
369                                           (completing-read "Select a file: "
370                                                            other-files))
371                                          ((= l 1)
372                                           (car other-files))
373                                          (t (projectile-find-file))))))
374             (error nil)))
375          ((and (string-equal option "(Project file)")
376                (featurep 'projectile))
377           (setq file (concat (projectile-project-root)
378                              (completing-read "Select a file: "
379                                               (projectile-current-project-files)))))
380          ))
381
382     (when (string-equal option "(Current file)")
383       (setq file (buffer-file-name (current-buffer))))
384
385     (when (string-equal option "(File)")
386       (setq file (with-current-buffer (call-interactively 'find-file-other-window)
387                    (buffer-file-name (current-buffer)))))
388     file))
389
390 (defun srefactor--tag-persistent-action ()
391   "Move to a tag when executed."
392   (back-to-indentation)
393   (when srefactor-ui--current-active-tag-overlay
394     (delete-overlay srefactor-ui--current-active-tag-overlay))
395   (let (link tag)
396     (save-excursion
397       (if (search-forward ":" (line-end-position) t)
398           (setq link (get-pos-property (point) 'button))
399         (setq link (get-pos-property (point) 'button))))
400     (when (and link
401                (listp (widget-value link))
402                (semantic-tag-p (car (widget-value link))))
403       (with-selected-window srefactor-ui--current-active-window
404         (setq tag (car (widget-value link)))
405         (when (car (widget-value link))
406           (semantic-go-to-tag tag)
407           (let ((o (make-overlay (semantic-tag-start tag)
408                                  (semantic-tag-end tag))))
409             (setq srefactor-ui--current-active-tag-overlay o)
410             (overlay-put o 'face 'region)))))))
411
412 (defun srefactor--refactor-tag (buffer refactor-tag func-type &optional ask-place-p)
413   "Refactor a tag.
414
415 BUFFER is a buffer from opening selected file chosen from the menu.
416
417 REFACTOR-TAG is selected tag to be refactored.
418
419 FUNC-TYPE is a refactoring action to be performed.
420
421 ASK-PLACE-P, if true, asks user to select a tag in BUFFER to insert next to it."
422   (let (dest-tag
423         (tag-list (nreverse (srefactor--fetch-candidates))))
424     (setq srefactor-ui--func-type func-type)
425     (with-current-buffer buffer
426       (if (and ask-place-p tag-list)
427           (progn
428             (oset srefactor-ui--current-active-menu :items tag-list)
429             (oset srefactor-ui--current-active-menu :action #'srefactor-ui--tag-action)
430             (oset srefactor-ui--current-active-menu :shortcut-p nil)
431             (oset srefactor-ui--current-active-menu :persistent-action 'srefactor--tag-persistent-action)
432             (oset srefactor-ui--current-active-menu :post-handler
433                   (lambda ()
434                     (let ((tag (context srefactor-ui--current-active-menu))
435                           tag-string)
436                       (with-temp-buffer
437                         (setq major-mode 'c++-mode)
438                         (setq tag-string (semantic-format-tag-summarize tag nil nil)))
439                       (search-forward-regexp (regexp-quote tag-string) (point-max) t)
440                       (back-to-indentation))))
441             (oset srefactor-ui--current-active-menu :keymap
442                   (lambda ()
443                     (cl-flet ((next (key)
444                                     (define-key srefactor-ui-menu-mode-map key
445                                       (lambda ()
446                                         (interactive)
447                                         (widget-forward 1)
448                                         (srefactor--tag-persistent-action))))
449                               (previous (key)
450                                         (define-key srefactor-ui-menu-mode-map key
451                                           (lambda ()
452                                             (interactive)
453                                             (widget-backward 1)
454                                             (srefactor--tag-persistent-action)))))
455                       (next "n")
456                       (next "j")
457                       (previous "p")
458                       (previous "k"))))
459             (srefactor-ui-create-menu srefactor-ui--current-active-menu))
460         (srefactor--insert-tag refactor-tag nil func-type)))))
461
462 (defun srefactor--refactor-type (dest-buffer refactor-tag)
463   "Generate function implementations for all functions in a
464 class, including functions in nested classes.
465
466 DEST-BUFFER is the destination buffer to insert generated code.
467 REFACTOR-TAG is a Semantic tag that holds information of a C++ class."
468   (let* ((members (semantic-tag-type-members refactor-tag))
469          (dest-buffer-tags (with-current-buffer dest-buffer
470                              (semantic-fetch-tags)))
471          (diff (set-difference members
472                                dest-buffer-tags
473                                :test #'semantic-equivalent-tag-p))
474          )
475     (dolist (tag diff)
476       (cond
477        ((and (eq (semantic-tag-class tag) 'function)
478              (semantic-tag-prototype-p tag))
479         (srefactor--refactor-tag dest-buffer tag 'gen-func-impl))
480        ((eq (semantic-tag-class tag) 'type)
481         (srefactor--refactor-type dest-buffer tag))
482        (t)))))
483
484 (defun srefactor--insert-tag (refactor-tag dest-tag insert-type &optional pos)
485   "Insert a Semantic TAG to current buffer.
486
487 REFACTOR-TAG is selected Semantic tag to be refactored.
488
489 DEST-TAG is destination tag for refactored tag to be inserted
490 next to it. If nil, insert at the end of file.
491
492 POS is specific relative position to be inserted. POS is one of
493 the option \"Before|Inside|After\" that appears when a
494 destination tag can have its own members, such as a class or a
495 namespace.
496 "
497   (let* ((parent-is-func-p (eq (semantic-tag-class (semantic-tag-calculate-parent dest-tag))
498                                'function))
499          (class (semantic-tag-class refactor-tag))
500          beg end)
501
502     ;; if  refactor-tag dest-tag is nil, just insert at end of file
503     (if dest-tag
504         (progn
505           (semantic-go-to-tag dest-tag)
506
507           (if parent-is-func-p
508               (srefactor--insert-function-as-parameter refactor-tag)
509
510             ;; Handle selected position
511             (cond
512              ((string-equal pos "(Before)")
513               (open-line 1))
514              ((string-equal pos "(Inside)")
515               (search-forward "{")
516               (newline 1))
517              (t (goto-char (semantic-tag-end dest-tag))
518                 (forward-line 1)))
519
520             ;; handle insert type
521             (cond
522              ((eq insert-type 'gen-func-ptr)
523               (srefactor--insert-function-pointer refactor-tag)
524               (newline-and-indent)
525               (recenter))
526              ((or (eq insert-type 'gen-func-impl) (eq insert-type 'gen-func-proto))
527               (if (region-active-p)
528                   (mapc (lambda (f-t)
529                           (srefactor--insert-function f-t insert-type))
530                         (semantic-parse-region (region-beginning) (region-end)))
531                 (srefactor--insert-function refactor-tag insert-type)))
532              ((srefactor--tag-pointer refactor-tag)
533               (semantic-insert-foreign-tag (srefactor--function-pointer-to-function refactor-tag)))
534              ((eq insert-type 'move)
535               (with-current-buffer (semantic-tag-buffer refactor-tag)
536                 (save-excursion
537                   (goto-char (semantic-tag-start refactor-tag))
538                   (delete-region (semantic-tag-start refactor-tag)
539                                  (semantic-tag-end refactor-tag))
540                   (delete-blank-lines)))
541               (if (and (or (srefactor--tag-struct-p dest-tag)
542                            (srefactor--tag-struct-p
543                             (srefactor--calculate-parent-tag dest-tag)))
544                        (eq class 'function)
545                        (eq major-mode 'c-mode))
546                   (progn
547                     (insert (srefactor--function-to-function-pointer refactor-tag))
548                     (insert ";"))
549                 (delete-trailing-whitespace)
550                 (if (eq class 'function)
551                     (srefactor--insert-function refactor-tag (if (semantic-tag-prototype-p refactor-tag)
552                                                                  'gen-func-proto
553                                                                'gen-func-proto))
554                   (setq beg (point))
555                   (yank)
556                   (insert "\n")
557                   (setq end (point))
558                   (indent-region beg end))))
559              (t (senator-yank-tag)))))
560       (goto-char (point-max))
561       (cond
562        ((eq insert-type 'gen-func-ptr)
563         (srefactor--insert-function-pointer refactor-tag))
564        ((eq insert-type 'gen-func-impl)
565         (srefactor--insert-function refactor-tag 'gen-func-impl))
566        ((eq insert-type 'gen-func-proto)
567         (srefactor--insert-function refactor-tag 'gen-func-proto))
568        ((semantic-tag-get-attribute refactor-tag :function-pointer)
569         (semantic-insert-foreign-tag (srefactor--function-pointer-to-function refactor-tag)))
570        (t (senator-yank-tag))))
571
572     ;; indent after inserting refactor-tag
573     (indent-according-to-mode)
574     ))
575
576 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
577 ;; Functions - IO
578 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
579 (defun srefactor--contextual-open-file (other-file)
580   "If the current buffer is also the selected file, don't open
581 the file in another window but use the current buffer and window
582 instead.
583
584 OTHER-FILE is the selected file from the menu."
585   (if other-file
586       (cond
587        ((srefactor--switch-to-window other-file)
588         (current-buffer))
589        ((equal other-file (buffer-file-name (current-buffer)))
590         (find-file other-file))
591        (t (find-file-other-window other-file)
592           (current-buffer)))
593     ;; use ff-find-other-file when no file is chosen,
594     ;; it means that user selected (Other file) option, but
595     ;; does not install Projectile so he cannot use its function to
596     ;; return the filename of other file. In this case, he simply gets
597     ;; nil, which mean it's the job for `ff-find-other-file'. This needs
598     ;; fixing in the future
599     (ff-find-other-file t t)
600
601     ;; `ff-find-other-file' does not return a buffer but switching to
602     ;; the opened buffer instantly. We must return a buffer from this
603     ;; function otherwise things go wrong
604     (current-buffer)))
605
606 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
607 ;; Functions that insert actual text or modify text
608 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
609
610 ;;
611 ;; CLASS
612 ;;
613 (defun srefactor-insert-class-getters-setters (tag file-option)
614   "Insert getter-setter of a class TAG into file specified in FILE-OPTION."
615   (semantic-fetch-tags-fast)
616   (let ((tag (semantic-current-tag))
617         (buffer (srefactor--contextual-open-file (srefactor--select-file file-option))))
618     (when (eq (semantic-tag-class tag) 'type)
619       (when (eq (semantic-tag-class tag) 'type)
620         (let* ((members (srefactor--tag-filter 'semantic-tag-class
621                                                '(variable label)
622                                                (semantic-tag-type-members tag)))
623                (variables (srefactor--tag-filter 'semantic-tag-class '(variable) members))
624                (tag-start (semantic-tag-start tag)))
625           (dolist (v variables)
626             (when (srefactor--tag-private-p v)
627               (srefactor--variable-insert-getter-setter t t v buffer)))
628           (recenter))))))
629
630 (defun srefactor--insert-getter (tag &optional newline-before newline-after prototype-p)
631   "Insert getter for TAG.
632 Add NEWLINE-BEFORE and NEWLINE-AFTER if t."
633   (let ((tag-type (srefactor--tag-type-string tag))
634         (tag-buffer (semantic-tag-buffer tag))
635         (tag-parent-string "")
636         tag-name beg)
637     (setq beg (point))
638     (unless (eq tag-buffer (current-buffer))
639       (setq tag-parent-string (srefactor--tag-parents-string tag)))
640     (when newline-before
641       (newline newline-before))
642     (when (and (or (listp (semantic-tag-type tag))
643                    (semantic-tag-get-attribute tag :pointer))
644                (not (semantic-tag-get-attribute tag :constant-flag)))
645       (insert "const "))
646     (insert tag-type)
647     (setq tag-name (replace-regexp-in-string srefactor--getter-setter-removal-prefix
648                                              ""
649                                              (semantic-tag-name tag)))
650     (insert (concat " "
651                     tag-parent-string
652                     srefactor--getter-prefix
653                     (if srefactor--getter-setter-capitalize-p
654                         (capitalize tag-name)
655                       tag-name)))
656     (insert "() const")
657     (if prototype-p
658         (insert ";")
659       (insert " {")
660       (srefactor--indent-and-newline 1)
661       (insert (concat "return"
662                       " "
663                       (semantic-tag-name tag) ";"))
664       (srefactor--indent-and-newline 1)
665       (insert "}")
666       (indent-according-to-mode)
667       (when newline-after
668         (newline newline-after)))
669     (indent-region beg (point))))
670
671 (defun srefactor--insert-setter (tag newline-before newline-after &optional prototype-p)
672   "Insert setter for TAG.
673 Add NEWLINE-BEFORE and NEWLINE-AFTER if t."
674   (when newline-before
675     (newline newline-before))
676   (let ((tag-type (srefactor--tag-type-string tag))
677         (tag-type (srefactor--tag-type-string tag))
678         (tag-pointer (srefactor--tag-pointer tag))
679         (tag-name (semantic-tag-name tag))
680         (tag-type-string (srefactor--tag-type-string tag))
681         (tag-buffer (semantic-tag-buffer tag))
682         tag-parent-string modified-tag-name beg)
683     (setq beg (point))
684     (unless (eq tag-buffer (current-buffer))
685       (setq tag-parent-string (srefactor--tag-parents-string tag)))
686     (insert "void")
687     (setq modified-tag-name (replace-regexp-in-string srefactor--getter-setter-removal-prefix
688                                                       ""
689                                                       (semantic-tag-name tag)))
690     (insert (concat " "
691                     tag-parent-string
692                     srefactor--setter-prefix
693                     (if srefactor--getter-setter-capitalize-p
694                         (capitalize modified-tag-name)
695                       modified-tag-name)))
696     (insert (concat (insert "(")
697                     (unless (semantic-tag-variable-constant-p tag)
698                       "const ")
699                     tag-type
700                     (when (and (listp tag-type)
701                                ;; (srefactor--tag-reference tag)
702                                (not tag-pointer))
703                       "&")
704                     " "
705                     tag-name
706                     ")"))
707     (if prototype-p
708         (insert ";")
709       (insert " {")
710       (srefactor--indent-and-newline 1)
711       (insert (concat "this->" tag-name " = " tag-name ";"))
712       (srefactor--indent-and-newline 1)
713       (insert "}")
714       (indent-according-to-mode)
715       (when newline-after
716         (newline newline-after)))
717     (indent-region beg (point))))
718
719 (defun srefactor--jump-or-insert-public-label (tag)
720   "Check if TAG is a class or struct.
721 If so, check if any public label exists, jump to it.
722 Otherwise, insert one."
723   (when (eq (semantic-tag-class tag) 'type)
724     (goto-char (semantic-tag-start tag))
725     (let* (label-pos
726            (members (srefactor--tag-filter 'semantic-tag-class
727                                            '(variable label)
728                                            (semantic-tag-type-members tag)))
729            (public-label (car (srefactor--tag-filter 'semantic-tag-name
730                                                      '("public")
731                                                      members))))
732       (if public-label
733           (progn
734             (if (semantic-overlay-start (semantic-tag-overlay public-label))
735                 (progn
736                   (goto-char (semantic-tag-end public-label))
737                   (setq label-pos (semantic-tag-start public-label)))
738               (search-forward "public:")
739               (setq label-pos (point))))
740         (goto-char (semantic-tag-end tag))
741         (search-backward "}")
742         (open-line 1)
743         (insert "public:")
744         (setq label-pos (point)))
745       label-pos)))
746
747 (defun srefactor--variable-insert-getter-setter (insert-getter-p insert-setter-p tag buffer)
748   "Insert getter if INSERT-GETTER-P is t, insert setter if INSERT-SETTER-P is t.
749 TAG is the current variable at point.
750 BUFFER is the destination buffer from file user selects from contextual menu."
751   (with-current-buffer buffer
752     (unless (srefactor--jump-or-insert-public-label (save-excursion
753                                                       (goto-char (semantic-tag-start tag))
754                                                       (semantic-current-tag-parent)))
755       (goto-char (point-max)))
756     (unless (eq buffer (semantic-tag-buffer tag))
757       (with-current-buffer (semantic-tag-buffer tag)
758         (srefactor--jump-or-insert-public-label (save-excursion
759                                                   (goto-char (semantic-tag-start tag))
760                                                   (semantic-current-tag-parent)))
761         (when insert-getter-p (srefactor--insert-getter tag 1 1 t))
762         (when insert-setter-p (srefactor--insert-setter tag 1 1 t))))
763     (when insert-getter-p (srefactor--insert-getter tag 1 1))
764     (when insert-setter-p (srefactor--insert-setter tag 1 1))))
765
766 ;;
767 ;; FUNCTION
768 ;;
769 (defun srefactor--insert-with-srecode (func-tag)
770   "Insert a tag using srecode"
771   (let* ((copy (semantic-tag-copy func-tag))
772          ;; (parent (semantic-tag-calculate-parent func-tag))
773          ;; TODO - below srefactor fcn should be a part of semantic or srecode.
774          (parentstring1 (srefactor--tag-parents-string func-tag))
775          (parentstring (substring parentstring1 0 (- (length parentstring1) 2)))
776          (endofinsert nil))
777     ;; Copied this line from original
778     (semantic-tag-put-attribute func-tag :typemodifiers nil)
779     (semantic-tag-put-attribute func-tag :parent parentstring)
780     ;; Insert the tag
781     (require 'srecode/semantic)
782     ;; TODO - does it need any special dictionary entries?
783     (setq endofinsert
784           (srecode-semantic-insert-tag
785            func-tag
786            nil ;; Style
787            (lambda (localtag)
788              (srefactor--insert-initial-content-based-on-return-type
789               (if (or (srefactor--tag-function-constructor copy)
790                       (srefactor--tag-function-destructor copy))
791                   ""
792                 (semantic-tag-type copy)))
793              ) ;; Callbck for function body.
794            ;; Dictionary entries go here.
795            ))
796     (goto-char endofinsert)
797     (insert "\n\n")))
798
799 (defun srefactor--insert-function (func-tag type)
800   "Insert function implementations for FUNC-TAG at point, a tag that is a function.
801 `type' is the operation to be done, not the type of the tag."
802   (newline)
803   (left-char)
804   (if srefactor-use-srecode-p
805       ;; Try using SRecode as the mechanism for inserting a tag.
806       (srefactor--insert-with-srecode func-tag)
807     ;; official routine
808     ;; add 2 newlines before insert the function
809     ;; (newline-and-indent)
810     (unless (srefactor--is-proto type)
811       (newline-and-indent))
812
813     (let ((func-tag-name (srefactor--tag-name func-tag))
814           (parent (srefactor--calculate-parent-tag func-tag)))
815       ;; insert const if return a const value
816       (when (semantic-tag-get-attribute func-tag :constant-flag)
817         (insert "const "))
818
819       (when (srefactor--tag-function-modifiers func-tag)
820         (semantic-tag-put-attribute func-tag :typemodifiers nil))
821       (save-excursion
822         (when (and (eq major-mode 'c++-mode)
823                    parent)
824           (insert (srefactor--tag-templates-declaration-string parent)))
825         (insert (srefactor--tag-function-string func-tag))
826
827         ;; insert const modifer for method
828         (when (semantic-tag-get-attribute func-tag :methodconst-flag)
829           (insert " const"))
830
831         (when (srefactor--is-proto type)
832           (insert ";\n")))
833       (unless (eq major-mode 'c-mode)
834         (search-forward-regexp (regexp-quote func-tag-name) (line-end-position) t)
835         (search-backward-regexp (regexp-quote func-tag-name) (line-beginning-position) t)
836
837         (when (srefactor--tag-function-destructor func-tag)
838           (forward-char -1))
839
840         ;; insert tag parent if any
841         (unless (or (srefactor--tag-friend-p func-tag)
842                     (eq type 'gen-func-proto)
843                     ;; check if parent exists for a tag
844                     (null (srefactor--calculate-parent-tag func-tag)))
845           (insert (srefactor--tag-parents-string func-tag)))
846
847         (when (srefactor--tag-function-constructor func-tag)
848           (let ((variables (srefactor--tag-filter #'semantic-tag-class
849                                                   '(variable)
850                                                   (semantic-tag-type-members parent))))
851             (setq variables
852                   (remove-if-not (lambda (v)
853                                    (string-match "const" (srefactor--tag-type-string v)))
854                                  variables))
855             (when variables
856               (goto-char (line-end-position))
857               (insert ":")
858               (mapc (lambda (v)
859                       (when (string-match "const" (srefactor--tag-type-string v))
860                         (insert (semantic-tag-name v))
861                         (insert "()")))
862                     variables)))))))
863
864   ;; post content insertion based on context
865   (unless (srefactor--is-proto type)
866     (end-of-line)
867     (insert " {")
868     (newline 1)
869     (save-excursion
870       (srefactor--insert-initial-content-based-on-return-type
871        (if (or (srefactor--tag-function-constructor func-tag)
872                (srefactor--tag-function-destructor func-tag))
873            ""
874          (semantic-tag-type func-tag)))
875       (insert "}")
876       (indent-according-to-mode))
877     (goto-char (line-end-position))))
878
879 (defun srefactor--insert-function-pointer (tag)
880   "Insert function pointer definition for TAG."
881   (insert (concat "typedef "
882                   (srefactor--tag-type-string tag)
883                   " "
884                   "("
885                   (srefactor--tag-parents-string tag)
886                   "*"
887                   (semantic-tag-name tag)
888                   ")"
889                   "("))
890   (let ((param-str (mapconcat
891                     (lambda (tag)
892                       (let ((ptr-level (srefactor--tag-pointer tag))
893                             (ref-level (srefactor--tag-reference tag)))
894                         (srefactor--tag-type-string tag)))
895                     (semantic-tag-function-arguments tag)
896                     ", ")))
897     (insert param-str)
898     (insert ");")))
899
900 (defun srefactor--insert-function-as-parameter (tag)
901   "Insert TAG that is a function as a function parameter.
902 This means, the function is converted into a function pointer."
903   (insert (srefactor--function-to-function-pointer tag))
904   (insert ", "))
905
906 (defun srefactor--insert-new-function-from-region ()
907   "Extract function from region."
908   (semantic-force-refresh)
909   (push-mark (region-beginning))
910   (let ((reg-diff (- (region-end) (region-beginning)))
911         (region (buffer-substring-no-properties (region-beginning) (region-end)))
912         (tag (semantic-current-tag))
913         (local-vars (semantic-get-all-local-variables))
914         l orig p1 p2 name has-error)
915     (unwind-protect
916         (condition-case e
917             (progn
918               (setq orig (point))
919               (setq region (with-temp-buffer
920                              (let (p1 p2)
921                                (insert (concat "void" " " "new_function"))
922                                (insert "()")
923                                (insert " {")
924                                (newline 1)
925                                (setq p1 (point))
926                                (insert region)
927                                (setq p2 (point))
928                                (newline 1)
929                                (insert "}")
930                                (c-beginning-of-defun-1)
931                                (search-forward "(" (point-max) t)
932                                (dolist (v local-vars l)
933                                  (when (srefactor--var-in-region-p v p1 p2)
934                                    (push v l)))
935                                (insert (srefactor--tag-function-parameters-string l))
936                                (buffer-substring-no-properties (point-min) (point-max)))))
937               (beginning-of-defun-raw)
938               (recenter-top-bottom)
939               (setq p1 (point))
940               (insert region)
941               (open-line 2)
942               (setq p2 (point))
943               (re-search-backward "new_function" nil t)
944               (forward-char 1)
945               (srefactor--mark-symbol-at-point)
946               (setq name (read-from-minibuffer "Enter function name: "))
947               (when (re-search-backward "new_function" nil t)
948                 (replace-match name))
949               (indent-region (progn
950                                (c-beginning-of-defun)
951                                (point))
952                              (progn
953                                (c-end-of-defun)
954                                (point))))
955           (error "malform"
956                  (setq has-error t)
957                  (message "%s" "The selected region is malformed."))))
958     (when has-error
959       (unless (and (null p1) (null p2))
960         (delete-region p1 p2))
961       (kill-line 2)
962       (goto-char orig)
963       (pop-mark))
964     (goto-char (car mark-ring))
965     (delete-region (car mark-ring) (+ (car mark-ring) reg-diff))
966     (setq p1 (point))
967     (insert name)
968     (insert "(")
969     (dolist (v l)
970       (insert (concat (semantic-tag-name v) ", ")))
971     (insert ");")
972     (indent-region p1 (point))
973     (when (re-search-backward ", " nil t)
974       (replace-match ""))
975     (pop-mark)))
976
977 (defun srefactor--insert-initial-content-based-on-return-type (tag-type)
978   "Insert initial content of function implementations.
979
980 TAG-TYPE is the return type such as int, long, float, double..."
981   (cond
982    ((listp tag-type)
983     (insert (semantic-tag-name tag-type) " b;" )
984     (indent-according-to-mode)
985     (newline 2)
986     (insert "return b;")
987     (indent-according-to-mode))
988    ((or (string-match "int" tag-type)
989         (string-match "short" tag-type)
990         (string-match "long" tag-type))
991     (insert "return 0;"))
992    ((or (string-match "double" tag-type)
993         (string-match "float" tag-type))
994     (insert "return 0.0;"))
995    ((string-match "bool" tag-type)
996     (insert "return true;"))
997    ((string-match "char" tag-type)
998     (insert "return 'a';"))
999    (t))
1000   (srefactor--indent-and-newline 1))
1001
1002 ;; TODO: work on this in next release
1003 (defun srefactor--insert-new-macro-from-region ()
1004   "Assume region is marked."
1005   (let* ((region (buffer-substring (region-beginning) (region-end)))
1006          (beg (region-beginning))
1007          (end (region-end))
1008          (multiline-p (> (count-lines beg end) 1))
1009          (name (read-from-minibuffer "Enter a macro name: ")))
1010     (filter-buffer-substring beg end t)
1011     (insert (concat name "()"))
1012     (goto-char (semantic-tag-start (semantic-current-tag)))
1013     (search-backward-regexp "^$")
1014     (newline 1)
1015     (open-line 1)
1016     ;; (setq mark-active nil)
1017     (setq beg (point))
1018     (insert (concat "#define " name (if multiline-p "\n" " ")))
1019     (insert region)
1020     (forward-line 2)
1021     (setq end (point))
1022     (goto-char beg)
1023     (set-mark-command nil )
1024     (goto-char end)
1025     (setq deactivate-mark nil)
1026     (recenter)
1027     (when multiline-p
1028       (call-interactively 'c-backslash-region))
1029     (setq end (point))
1030     (indent-region beg end)
1031     (setq mark-active nil)))
1032
1033 ;;
1034 ;; VARIABLE
1035 ;;
1036 (defun srefactor--rename-local-var (tag tag-occurrences function-tag new-name)
1037   "Rename the variable instances in TAG-OCCURRENCES in FUNCTION-TAG to NEW-NAME."
1038   (save-excursion
1039     (goto-char (semantic-tag-start function-tag))
1040     (let* ((distance (- (length new-name)
1041                         (length (semantic-tag-name tag))))
1042            (var-list (loop for v in tag-occurrences
1043                            for i from 0 upto (1- (length tag-occurrences))
1044                            collect (if (consp v)
1045                                        (cons (+ (car v) (* 14 i)) (cdr v))
1046                                      (+ v (* distance i))))))
1047       (mapc (lambda (c)
1048               (goto-char c)
1049               (search-forward-regexp (srefactor--local-var-regexp tag)
1050                                      (semantic-tag-end function-tag)
1051                                      t)
1052               (replace-match new-name t t nil 1))
1053             var-list)
1054       (message (format "Renamed %d occurrences of %s to %s" (length var-list) (semantic-tag-name tag) new-name)))))
1055
1056 ;;
1057 ;; GENERAL
1058 ;;
1059
1060 (defun srefactor--indent-and-newline (&optional number)
1061   "Indent than insert a NUMBER of newline."
1062   (indent-according-to-mode)
1063   (newline (if number number 1)))
1064
1065 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1066 ;; Functions that operate on a Semantic tag and return information
1067 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1068 (defun srefactor--get-all-parents (tag)
1069   "Return a list of parent tags of a TAG.
1070 The closer to the end of the list, the higher the parents."
1071   (let* ((tag-buffer (semantic-tag-buffer tag))
1072          (parents (cdr (nreverse
1073                         (semantic-find-tag-by-overlay (semantic-tag-start tag)
1074                                                       (if tag-buffer
1075                                                           tag-buffer
1076                                                         (current-buffer)))))))
1077     parents))
1078
1079 (defun srefactor--tag-parents-string (tag)
1080   "Return parent prefix string of a TAG.
1081
1082 It is used for prepending to function or variable name defined
1083 outside of a scope."
1084   (let* ((parents (srefactor--get-all-parents tag))
1085          (parents-at-point (semantic-find-tag-by-overlay))
1086          (parents-str-lst (mapcar (lambda (tag)
1087                                     (concat (semantic-tag-name tag)
1088                                             (srefactor--tag-templates-parameters-string tag)))
1089                                   parents))
1090          (parents-at-point-str-lst (mapcar (lambda (tag)
1091                                              (concat (semantic-tag-name tag)
1092                                                      (srefactor--tag-templates-parameters-string tag)))
1093                                            parents-at-point))
1094          (diff (set-difference parents-str-lst
1095                                parents-at-point-str-lst
1096                                :test #'string-equal)))
1097     (concat (mapconcat #'identity (nreverse diff) "::") "::")))
1098
1099 (defun srefactor--tag-function-parameters-string (members)
1100   "Return function parameter string of a function.
1101
1102 MEMBERS is a list of tags that are parameters of a function.  The
1103 parameters are retrieved by the function `semantic-tag-function-arguments'.
1104
1105 The returned string is formatted as \"param1, param2, param3,...\"."
1106   (string-trim-right
1107    (mapconcat (lambda (m)
1108                 (concat (srefactor--tag-type-string m)
1109                         " "
1110                         (semantic-tag-name m)
1111                         ))
1112               members
1113               ", ")))
1114
1115 (defun srefactor--tag-function-string (tag)
1116   "Return a complete string representation of a TAG that is a function."
1117   (let ((return-type (srefactor--tag-type-string tag))
1118         (members (semantic-tag-function-arguments tag))
1119         (is-constructor (srefactor--tag-function-constructor tag))
1120         (is-destructor (srefactor--tag-function-destructor tag)))
1121     (string-trim-left (concat (unless (or is-destructor is-constructor)
1122                                 (concat return-type " "))
1123                               (when is-destructor "~")
1124                               (srefactor--tag-name tag)
1125                               "("
1126                               (srefactor--tag-function-parameters-string members)
1127                               ")"))))
1128
1129 (defun srefactor--tag-template-string-list (tag)
1130   "Return a list of templates as a list of strings from a TAG."
1131   (let ((templates (semantic-c-tag-template tag)))
1132     (unless templates
1133       (setq templates (semantic-c-tag-template (srefactor--calculate-parent-tag tag))))
1134     (when templates
1135       (mapcar #'car templates))))
1136
1137 (defun srefactor--calculate-parent-tag (tag)
1138   "An alternative version of `semantic-tag-calculate-parent'.
1139
1140 It is the same except does not check if a TAG is in current
1141 buffer.  If such check is performed, even if a TAG has parent, nil
1142 is returned."
1143   (let ((tag-buffer (semantic-tag-buffer tag)))
1144     (with-current-buffer (if tag-buffer
1145                              tag-buffer
1146                            (current-buffer))
1147       (save-excursion
1148         (goto-char (semantic-tag-start tag))
1149         (semantic-current-tag-parent)))))
1150
1151 (defun srefactor--tag-templates-parameters-string (tag)
1152   "Return a string with all template parameters from a TAG.
1153
1154 The returned string is formatted as \"<class T1, class T2, ...>\"."
1155   (let ((tmpl-list (srefactor--tag-template-string-list tag)))
1156     (if tmpl-list
1157         (concat "<"
1158                 (mapconcat #'identity tmpl-list ", ")
1159                 ">")
1160       ""))
1161   )
1162
1163 (defun srefactor--tag-templates-declaration-string (tag)
1164   "Return a string with all template declarations from a TAG.
1165
1166 The returned string is formatted as:
1167
1168 \"template <class T1, class T2>\"
1169 \"template <class T3>\"
1170 \"....\"."
1171   (let* ((parent (condition-case nil
1172                      (srefactor--calculate-parent-tag tag)
1173                    (error nil)))
1174          (tmpl-list (srefactor--tag-template-string-list tag)))
1175     (if tmpl-list
1176         (concat (if parent
1177                     (srefactor--tag-templates-declaration-string parent)
1178                   "")
1179                 (concat "template <"
1180                         (mapconcat (lambda (T)
1181                                      (concat "class " T))
1182                                    tmpl-list
1183                                    ", ")
1184                         ">"
1185                         "\n"))
1186       "")))
1187
1188 (defun srefactor--function-pointer-to-function (tag)
1189   "Convert a function pointer from a function TAG."
1190   (let* ((new-tag (semantic-tag-copy tag))
1191          (args (semantic-tag-function-arguments new-tag))
1192          (i 1))
1193     (mapc (lambda (arg)
1194             (semantic-tag-set-name arg (concat "a" (number-to-string i)))
1195             (setq i (+ i 1)))
1196           args)
1197     (semantic-tag-set-name new-tag (semantic-tag-name new-tag))
1198     (semantic--tag-put-property new-tag :foreign-flag t)
1199     (semantic-tag-put-attribute new-tag :function-pointer nil)
1200     new-tag))
1201
1202 (defun srefactor--function-to-function-pointer (tag)
1203   "Convert a function to function pointer from a TAG"
1204   (let* ((type-string (srefactor--tag-type-string tag))
1205          (tag-name (concat "(*" (semantic-tag-name tag) ")"))
1206          (args (semantic-tag-function-arguments tag)))
1207     (concat type-string
1208             " "
1209             tag-name
1210             " "
1211             "("
1212             (mapconcat (lambda (arg)
1213                          (srefactor--tag-type-string arg))
1214                        args
1215                        ", ")
1216             ")")))
1217
1218 (defun srefactor--tag-function-modifiers (tag)
1219   "Return `:typemodifiers' attribute of a TAG."
1220   (semantic-tag-get-attribute tag :typemodifiers))
1221
1222 (defun srefactor--tag-function-destructor (tag)
1223   "Return `:destructor-flag' attribute of a TAG, that is either t or nil."
1224   (semantic-tag-get-attribute tag :destructor-flag))
1225
1226 (defun srefactor--tag-function-constructor (tag)
1227   "Return `:constructor-flag' attribute of a TAG, that is either t or nil."
1228   (semantic-tag-get-attribute tag :constructor-flag))
1229
1230 (defun srefactor--local-var-regexp (tag)
1231   "Return regexp for seraching local variable TAG."
1232   (format (concat "\\(\\_\<%s\\)[ ]*\\([^[:alnum:]_"
1233                   ;; (unless (srefactor--tag-lambda-p tag) "(")
1234                   "]\\)")
1235           (regexp-quote (semantic-tag-name tag))))
1236
1237 (defun srefactor--tag-pointer (tag)
1238   "Return `:pointer' attribute of a TAG."
1239   (semantic-tag-get-attribute tag :pointer))
1240
1241 (defun srefactor--tag-typedef (tag)
1242   "Return `:typedef' attribute of a TAG."
1243   (semantic-tag-get-attribute tag :typedef))
1244
1245 (defun srefactor--tag-reference (tag)
1246   "Return `:reference' attribute of a TAG.
1247
1248 If it does not exist, perform additional check to make sure it
1249 does not, since the actual text in buffer has it but for some
1250 complicated language construct, Semantic cannot retrieve it."
1251   (let ((reference (semantic-tag-get-attribute tag :reference))
1252         (tag-buffer (semantic-tag-buffer tag))
1253         (tag-start (semantic-tag-start tag))
1254         (tag-end (semantic-tag-end tag))
1255         ref-start ref-end
1256         statement-beg)
1257     (if reference
1258         reference
1259       (save-excursion
1260         (with-current-buffer (if tag-buffer
1261                                  tag-buffer
1262                                ;; only tag in current buffer does not
1263                                ;; carry buffer information
1264                                (current-buffer))
1265           (goto-char tag-end)
1266           (setq statement-beg (save-excursion
1267                                 (c-beginning-of-statement-1)
1268                                 (point)))
1269           (goto-char statement-beg)
1270           (setq ref-start (re-search-forward "&"
1271                                              tag-end
1272                                              t))
1273           (goto-char statement-beg)
1274           (setq ref-end (re-search-forward "[&]+"
1275                                            tag-end
1276                                            t))
1277           (when (and ref-end ref-start)
1278             (1+ (- ref-end ref-start))))))))
1279
1280 (defun srefactor--tag-name (tag)
1281   "Return TAG name and handle edge cases."
1282   (let ((tag-name (semantic-tag-name tag)))
1283     (with-current-buffer (semantic-tag-buffer tag)
1284       (if (not (string-empty-p tag-name))
1285           (if (semantic-tag-get-attribute tag :operator-flag)
1286               (concat "operator " tag-name)
1287             tag-name)
1288         ""))))
1289
1290 (defun srefactor--tag-type-string (tag)
1291   "Return a complete return type of a TAG as string."
1292   (let* ((ptr-level (srefactor--tag-pointer tag))
1293          (ref-level (srefactor--tag-reference tag))
1294          (ptr-string (if ptr-level
1295                          (make-string ptr-level ?\*)
1296                        ""))
1297          (ref-string (if ref-level
1298                          (make-string ref-level ?\&)
1299                        ""))
1300          (tag-type (semantic-tag-type tag))
1301          (const-p (semantic-tag-variable-constant-p tag))
1302          (template-specifier (when (semantic-tag-p tag-type)
1303                                (semantic-c-tag-template-specifier tag-type))))
1304     (cond
1305      ((semantic-tag-function-constructor-p tag)
1306       "")
1307      (template-specifier
1308       (replace-regexp-in-string ",>" ">"
1309                                 (concat (when (semantic-tag-variable-constant-p tag)
1310                                           "const ")
1311                                         (when (srefactor--tag-struct-p tag)
1312                                           "struct ")
1313                                         (car (semantic-tag-type tag))
1314                                         "<"
1315                                         (srefactor--tag-type-string-inner-template-list template-specifier)
1316                                         ">"
1317                                         (cond
1318                                          (ptr-level
1319                                           ptr-string)
1320                                          (ref-level
1321                                           ref-string)
1322                                          (t "")))))
1323      (t
1324       (if (listp tag-type)
1325           (concat (when const-p
1326                     "const ")
1327                   (when (srefactor--tag-struct-p tag)
1328                     "struct ")
1329                   (car tag-type)
1330                   (cond
1331                    (ref-level
1332                     ref-string)
1333                    (ptr-level
1334                     ptr-string)))
1335         tag-type)))))
1336
1337 (defun srefactor--tag-type-string-inner-template-list (tmpl-spec-list)
1338   (mapconcat (lambda (tmpl)
1339                (let* ((templates (semantic-c-tag-template-specifier tmpl)))
1340                  (concat (if (listp tmpl)
1341                              (car tmpl)
1342                            tmpl)
1343                          (if (and (not (null templates)) (listp templates))
1344                              (concat "<"  (srefactor--tag-type-string-inner-template-list templates)) ",")
1345                          (when templates "> "))))
1346              tmpl-spec-list
1347              ""))
1348
1349 (defun srefactor--extract-region (extract-type)
1350   "Extract region based on type.
1351
1352 EXTRACT-TYPE can be 'function or 'macro."
1353   (if (region-active-p)
1354       (unwind-protect
1355           (progn
1356             ;; (narrow-to-region (region-beginning) (region-end))
1357             ;; (when (semantic-parse-region (region-beginning) (region-end))
1358             ;;   (error "Please select a region that is not a declaration or an implementation."))
1359             (save-excursion
1360               (narrow-to-region (region-beginning) (region-end))
1361               (c-beginning-of-defun)
1362               (c-end-of-defun))
1363             (widen)
1364             (cond
1365              ((eq extract-type 'function)
1366               (srefactor--insert-new-function-from-region))
1367              ((eq extract-type 'macro)
1368               (srefactor--insert-new-macro-from-region))
1369              (t)))
1370         (widen))
1371     (error "No active region.")))
1372
1373 (defun srefactor--mark-symbol-at-point ()
1374   "Activate mark for a symbol at point."
1375   (interactive)
1376   (forward-sexp -1)
1377   (set-mark-command nil)
1378   (forward-sexp 1)
1379   (setq deactivate-mark nil))
1380
1381 (defun srefactor--fetch-candidates ()
1382   "Return a list of candidates in current buffer.
1383
1384 Each candidate is a list '(DISPLAY TAG OPTIONS).  This is a
1385 wrapper for `srefactor--fetch-candidates-helper'.  See
1386 `srefactor--fetch-candidates-helper' for more details."
1387   (srefactor--fetch-candidates-helper (semantic-fetch-tags) 0 nil))
1388
1389 (defun srefactor--fetch-candidates-helper (tags depth &optional class)
1390   "Return a list of lists '(DISPLAY TAG OPTIONS).
1391
1392 This function is intended to be used with `srefactor-ui-create-menu' to
1393 be displayed as a list of menu items.
1394
1395 DISPLAY is the string to bepresented to user, TAG is a semantic
1396 tag and OPTIONS is a list of possible choices for each menu item.
1397
1398  TAGS are collection of Semantic tags in current buffer.
1399  DEPTH is current recursion depth.
1400  CLASS is the parent class."
1401   (let ((spaces (make-string (* depth 3) ?\s))
1402         (srefactor--tag-options (srefactor-ui--return-option-list 'tag))
1403         (dashes (make-string 1 ?\-))
1404         (class class)
1405         cur-type display tag-list)
1406     (cl-dolist (tag tags)
1407       (when (listp tag)
1408         (cl-case (setq cur-type (semantic-tag-class tag))
1409           ((function type)
1410            (let ((type-p (eq cur-type 'type)))
1411              (unless (and (> depth 0) (not type-p))
1412                (setq class nil))
1413              (setq display (concat (if (null class)
1414                                        spaces
1415                                      (format "%s|%s%s" spaces dashes "â–º"))
1416                                    (semantic-format-tag-summarize tag nil t)
1417                                    (if (eq cur-type 'type)
1418                                        " (Inside)")))
1419              (and type-p
1420                   (setq class (car tag)))
1421              ;; Recurse to children
1422              (push (list display tag (if (eq cur-type 'type)
1423                                          srefactor--tag-options
1424                                        nil)) tag-list)
1425              (setq tag-list (append (srefactor--fetch-candidates-helper (semantic-tag-components tag)
1426                                                                         (1+ depth)
1427                                                                         class)
1428                                     tag-list))))
1429
1430           ((package include label variable)
1431            (let* ((parent-tag (semantic-tag-calculate-parent tag))
1432                   (display (concat (if parent-tag
1433                                        (format "%s|%s%s" spaces dashes "â–º")
1434                                      spaces)
1435                                    (semantic-format-tag-summarize tag nil t))))
1436              (push (list display tag nil) tag-list)))
1437           ;; Catch-all
1438           (t))))
1439     tag-list))
1440
1441 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1442 ;; Functions - Predicates
1443 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1444 (defun srefactor--menu-add-function-proto-p (tag)
1445   "Check whether to add generate function prototype menu item for a TAG."
1446   (let ((class (semantic-tag-class tag)))
1447     (and (eq class 'function)
1448          (not (semantic-tag-prototype-p tag))
1449          (and (not (srefactor--tag-function-constructor tag))
1450               (not (srefactor--tag-function-destructor tag)))
1451          (not (region-active-p))
1452          (null srefactor--current-local-var) )))
1453
1454 (defun srefactor--menu-add-function-implementation-p (tag)
1455   "Check whether to add generate function implementation menu item for a TAG."
1456   (let ((class (semantic-tag-class tag)))
1457     (and (or (eq class 'type)
1458              (and (eq class 'function)
1459                   (semantic-tag-prototype-p tag)))
1460          (not (region-active-p))
1461          (null srefactor--current-local-var))))
1462
1463 (defun srefactor--menu-add-rename-local-p ()
1464   "Check whether to add rename menu item."
1465   (let* ((local-var (srefactor--tag-at-point))
1466          (cur-tag (semantic-current-tag))
1467          cur-tag-start cur-tag-end tag-name)
1468     (when (and local-var
1469                (eq (semantic-tag-class cur-tag) 'function)
1470                (not (equal (car (nreverse (semantic-ctxt-current-symbol)))
1471                            (semantic-tag-name cur-tag)))
1472                (not (semantic-tag-prototype-p cur-tag))
1473                (not (region-active-p)))
1474       local-var)))
1475
1476 (defun srefactor--menu-add-function-pointer-p (tag)
1477   "Check whether to add generate function pointer menu item for a TAG."
1478   (and (eq (semantic-tag-class tag) 'function)
1479        (not (semantic-tag-get-attribute tag :pointer))
1480        (and (not (srefactor--tag-function-constructor tag))
1481             (not (srefactor--tag-function-destructor tag)))
1482        (not (region-active-p))
1483        (null srefactor--current-local-var)))
1484
1485 (defun srefactor--menu-add-getters-setters-p (tag)
1486   "Check whether to add generate getters and setters menu item for a TAG."
1487   (and (eq (semantic-tag-class tag) 'type)
1488        (srefactor--tag-filter 'semantic-tag-class '(variable) (semantic-tag-type-members tag))
1489        (not (region-active-p))))
1490
1491 (defun srefactor--menu-add-getter-setter-p (tag)
1492   "Check whether to add generate getter and setter menu item for a TAG."
1493   (and (eq (semantic-tag-class tag) 'variable)
1494        (eq (semantic-tag-class (semantic-current-tag-parent)) 'type)
1495        (not (region-active-p))))
1496
1497 (defun srefactor--menu-add-move-p ()
1498   "Check whether to add move menu."
1499   (and (semantic-current-tag)
1500        (not (region-active-p))))
1501
1502 (defun srefactor--tag-at-point ()
1503   "Retrieve current variable tag at piont."
1504   (let* ((ctxt (semantic-analyze-current-context (point)))
1505          (pf (when ctxt
1506                ;; The CTXT is an EIEIO object.  The below
1507                ;; method will attempt to pick the most interesting
1508                ;; tag associated with the current context.
1509                (semantic-analyze-interesting-tag ctxt))))
1510     pf))
1511
1512 (defun srefactor--activate-region (beg end)
1513   "Activate a region from BEG to END."
1514   (interactive)
1515   (goto-char beg)
1516   (set-mark-command nil)
1517   (goto-char end)
1518   (setq deactivate-mark nil))
1519
1520 (defun srefactor--menu-for-region-p ()
1521   "Check whether to add exclusive menu item for a region."
1522   (region-active-p))
1523
1524 (defun srefactor--var-in-region-p (tag beg end)
1525   "Check if a local variable TAG is in a region from BEG to END."
1526   (save-excursion
1527     (goto-char beg)
1528     (search-forward-regexp (srefactor--local-var-regexp tag)
1529                            end t)))
1530
1531 (defun srefactor--tag-struct-p (tag)
1532   "Check if TAG is a C struct."
1533   (condition-case nil
1534       (let* ((type-tag (semantic-tag-type tag))
1535              (typedef-tag (srefactor--tag-typedef tag))
1536              type-type-tag struct-p)
1537         (when typedef-tag
1538           (setq struct-p (semantic-tag-type typedef-tag)))
1539         (unless struct-p
1540           (setq type-type-tag (semantic-tag-type type-tag))
1541           (setq struct-p (and (stringp type-type-tag)
1542                               (string-equal type-type-tag "struct"))))
1543         struct-p)
1544     (error nil)))
1545
1546 (defun srefactor--tag-private-p (tag)
1547   "Check whether a TAG is a private variable."
1548   (let* ((members (srefactor--tag-filter 'semantic-tag-class
1549                                          '(variable label)
1550                                          (semantic-tag-type-members (semantic-tag-calculate-parent tag))))
1551          (labels (srefactor--tag-filter 'semantic-tag-class
1552                                         '(label)
1553                                         members))
1554          (public-label (car (srefactor--tag-filter 'semantic-tag-name
1555                                                    '("public")
1556                                                    labels)))
1557          (private-label (car (srefactor--tag-filter 'semantic-tag-name
1558                                                     '("private")
1559                                                     labels)))
1560          (tag-start (when tag (semantic-tag-start tag)))
1561          (private-pos (when private-label (semantic-tag-start private-label)))
1562          (public-pos (when public-label (semantic-tag-start public-label))))
1563     (when (and private-label public-label)
1564       (or (and private-label (> tag-start private-pos)
1565                public-label (< tag-start public-pos))
1566           (and public-label (> tag-start public-pos)
1567                private-label (> tag-start private-pos)
1568                (> private-pos public-pos))))))
1569
1570 (defun srefactor--tag-auto-p (tag)
1571   "Check whether a TAG is an auto variable."
1572   (let ((type (semantic-tag-type tag)))
1573     (and (listp type)
1574          (string-equal "auto" (car type)))))
1575
1576 (defun srefactor--tag-lambda-p (tag)
1577   "Check whether TAG is a lambda function."
1578   (condition-case nil
1579       (save-excursion
1580         (goto-char (semantic-tag-start tag))
1581         (and (srefactor--tag-auto-p tag)
1582              (search-forward-regexp "=[ ]*\\[.*\\][ ]*(.*)[ ]*"  (semantic-tag-end tag) t)))
1583     (error nil)))
1584
1585 (defun srefactor--tag-friend-p (tag)
1586   "Check whether a TAG is a friend to everyone."
1587   (condition-case nil
1588       (let ((tag-start (semantic-tag-start tag))
1589             (tag-end (semantic-tag-end tag))
1590             (tag-buffer (semantic-tag-buffer tag)))
1591         (with-current-buffer tag-buffer
1592           (save-excursion
1593             (goto-char tag-start)
1594             (search-forward-regexp "friend" tag-end t))))
1595     (error nil)))
1596
1597 (defun srefactor--unknown-symbol-at-point-p ()
1598   "Check whether a symbol at point is an unknown variable."
1599   (unless (and (semantic-ctxt-current-symbol)
1600                (srefactor--tag-at-point))
1601     t))
1602
1603 (defun srefactor--introduce-variable-at-point ()
1604   (save-excursion
1605     ;;
1606     (let ((var (save-excursion
1607                  (c-end-of-statement)
1608                  (semantic-ctxt-current-assignment)))
1609           var-string)
1610       (unless var
1611         (setq var (semantic-ctxt-current-symbol)))
1612       (setq var-string (read-from-minibuffer "New variable: " var))
1613       (goto-char (semantic-tag-end (car (last (semantic-get-all-local-variables)))))
1614       (newline-and-indent)
1615       (insert (concat var-string ";")))))
1616 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1617 ;; Functions - Utilities
1618 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1619 (defun srefactor--collect-tag-occurrences (tag beg end &optional with-content)
1620   "Collect all TAG occurrences.
1621 PARENT-TAG is the tag that contains TAG, such as a function or a class or a namespace."
1622   (save-excursion
1623     (let ((local-var-regexp (srefactor--local-var-regexp tag))
1624           p positions)
1625       (goto-char beg)
1626       (while (re-search-forward local-var-regexp end t)
1627         (setq p (match-beginning 0))
1628         ;; must compare tag to avoid tags with the same name but are
1629         ;; different types and/or different scopes
1630         (save-excursion
1631           (goto-char p)
1632           (when (or (semantic-equivalent-tag-p tag (srefactor--tag-at-point))
1633                     (semantic-equivalent-tag-p tag (semantic-current-tag)))
1634             (push (if with-content
1635                       (cons p (buffer-substring-no-properties (line-beginning-position)
1636                                                               (line-end-position)))
1637                     p)
1638                   positions))))
1639       (nreverse positions))))
1640
1641 (defun srefactor--highlight-tag (tag tag-occurrences &optional scope-tag face)
1642   "Highlight tag in TAG-OCCURRENCES in SCOPE-TAG with FACE."
1643   (let (beg end)
1644     (mapc (lambda (p)
1645             (save-excursion
1646               (goto-char p)
1647               (let ((overlay (make-overlay p (progn
1648                                                (forward-sexp 1)
1649                                                (point)))))
1650                 (overlay-put overlay 'face 'match))))
1651           tag-occurrences)))
1652
1653 (defun srefactor--switch-to-window (file-path)
1654   "Switch to window that contains FILE-PATH string."
1655   (catch 'found
1656     (dolist (w (window-list))
1657       (when (equal file-path (buffer-file-name (window-buffer w)))
1658         (select-window w)
1659         (throw 'found "Found window.")))))
1660
1661 (provide 'srefactor)
1662
1663 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1664 ;;; srefactor.el ends here
1665 ;; Local Variables:
1666 ;; byte-compile-warnings: (not cl-functions)
1667 ;; End: