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

Chizi123
2018-11-18 9d27fc972e84736015ab3b1c331888a8fe3d1276
commit | author | age
5cb5f7 1 ;;; helm-tags.el --- Helm for Etags. -*- 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-help)
23 (require 'helm-utils)
24 (require 'helm-grep)
25
26
27 (defgroup helm-tags nil
28   "Tags related Applications and libraries for Helm."
29   :group 'helm)
30
31 (defcustom helm-etags-tag-file-name "TAGS"
32   "Etags tag file name."
33   :type  'string
34   :group 'helm-tags)
35
36 (defcustom helm-etags-tag-file-search-limit 10
37   "The limit level of directory to search tag file.
38 Don't search tag file deeply if outside this value."
39   :type  'number
40   :group 'helm-tags)
41
42 (defcustom helm-etags-match-part-only 'tag
43   "Allow choosing the tag part of CANDIDATE in `helm-source-etags-select'.
44 A tag looks like this:
45     filename: \(defun foo
46 You can choose matching against the tag part (i.e \"(defun foo\"),
47 or against the whole candidate (i.e \"(filename:5:(defun foo\")."
48   :type '(choice
49           (const :tag "Match only tag" tag)
50           (const :tag "Match all file+tag" all))
51   :group 'helm-tags)
52
53 (defcustom helm-etags-execute-action-at-once-if-one t
54   "Whether to jump straight to the selected tag if there's only
55 one match."
56   :type 'boolean
57   :group 'helm-tags)
58
59
60 (defgroup helm-tags-faces nil
61   "Customize the appearance of helm-tags faces."
62   :prefix "helm-"
63   :group 'helm-tags
64   :group 'helm-faces)
65
66 (defface helm-etags-file
67     '((t (:foreground "Lightgoldenrod4"
68           :underline t)))
69   "Face used to highlight etags filenames."
70   :group 'helm-tags-faces)
71
72
73 ;;; Etags
74 ;;
75 ;;
76 (defun helm-etags-run-switch-other-window ()
77   "Run switch to other window action from `helm-source-etags-select'."
78   (interactive)
79   (with-helm-alive-p
80     (helm-exit-and-execute-action
81      (lambda (c)
82        (helm-etags-action-goto 'find-file-other-window c)))))
83 (put 'helm-etags-run-switch-other-window 'helm-only t)
84
85 (defun helm-etags-run-switch-other-frame ()
86   "Run switch to other frame action from `helm-source-etags-select'."
87   (interactive)
88   (with-helm-alive-p
89     (helm-exit-and-execute-action
90      (lambda (c)
91        (helm-etags-action-goto 'find-file-other-frame c)))))
92 (put 'helm-etags-run-switch-other-frame 'helm-only t)
93
94 (defvar helm-etags-map
95   (let ((map (make-sparse-keymap)))
96     (set-keymap-parent map helm-map)
97     (define-key map (kbd "M-<down>") 'helm-goto-next-file)
98     (define-key map (kbd "M-<up>")   'helm-goto-precedent-file)
99     (define-key map (kbd "C-c o")    'helm-etags-run-switch-other-window)
100     (define-key map (kbd "C-c C-o")  'helm-etags-run-switch-other-frame)
101     map)
102   "Keymap used in Etags.")
103
104 (defvar helm-etags-mtime-alist nil
105   "Store the last modification time of etags files here.")
106 (defvar helm-etags-cache (make-hash-table :test 'equal)
107   "Cache content of etags files used here for faster access.")
108
109 (defun helm-etags-get-tag-file (&optional directory)
110   "Return the path of etags file if found.
111 Lookes recursively in parents directorys for a
112 `helm-etags-tag-file-name' file."
113   ;; Get tag file from `default-directory' or upper directory.
114   (let ((current-dir (helm-etags-find-tag-file-directory
115                       (or directory default-directory))))
116     ;; Return nil if not find tag file.
117     (when current-dir
118       (expand-file-name helm-etags-tag-file-name current-dir))))
119
120 (defun helm-etags-all-tag-files ()
121   "Return files from the following sources;
122   1) An automatically located file in the parent directories, by `helm-etags-get-tag-file'.
123   2) `tags-file-name', which is commonly set by `find-tag' command.
124   3) `tags-table-list' which is commonly set by `visit-tags-table' command."
125   (helm-fast-remove-dups
126    (delq nil
127          (append (list (helm-etags-get-tag-file)
128                        tags-file-name)
129                  tags-table-list))
130    :test 'equal))
131
132 (defun helm-etags-find-tag-file-directory (current-dir)
133   "Try to find the directory containing tag file.
134 If not found in CURRENT-DIR search in upper directory."
135   (let ((file-exists? (lambda (dir)
136                           (let ((tag-path (expand-file-name
137                                            helm-etags-tag-file-name dir)))
138                             (and (stringp tag-path)
139                                  (file-regular-p tag-path)
140                                  (file-readable-p tag-path))))))
141     (cl-loop with count = 0
142           until (funcall file-exists? current-dir)
143           ;; Return nil if outside the value of
144           ;; `helm-etags-tag-file-search-limit'.
145           if (= count helm-etags-tag-file-search-limit)
146           do (cl-return nil)
147           ;; Or search upper directories.
148           else
149           do (cl-incf count)
150           (setq current-dir (expand-file-name (concat current-dir "../")))
151           finally return current-dir)))
152
153 (defun helm-etags-get-header-name (_x)
154   "Create header name for this helm etags session."
155   (concat "Etags in "
156           (with-helm-current-buffer
157             (helm-etags-get-tag-file))))
158
159 (defun helm-etags-create-buffer (file)
160   "Create the `helm-buffer' based on contents of etags tag FILE."
161   (let* (max
162          (split (with-temp-buffer
163                   (insert-file-contents file)
164                   (prog1
165                       (split-string (buffer-string) "\n" 'omit-nulls)
166                     (setq max (line-number-at-pos (point-max))))))
167          (progress-reporter (make-progress-reporter "Loading tag file..." 0 max)))
168     (cl-loop
169           with fname
170           with cand
171           for i in split for count from 0
172           for elm = (unless (string-match "^\x0c" i)    ;; "^L"
173                       (helm-aif (string-match "\177" i) ;; "^?"
174                           (substring i 0 it)
175                         i))
176           for linum = (when (string-match "[0-9]+,?[0-9]*$" i)
177                         (car (split-string (match-string 0 i) ",")))
178           do (cond ((and elm (string-match "^\\([^,]+\\),[0-9]+$" elm))
179                     (setq fname (propertize (match-string 1 elm)
180                                             'face 'helm-etags-file)))
181                    (elm (setq cand (format "%s:%s:%s" fname linum elm)))
182                    (t (setq cand nil)))
183           when cand do (progn
184                          (insert (propertize (concat cand "\n") 'linum linum))
185                          (progress-reporter-update progress-reporter count)))))
186
187 (defun helm-etags-init ()
188   "Feed `helm-buffer' using `helm-etags-cache' or tag file.
189 If no entry in cache, create one."
190   (let ((tagfiles (helm-etags-all-tag-files)))
191     (when tagfiles
192       (with-current-buffer (helm-candidate-buffer 'global)
193         (dolist (f tagfiles)
194           (helm-aif (gethash f helm-etags-cache)
195               ;; An entry is present in cache, insert it.
196               (insert it)
197             ;; No entry, create a new buffer using content of tag file (slower).
198             (helm-etags-create-buffer f)
199             ;; Store content of buffer in cache.
200             (puthash f (buffer-string) helm-etags-cache)
201             ;; Store or set the last modification of tag file.
202             (helm-aif (assoc f helm-etags-mtime-alist)
203                 ;; If an entry exists modify it.
204                 (setcdr it (helm-etags-mtime f))
205               ;; No entry create a new one.
206               (cl-pushnew (cons f (helm-etags-mtime f))
207                           helm-etags-mtime-alist
208                           :test 'equal))))))))
209
210 (defvar helm-source-etags-select nil
211   "Helm source for Etags.")
212
213 (defun helm-etags-build-source ()
214   (helm-build-in-buffer-source "Etags"
215     :header-name 'helm-etags-get-header-name
216     :init 'helm-etags-init
217     :get-line 'buffer-substring
218     :match-part (lambda (candidate)
219                   ;; Match only the tag part of CANDIDATE
220                   ;; and not the filename.
221                   (cl-case helm-etags-match-part-only
222                       (tag (cl-caddr (helm-grep-split-line candidate)))
223                       (t   candidate)))
224     :fuzzy-match helm-etags-fuzzy-match
225     :help-message 'helm-etags-help-message
226     :keymap helm-etags-map
227     :action '(("Go to tag" . (lambda (c)
228                                (helm-etags-action-goto 'find-file c)))
229               ("Go to tag in other window" . (lambda (c)
230                                                (helm-etags-action-goto
231                                                 'find-file-other-window
232                                                 c)))
233               ("Go to tag in other frame" . (lambda (c)
234                                               (helm-etags-action-goto
235                                                'find-file-other-frame
236                                                c))))
237     :group 'helm-tags
238     :persistent-help "Go to line"
239     :persistent-action (lambda (candidate)
240                          (helm-etags-action-goto 'find-file candidate)
241                          (helm-highlight-current-line))))
242
243 (defcustom helm-etags-fuzzy-match nil
244   "Use fuzzy matching in `helm-etags-select'."
245   :group 'helm-tags
246   :type 'boolean
247   :set (lambda (var val)
248          (set var val)
249          (setq helm-source-etags-select
250                 (helm-etags-build-source))))
251
252 (defvar find-tag-marker-ring)
253
254 (defsubst helm-etags--file-from-tag (fname)
255   (cl-loop for ext in
256            (cons "" (remove "" tags-compression-info-list))
257            for file = (concat fname ext)
258            when (file-exists-p file)
259            return file))
260
261 (defun helm-etags-action-goto (switcher candidate)
262   "Helm default action to jump to an etags entry in other window."
263   (require 'etags)
264   (deactivate-mark t)
265   (helm-log-run-hook 'helm-goto-line-before-hook)
266   (let* ((split (helm-grep-split-line candidate))
267          (fname (cl-loop for tagf being the hash-keys of helm-etags-cache
268                          for f = (expand-file-name
269                                   (car split) (file-name-directory tagf))
270                          ;; Try to find an existing file, possibly compressed.
271                          when (helm-etags--file-from-tag f)
272                          return it))
273          (elm   (cl-caddr split))
274          (linum (string-to-number (cadr split))))
275     (if (null fname)
276         (error "file %s not found" fname)
277       (ring-insert find-tag-marker-ring (point-marker))
278       (funcall switcher fname)
279       (helm-goto-line linum t)
280       (when (search-forward elm nil t)
281         (goto-char (match-beginning 0))))))
282
283 (defun helm-etags-mtime (file)
284   "Last modification time of etags tag FILE."
285   (cadr (nth 5 (file-attributes file))))
286
287 (defun helm-etags-file-modified-p (file)
288   "Check if tag FILE have been modified in this session.
289 If FILE is nil return nil."
290   (let ((last-modif (and file
291                          (assoc-default file helm-etags-mtime-alist))))
292     (and last-modif
293          (/= last-modif (helm-etags-mtime file)))))
294
295 ;;;###autoload
296 (defun helm-etags-select (reinit)
297   "Preconfigured helm for etags.
298 If called with a prefix argument REINIT
299 or if any of the tag files have been modified, reinitialize cache.
300
301 This function aggregates three sources of tag files:
302
303   1) An automatically located file in the parent directories,
304      by `helm-etags-get-tag-file'.
305   2) `tags-file-name', which is commonly set by `find-tag' command.
306   3) `tags-table-list' which is commonly set by `visit-tags-table' command."
307   (interactive "P")
308   (let ((tag-files (helm-etags-all-tag-files))
309         (helm-execute-action-at-once-if-one
310          helm-etags-execute-action-at-once-if-one)
311         (str (if (region-active-p)
312                  (buffer-substring-no-properties
313                   (region-beginning) (region-end))
314                (thing-at-point 'symbol))))
315     (if (cl-notany 'file-exists-p tag-files)
316         (message "Error: No tag file found.\
317 Create with etags shell command, or visit with `find-tag' or `visit-tags-table'.")
318         (cl-loop for k being the hash-keys of helm-etags-cache
319                  unless (member k tag-files)
320                  do (remhash k helm-etags-cache))
321         (mapc (lambda (f)
322                 (when (or (equal reinit '(4))
323                           (and helm-etags-mtime-alist
324                                (helm-etags-file-modified-p f)))
325                   (remhash f helm-etags-cache)))
326               tag-files)
327         (unless helm-source-etags-select
328           (setq helm-source-etags-select
329                 (helm-etags-build-source)))
330         (helm :sources 'helm-source-etags-select
331               :keymap helm-etags-map
332               :default (if helm-etags-fuzzy-match
333                            str
334                            (list (concat "\\_<" str "\\_>") str))
335               :buffer "*helm etags*"))))
336
337 (provide 'helm-tags)
338
339 ;; Local Variables:
340 ;; byte-compile-warnings: (not obsolete)
341 ;; coding: utf-8
342 ;; indent-tabs-mode: nil
343 ;; End:
344
345 ;;; helm-tags.el ends here