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

Chizi123
2018-11-17 5cb5f70b1872a757e93ea333b0e2dca50c6c8957
commit | author | age
5cb5f7 1 ;;; helm-semantic.el --- Helm interface for Semantic -*- lexical-binding: t -*-
C 2
3 ;; Copyright (C) 2012 ~ 2017 Daniel Hackney <dan@haxney.org>
4 ;;               2012 ~ 2018  Thierry Volpiatto<thierry.volpiatto@gmail.com>
5
6 ;; Author: Daniel Hackney <dan@haxney.org>
7
8 ;; This program is free software; you can redistribute it and/or modify
9 ;; it under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation, either version 3 of the License, or
11 ;; (at your option) any later version.
12
13 ;; This program is distributed in the hope that it will be useful,
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16 ;; GNU General Public License for more details.
17
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
20
21 ;;; Commentary:
22
23 ;; Uses `candidates-in-buffer' for speed.
24
25 ;;; Code:
26
27 (require 'cl-lib)
28 (require 'semantic)
29 (require 'helm-help)
30 (require 'helm-imenu)
31
32 (declare-function pulse-momentary-highlight-one-line "pulse.el" (point &optional face))
33
34 (defgroup helm-semantic nil
35   "Semantic tags related libraries and applications for helm."
36   :group 'helm)
37
38 (defcustom helm-semantic-lynx-style-map t
39   "Use Arrow keys to jump to occurences."
40   :group 'helm-semantic
41   :type  'boolean)
42
43 (defcustom helm-semantic-display-style
44   '((python-mode . semantic-format-tag-summarize)
45     (c-mode . semantic-format-tag-concise-prototype-c-mode)
46     (emacs-lisp-mode . semantic-format-tag-abbreviate-emacs-lisp-mode))
47   "Function to present a semantic tag according to `major-mode'.
48
49 It is an alist where the `car' of each element is a `major-mode' and
50 the `cdr' a `semantic-format-tag-*' function.
51
52 If no function is found for current `major-mode', fall back to
53 `semantic-format-tag-summarize' default function.
54
55 You can have more or less informations depending of the `semantic-format-tag-*'
56 function you choose.
57
58 All the supported functions are prefixed with \"semantic-format-tag-\",
59 you have completion on these functions with `C-M i' in the customize interface."
60   :group 'helm-semantic
61   :type '(alist :key-type symbol :value-type symbol))
62
63 ;;; keymap
64 (defvar helm-semantic-map
65   (let ((map (make-sparse-keymap)))
66     (set-keymap-parent map helm-map)
67     (when helm-semantic-lynx-style-map
68       (define-key map (kbd "<left>")  'helm-maybe-exit-minibuffer)
69       (define-key map (kbd "<right>") 'helm-execute-persistent-action))
70     (delq nil map)))
71
72 ;; Internals vars
73 (defvar helm-semantic--tags-cache nil)
74
75 (defun helm-semantic--fetch-candidates (tags depth &optional class)
76   "Write the contents of TAGS to the current buffer."
77   (let ((class class) cur-type
78         (stylefn (or (with-helm-current-buffer
79                        (assoc-default major-mode helm-semantic-display-style))
80                      #'semantic-format-tag-summarize)))
81     (cl-dolist (tag tags)
82       (when (listp tag)
83         (cl-case (setq cur-type (semantic-tag-class tag))
84           ((function variable type)
85            (let ((spaces (make-string (* depth 2) ?\s))
86                  (type-p (eq cur-type 'type)))
87              (unless (and (> depth 0) (not type-p))
88                (setq class nil))
89              (insert
90               (if (and class (not type-p))
91                   (format "%s%s(%s) "
92                           spaces (if (< depth 2) "" "├►") class)
93                 spaces)
94               ;; Save the tag for later
95               (propertize (funcall stylefn tag nil t)
96                           'semantic-tag tag)
97               "\n")
98              (and type-p (setq class (car tag)))
99              ;; Recurse to children
100              (unless (eq cur-type 'function)
101                (helm-semantic--fetch-candidates
102                 (semantic-tag-components tag) (1+ depth) class))))
103
104           ;; Don't do anything with packages or includes for now
105           ((package include)
106            (insert
107             (propertize (funcall stylefn tag nil t)
108                         'semantic-tag tag)
109             "\n")
110            )
111           ;; Catch-all
112           (t))))))
113
114 (defun helm-semantic-default-action (_candidate &optional persistent)
115   ;; By default, helm doesn't pass on the text properties of the selection.
116   ;; Fix this.
117   (helm-log-run-hook 'helm-goto-line-before-hook)
118   (with-current-buffer helm-buffer
119     (when (looking-at " ")
120       (goto-char (next-single-property-change
121                   (point-at-bol) 'semantic-tag nil (point-at-eol)))) 
122     (let ((tag (get-text-property (point) 'semantic-tag)))
123       (semantic-go-to-tag tag)
124       (unless persistent
125         (pulse-momentary-highlight-one-line (point))))))
126
127 (defun helm-semantic--maybe-set-needs-update ()
128   (with-helm-current-buffer
129     (when (semantic-parse-tree-needs-update-p)
130       (semantic-parse-tree-set-needs-update))))
131
132 (defvar helm-source-semantic nil)
133
134 (defclass helm-semantic-source (helm-source-in-buffer)
135   ((init :initform (lambda ()
136                      (helm-semantic--maybe-set-needs-update)
137                      (setq helm-semantic--tags-cache (semantic-fetch-tags))
138                      (with-current-buffer (helm-candidate-buffer 'global)
139                        (let ((major-mode (with-helm-current-buffer major-mode)))
140                          (helm-semantic--fetch-candidates helm-semantic--tags-cache 0)))))
141    (get-line :initform 'buffer-substring)
142    (persistent-help :initform "Show this entry")
143    (keymap :initform 'helm-semantic-map)
144    (help-message :initform 'helm-semantic-help-message)
145    (persistent-action :initform (lambda (elm)
146                                   (helm-semantic-default-action elm t)
147                                   (helm-highlight-current-line)))
148    (action :initform 'helm-semantic-default-action)))
149
150 (defcustom helm-semantic-fuzzy-match nil
151   "Enable fuzzy matching in `helm-source-semantic'."
152   :group 'helm-semantic
153   :type  'boolean
154   :set (lambda (var val)
155          (set var val)
156          (setq helm-source-semantic
157                (helm-make-source "Semantic Tags" 'helm-semantic-source
158                  :fuzzy-match helm-semantic-fuzzy-match))))
159
160 ;;;###autoload
161 (defun helm-semantic (arg)
162   "Preconfigured `helm' for `semantic'.
163 If ARG is supplied, pre-select symbol at point instead of current"
164   (interactive "P")
165   (let ((tag (helm-aif (car (semantic-current-tag-parent))
166                  (let ((curtag (car (semantic-current-tag))))
167                    (if (string= it curtag)
168                        (format "\\_<%s\\_>" curtag)
169                      (cons (format "\\_<%s\\_>" it)
170                            (format "\\_<%s\\_>" curtag))))
171                (format "\\_<%s\\_>" (car (semantic-current-tag))))))
172     (unless helm-source-semantic
173       (setq helm-source-semantic
174             (helm-make-source "Semantic Tags" 'helm-semantic-source
175               :fuzzy-match helm-semantic-fuzzy-match)))
176     (helm :sources 'helm-source-semantic
177           :candidate-number-limit 9999
178           :preselect (if arg
179                          (thing-at-point 'symbol)
180                        tag)
181           :buffer "*helm semantic*")))
182
183 ;;;###autoload
184 (defun helm-semantic-or-imenu (arg)
185   "Preconfigured helm for `semantic' or `imenu'.
186 If ARG is supplied, pre-select symbol at point instead of current
187 semantic tag in scope.
188
189 If `semantic-mode' is active in the current buffer, then use
190 semantic for generating tags, otherwise fall back to `imenu'.
191 Fill in the symbol at point by default."
192   (interactive "P")
193   (unless helm-source-semantic
194     (setq helm-source-semantic
195           (helm-make-source "Semantic Tags" 'helm-semantic-source
196             :fuzzy-match helm-semantic-fuzzy-match)))
197   (unless helm-source-imenu
198     (setq helm-source-imenu
199           (helm-make-source "Imenu" 'helm-imenu-source
200             :fuzzy-match helm-imenu-fuzzy-match)))
201   (let* ((source (if (semantic-active-p)
202                      'helm-source-semantic
203                      'helm-source-imenu))
204          (imenu-p (eq source 'helm-source-imenu))
205          (imenu-auto-rescan imenu-p)
206          (str (thing-at-point 'symbol))
207          (helm-execute-action-at-once-if-one
208           (and imenu-p
209                helm-imenu-execute-action-at-once-if-one))
210          (tag (helm-aif (car (semantic-current-tag-parent))
211                   (let ((curtag (car (semantic-current-tag))))
212                     (if (string= it curtag)
213                         (format "\\_<%s\\_>" curtag)
214                       (cons (format "\\_<%s\\_>" it)
215                             (format "\\_<%s\\_>" curtag))))
216                 (format "\\_<%s\\_>" (car (semantic-current-tag))))))
217     (helm :sources source
218           :candidate-number-limit 9999
219           :default (and imenu-p (list (concat "\\_<" (and str (regexp-quote str)) "\\_>") str))
220           :preselect (if (or arg imenu-p) str tag)
221           :buffer "*helm semantic/imenu*")))
222
223 (provide 'helm-semantic)
224
225 ;; Local Variables:
226 ;; byte-compile-warnings: (not obsolete)
227 ;; coding: utf-8
228 ;; indent-tabs-mode: nil
229 ;; End:
230
231 ;;; helm-semantic.el ends here