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