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

Chizi123
2018-11-18 8f6f2705a38e2515b6c57fda12c5be29fb9a798f
commit | author | age
5cb5f7 1 ;;; ibuffer-vc.el --- Group ibuffer's list by VC project, or show VC status
C 2 ;;
3 ;; Copyright (C) 2011-2014 Steve Purcell
4 ;;
5 ;; Author: Steve Purcell <steve@sanityinc.com>
6 ;; Keywords: themes
7 ;; Package-Version: 20181025.324
8 ;; Package-Requires: ((cl-lib "0.2"))
9 ;; X-URL: http://github.com/purcell/ibuffer-vc
10 ;; URL: http://github.com/purcell/ibuffer-vc
11 ;; Version: DEV
12 ;;
13 ;; This program is free software; you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation, either version 3 of the License, or
16 ;; (at your option) any later version.
17 ;;
18 ;; This program is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
21 ;; GNU General Public License for more details.
22 ;;
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
25 ;;
26 ;;; Commentary:
27 ;;
28 ;; Adds functionality to ibuffer for grouping buffers by their parent
29 ;; vc root directory, and for displaying and/or sorting by the vc
30 ;; status of listed files.
31 ;;
32 ;;; Use:
33 ;;
34 ;; To group buffers by vc parent dir:
35 ;;
36 ;;   M-x ibuffer-vc-set-filter-groups-by-vc-root
37 ;;
38 ;; or, make this the default:
39 ;;
40 ;;   (add-hook 'ibuffer-hook
41 ;;     (lambda ()
42 ;;       (ibuffer-vc-set-filter-groups-by-vc-root)
43 ;;       (unless (eq ibuffer-sorting-mode 'alphabetic)
44 ;;         (ibuffer-do-sort-by-alphabetic))))
45 ;;
46 ;; Alternatively, use `ibuffer-vc-generate-filter-groups-by-vc-root'
47 ;; to programmatically obtain a list of filter groups that you can
48 ;; combine with your own custom groups.
49 ;;
50 ;; To include vc status info in the ibuffer list, add either
51 ;; vc-status-mini or vc-status to `ibuffer-formats':
52 ;;
53 ;; (setq ibuffer-formats
54 ;;       '((mark modified read-only vc-status-mini " "
55 ;;               (name 18 18 :left :elide)
56 ;;               " "
57 ;;               (size 9 -1 :right)
58 ;;               " "
59 ;;               (mode 16 16 :left :elide)
60 ;;               " "
61 ;;               (vc-status 16 16 :left)
62 ;;               " "
63 ;;               filename-and-process)))
64 ;;
65 ;; To sort by vc status, use `ibuffer-do-sort-by-vc-status', which can
66 ;; also be selected by repeatedly executing
67 ;; `ibuffer-toggle-sorting-mode' (bound to "," by default).
68 ;;
69 ;;; Code:
70
71 ;; requires
72
73 (require 'ibuffer)
74 (require 'ibuf-ext)
75 (require 'vc-hooks)
76 (require 'cl-lib)
77
78
79 (defgroup ibuffer-vc nil
80   "Group ibuffer entries according to their version control status."
81   :prefix "ibuffer-vc-"
82   :group 'convenience)
83
84 (defcustom ibuffer-vc-skip-if-remote t
85   "If non-nil, don't query the VC status of remote files."
86   :type 'boolean
87   :group 'ibuffer-vc)
88
89 (defcustom ibuffer-vc-include-function 'identity
90   "A function which tells whether a given file should be grouped.
91
92 The function is passed a filename, and should return non-nil if the file
93 is to be grouped.
94
95 This option can be used to exclude certain files from the grouping mechanism."
96   :type 'function
97   :group 'ibuffer-vc)
98
99 ;;; Group and filter ibuffer entries by parent vc directory
100
101 (defun ibuffer-vc--include-file-p (file)
102   "Return t iff FILE should be included in ibuffer-vc's filtering."
103   (and file
104        (or (null ibuffer-vc-skip-if-remote)
105            (not (file-remote-p file)))
106        (funcall ibuffer-vc-include-function file)))
107
108 (defun ibuffer-vc--deduce-backend (file)
109   "Return the vc backend for FILE, or nil if not under VC supervision."
110   (if (fboundp 'vc-responsible-backend)
111       (ignore-errors (vc-responsible-backend file))
112     (or (vc-backend file)
113         (cl-loop for backend in vc-handled-backends
114                  when (vc-call-backend backend 'responsible-p file)
115                  return backend))))
116
117 (defun ibuffer-vc-root (buf)
118   "Return a cons cell (backend-name . root-dir) for BUF.
119 If the file is not under version control, nil is returned instead."
120   (let ((file-name (with-current-buffer buf
121                      (file-truename (or buffer-file-name
122                     default-directory)))))
123     (when (ibuffer-vc--include-file-p file-name)
124       (let ((backend (ibuffer-vc--deduce-backend file-name)))
125         (when backend
126           (let* ((root-fn-name (intern (format "vc-%s-root" (downcase (symbol-name backend)))))
127                  (root-dir
128                   (cond
129                    ((fboundp root-fn-name) (funcall root-fn-name file-name)) ; git, svn, hg, bzr (at least)
130                    ((memq backend '(darcs DARCS)) (vc-darcs-find-root file-name))
131                    ((memq backend '(cvs CVS)) (vc-find-root file-name "CVS"))
132                    ((memq backend '(rcs RCS)) (or (vc-find-root file-name "RCS")
133                                                   (concat file-name ",v")))
134                    ((memq backend '(src SRC)) (or (vc-find-root file-name ".src")
135                                                   (concat file-name ",v")))
136                    (t (error "ibuffer-vc: don't know how to find root for vc backend '%s' - please submit a bug report or patch" backend)))))
137             (cons backend root-dir)))))))
138
139 (defun ibuffer-vc-read-filter ()
140   "Read a cons cell of (backend-name . root-dir)."
141   (cons (car (read-from-string
142               (completing-read "VC backend: " vc-handled-backends nil t)))
143         (read-directory-name "Root directory: " nil nil t)))
144
145 (define-ibuffer-filter vc-root
146     "Toggle current view to buffers with vc root dir QUALIFIER."
147   (:description "vc root dir"
148                 :reader (ibuffer-vc-read-filter))
149   (ibuffer-awhen (ibuffer-vc-root buf)
150     (equal qualifier it)))
151
152 ;;;###autoload
153 (defun ibuffer-vc-generate-filter-groups-by-vc-root ()
154   "Create a set of ibuffer filter groups based on the vc root dirs of buffers."
155   (let ((roots (ibuffer-remove-duplicates
156                 (delq nil (mapcar 'ibuffer-vc-root (buffer-list))))))
157     (mapcar (lambda (vc-root)
158               (cons (format "%s:%s" (car vc-root) (cdr vc-root))
159                     `((vc-root . ,vc-root))))
160             roots)))
161
162 ;;;###autoload
163 (defun ibuffer-vc-set-filter-groups-by-vc-root ()
164   "Set the current filter groups to filter by vc root dir."
165   (interactive)
166   (setq ibuffer-filter-groups (ibuffer-vc-generate-filter-groups-by-vc-root))
167   (message "ibuffer-vc: groups set")
168   (let ((ibuf (get-buffer "*Ibuffer*")))
169     (when ibuf
170         (with-current-buffer ibuf
171           (pop-to-buffer ibuf)
172           (ibuffer-update nil t)))))
173
174
175 ;;; Display vc status info in the ibuffer list
176
177 (defun ibuffer-vc--state (file)
178   "Return the `vc-state' for FILE, or nil if unregistered."
179   (ignore-errors (vc-state file)))
180
181 (defun ibuffer-vc--status-string ()
182   "Return a short string to represent the current buffer's status."
183   (when (and buffer-file-name (ibuffer-vc--include-file-p buffer-file-name))
184     (let ((state (ibuffer-vc--state buffer-file-name)))
185       (if state
186           (symbol-name state)
187         "-"))))
188
189 ;;;###autoload (autoload 'ibuffer-make-column-vc-status "ibuffer-vc")
190 (define-ibuffer-column vc-status
191   (:name "VC status")
192   (ibuffer-vc--status-string))
193
194 ;;;###autoload (autoload 'ibuffer-make-column-vc-status-mini "ibuffer-vc")
195 (define-ibuffer-column vc-status-mini
196   (:name "V")
197   (if (and buffer-file-name (ibuffer-vc--include-file-p buffer-file-name))
198       (let ((state (ibuffer-vc--state buffer-file-name)))
199         (cond
200          ((eq 'added state) "A")
201          ((eq 'removed state) "D")
202          ((eq 'up-to-date state) "=")
203          ((eq 'edited state) "*")
204          ((eq 'needs-update state) "O")
205          ((memq state '(conflict needs-merge unlocked-changes)) "!")
206          ((eq 'ignored state) "I")
207          ((memq state '(() unregistered missing)) "?")))
208     " "))
209
210 ;;;###autoload (autoload 'ibuffer-do-sort-by-vc-status "ibuffer-vc")
211 (define-ibuffer-sorter vc-status
212   "Sort the buffers by their vc status."
213   (:description "vc status")
214   (let ((file1 (with-current-buffer (car a)
215                  buffer-file-name))
216         (file2 (with-current-buffer (car b)
217                  buffer-file-name)))
218     (if (and file1 file2)
219         (string-lessp (with-current-buffer (car a)
220                         (ibuffer-vc--status-string))
221                       (with-current-buffer (car b)
222                         (ibuffer-vc--status-string)))
223       (not (null file1)))))
224
225
226 (provide 'ibuffer-vc)
227 ;;; ibuffer-vc.el ends here