blob: bbd38e6aff1f87d54cddae530d1574f7b812d4c0 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
;;; km-dired.el --- Dired extensions
;; Copyright (C) 2012-2016 Kyle Meyer <kyle@kyleam.com>
;; Author: Kyle Meyer <kyle@kyleam.com>
;; URL: https://github.com/kyleam/emacs.d
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'dired)
(require 'org)
(require 'km-util)
(require 'projectile)
(defun km/dired-switch-to-buffer ()
(interactive)
(switch-to-buffer (km/dired-completing-buffer)))
;;;###autoload
(defun km/dired-switch-to-buffer-other-window ()
(interactive)
(pop-to-buffer (km/dired-completing-buffer)))
(defun km/dired-completing-buffer ()
(completing-read "Dired buffer: "
(mapcar #'buffer-name (km/mode-buffers 'dired-mode))))
;;;###autoload
(defun km/org-open-dired-marked-files (&optional arg)
"Open marked files (or next ARG) with `org-open-file'."
(interactive "p")
(setq arg (and current-prefix-arg arg))
(let* ((files (dired-get-marked-files nil arg))
(num-files (length files)))
(when (or (< num-files 5)
(yes-or-no-p (format "Open %s files?" num-files)))
(dolist (f files) (org-open-file f)))))
;;;###autoload
(defun km/dired-view-file-other-window ()
"In Dired, view this file in another window."
(interactive)
(view-file-other-window (dired-get-file-for-visit)))
;;;###autoload
(defun km/dired-copy-and-edit ()
"Copy file and enter `wdired-mode' for completing rename."
(interactive)
(unless (derived-mode-p 'dired-mode)
(user-error "Must be in a Dired buffer"))
(let* ((fname (dired-get-filename))
(flag "---copy---")
(new-fname (concat fname flag)))
(when (file-directory-p fname)
(user-error "File cannot be directory"))
(copy-file fname new-fname)
(dired-revert)
(wdired-change-to-wdired-mode)
(goto-char (point-min))
(re-search-forward (format "%s\\(%s\\)"
(file-name-nondirectory fname)
flag))
(replace-match "" t nil nil 1)))
;;; Copying file names
;;;###autoload
(defun km/dired-copy-project-filename-as-kill ()
"Copy names of marked project files into kill ring.
This is similar to `dired-copy-filename-as-kill', but the leading
path is always relative to `projectile-project-root'."
(interactive)
(km/dired-copy-filename-relative-to-directory
(projectile-project-root)))
;;;###autoload
(defun km/dired-copy-relative-filename-as-kill (&optional arg)
"Copy names of marked (or next ARG) files into kill ring.
This is similar to `dired-copy-filename-as-kill', but the leading
path is always relative to the `default-directory' of the other
window."
(interactive "p")
(setq arg (and current-prefix-arg arg))
(km/dired-copy-filename-relative-to-directory
(km/other-default-directory) arg))
(defun km/dired-copy-filename-relative-to-directory (directory &optional arg)
"Like `dired-copy-filename-as-kill', but the filename is always
relative to DIRECTORY."
(let* ((string
(mapconcat #'identity
(mapcar (lambda (f) (file-relative-name f directory))
(dired-get-marked-files t arg))
" ")))
(if (eq last-command 'kill-region)
(kill-append string nil)
(kill-new string))
(message "%s" string)))
(defun km/other-default-directory ()
"Get `default-directory' for result of `(other-window 1)'."
(save-window-excursion
(other-window 1)
default-directory))
(provide 'km-dired)
;;; km-dired.el ends here
|