| commit | author | age | ||
| 5cb5f7 | 1 | ;;; magit-repos.el --- listing repositories -*- lexical-binding: t -*- |
| C | 2 | |
| 3 | ;; Copyright (C) 2010-2018 The Magit Project Contributors | |
| 4 | ;; | |
| 5 | ;; You should have received a copy of the AUTHORS.md file which | |
| 6 | ;; lists all contributors. If not, see http://magit.vc/authors. | |
| 7 | ||
| 8 | ;; Author: Jonas Bernoulli <jonas@bernoul.li> | |
| 9 | ;; Maintainer: Jonas Bernoulli <jonas@bernoul.li> | |
| 10 | ||
| 11 | ;; Magit is free software; you can redistribute it and/or modify it | |
| 12 | ;; under the terms of the GNU General Public License as published by | |
| 13 | ;; the Free Software Foundation; either version 3, or (at your option) | |
| 14 | ;; any later version. | |
| 15 | ;; | |
| 16 | ;; Magit is distributed in the hope that it will be useful, but WITHOUT | |
| 17 | ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY | |
| 18 | ;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public | |
| 19 | ;; License for more details. | |
| 20 | ;; | |
| 21 | ;; You should have received a copy of the GNU General Public License | |
| 22 | ;; along with Magit. If not, see http://www.gnu.org/licenses. | |
| 23 | ||
| 24 | ;;; Commentary: | |
| 25 | ||
| 26 | ;; This library implements support for listing repositories. This | |
| 27 | ;; includes getting a Lisp list of known repositories as well as a | |
| 28 | ;; mode for listing repositories in a buffer. | |
| 29 | ||
| 30 | ;;; Code: | |
| 31 | ||
| 32 | (eval-when-compile | |
| 33 | (require 'subr-x)) | |
| 34 | ||
| 35 | (require 'magit-core) | |
| 36 | ||
| 37 | (declare-function magit-status-internal "magit-status" (directory)) | |
| 38 | ||
| 39 | (defvar x-stretch-cursor) | |
| 40 | ||
| 41 | ;;; Options | |
| 42 | ||
| 43 | (defcustom magit-repository-directories | |
| 44 | '(("~/.emacs.d/" . 0) ; this should always be a repository | |
| 45 | ("~/.emacs.d/lib/" . 1)) ; useful for `borg' users | |
| 46 | "List of directories that are or contain Git repositories. | |
| 47 | ||
| 48 | Each element has the form (DIRECTORY . DEPTH). DIRECTORY has | |
| 49 | to be a directory or a directory file-name, a string. DEPTH, | |
| 50 | an integer, specifies the maximum depth to look for Git | |
| 51 | repositories. If it is 0, then only add DIRECTORY itself." | |
| 52 | :package-version '(magit . "2.90.0") | |
| 53 | :group 'magit-essentials | |
| 54 | :type '(repeat (cons directory (integer :tag "Depth")))) | |
| 55 | ||
| 56 | (defgroup magit-repolist nil | |
| 57 | "List repositories in a buffer." | |
| 58 | :link '(info-link "(magit)Repository List") | |
| 59 | :group 'magit-modes) | |
| 60 | ||
| 61 | (defcustom magit-repolist-mode-hook '(hl-line-mode) | |
| 62 | "Hook run after entering Magit-Repolist mode." | |
| 63 | :package-version '(magit . "2.9.0") | |
| 64 | :group 'magit-repolist | |
| 65 | :type 'hook | |
| 66 | :get 'magit-hook-custom-get | |
| 67 | :options '(hl-line-mode)) | |
| 68 | ||
| 69 | (defcustom magit-repolist-columns | |
| 70 | '(("Name" 25 magit-repolist-column-ident nil) | |
| 71 | ("Version" 25 magit-repolist-column-version nil) | |
| 72 | ("B<U" 3 magit-repolist-column-unpulled-from-upstream | |
| 73 | ((:right-align t) | |
| 74 | (:help-echo "Upstream changes not in branch"))) | |
| 75 | ("B>U" 3 magit-repolist-column-unpushed-to-upstream | |
| 76 | ((:right-align t) | |
| 77 | (:help-echo "Local changes not in upstream"))) | |
| 78 | ("Path" 99 magit-repolist-column-path nil)) | |
| 79 | "List of columns displayed by `magit-list-repositories'. | |
| 80 | ||
| 81 | Each element has the form (HEADER WIDTH FORMAT PROPS). | |
| 82 | ||
| 83 | HEADER is the string displayed in the header. WIDTH is the width | |
| 84 | of the column. FORMAT is a function that is called with one | |
| 85 | argument, the repository identification (usually its basename), | |
| 86 | and with `default-directory' bound to the toplevel of its working | |
| 87 | tree. It has to return a string to be inserted or nil. PROPS is | |
| 88 | an alist that supports the keys `:right-align' and `:pad-right'. | |
| 89 | Some entries also use `:help-echo', but `tabulated-list' does not | |
| 90 | actually support that yet." | |
| 91 | :package-version '(magit . "2.12.0") | |
| 92 | :group 'magit-repolist | |
| 93 | :type `(repeat (list :tag "Column" | |
| 94 | (string :tag "Header Label") | |
| 95 | (integer :tag "Column Width") | |
| 96 | (function :tag "Inserter Function") | |
| 97 | (repeat :tag "Properties" | |
| 98 | (list (choice :tag "Property" | |
| 99 | (const :right-align) | |
| 100 | (const :pad-right) | |
| 101 | (symbol)) | |
| 102 | (sexp :tag "Value")))))) | |
| 103 | ||
| 104 | ||
| 105 | ;;; List Repositories | |
| 106 | ;;;; Command | |
| 107 | ;;;###autoload | |
| 108 | (defun magit-list-repositories () | |
| 109 | "Display a list of repositories. | |
| 110 | ||
| 111 | Use the options `magit-repository-directories' to control which | |
| 112 | repositories are displayed." | |
| 113 | (interactive) | |
| 114 | (if magit-repository-directories | |
| 115 | (with-current-buffer (get-buffer-create "*Magit Repositories*") | |
| 116 | (magit-repolist-mode) | |
| 117 | (magit-repolist-refresh) | |
| 118 | (tabulated-list-print) | |
| 119 | (switch-to-buffer (current-buffer))) | |
| 120 | (message "You need to customize `magit-repository-directories' %s" | |
| 121 | "before you can list repositories"))) | |
| 122 | ||
| 123 | ;;;; Mode | |
| 124 | ||
| 125 | (defvar magit-repolist-mode-map | |
| 126 | (let ((map (make-sparse-keymap))) | |
| 127 | (set-keymap-parent map tabulated-list-mode-map) | |
| 128 | (define-key map (if (featurep 'jkl) [return] (kbd "C-m")) | |
| 129 | 'magit-repolist-status) | |
| 130 | map) | |
| 131 | "Local keymap for Magit-Repolist mode buffers.") | |
| 132 | ||
| 133 | (defun magit-repolist-status (&optional _button) | |
| 134 | "Show the status for the repository at point." | |
| 135 | (interactive) | |
| 136 | (--if-let (tabulated-list-get-id) | |
| 137 | (magit-status-internal (expand-file-name it)) | |
| 138 | (user-error "There is no repository at point"))) | |
| 139 | ||
| 140 | (define-derived-mode magit-repolist-mode tabulated-list-mode "Repos" | |
| 141 | "Major mode for browsing a list of Git repositories." | |
| 142 | (setq x-stretch-cursor nil) | |
| 143 | (setq tabulated-list-padding 0) | |
| 144 | (setq tabulated-list-sort-key (cons "Path" nil)) | |
| 145 | (setq tabulated-list-format | |
| 146 | (vconcat (mapcar (pcase-lambda (`(,title ,width ,_fn ,props)) | |
| 147 | (nconc (list title width t) | |
| 148 | (-flatten props))) | |
| 149 | magit-repolist-columns))) | |
| 150 | (tabulated-list-init-header) | |
| 151 | (add-hook 'tabulated-list-revert-hook 'magit-repolist-refresh nil t) | |
| 152 | (setq imenu-prev-index-position-function | |
| 153 | 'magit-imenu--repolist-prev-index-position-function) | |
| 154 | (setq imenu-extract-index-name-function | |
| 155 | 'magit-imenu--repolist-extract-index-name-function)) | |
| 156 | ||
| 157 | (defun magit-repolist-refresh () | |
| 158 | (setq tabulated-list-entries | |
| 159 | (mapcar (pcase-lambda (`(,id . ,path)) | |
| 160 | (let ((default-directory path)) | |
| 161 | (list path | |
| 162 | (vconcat (--map (or (funcall (nth 2 it) id) "") | |
| 163 | magit-repolist-columns))))) | |
| 164 | (magit-list-repos-uniquify | |
| 165 | (--map (cons (file-name-nondirectory (directory-file-name it)) | |
| 166 | it) | |
| 167 | (magit-list-repos)))))) | |
| 168 | ||
| 169 | ;;;; Columns | |
| 170 | ||
| 171 | (defun magit-repolist-column-ident (id) | |
| 172 | "Insert the identification of the repository. | |
| 173 | Usually this is just its basename." | |
| 174 | id) | |
| 175 | ||
| 176 | (defun magit-repolist-column-path (_id) | |
| 177 | "Insert the absolute path of the repository." | |
| 178 | (abbreviate-file-name default-directory)) | |
| 179 | ||
| 180 | (defun magit-repolist-column-version (_id) | |
| 181 | "Insert a description of the repository's `HEAD' revision." | |
| 182 | (let ((v (or (magit-git-string "describe" "--tags" "--dirty") | |
| 183 | ;; If there are no tags, use the date in MELPA format. | |
| 184 | (magit-git-string "show" "--no-patch" "--format=%cd-g%h" | |
| 185 | "--date=format:%Y%m%d.%H%M")))) | |
| 186 | (save-match-data | |
| 187 | (when (string-match "-dirty\\'" v) | |
| 188 | (put-text-property (1+ (match-beginning 0)) (length v) 'face 'error v)) | |
| 189 | (if (and v (string-match "\\`[0-9]" v)) | |
| 190 | (concat " " v) | |
| 191 | v)))) | |
| 192 | ||
| 193 | (defun magit-repolist-column-branch (_id) | |
| 194 | "Insert the current branch." | |
| 195 | (magit-get-current-branch)) | |
| 196 | ||
| 197 | (defun magit-repolist-column-upstream (_id) | |
| 198 | "Insert the upstream branch of the current branch." | |
| 199 | (magit-get-upstream-branch)) | |
| 200 | ||
| 201 | (defun magit-repolist-column-dirty (_id) | |
| 202 | "Insert a letter if there are uncommitted changes. | |
| 203 | ||
| 204 | Show N if there is at least one untracked file. | |
| 205 | Show U if there is at least one unstaged file. | |
| 206 | Show S if there is at least one staged file. | |
| 207 | Only one letter is shown, the first that applies." | |
| 208 | (cond ((magit-untracked-files) "N") | |
| 209 | ((magit-unstaged-files) "U") | |
| 210 | ((magit-staged-files) "S"))) | |
| 211 | ||
| 212 | (defun magit-repolist-column-unpulled-from-upstream (_id) | |
| 213 | "Insert number of upstream commits not in the current branch." | |
| 214 | (--when-let (magit-get-upstream-branch nil t) | |
| 215 | (let ((n (cadr (magit-rev-diff-count "HEAD" it)))) | |
| 216 | (propertize (number-to-string n) 'face (if (> n 0) 'bold 'shadow))))) | |
| 217 | ||
| 218 | (defun magit-repolist-column-unpulled-from-pushremote (_id) | |
| 219 | "Insert number of commits in the push branch but not the current branch." | |
| 220 | (--when-let (magit-get-push-branch nil t) | |
| 221 | (let ((n (cadr (magit-rev-diff-count "HEAD" it)))) | |
| 222 | (propertize (number-to-string n) 'face (if (> n 0) 'bold 'shadow))))) | |
| 223 | ||
| 224 | (defun magit-repolist-column-unpushed-to-upstream (_id) | |
| 225 | "Insert number of commits in the current branch but not its upstream." | |
| 226 | (--when-let (magit-get-upstream-branch nil t) | |
| 227 | (let ((n (car (magit-rev-diff-count "HEAD" it)))) | |
| 228 | (propertize (number-to-string n) 'face (if (> n 0) 'bold 'shadow))))) | |
| 229 | ||
| 230 | (defun magit-repolist-column-unpushed-to-pushremote (_id) | |
| 231 | "Insert number of commits in the current branch but not its push branch." | |
| 232 | (--when-let (magit-get-push-branch nil t) | |
| 233 | (let ((n (car (magit-rev-diff-count "HEAD" it)))) | |
| 234 | (propertize (number-to-string n) 'face (if (> n 0) 'bold 'shadow))))) | |
| 235 | ||
| 236 | (defun magit-repolist-column-branches (_id) | |
| 237 | "Insert number of branches." | |
| 238 | (let ((n (length (magit-list-local-branches)))) | |
| 239 | (propertize (number-to-string n) 'face (if (> n 1) 'bold 'shadow)))) | |
| 240 | ||
| 241 | (defun magit-repolist-column-stashes (_id) | |
| 242 | "Insert number of stashes." | |
| 243 | (let ((n (length (magit-list-stashes)))) | |
| 244 | (propertize (number-to-string n) 'face (if (> n 0) 'bold 'shadow)))) | |
| 245 | ||
| 246 | ;;; Read Repository | |
| 247 | ||
| 248 | (defun magit-read-repository (&optional read-directory-name) | |
| 249 | "Read a Git repository in the minibuffer, with completion. | |
| 250 | ||
| 251 | The completion choices are the basenames of top-levels of | |
| 252 | repositories found in the directories specified by option | |
| 253 | `magit-repository-directories'. In case of name conflicts | |
| 254 | the basenames are prefixed with the name of the respective | |
| 255 | parent directories. The returned value is the actual path | |
| 256 | to the selected repository. | |
| 257 | ||
| 258 | With prefix argument simply read a directory name using | |
| 259 | `read-directory-name'." | |
| 260 | (if-let ((repos (and (not read-directory-name) | |
| 261 | magit-repository-directories | |
| 262 | (magit-list-repos-uniquify | |
| 263 | (--map (cons (file-name-nondirectory | |
| 264 | (directory-file-name it)) | |
| 265 | it) | |
| 266 | (magit-list-repos)))))) | |
| 267 | (let ((reply (magit-completing-read "Git repository" repos))) | |
| 268 | (file-name-as-directory | |
| 269 | (or (cdr (assoc reply repos)) | |
| 270 | (if (file-directory-p reply) | |
| 271 | (expand-file-name reply) | |
| 272 | (user-error "Not a repository or a directory: %s" reply))))) | |
| 273 | (file-name-as-directory | |
| 274 | (read-directory-name "Git repository: " | |
| 275 | (or (magit-toplevel) default-directory))))) | |
| 276 | ||
| 277 | (defun magit-list-repos () | |
| 278 | (cl-mapcan (pcase-lambda (`(,dir . ,depth)) | |
| 279 | (magit-list-repos-1 dir depth)) | |
| 280 | magit-repository-directories)) | |
| 281 | ||
| 282 | (defun magit-list-repos-1 (directory depth) | |
| 283 | (cond ((file-readable-p (expand-file-name ".git" directory)) | |
| 284 | (list directory)) | |
| 285 | ((and (> depth 0) (magit-file-accessible-directory-p directory)) | |
| 286 | (--mapcat (and (file-directory-p it) | |
| 287 | (magit-list-repos-1 it (1- depth))) | |
| 288 | (directory-files directory t | |
| 289 | directory-files-no-dot-files-regexp t))))) | |
| 290 | ||
| 291 | (defun magit-list-repos-uniquify (alist) | |
| 292 | (let (result (dict (make-hash-table :test 'equal))) | |
| 293 | (dolist (a (delete-dups alist)) | |
| 294 | (puthash (car a) (cons (cdr a) (gethash (car a) dict)) dict)) | |
| 295 | (maphash | |
| 296 | (lambda (key value) | |
| 297 | (if (= (length value) 1) | |
| 298 | (push (cons key (car value)) result) | |
| 299 | (setq result | |
| 300 | (append result | |
| 301 | (magit-list-repos-uniquify | |
| 302 | (--map (cons (concat | |
| 303 | key "\\" | |
| 304 | (file-name-nondirectory | |
| 305 | (directory-file-name | |
| 306 | (substring it 0 (- (1+ (length key))))))) | |
| 307 | it) | |
| 308 | value)))))) | |
| 309 | dict) | |
| 310 | result)) | |
| 311 | ||
| 312 | ;;; _ | |
| 313 | (provide 'magit-repos) | |
| 314 | ;;; magit-repos.el ends here | |
