| commit | author | age | ||
| 5cb5f7 | 1 | ;;; helm-types.el --- Helm types classes and methods. -*- lexical-binding: t -*- |
| C | 2 | |
| 3 | ;; Copyright (C) 2015 ~ 2018 Thierry Volpiatto <thierry.volpiatto@gmail.com> | |
| 4 | ||
| 5 | ;; Author: Thierry Volpiatto <thierry.volpiatto@gmail.com> | |
| 6 | ;; URL: http://github.com/emacs-helm/helm | |
| 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 | ||
| 22 | ;;; Code: | |
| 23 | ||
| 24 | (require 'cl-lib) | |
| 25 | (require 'eieio) | |
| 26 | ||
| 27 | ||
| 28 | ;; Files | |
| 29 | (defclass helm-type-file (helm-source) () | |
| 30 | "A class to define helm type file.") | |
| 31 | ||
| 32 | (defmethod helm-source-get-action-from-type ((object helm-type-file)) | |
| 33 | (slot-value object 'action)) | |
| 34 | ||
| 35 | (defun helm-actions-from-type-file () | |
| 36 | (let ((source (make-instance 'helm-type-file))) | |
| 37 | (helm--setup-source source) | |
| 38 | (helm-source-get-action-from-type source))) | |
| 39 | ||
| 40 | (defvar helm-generic-files-map | |
| 41 | (let ((map (make-sparse-keymap))) | |
| 42 | (set-keymap-parent map helm-map) | |
| 43 | (define-key map (kbd "C-]") 'helm-ff-run-toggle-basename) | |
| 44 | (define-key map (kbd "C-s") 'helm-ff-run-grep) | |
| 45 | (define-key map (kbd "M-g s") 'helm-ff-run-grep) | |
| 46 | (define-key map (kbd "M-g z") 'helm-ff-run-zgrep) | |
| 47 | (define-key map (kbd "M-g p") 'helm-ff-run-pdfgrep) | |
| 48 | (define-key map (kbd "C-c g") 'helm-ff-run-gid) | |
| 49 | (define-key map (kbd "M-R") 'helm-ff-run-rename-file) | |
| 50 | (define-key map (kbd "M-C") 'helm-ff-run-copy-file) | |
| 51 | (define-key map (kbd "M-B") 'helm-ff-run-byte-compile-file) | |
| 52 | (define-key map (kbd "M-L") 'helm-ff-run-load-file) | |
| 53 | (define-key map (kbd "M-S") 'helm-ff-run-symlink-file) | |
| 54 | (define-key map (kbd "M-H") 'helm-ff-run-hardlink-file) | |
| 55 | (define-key map (kbd "M-D") 'helm-ff-run-delete-file) | |
| 56 | (define-key map (kbd "C-=") 'helm-ff-run-ediff-file) | |
| 57 | (define-key map (kbd "C-c =") 'helm-ff-run-ediff-merge-file) | |
| 58 | (define-key map (kbd "C-c o") 'helm-ff-run-switch-other-window) | |
| 59 | (define-key map (kbd "C-c r") 'helm-ff-run-find-file-as-root) | |
| 60 | (define-key map (kbd "C-c C-o") 'helm-ff-run-switch-other-frame) | |
| 61 | (define-key map (kbd "M-i") 'helm-ff-properties-persistent) | |
| 62 | (define-key map (kbd "C-c C-x") 'helm-ff-run-open-file-externally) | |
| 63 | (define-key map (kbd "C-c X") 'helm-ff-run-open-file-with-default-tool) | |
| 64 | (define-key map (kbd "M-.") 'helm-ff-run-etags) | |
| 65 | (define-key map (kbd "C-c @") 'helm-ff-run-insert-org-link) | |
| 66 | (define-key map (kbd "C-x C-q") 'helm-ff-run-marked-files-in-dired) | |
| 67 | (define-key map (kbd "C-c C-a") 'helm-ff-run-mail-attach-files) | |
| 68 | map) | |
| 69 | "Generic Keymap for files.") | |
| 70 | ||
| 71 | (defcustom helm-type-file-actions | |
| 72 | (helm-make-actions | |
| 73 | "Find file" 'helm-find-many-files | |
| 74 | "Find file as root" 'helm-find-file-as-root | |
| 75 | "Find file other window" 'helm-find-files-other-window | |
| 76 | "Find file other frame" 'find-file-other-frame | |
| 77 | "Open dired in file's directory" 'helm-open-dired | |
| 78 | "Attach file(s) to mail buffer `C-c C-a'" 'helm-ff-mail-attach-files | |
| 79 | "Marked files in dired" 'helm-marked-files-in-dired | |
| 80 | "Grep File(s) `C-u recurse'" 'helm-find-files-grep | |
| 81 | "Zgrep File(s) `C-u Recurse'" 'helm-ff-zgrep | |
| 82 | "Pdfgrep File(s)" 'helm-ff-pdfgrep | |
| 83 | "Insert as org link" 'helm-files-insert-as-org-link | |
| 84 | "Checksum File" 'helm-ff-checksum | |
| 85 | "Ediff File" 'helm-find-files-ediff-files | |
| 86 | "Ediff Merge File" 'helm-find-files-ediff-merge-files | |
| 87 | "Etags `M-., C-u reload tag file'" 'helm-ff-etags-select | |
| 88 | "View file" 'view-file | |
| 89 | "Insert file" 'insert-file | |
| 90 | "Add marked files to file-cache" 'helm-ff-cache-add-file | |
| 91 | "Delete file(s)" 'helm-ff-delete-files | |
| 92 | "Copy file(s) `M-C, C-u to follow'" 'helm-find-files-copy | |
| 93 | "Rename file(s) `M-R, C-u to follow'" 'helm-find-files-rename | |
| 94 | "Symlink files(s) `M-S, C-u to follow'" 'helm-find-files-symlink | |
| 95 | "Relsymlink file(s) `C-u to follow'" 'helm-find-files-relsymlink | |
| 96 | "Hardlink file(s) `M-H, C-u to follow'" 'helm-find-files-hardlink | |
| 97 | "Open file externally (C-u to choose)" 'helm-open-file-externally | |
| 98 | "Open file with default tool" 'helm-open-file-with-default-tool | |
| 99 | "Find file in hex dump" 'hexl-find-file) | |
| 100 | "Default actions for type files." | |
| 101 | :group 'helm-files | |
| 102 | :type '(alist :key-type string :value-type function)) | |
| 103 | ||
| 104 | (defmethod helm--setup-source :primary ((_source helm-type-file))) | |
| 105 | ||
| 106 | (defmethod helm--setup-source :before ((source helm-type-file)) | |
| 107 | (setf (slot-value source 'action) 'helm-type-file-actions) | |
| 108 | (setf (slot-value source 'persistent-help) "Show this file") | |
| 109 | (setf (slot-value source 'action-transformer) | |
| 110 | '(helm-transform-file-load-el | |
| 111 | helm-transform-file-browse-url | |
| 112 | helm-transform-file-cache)) | |
| 113 | (setf (slot-value source 'candidate-transformer) | |
| 114 | '(helm-skip-boring-files | |
| 115 | helm-w32-pathname-transformer)) | |
| 116 | (setf (slot-value source 'filtered-candidate-transformer) | |
| 117 | 'helm-highlight-files) | |
| 118 | (setf (slot-value source 'help-message) 'helm-generic-file-help-message) | |
| 119 | (setf (slot-value source 'mode-line) (list "File(s)" helm-mode-line-string)) | |
| 120 | (setf (slot-value source 'keymap) helm-generic-files-map) | |
| 121 | (setf (slot-value source 'group) 'helm-files)) | |
| 122 | ||
| 123 | ||
| 124 | ;; Bookmarks | |
| 125 | (defclass helm-type-bookmark (helm-source) () | |
| 126 | "A class to define type bookmarks.") | |
| 127 | ||
| 128 | (defcustom helm-type-bookmark-actions | |
| 129 | (helm-make-actions | |
| 130 | "Jump to bookmark" 'helm-bookmark-jump | |
| 131 | "Jump to BM other window" 'helm-bookmark-jump-other-window | |
| 132 | "Jump to BM other frame" 'helm-bookmark-jump-other-frame | |
| 133 | "Bookmark edit annotation" 'bookmark-edit-annotation | |
| 134 | "Bookmark show annotation" 'bookmark-show-annotation | |
| 135 | "Delete bookmark(s)" 'helm-delete-marked-bookmarks | |
| 136 | "Edit Bookmark" 'helm-bookmark-edit-bookmark | |
| 137 | "Rename bookmark" 'helm-bookmark-rename | |
| 138 | "Relocate bookmark" 'bookmark-relocate) | |
| 139 | "Default actions for type bookmarks." | |
| 140 | :group 'helm-bookmark | |
| 141 | :type '(alist :key-type string | |
| 142 | :value-type function)) | |
| 143 | ||
| 144 | (defmethod helm-source-get-action-from-type ((object helm-type-bookmark)) | |
| 145 | (slot-value object 'action)) | |
| 146 | ||
| 147 | (defmethod helm--setup-source :primary ((_source helm-type-bookmark))) | |
| 148 | ||
| 149 | (defmethod helm--setup-source :before ((source helm-type-bookmark)) | |
| 150 | (setf (slot-value source 'action) 'helm-type-bookmark-actions) | |
| 151 | (setf (slot-value source 'keymap) helm-bookmark-map) | |
| 152 | (setf (slot-value source 'mode-line) (list "Bookmark(s)" helm-mode-line-string)) | |
| 153 | (setf (slot-value source 'help-message) 'helm-bookmark-help-message) | |
| 154 | (setf (slot-value source 'migemo) t) | |
| 155 | (setf (slot-value source 'follow) 'never) | |
| 156 | (setf (slot-value source 'group) 'helm-bookmark)) | |
| 157 | ||
| 158 | ||
| 159 | ;; Buffers | |
| 160 | (defclass helm-type-buffer (helm-source) () | |
| 161 | "A class to define type buffer.") | |
| 162 | ||
| 163 | (defcustom helm-type-buffer-actions | |
| 164 | (helm-make-actions | |
| 165 | "Switch to buffer(s)" 'helm-buffer-switch-buffers | |
| 166 | "Switch to buffer(s) other window `C-c o'" | |
| 167 | 'helm-buffer-switch-buffers-other-window | |
| 168 | "Switch to buffer other frame `C-c C-o'" | |
| 169 | 'switch-to-buffer-other-frame | |
| 170 | "Browse project from buffer" | |
| 171 | 'helm-buffers-browse-project | |
| 172 | "Query replace regexp `C-M-%'" | |
| 173 | 'helm-buffer-query-replace-regexp | |
| 174 | "Query replace `M-%'" 'helm-buffer-query-replace | |
| 175 | "View buffer" 'view-buffer | |
| 176 | "Display buffer" 'display-buffer | |
| 177 | "Rename buffer" 'helm-buffers-rename-buffer | |
| 178 | "Grep buffers `M-g s' (C-u grep all buffers)" | |
| 179 | 'helm-zgrep-buffers | |
| 180 | "Multi occur buffer(s) `C-s'" 'helm-multi-occur-as-action | |
| 181 | "Revert buffer(s) `M-U'" 'helm-revert-marked-buffers | |
| 182 | "Insert buffer" 'insert-buffer | |
| 183 | "Kill buffer(s) `M-D'" 'helm-kill-marked-buffers | |
| 184 | "Diff with file `C-='" 'diff-buffer-with-file | |
| 185 | "Ediff Marked buffers `C-c ='" 'helm-ediff-marked-buffers | |
| 186 | "Ediff Merge marked buffers `M-='" | |
| 187 | (lambda (candidate) | |
| 188 | (helm-ediff-marked-buffers candidate t))) | |
| 189 | "Default actions for type buffers." | |
| 190 | :group 'helm-buffers | |
| 191 | :type '(alist :key-type string :value-type function)) | |
| 192 | ||
| 193 | (defmethod helm-source-get-action-from-type ((object helm-type-buffer)) | |
| 194 | (slot-value object 'action)) | |
| 195 | ||
| 196 | (defmethod helm--setup-source :primary ((_source helm-type-buffer))) | |
| 197 | ||
| 198 | (defmethod helm--setup-source :before ((source helm-type-buffer)) | |
| 199 | (setf (slot-value source 'action) 'helm-type-buffer-actions) | |
| 200 | (setf (slot-value source 'persistent-help) "Show this buffer") | |
| 201 | (setf (slot-value source 'mode-line) (list "Buffer(s)" helm-mode-line-string)) | |
| 202 | (setf (slot-value source 'filtered-candidate-transformer) | |
| 203 | '(helm-skip-boring-buffers | |
| 204 | helm-buffers-sort-transformer | |
| 205 | helm-highlight-buffers)) | |
| 206 | (setf (slot-value source 'group) 'helm-buffers)) | |
| 207 | ||
| 208 | ;; Functions | |
| 209 | (defclass helm-type-function (helm-source) () | |
| 210 | "A class to define helm type function.") | |
| 211 | ||
| 212 | (defcustom helm-type-function-actions | |
| 213 | (helm-make-actions | |
| 214 | "Describe command" 'describe-function | |
| 215 | "Add command to kill ring" 'helm-kill-new | |
| 216 | "Go to command's definition" 'find-function | |
| 217 | "Debug on entry" 'debug-on-entry | |
| 218 | "Cancel debug on entry" 'cancel-debug-on-entry | |
| 219 | "Trace function" 'trace-function | |
| 220 | "Trace function (background)" 'trace-function-background | |
| 221 | "Untrace function" 'untrace-function) | |
| 222 | "Default actions for type functions." | |
| 223 | :group 'helm-elisp | |
| 224 | :type '(alist :key-type string :value-type function)) | |
| 225 | ||
| 226 | (defmethod helm-source-get-action-from-type ((object helm-type-function)) | |
| 227 | (slot-value object 'action)) | |
| 228 | ||
| 229 | (defun helm-actions-from-type-function () | |
| 230 | (let ((source (make-instance 'helm-type-function))) | |
| 231 | (helm--setup-source source) | |
| 232 | (helm-source-get-action-from-type source))) | |
| 233 | ||
| 234 | (defmethod helm--setup-source :primary ((_source helm-type-function))) | |
| 235 | ||
| 236 | (defmethod helm--setup-source :before ((source helm-type-function)) | |
| 237 | (setf (slot-value source 'action) 'helm-type-function-actions) | |
| 238 | (setf (slot-value source 'action-transformer) | |
| 239 | 'helm-transform-function-call-interactively) | |
| 240 | (setf (slot-value source 'candidate-transformer) | |
| 241 | 'helm-mark-interactive-functions) | |
| 242 | (setf (slot-value source 'coerce) 'helm-symbolify)) | |
| 243 | ||
| 244 | ||
| 245 | ;; Commands | |
| 246 | (defclass helm-type-command (helm-source) () | |
| 247 | "A class to define helm type command.") | |
| 248 | ||
| 249 | (defun helm-actions-from-type-command () | |
| 250 | (let ((source (make-instance 'helm-type-command))) | |
| 251 | (helm--setup-source source) | |
| 252 | (helm-source-get-action-from-type source))) | |
| 253 | ||
| 254 | (defcustom helm-type-command-actions | |
| 255 | (append (helm-make-actions | |
| 256 | "Call interactively" 'helm-call-interactively) | |
| 257 | (helm-actions-from-type-function)) | |
| 258 | "Default actions for type command." | |
| 259 | :group 'helm-command | |
| 260 | :type '(alist :key-type string :value-type function)) | |
| 261 | ||
| 262 | (defmethod helm--setup-source :primary ((_source helm-type-command))) | |
| 263 | ||
| 264 | (defmethod helm--setup-source :before ((source helm-type-command)) | |
| 265 | (setf (slot-value source 'action) 'helm-type-command-actions) | |
| 266 | (setf (slot-value source 'coerce) 'helm-symbolify) | |
| 267 | (setf (slot-value source 'persistent-action) 'describe-function) | |
| 268 | (setf (slot-value source 'group) 'helm-command)) | |
| 269 | ||
| 270 | ;; Timers | |
| 271 | (defclass helm-type-timers (helm-source) () | |
| 272 | "A class to define helm type timers.") | |
| 273 | ||
| 274 | (defcustom helm-type-timers-actions | |
| 275 | '(("Cancel Timer" . (lambda (_timer) | |
| 276 | (let ((mkd (helm-marked-candidates))) | |
| 277 | (cl-loop for timer in mkd | |
| 278 | do (cancel-timer timer))))) | |
| 279 | ("Describe Function" . (lambda (tm) | |
| 280 | (describe-function (timer--function tm)))) | |
| 281 | ("Find Function" . (lambda (tm) | |
| 282 | (helm-aif (timer--function tm) | |
| 283 | (if (byte-code-function-p it) | |
| 284 | (message "Can't find anonymous function `%s'" it) | |
| 285 | (find-function it)))))) | |
| 286 | "Default actions for type timers." | |
| 287 | :group 'helm-elisp | |
| 288 | :type '(alist :key-type string :value-type function)) | |
| 289 | ||
| 290 | (defmethod helm--setup-source :primary ((_source helm-type-timers))) | |
| 291 | ||
| 292 | (defmethod helm--setup-source :before ((source helm-type-timers)) | |
| 293 | (setf (slot-value source 'action) 'helm-type-timers-actions) | |
| 294 | (setf (slot-value source 'persistent-action) | |
| 295 | (lambda (tm) | |
| 296 | (describe-function (timer--function tm)))) | |
| 297 | (setf (slot-value source 'persistent-help) "Describe Function") | |
| 298 | (setf (slot-value source 'group) 'helm-elisp)) | |
| 299 | ||
| 300 | ;; Builders. | |
| 301 | (defun helm-build-type-file () | |
| 302 | (helm-make-type 'helm-type-file)) | |
| 303 | ||
| 304 | (defun helm-build-type-function () | |
| 305 | (helm-make-type 'helm-type-function)) | |
| 306 | ||
| 307 | (defun helm-build-type-command () | |
| 308 | (helm-make-type 'helm-type-command)) | |
| 309 | ||
| 310 | (provide 'helm-types) | |
| 311 | ||
| 312 | ;; Local Variables: | |
| 313 | ;; byte-compile-warnings: (not obsolete) | |
| 314 | ;; coding: utf-8 | |
| 315 | ;; indent-tabs-mode: nil | |
| 316 | ;; End: | |
| 317 | ||
| 318 | ;;; helm-types.el ends here | |
