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

Chizi123
2018-11-18 434b46beff1c5ec01cbefd5273d89971a82d6bab
commit | author | age
5cb5f7 1 ;;; helm-imenu.el --- Helm interface for Imenu -*- lexical-binding: t -*-
C 2
3 ;; Copyright (C) 2012 ~ 2018 Thierry Volpiatto <thierry.volpiatto@gmail.com>
4
5 ;; This program is free software; you can redistribute it and/or modify
6 ;; it under the terms of the GNU General Public License as published by
7 ;; the Free Software Foundation, either version 3 of the License, or
8 ;; (at your option) any later version.
9
10 ;; This program is distributed in the hope that it will be useful,
11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13 ;; GNU General Public License for more details.
14
15 ;; You should have received a copy of the GNU General Public License
16 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
17
18 ;;; Code:
19
20 (require 'cl-lib)
21 (require 'helm)
22 (require 'helm-lib)
23 (require 'imenu)
24 (require 'helm-utils)
25 (require 'helm-help)
26
27
28 (defgroup helm-imenu nil
29   "Imenu related libraries and applications for helm."
30   :group 'helm)
31
32 (defcustom helm-imenu-delimiter " / "
33   "Delimit types of candidates and his value in `helm-buffer'."
34   :group 'helm-imenu
35   :type 'string)
36
37 (defcustom helm-imenu-execute-action-at-once-if-one
38   #'helm-imenu--execute-action-at-once-p
39   "Goto the candidate when only one is remaining."
40   :group 'helm-imenu
41   :type 'function)
42
43 (defcustom helm-imenu-lynx-style-map t
44   "Use Arrow keys to jump to occurences."
45   :group 'helm-imenu
46   :type  'boolean)
47
48 (defcustom helm-imenu-all-buffer-assoc nil
49   "Major mode association alist for `helm-imenu-in-all-buffers'.
50 Allow `helm-imenu-in-all-buffers' searching in these associated buffers
51 even if they are not derived from each other.
52 The alist is bidirectional, i.e no need to add '((foo . bar) (bar . foo))
53 only '((foo . bar)) is needed."
54   :type '(alist :key-type symbol :value-type symbol)
55   :group 'helm-imenu)
56
57 (defcustom helm-imenu-in-all-buffers-separate-sources t
58   "Display imenu index of each buffer in its own source when non-nil.
59
60 When nil all candidates are displayed in a single source.
61
62 NOTE: Each source will have as name \"Imenu <buffer-name>\".
63 `helm-source-imenu-all' will not be set, however it will continue
64 to be used as a flag for using default as input, if you do not want
65 this behavior, remove it from `helm-sources-using-default-as-input'
66 even if not using a single source to display imenu in all buffers."
67   :type 'boolean
68   :group 'helm-imenu)
69
70 (defcustom helm-imenu-type-faces
71   '(("^Variables$" . font-lock-variable-name-face)
72     ("^\\(Function\\|Functions\\|Defuns\\)$" . font-lock-function-name-face)
73     ("^\\(Types\\|Provides\\|Requires\\|Classes\\|Class\\|Includes\\|Imports\\|Misc\\|Code\\)$" . font-lock-type-face))
74   "Faces for showing type in helm-imenu.
75 This is a list of cons cells.  The cdr of each cell is a face to be used,
76 and it can also just be like \\='(:foreground \"yellow\").
77 Each car is a regexp match pattern of the imenu type string."
78   :group 'helm-faces
79   :type '(repeat
80           (cons
81            (regexp :tag "Imenu type regexp pattern")
82            (sexp :tag "Face"))))
83
84 (defcustom helm-imenu-extra-modes nil
85   "Extra modes where helm-imenu-in-all-buffers should look into."
86   :group 'helm-imenu
87   :type '(repeat symbol))
88
89 ;;; keymap
90 (defvar helm-imenu-map
91   (let ((map (make-sparse-keymap)))
92     (set-keymap-parent map helm-map)
93     (define-key map (kbd "M-<down>") 'helm-imenu-next-section)
94     (define-key map (kbd "M-<up>")   'helm-imenu-previous-section)
95     (when helm-imenu-lynx-style-map
96       (define-key map (kbd "<left>")    'helm-maybe-exit-minibuffer)
97       (define-key map (kbd "<right>")   'helm-execute-persistent-action)
98       (define-key map (kbd "M-<left>")  'helm-previous-source)
99       (define-key map (kbd "M-<right>") 'helm-next-source))
100     (delq nil map)))
101
102 (defun helm-imenu-next-or-previous-section (n)
103   (with-helm-buffer
104     (let* ((fn (lambda ()
105                  (car (split-string (helm-get-selection nil t)
106                                     helm-imenu-delimiter))))
107            (curtype (funcall fn))
108            (move-fn (if (> n 0) #'helm-next-line #'helm-previous-line))
109            (stop-fn (if (> n 0)
110                         #'helm-end-of-source-p
111                         #'helm-beginning-of-source-p)))
112       (catch 'break
113         (while (not (funcall stop-fn))
114           (funcall move-fn)
115           (unless (string= curtype (funcall fn))
116             (throw 'break nil)))))))
117
118 (defun helm-imenu-next-section ()
119   (interactive)
120   (helm-imenu-next-or-previous-section 1))
121
122 (defun helm-imenu-previous-section ()
123   (interactive)
124   (helm-imenu-next-or-previous-section -1))
125
126
127 ;;; Internals
128 (defvar helm-cached-imenu-alist nil)
129 (make-variable-buffer-local 'helm-cached-imenu-alist)
130
131 (defvar helm-cached-imenu-candidates nil)
132 (make-variable-buffer-local 'helm-cached-imenu-candidates)
133
134 (defvar helm-cached-imenu-tick nil)
135 (make-variable-buffer-local 'helm-cached-imenu-tick)
136
137 (defvar helm-imenu--in-all-buffers-cache nil)
138
139 (defvar helm-source-imenu nil "See (info \"(emacs)Imenu\")")
140 (defvar helm-source-imenu-all nil)
141
142 (defclass helm-imenu-source (helm-source-sync)
143   ((candidates :initform 'helm-imenu-candidates)
144    (candidate-transformer :initform 'helm-imenu-transformer)
145    (persistent-action :initform 'helm-imenu-persistent-action)
146    (persistent-help :initform "Show this entry")
147    (nomark :initform t)
148    (keymap :initform helm-imenu-map)
149    (help-message :initform 'helm-imenu-help-message)
150    (action :initform 'helm-imenu-action)
151    (group :initform 'helm-imenu)))
152
153 (defcustom helm-imenu-fuzzy-match nil
154   "Enable fuzzy matching in `helm-source-imenu'."
155   :group 'helm-imenu
156   :type  'boolean
157   :set (lambda (var val)
158          (set var val)
159          (setq helm-source-imenu
160                (helm-make-source "Imenu" 'helm-imenu-source
161                  :fuzzy-match helm-imenu-fuzzy-match))))
162
163 (defun helm-imenu--maybe-switch-to-buffer (candidate)
164   (let ((cand (cdr candidate)))
165     (helm-aif (and (markerp cand) (marker-buffer cand))
166         (switch-to-buffer it))))
167
168 (defun helm-imenu--execute-action-at-once-p ()
169   (let ((cur (helm-get-selection))
170         (mb (with-helm-current-buffer
171               (save-excursion
172                 (goto-char (point-at-bol))
173                  (point-marker)))))
174     (if (equal (cdr cur) mb)
175         (prog1 nil
176           (helm-set-pattern "")
177           (helm-force-update))
178         t)))
179
180 (defun helm-imenu-action (candidate)
181   "Default action for `helm-source-imenu'."
182   (helm-log-run-hook 'helm-goto-line-before-hook)
183   (helm-imenu--maybe-switch-to-buffer candidate)
184   (imenu candidate)
185   ;; If semantic is supported in this buffer
186   ;; imenu used `semantic-imenu-goto-function'
187   ;; and position have been highlighted,
188   ;; no need to highlight again.
189   (unless (eq imenu-default-goto-function
190               'semantic-imenu-goto-function)
191     (helm-highlight-current-line)))
192
193 (defun helm-imenu-persistent-action (candidate)
194   "Default persistent action for `helm-source-imenu'."
195   (helm-imenu--maybe-switch-to-buffer candidate)
196   (imenu candidate)
197   (helm-highlight-current-line))
198
199 (defun helm-imenu-candidates (&optional buffer)
200   (with-current-buffer (or buffer helm-current-buffer)
201     (let ((tick (buffer-modified-tick)))
202       (if (eq helm-cached-imenu-tick tick)
203           helm-cached-imenu-candidates
204         (setq imenu--index-alist nil)
205         (prog1 (setq helm-cached-imenu-candidates
206                      (let ((index (imenu--make-index-alist t))) 
207                        (helm-imenu--candidates-1
208                         (delete (assoc "*Rescan*" index) index))))
209           (setq helm-cached-imenu-tick tick))))))
210
211 (defun helm-imenu-candidates-in-all-buffers (&optional build-sources)
212   (let* ((lst (buffer-list))
213          (progress-reporter (make-progress-reporter
214                              "Imenu indexing buffers..." 1 (length lst))))
215     (prog1
216         (cl-loop with cur-buf = (if build-sources
217                                     (current-buffer) helm-current-buffer)
218                  for b in lst
219                  for count from 1
220                  when (with-current-buffer b
221                         (and (or (member major-mode helm-imenu-extra-modes)
222                                  (derived-mode-p 'prog-mode))
223                              (helm-same-major-mode-p
224                               cur-buf helm-imenu-all-buffer-assoc)))
225                  if build-sources
226                  collect (helm-make-source
227                              (format "Imenu in %s" (buffer-name b))
228                              'helm-imenu-source
229                            :candidates (with-current-buffer b
230                                          (helm-imenu-candidates b))
231                            :fuzzy-match helm-imenu-fuzzy-match)
232                  else
233                  append (with-current-buffer b
234                           (helm-imenu-candidates b))
235                  do (progress-reporter-update progress-reporter count))
236       (progress-reporter-done progress-reporter))))
237
238 (defun helm-imenu--candidates-1 (alist)
239   (cl-loop for elm in alist
240            nconc (cond
241                   ((imenu--subalist-p elm)
242                    (helm-imenu--candidates-1
243                     (cl-loop for (e . v) in (cdr elm) collect
244                              (cons (propertize
245                                     e 'helm-imenu-type (car elm))
246                                    ;; If value is an integer, convert it
247                                    ;; to a marker, otherwise it is a cons cell
248                                    ;; and it will be converted on next recursions.
249                                    ;; (Issue #1060) [1].
250                                    (if (integerp v) (copy-marker v) v)))))
251                   ((listp (cdr elm))
252                    (and elm (list elm)))
253                   (t
254                    ;; bug in imenu, should not be needed.
255                    (and (cdr elm)
256                         ;; Semantic uses overlays whereas imenu uses
257                         ;; markers (issue #1706).
258                         (setcdr elm (pcase (cdr elm) ; Same as [1].
259                                       ((and ov (pred overlayp))
260                                        (copy-overlay ov))
261                                       ((and mk (or (pred markerp)
262                                                    (pred integerp)))
263                                        (copy-marker mk))))
264                         (list elm))))))
265
266 (defun helm-imenu--get-prop (item)
267   ;; property value of ITEM can have itself
268   ;; a property value which have itself a property value
269   ;; ...and so on; Return a list of all these
270   ;; properties values starting at ITEM.
271   (let* ((prop (get-text-property 0 'helm-imenu-type item))
272          (lst  (list prop item)))
273     (when prop
274       (while prop
275         (setq prop (get-text-property 0 'helm-imenu-type prop))
276         (and prop (push prop lst)))
277       lst)))
278
279 (defun helm-imenu-transformer (candidates)
280   (cl-loop for (k . v) in candidates
281            ;; (k . v) == (symbol-name . marker)
282            for bufname = (buffer-name
283                           (pcase v
284                             ((pred overlayp) (overlay-buffer v))
285                             ((or (pred markerp) (pred integerp))
286                              (marker-buffer v))))
287            for types = (or (helm-imenu--get-prop k)
288                            (list (if (with-current-buffer bufname
289                                        (derived-mode-p 'prog-mode))
290                                      "Function"
291                                    "Top level")
292                                  k))
293            for disp1 = (mapconcat
294                         (lambda (x)
295                           (propertize
296                            x 'face
297                            (cl-loop for (p . f) in helm-imenu-type-faces
298                                     when (string-match p x) return f
299                                     finally return 'default)))
300                         types helm-imenu-delimiter)
301            for disp = (propertize disp1 'help-echo bufname)
302            collect
303            (cons disp (cons k v))))
304
305 ;;;###autoload
306 (defun helm-imenu ()
307   "Preconfigured `helm' for `imenu'."
308   (interactive)
309   (unless helm-source-imenu
310     (setq helm-source-imenu
311           (helm-make-source "Imenu" 'helm-imenu-source
312             :fuzzy-match helm-imenu-fuzzy-match)))
313   (let ((imenu-auto-rescan t)
314         (str (thing-at-point 'symbol))
315         (helm-execute-action-at-once-if-one
316          helm-imenu-execute-action-at-once-if-one))
317     (helm :sources 'helm-source-imenu
318           :default (list (concat "\\_<" (and str (regexp-quote str)) "\\_>") str)
319           :preselect str
320           :buffer "*helm imenu*")))
321
322 ;;;###autoload
323 (defun helm-imenu-in-all-buffers ()
324   "Preconfigured helm for fetching imenu entries in all buffers with similar mode as current.
325 A mode is similar as current if it is the same, it is derived i.e `derived-mode-p'
326 or it have an association in `helm-imenu-all-buffer-assoc'."
327   (interactive)
328   (unless helm-imenu-in-all-buffers-separate-sources
329     (unless helm-source-imenu-all
330       (setq helm-source-imenu-all
331             (helm-make-source "Imenu in all buffers" 'helm-imenu-source
332               :init (lambda ()
333                       ;; Use a cache to avoid repeatedly sending
334                       ;; progress-reporter message when updating
335                       ;; (Issue #1704).
336                       (setq helm-imenu--in-all-buffers-cache
337                             (helm-imenu-candidates-in-all-buffers)))
338               :candidates 'helm-imenu--in-all-buffers-cache
339               :fuzzy-match helm-imenu-fuzzy-match))))
340   (let ((imenu-auto-rescan t)
341         (str (thing-at-point 'symbol))
342         (helm-execute-action-at-once-if-one
343          helm-imenu-execute-action-at-once-if-one)
344         (helm--maybe-use-default-as-input
345          (not (null (memq 'helm-source-imenu-all
346                           helm-sources-using-default-as-input))))
347         (sources (if helm-imenu-in-all-buffers-separate-sources
348                      (helm-imenu-candidates-in-all-buffers 'build-sources)
349                      '(helm-source-imenu-all))))
350     (helm :sources sources
351           :default (list (concat "\\_<" (and str (regexp-quote str)) "\\_>") str)
352           :preselect (unless helm--maybe-use-default-as-input str)
353           :buffer "*helm imenu all*")))
354
355 (provide 'helm-imenu)
356
357 ;; Local Variables:
358 ;; byte-compile-warnings: (not obsolete)
359 ;; coding: utf-8
360 ;; indent-tabs-mode: nil
361 ;; End:
362
363 ;;; helm-imenu.el ends here