magit-repos.el (15394B)
1 ;;; magit-repos.el --- listing repositories -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2010-2021 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 ;; SPDX-License-Identifier: GPL-3.0-or-later 12 13 ;; Magit is free software; you can redistribute it and/or modify it 14 ;; under the terms of the GNU General Public License as published by 15 ;; the Free Software Foundation; either version 3, or (at your option) 16 ;; any later version. 17 ;; 18 ;; Magit is distributed in the hope that it will be useful, but WITHOUT 19 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 20 ;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public 21 ;; License for more details. 22 ;; 23 ;; You should have received a copy of the GNU General Public License 24 ;; along with Magit. If not, see http://www.gnu.org/licenses. 25 26 ;;; Commentary: 27 28 ;; This library implements support for listing repositories. This 29 ;; includes getting a Lisp list of known repositories as well as a 30 ;; mode for listing repositories in a buffer. 31 32 ;;; Code: 33 34 (require 'magit-core) 35 36 (declare-function magit-status-setup-buffer "magit-status" (directory)) 37 38 (defvar x-stretch-cursor) 39 40 ;;; Options 41 42 (defcustom magit-repository-directories nil 43 "List of directories that are or contain Git repositories. 44 45 Each element has the form (DIRECTORY . DEPTH). DIRECTORY has 46 to be a directory or a directory file-name, a string. DEPTH, 47 an integer, specifies the maximum depth to look for Git 48 repositories. If it is 0, then only add DIRECTORY itself. 49 50 This option controls which repositories are being listed by 51 `magit-list-repositories'. It also affects `magit-status' 52 \(which see) in potentially surprising ways." 53 :package-version '(magit . "3.0.0") 54 :group 'magit-essentials 55 :type '(repeat (cons directory (integer :tag "Depth")))) 56 57 (defgroup magit-repolist nil 58 "List repositories in a buffer." 59 :link '(info-link "(magit)Repository List") 60 :group 'magit-modes) 61 62 (defcustom magit-repolist-mode-hook '(hl-line-mode) 63 "Hook run after entering Magit-Repolist mode." 64 :package-version '(magit . "2.9.0") 65 :group 'magit-repolist 66 :type 'hook 67 :get 'magit-hook-custom-get 68 :options '(hl-line-mode)) 69 70 (defcustom magit-repolist-columns 71 '(("Name" 25 magit-repolist-column-ident nil) 72 ("Version" 25 magit-repolist-column-version nil) 73 ("B<U" 3 magit-repolist-column-unpulled-from-upstream 74 ((:right-align t) 75 (:help-echo "Upstream changes not in branch"))) 76 ("B>U" 3 magit-repolist-column-unpushed-to-upstream 77 ((:right-align t) 78 (:help-echo "Local changes not in upstream"))) 79 ("Path" 99 magit-repolist-column-path nil)) 80 "List of columns displayed by `magit-list-repositories'. 81 82 Each element has the form (HEADER WIDTH FORMAT PROPS). 83 84 HEADER is the string displayed in the header. WIDTH is the width 85 of the column. FORMAT is a function that is called with one 86 argument, the repository identification (usually its basename), 87 and with `default-directory' bound to the toplevel of its working 88 tree. It has to return a string to be inserted or nil. PROPS is 89 an alist that supports the keys `:right-align' and `:pad-right'. 90 Some entries also use `:help-echo', but `tabulated-list' does not 91 actually support that yet. 92 93 You may wish to display a range of numeric columns using just one 94 character per column and without any padding between columns, in 95 which case you should use an appropriat HEADER, set WIDTH to 1, 96 and set `:pad-right' to 0. \"+\" is substituted for numbers higher 97 than 9." 98 :package-version '(magit . "2.12.0") 99 :group 'magit-repolist 100 :type '(repeat (list :tag "Column" 101 (string :tag "Header Label") 102 (integer :tag "Column Width") 103 (function :tag "Inserter Function") 104 (repeat :tag "Properties" 105 (list (choice :tag "Property" 106 (const :right-align) 107 (const :pad-right) 108 (symbol)) 109 (sexp :tag "Value")))))) 110 111 (defcustom magit-repolist-column-flag-alist 112 '((magit-untracked-files . "N") 113 (magit-unstaged-files . "U") 114 (magit-staged-files . "S")) 115 "Association list of predicates and flags for `magit-repolist-column-flag'. 116 117 Each element is of the form (FUNCTION . FLAG). Each FUNCTION is 118 called with no arguments, with `default-directory' bound to the 119 top level of a repository working tree, until one of them returns 120 a non-nil value. FLAG corresponding to that function is returned 121 as the value of `magit-repolist-column-flag'." 122 :package-version '(magit . "3.0.0") 123 :group 'magit-repolist 124 :type '(alist :key-type (function :tag "Predicate Function") 125 :value-type (string :tag "Flag"))) 126 127 (defcustom magit-repolist-sort-key '("Path" . nil) 128 "Initial sort key for buffer created by `magit-list-repositories'. 129 If nil, no additional sorting is performed. Otherwise, this 130 should be a cons cell (NAME . FLIP). NAME is a string matching 131 one of the column names in `magit-repolist-columns'. FLIP, if 132 non-nil, means to invert the resulting sort." 133 :package-version '(magit . "3.2.0") 134 :group 'magit-repolist 135 :type '(choice (const nil) 136 (cons (string :tag "Column name") 137 (boolean :tag "Flip order")))) 138 139 ;;; List Repositories 140 ;;;; Command 141 ;;;###autoload 142 (defun magit-list-repositories () 143 "Display a list of repositories. 144 145 Use the options `magit-repository-directories' to control which 146 repositories are displayed." 147 (interactive) 148 (magit-repolist-setup (default-value 'magit-repolist-columns))) 149 150 ;;;; Mode 151 152 (defvar magit-repolist-mode-map 153 (let ((map (make-sparse-keymap))) 154 (set-keymap-parent map tabulated-list-mode-map) 155 (define-key map (kbd "C-m") 'magit-repolist-status) 156 map) 157 "Local keymap for Magit-Repolist mode buffers.") 158 159 (defun magit-repolist-status (&optional _button) 160 "Show the status for the repository at point." 161 (interactive) 162 (--if-let (tabulated-list-get-id) 163 (magit-status-setup-buffer (expand-file-name it)) 164 (user-error "There is no repository at point"))) 165 166 (define-derived-mode magit-repolist-mode tabulated-list-mode "Repos" 167 "Major mode for browsing a list of Git repositories." 168 (setq-local x-stretch-cursor nil) 169 (setq tabulated-list-padding 0) 170 (add-hook 'tabulated-list-revert-hook 'magit-repolist-refresh nil t) 171 (setq imenu-prev-index-position-function 172 'magit-imenu--repolist-prev-index-position-function) 173 (setq imenu-extract-index-name-function 174 'magit-imenu--repolist-extract-index-name-function)) 175 176 (defun magit-repolist-setup (columns) 177 (unless magit-repository-directories 178 (user-error "You need to customize `magit-repository-directories' %s" 179 "before you can list repositories")) 180 (with-current-buffer (get-buffer-create "*Magit Repositories*") 181 (magit-repolist-mode) 182 (setq-local magit-repolist-columns columns) 183 (magit-repolist-refresh) 184 (switch-to-buffer (current-buffer)))) 185 186 (defun magit-repolist-refresh () 187 (unless tabulated-list-sort-key 188 (setq tabulated-list-sort-key 189 (pcase-let ((`(,column . ,flip) magit-repolist-sort-key)) 190 (cons (or (car (assoc column magit-repolist-columns)) 191 (caar magit-repolist-columns)) 192 flip)))) 193 (setq tabulated-list-format 194 (vconcat (mapcar (pcase-lambda (`(,title ,width ,_fn ,props)) 195 (nconc (list title width t) 196 (-flatten props))) 197 magit-repolist-columns))) 198 (setq tabulated-list-entries 199 (mapcar (pcase-lambda (`(,id . ,path)) 200 (let ((default-directory path)) 201 (list path 202 (vconcat 203 (mapcar (pcase-lambda (`(,title ,width ,fn ,props)) 204 (or (funcall fn `((:id ,id) 205 (:title ,title) 206 (:width ,width) 207 ,@props)) 208 "")) 209 magit-repolist-columns))))) 210 (magit-list-repos-uniquify 211 (--map (cons (file-name-nondirectory (directory-file-name it)) 212 it) 213 (magit-list-repos))))) 214 (message "Listing repositories...") 215 (tabulated-list-init-header) 216 (tabulated-list-print) 217 (message "Listing repositories...done")) 218 219 ;;;; Columns 220 221 (defun magit-repolist-column-ident (spec) 222 "Insert the identification of the repository. 223 Usually this is just its basename." 224 (cadr (assq :id spec))) 225 226 (defun magit-repolist-column-path (_) 227 "Insert the absolute path of the repository." 228 (abbreviate-file-name default-directory)) 229 230 (defun magit-repolist-column-version (_) 231 "Insert a description of the repository's `HEAD' revision." 232 (when-let ((v (or (magit-git-string "describe" "--tags" "--dirty") 233 ;; If there are no tags, use the date in MELPA format. 234 (magit-git-string "show" "--no-patch" "--format=%cd-g%h" 235 "--date=format:%Y%m%d.%H%M")))) 236 (save-match-data 237 (when (string-match "-dirty\\'" v) 238 (magit--put-face (1+ (match-beginning 0)) (length v) 'error v)) 239 (if (and v (string-match "\\`[0-9]" v)) 240 (concat " " v) 241 v)))) 242 243 (defun magit-repolist-column-branch (_) 244 "Insert the current branch." 245 (magit-get-current-branch)) 246 247 (defun magit-repolist-column-upstream (_) 248 "Insert the upstream branch of the current branch." 249 (magit-get-upstream-branch)) 250 251 (defun magit-repolist-column-flag (_) 252 "Insert a flag as specified by `magit-repolist-column-flag-alist'. 253 254 By default this indicates whether there are uncommitted changes. 255 - N if there is at least one untracked file. 256 - U if there is at least one unstaged file. 257 - S if there is at least one staged file. 258 Only one letter is shown, the first that applies." 259 (seq-some (pcase-lambda (`(,fun . ,flag)) 260 (and (funcall fun) flag)) 261 magit-repolist-column-flag-alist)) 262 263 (defun magit-repolist-column-flags (_) 264 "Insert all flags as specified by `magit-repolist-column-flag-alist'. 265 This is an alternative to function `magit-repolist-column-flag', 266 which only lists the first one found." 267 (mapconcat (pcase-lambda (`(,fun . ,flag)) 268 (if (funcall fun) flag " ")) 269 magit-repolist-column-flag-alist 270 "")) 271 272 (defun magit-repolist-column-unpulled-from-upstream (spec) 273 "Insert number of upstream commits not in the current branch." 274 (--when-let (magit-get-upstream-branch) 275 (magit-repolist-insert-count (cadr (magit-rev-diff-count "HEAD" it)) spec))) 276 277 (defun magit-repolist-column-unpulled-from-pushremote (spec) 278 "Insert number of commits in the push branch but not the current branch." 279 (--when-let (magit-get-push-branch nil t) 280 (magit-repolist-insert-count (cadr (magit-rev-diff-count "HEAD" it)) spec))) 281 282 (defun magit-repolist-column-unpushed-to-upstream (spec) 283 "Insert number of commits in the current branch but not its upstream." 284 (--when-let (magit-get-upstream-branch) 285 (magit-repolist-insert-count (car (magit-rev-diff-count "HEAD" it)) spec))) 286 287 (defun magit-repolist-column-unpushed-to-pushremote (spec) 288 "Insert number of commits in the current branch but not its push branch." 289 (--when-let (magit-get-push-branch nil t) 290 (magit-repolist-insert-count (car (magit-rev-diff-count "HEAD" it)) spec))) 291 292 (defun magit-repolist-column-branches (spec) 293 "Insert number of branches." 294 (magit-repolist-insert-count (length (magit-list-local-branches)) 295 `((:normal-count 1) ,@spec))) 296 297 (defun magit-repolist-column-stashes (spec) 298 "Insert number of stashes." 299 (magit-repolist-insert-count (length (magit-list-stashes)) spec)) 300 301 (defun magit-repolist-insert-count (n spec) 302 (magit--propertize-face 303 (if (and (> n 9) (= (cadr (assq :width spec)) 1)) 304 "+" 305 (number-to-string n)) 306 (if (> n (or (cadr (assq :normal-count spec)) 0)) 'bold 'shadow))) 307 308 ;;; Read Repository 309 310 (defun magit-read-repository (&optional read-directory-name) 311 "Read a Git repository in the minibuffer, with completion. 312 313 The completion choices are the basenames of top-levels of 314 repositories found in the directories specified by option 315 `magit-repository-directories'. In case of name conflicts 316 the basenames are prefixed with the name of the respective 317 parent directories. The returned value is the actual path 318 to the selected repository. 319 320 If READ-DIRECTORY-NAME is non-nil or no repositories can be 321 found based on the value of `magit-repository-directories', 322 then read an arbitrary directory using `read-directory-name' 323 instead." 324 (if-let ((repos (and (not read-directory-name) 325 magit-repository-directories 326 (magit-repos-alist)))) 327 (let ((reply (magit-completing-read "Git repository" repos))) 328 (file-name-as-directory 329 (or (cdr (assoc reply repos)) 330 (if (file-directory-p reply) 331 (expand-file-name reply) 332 (user-error "Not a repository or a directory: %s" reply))))) 333 (file-name-as-directory 334 (read-directory-name "Git repository: " 335 (or (magit-toplevel) default-directory))))) 336 337 (defun magit-list-repos () 338 (cl-mapcan (pcase-lambda (`(,dir . ,depth)) 339 (magit-list-repos-1 dir depth)) 340 magit-repository-directories)) 341 342 (defun magit-list-repos-1 (directory depth) 343 (cond ((file-readable-p (expand-file-name ".git" directory)) 344 (list (file-name-as-directory directory))) 345 ((and (> depth 0) (magit-file-accessible-directory-p directory)) 346 (--mapcat (and (file-directory-p it) 347 (magit-list-repos-1 it (1- depth))) 348 (directory-files directory t 349 directory-files-no-dot-files-regexp t))))) 350 351 (defun magit-list-repos-uniquify (alist) 352 (let (result (dict (make-hash-table :test 'equal))) 353 (dolist (a (delete-dups alist)) 354 (puthash (car a) (cons (cdr a) (gethash (car a) dict)) dict)) 355 (maphash 356 (lambda (key value) 357 (if (= (length value) 1) 358 (push (cons key (car value)) result) 359 (setq result 360 (append result 361 (magit-list-repos-uniquify 362 (--map (cons (concat 363 key "\\" 364 (file-name-nondirectory 365 (directory-file-name 366 (substring it 0 (- (1+ (length key))))))) 367 it) 368 value)))))) 369 dict) 370 result)) 371 372 (defun magit-repos-alist () 373 (magit-list-repos-uniquify 374 (--map (cons (file-name-nondirectory (directory-file-name it)) it) 375 (magit-list-repos)))) 376 377 ;;; _ 378 (provide 'magit-repos) 379 ;;; magit-repos.el ends here