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