magit-repos.el (22005B)
1 ;;; magit-repos.el --- Listing repositories -*- lexical-binding:t -*- 2 3 ;; Copyright (C) 2008-2024 The Magit Project Contributors 4 5 ;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> 6 ;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> 7 8 ;; SPDX-License-Identifier: GPL-3.0-or-later 9 10 ;; Magit is free software: you can redistribute it and/or modify it 11 ;; under the terms of the GNU General Public License as published by 12 ;; the Free Software Foundation, either version 3 of the License, or 13 ;; (at your option) any later version. 14 ;; 15 ;; Magit is distributed in the hope that it will be useful, but WITHOUT 16 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 17 ;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public 18 ;; License for more details. 19 ;; 20 ;; You should have received a copy of the GNU General Public License 21 ;; along with Magit. If not, see <https://www.gnu.org/licenses/>. 22 23 ;;; Commentary: 24 25 ;; This library implements support for listing repositories. This 26 ;; includes getting a Lisp list of known repositories as well as a 27 ;; mode for listing repositories in a buffer. 28 29 ;;; Code: 30 31 (require 'magit-core) 32 33 (declare-function magit-status-setup-buffer "magit-status" (&optional directory)) 34 35 (defvar x-stretch-cursor) 36 37 ;;; Options 38 39 (defcustom magit-repository-directories nil 40 "List of directories that are or contain Git repositories. 41 42 Each element has the form (DIRECTORY . DEPTH). DIRECTORY has 43 to be a directory or a directory file-name, a string. DEPTH, 44 an integer, specifies the maximum depth to look for Git 45 repositories. If it is 0, then only add DIRECTORY itself. 46 47 This option controls which repositories are being listed by 48 `magit-list-repositories'. It also affects `magit-status' 49 \(which see) in potentially surprising ways." 50 :package-version '(magit . "3.0.0") 51 :group 'magit-essentials 52 :type '(repeat (cons directory (integer :tag "Depth")))) 53 54 (defgroup magit-repolist nil 55 "List repositories in a buffer." 56 :link '(info-link "(magit)Repository List") 57 :group 'magit-modes) 58 59 (defcustom magit-repolist-mode-hook '(hl-line-mode) 60 "Hook run after entering Magit-Repolist mode." 61 :package-version '(magit . "2.9.0") 62 :group 'magit-repolist 63 :type 'hook 64 :get #'magit-hook-custom-get 65 :options '(hl-line-mode)) 66 67 (defcustom magit-repolist-columns 68 '(("Name" 25 magit-repolist-column-ident nil) 69 ("Version" 25 magit-repolist-column-version 70 ((:sort magit-repolist-version<))) 71 ("B<U" 3 magit-repolist-column-unpulled-from-upstream 72 (;; (:help-echo "Upstream changes not in branch") 73 (:right-align t) 74 (:sort <))) 75 ("B>U" 3 magit-repolist-column-unpushed-to-upstream 76 (;; (:help-echo "Local changes not in upstream") 77 (:right-align t) 78 (:sort <))) 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', `:pad-right' and 90 `:sort'. 91 92 The `:sort' function has a weird interface described in the 93 docstring of `tabulated-list--get-sort'. Alternatively `<' and 94 `magit-repolist-version<' can be used as those functions are 95 automatically replaced with functions that satisfy the interface. 96 Set `:sort' to nil to inhibit sorting; if unspecified, then the 97 column is sortable using the default sorter. 98 99 You may wish to display a range of numeric columns using just one 100 character per column and without any padding between columns, in 101 which case you should use an appropriate HEADER, set WIDTH to 1, 102 and set `:pad-right' to 0. \"+\" is substituted for numbers higher 103 than 9." 104 :package-version '(magit . "2.12.0") 105 :group 'magit-repolist 106 :type '(repeat (list :tag "Column" 107 (string :tag "Header Label") 108 (integer :tag "Column Width") 109 (function :tag "Inserter Function") 110 (repeat :tag "Properties" 111 (list (choice :tag "Property" 112 (const :right-align) 113 (const :pad-right) 114 (const :sort) 115 (symbol)) 116 (sexp :tag "Value")))))) 117 118 (defcustom magit-repolist-column-flag-alist 119 '((magit-untracked-files . "N") 120 (magit-unstaged-files . "U") 121 (magit-staged-files . "S")) 122 "Association list of predicates and flags for `magit-repolist-column-flag'. 123 124 Each element is of the form (FUNCTION . FLAG). Each FUNCTION is 125 called with no arguments, with `default-directory' bound to the 126 top level of a repository working tree, until one of them returns 127 a non-nil value. FLAG corresponding to that function is returned 128 as the value of `magit-repolist-column-flag'." 129 :package-version '(magit . "3.0.0") 130 :group 'magit-repolist 131 :type '(alist :key-type (function :tag "Predicate Function") 132 :value-type (string :tag "Flag"))) 133 134 (defcustom magit-repolist-sort-key '("Path" . nil) 135 "Initial sort key for buffer created by `magit-list-repositories'. 136 If nil, no additional sorting is performed. Otherwise, this 137 should be a cons cell (NAME . FLIP). NAME is a string matching 138 one of the column names in `magit-repolist-columns'. FLIP, if 139 non-nil, means to invert the resulting sort." 140 :package-version '(magit . "3.2.0") 141 :group 'magit-repolist 142 :type '(choice (const nil) 143 (cons (string :tag "Column name") 144 (boolean :tag "Flip order")))) 145 146 ;;; List Repositories 147 ;;;; List Commands 148 ;;;###autoload 149 (defun magit-list-repositories () 150 "Display a list of repositories. 151 152 Use the option `magit-repository-directories' to control which 153 repositories are displayed." 154 (interactive) 155 (magit-repolist-setup (default-value 'magit-repolist-columns))) 156 157 ;;;; Mode Commands 158 159 (defun magit-repolist-status (&optional _button) 160 "Show the status for the repository at point." 161 (interactive) 162 (if-let ((id (tabulated-list-get-id))) 163 (magit-status-setup-buffer (expand-file-name id)) 164 (user-error "There is no repository at point"))) 165 166 (defun magit-repolist-mark () 167 "Mark a repository and move to the next line." 168 (interactive) 169 (magit-repolist--ensure-padding) 170 (tabulated-list-put-tag "*" t)) 171 172 (defun magit-repolist-unmark () 173 "Unmark a repository and move to the next line." 174 (interactive) 175 (tabulated-list-put-tag " " t)) 176 177 (defun magit-repolist-fetch (repos) 178 "Fetch all marked or listed repositories." 179 (interactive (list (magit-repolist--get-repos ?*))) 180 (run-hooks 'magit-credential-hook) 181 (magit-repolist--mapc (apply-partially #'magit-run-git "remote" "update") 182 repos "Fetching in %s...")) 183 184 (defun magit-repolist-find-file-other-frame (repos file) 185 "Find a file in all marked or listed repositories." 186 (interactive (list (magit-repolist--get-repos ?*) 187 (read-string "Find file in repositories: "))) 188 (magit-repolist--mapc (apply-partially #'find-file-other-frame file) repos)) 189 190 (defun magit-repolist--ensure-padding () 191 "Set `tabulated-list-padding' to 2, unless that is already non-zero." 192 (when (zerop tabulated-list-padding) 193 (setq tabulated-list-padding 2) 194 (tabulated-list-init-header) 195 (tabulated-list-print t))) 196 197 (defun magit-repolist--get-repos (&optional char) 198 "Return marked repositories or `all' if none are marked. 199 If optional CHAR is non-nil, then only return repositories 200 marked with that character. If no repositories are marked 201 then ask whether to act on all repositories instead." 202 (or (magit-repolist--marked-repos char) 203 (if (magit-confirm 'repolist-all 204 "Nothing selected. Act on ALL displayed repositories") 205 'all 206 (user-error "Abort")))) 207 208 (defun magit-repolist--marked-repos (&optional char) 209 "Return marked repositories. 210 If optional CHAR is non-nil, then only return repositories 211 marked with that character." 212 (let (c list) 213 (save-excursion 214 (goto-char (point-min)) 215 (while (not (eobp)) 216 (setq c (char-after)) 217 (unless (eq c ?\s) 218 (if char 219 (when (eq c char) 220 (push (tabulated-list-get-id) list)) 221 (push (cons c (tabulated-list-get-id)) list))) 222 (forward-line))) 223 list)) 224 225 (defun magit-repolist--mapc (fn repos &optional msg) 226 "Apply FN to each directory in REPOS for side effects only. 227 If REPOS is the symbol `all', then call FN for all displayed 228 repositories. When FN is called, `default-directory' is bound to 229 the top-level directory of the current repository. If optional 230 MSG is non-nil then that is displayed around each call to FN. 231 If it contains \"%s\" then the directory is substituted for that." 232 (when (eq repos 'all) 233 (setq repos nil) 234 (save-excursion 235 (goto-char (point-min)) 236 (while (not (eobp)) 237 (push (tabulated-list-get-id) repos) 238 (forward-line))) 239 (setq repos (nreverse repos))) 240 (let ((base default-directory) 241 (len (length repos)) 242 (i 0)) 243 (mapc (lambda (repo) 244 (let ((default-directory 245 (file-name-as-directory (expand-file-name repo base)))) 246 (if msg 247 (let ((msg (concat (format "(%s/%s) " (cl-incf i) len) 248 (format msg default-directory)))) 249 (message msg) 250 (funcall fn) 251 (message (concat msg "done"))) 252 (funcall fn)))) 253 repos))) 254 255 ;;;; Mode 256 257 (defvar-keymap magit-repolist-mode-map 258 :doc "Local keymap for Magit-Repolist mode buffers." 259 :parent tabulated-list-mode-map 260 "C-m" #'magit-repolist-status 261 "m" #'magit-repolist-mark 262 "u" #'magit-repolist-unmark 263 "f" #'magit-repolist-fetch 264 "5" #'magit-repolist-find-file-other-frame) 265 266 (define-derived-mode magit-repolist-mode tabulated-list-mode "Repos" 267 "Major mode for browsing a list of Git repositories." 268 (setq-local x-stretch-cursor nil) 269 (setq tabulated-list-padding 0) 270 (add-hook 'tabulated-list-revert-hook #'magit-repolist-refresh nil t) 271 (setq imenu-prev-index-position-function 272 #'magit-repolist--imenu-prev-index-position) 273 (setq imenu-extract-index-name-function #'tabulated-list-get-id)) 274 275 (defun magit-repolist-setup (columns) 276 (unless magit-repository-directories 277 (user-error "You need to customize `magit-repository-directories' %s" 278 "before you can list repositories")) 279 (with-current-buffer (get-buffer-create "*Magit Repositories*") 280 (magit-repolist-mode) 281 (setq-local magit-repolist-columns columns) 282 (magit-repolist-setup-1) 283 (magit-repolist-refresh) 284 (switch-to-buffer (current-buffer)))) 285 286 (defun magit-repolist-setup-1 () 287 (unless tabulated-list-sort-key 288 (setq tabulated-list-sort-key 289 (pcase-let ((`(,column . ,flip) magit-repolist-sort-key)) 290 (cons (or (car (assoc column magit-repolist-columns)) 291 (caar magit-repolist-columns)) 292 flip)))) 293 (setq tabulated-list-format 294 (vconcat (seq-map-indexed 295 (lambda (column idx) 296 (pcase-let* ((`(,title ,width ,_fn ,props) column) 297 (sort-set (assoc :sort props)) 298 (sort-fn (cadr sort-set))) 299 (nconc (list title width 300 (cond ((eq sort-fn '<) 301 (magit-repolist-make-sorter 302 sort-fn #'string-to-number idx)) 303 ((eq sort-fn 'magit-repolist-version<) 304 (magit-repolist-make-sorter 305 sort-fn #'identity idx)) 306 (sort-fn sort-fn) 307 (sort-set nil) 308 (t t))) 309 (flatten-tree props)))) 310 magit-repolist-columns)))) 311 312 (defun magit-repolist-refresh () 313 (setq tabulated-list-entries 314 (mapcar (pcase-lambda (`(,id . ,path)) 315 (let ((default-directory path)) 316 (list path 317 (vconcat 318 (mapcar (pcase-lambda (`(,title ,width ,fn ,props)) 319 (or (funcall fn `((:id ,id) 320 (:title ,title) 321 (:width ,width) 322 ,@props)) 323 "")) 324 magit-repolist-columns))))) 325 (magit-list-repos-uniquify 326 (--map (cons (file-name-nondirectory (directory-file-name it)) 327 it) 328 (magit-list-repos))))) 329 (message "Listing repositories...") 330 (tabulated-list-init-header) 331 (tabulated-list-print t) 332 (message "Listing repositories...done")) 333 334 (defun magit-repolist--imenu-prev-index-position () 335 (and (not (bobp)) 336 (forward-line -1))) 337 338 ;;;; Columns 339 340 (defun magit-repolist-make-sorter (sort-predicate convert-cell column-idx) 341 "Return a function suitable as a sorter for tabulated lists. 342 See `tabulated-list--get-sorter'. Given a more reasonable API 343 this would not be necessary and one could just use SORT-PREDICATE 344 directly. CONVERT-CELL can be used to turn the cell value, which 345 is always a string back into, e.g., a number. COLUMN-IDX has to 346 be the index of the column that uses the returned sorter function." 347 (lambda (a b) 348 (funcall sort-predicate 349 (funcall convert-cell (aref (cadr a) column-idx)) 350 (funcall convert-cell (aref (cadr b) column-idx))))) 351 352 (defun magit-repolist-column-ident (spec) 353 "Insert the identification of the repository. 354 Usually this is just its basename." 355 (cadr (assq :id spec))) 356 357 (defun magit-repolist-column-path (_) 358 "Insert the absolute path of the repository." 359 (abbreviate-file-name default-directory)) 360 361 (defvar magit-repolist-column-version-regexp "\ 362 \\(?1:-\\(?2:[0-9]*\\)\ 363 \\(?3:-g[a-z0-9]*\\)\\)?\ 364 \\(?:-\\(?4:dirty\\)\\)\ 365 ?\\'") 366 367 (defvar magit-repolist-column-version-resume-regexp 368 "\\`Resume development\\'") 369 370 (defun magit-repolist-column-version (_) 371 "Insert a description of the repository's `HEAD' revision." 372 (and-let* ((v (or (magit-git-string "describe" "--tags" "--dirty") 373 ;; If there are no tags, use the date in MELPA format. 374 (magit-rev-format "%cd-g%h" nil 375 "--date=format:%Y%m%d.%H%M")))) 376 (save-match-data 377 (when (string-match magit-repolist-column-version-regexp v) 378 (magit--put-face (match-beginning 0) (match-end 0) 'shadow v) 379 (when (match-end 2) 380 (magit--put-face (match-beginning 2) (match-end 2) 'bold v)) 381 (when (match-end 4) 382 (magit--put-face (or (match-beginning 3) (match-beginning 4)) 383 (match-end 4) 'error v)) 384 (when (and (equal (match-string 2 v) "1") 385 (string-match-p magit-repolist-column-version-resume-regexp 386 (magit-rev-format "%s"))) 387 (setq v (replace-match (propertize "+" 'face 'shadow) t t v 1)))) 388 (if (and v (string-match "\\`[0-9]" v)) 389 (concat " " v) 390 (when (and v (string-match "\\`[^0-9]+" v)) 391 (magit--put-face 0 (match-end 0) 'shadow v)) 392 v)))) 393 394 (defun magit-repolist-version< (a b) 395 (save-match-data 396 (let ((re "[0-9]+\\(\\.[0-9]*\\)*")) 397 (setq a (and (string-match re a) (match-string 0 a))) 398 (setq b (and (string-match re b) (match-string 0 b))) 399 (cond ((and a b) (version< a b)) 400 (b nil) 401 (t t))))) 402 403 (defun magit-repolist-column-branch (_) 404 "Insert the current branch." 405 (let ((branch (magit-get-current-branch))) 406 (if (member branch magit-main-branch-names) 407 (magit--propertize-face branch 'shadow) 408 branch))) 409 410 (defun magit-repolist-column-upstream (_) 411 "Insert the upstream branch of the current branch." 412 (magit-get-upstream-branch)) 413 414 (defun magit-repolist-column-flag (_) 415 "Insert a flag as specified by `magit-repolist-column-flag-alist'. 416 417 By default this indicates whether there are uncommitted changes. 418 - N if there is at least one untracked file. 419 - U if there is at least one unstaged file. 420 - S if there is at least one staged file. 421 Only one letter is shown, the first that applies." 422 (seq-some (pcase-lambda (`(,fun . ,flag)) 423 (and (funcall fun) flag)) 424 magit-repolist-column-flag-alist)) 425 426 (defun magit-repolist-column-flags (_) 427 "Insert all flags as specified by `magit-repolist-column-flag-alist'. 428 This is an alternative to function `magit-repolist-column-flag', 429 which only lists the first one found." 430 (mapconcat (pcase-lambda (`(,fun . ,flag)) 431 (if (funcall fun) flag " ")) 432 magit-repolist-column-flag-alist 433 "")) 434 435 (defun magit-repolist-column-unpulled-from-upstream (spec) 436 "Insert number of upstream commits not in the current branch." 437 (and-let* ((br (magit-get-upstream-branch))) 438 (magit-repolist-insert-count (cadr (magit-rev-diff-count "HEAD" br)) spec))) 439 440 (defun magit-repolist-column-unpulled-from-pushremote (spec) 441 "Insert number of commits in the push branch but not the current branch." 442 (and-let* ((br (magit-get-push-branch nil t))) 443 (magit-repolist-insert-count (cadr (magit-rev-diff-count "HEAD" br)) spec))) 444 445 (defun magit-repolist-column-unpushed-to-upstream (spec) 446 "Insert number of commits in the current branch but not its upstream." 447 (and-let* ((br (magit-get-upstream-branch))) 448 (magit-repolist-insert-count (car (magit-rev-diff-count "HEAD" br)) spec))) 449 450 (defun magit-repolist-column-unpushed-to-pushremote (spec) 451 "Insert number of commits in the current branch but not its push branch." 452 (and-let* ((br (magit-get-push-branch nil t))) 453 (magit-repolist-insert-count (car (magit-rev-diff-count "HEAD" br)) spec))) 454 455 (defun magit-repolist-column-branches (spec) 456 "Insert number of branches." 457 (magit-repolist-insert-count (length (magit-list-local-branches)) 458 `((:normal-count 1) ,@spec))) 459 460 (defun magit-repolist-column-stashes (spec) 461 "Insert number of stashes." 462 (magit-repolist-insert-count (length (magit-list-stashes)) spec)) 463 464 (defun magit-repolist-insert-count (n spec) 465 (magit--propertize-face 466 (if (and (> n 9) (= (cadr (assq :width spec)) 1)) 467 "+" 468 (number-to-string n)) 469 (if (> n (or (cadr (assq :normal-count spec)) 0)) 'bold 'shadow))) 470 471 ;;; Read Repository 472 473 (defun magit-read-repository (&optional read-directory-name) 474 "Read a Git repository in the minibuffer, with completion. 475 476 The completion choices are the basenames of top-levels of 477 repositories found in the directories specified by option 478 `magit-repository-directories'. In case of name conflicts 479 the basenames are prefixed with the name of the respective 480 parent directories. The returned value is the actual path 481 to the selected repository. 482 483 If READ-DIRECTORY-NAME is non-nil or no repositories can be 484 found based on the value of `magit-repository-directories', 485 then read an arbitrary directory using `read-directory-name' 486 instead." 487 (if-let ((repos (and (not read-directory-name) 488 magit-repository-directories 489 (magit-repos-alist)))) 490 (let ((reply (magit-completing-read "Git repository" repos))) 491 (file-name-as-directory 492 (or (cdr (assoc reply repos)) 493 (if (file-directory-p reply) 494 (expand-file-name reply) 495 (user-error "Not a repository or a directory: %s" reply))))) 496 (file-name-as-directory 497 (read-directory-name "Git repository: " 498 (or (magit-toplevel) default-directory))))) 499 500 (defun magit-list-repos () 501 (cl-mapcan (pcase-lambda (`(,dir . ,depth)) 502 (magit-list-repos-1 dir depth)) 503 magit-repository-directories)) 504 505 (defun magit-list-repos-1 (directory depth) 506 (cond ((file-readable-p (expand-file-name ".git" directory)) 507 (list (file-name-as-directory directory))) 508 ((and (> depth 0) (file-accessible-directory-p directory)) 509 (--mapcat (and (file-directory-p it) 510 (magit-list-repos-1 it (1- depth))) 511 (directory-files directory t 512 directory-files-no-dot-files-regexp t))))) 513 514 (defun magit-list-repos-uniquify (alist) 515 (let (result (dict (make-hash-table :test #'equal))) 516 (dolist (a (delete-dups alist)) 517 (puthash (car a) (cons (cdr a) (gethash (car a) dict)) dict)) 518 (maphash 519 (lambda (key value) 520 (if (length= value 1) 521 (push (cons key (car value)) result) 522 (setq result 523 (append result 524 (magit-list-repos-uniquify 525 (--map (cons (concat 526 key "\\" 527 (file-name-nondirectory 528 (directory-file-name 529 (substring it 0 (- (1+ (length key))))))) 530 it) 531 value)))))) 532 dict) 533 result)) 534 535 (defun magit-repos-alist () 536 (magit-list-repos-uniquify 537 (--map (cons (file-name-nondirectory (directory-file-name it)) it) 538 (magit-list-repos)))) 539 540 ;;; _ 541 (provide 'magit-repos) 542 ;;; magit-repos.el ends here