| 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 | |
