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

Chizi123
2018-11-19 a4b9172aefa91861b587831e06f55b1e19f3f3be
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