magit-repos.el (22049B)
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 :interactive nil 269 :group 'magit-repolist 270 (setq-local x-stretch-cursor nil) 271 (setq tabulated-list-padding 0) 272 (add-hook 'tabulated-list-revert-hook #'magit-repolist-refresh nil t) 273 (setq imenu-prev-index-position-function 274 #'magit-repolist--imenu-prev-index-position) 275 (setq imenu-extract-index-name-function #'tabulated-list-get-id)) 276 277 (defun magit-repolist-setup (columns) 278 (unless magit-repository-directories 279 (user-error "You need to customize `magit-repository-directories' %s" 280 "before you can list repositories")) 281 (with-current-buffer (get-buffer-create "*Magit Repositories*") 282 (magit-repolist-mode) 283 (setq-local magit-repolist-columns columns) 284 (magit-repolist-setup-1) 285 (magit-repolist-refresh) 286 (switch-to-buffer (current-buffer)))) 287 288 (defun magit-repolist-setup-1 () 289 (unless tabulated-list-sort-key 290 (setq tabulated-list-sort-key 291 (pcase-let ((`(,column . ,flip) magit-repolist-sort-key)) 292 (cons (or (car (assoc column magit-repolist-columns)) 293 (caar magit-repolist-columns)) 294 flip)))) 295 (setq tabulated-list-format 296 (vconcat (seq-map-indexed 297 (lambda (column idx) 298 (pcase-let* ((`(,title ,width ,_fn ,props) column) 299 (sort-set (assoc :sort props)) 300 (sort-fn (cadr sort-set))) 301 (nconc (list title width 302 (cond ((eq sort-fn '<) 303 (magit-repolist-make-sorter 304 sort-fn #'string-to-number idx)) 305 ((eq sort-fn 'magit-repolist-version<) 306 (magit-repolist-make-sorter 307 sort-fn #'identity idx)) 308 (sort-fn sort-fn) 309 (sort-set nil) 310 (t t))) 311 (flatten-tree props)))) 312 magit-repolist-columns)))) 313 314 (defun magit-repolist-refresh () 315 (setq tabulated-list-entries 316 (mapcar (pcase-lambda (`(,id . ,path)) 317 (let ((default-directory path)) 318 (list path 319 (vconcat 320 (mapcar (pcase-lambda (`(,title ,width ,fn ,props)) 321 (or (funcall fn `((:id ,id) 322 (:title ,title) 323 (:width ,width) 324 ,@props)) 325 "")) 326 magit-repolist-columns))))) 327 (magit-list-repos-uniquify 328 (--map (cons (file-name-nondirectory (directory-file-name it)) 329 it) 330 (magit-list-repos))))) 331 (message "Listing repositories...") 332 (tabulated-list-init-header) 333 (tabulated-list-print t) 334 (message "Listing repositories...done")) 335 336 (defun magit-repolist--imenu-prev-index-position () 337 (and (not (bobp)) 338 (forward-line -1))) 339 340 ;;;; Columns 341 342 (defun magit-repolist-make-sorter (sort-predicate convert-cell column-idx) 343 "Return a function suitable as a sorter for tabulated lists. 344 See `tabulated-list--get-sorter'. Given a more reasonable API 345 this would not be necessary and one could just use SORT-PREDICATE 346 directly. CONVERT-CELL can be used to turn the cell value, which 347 is always a string back into, e.g., a number. COLUMN-IDX has to 348 be the index of the column that uses the returned sorter function." 349 (lambda (a b) 350 (funcall sort-predicate 351 (funcall convert-cell (aref (cadr a) column-idx)) 352 (funcall convert-cell (aref (cadr b) column-idx))))) 353 354 (defun magit-repolist-column-ident (spec) 355 "Insert the identification of the repository. 356 Usually this is just its basename." 357 (cadr (assq :id spec))) 358 359 (defun magit-repolist-column-path (_) 360 "Insert the absolute path of the repository." 361 (abbreviate-file-name default-directory)) 362 363 (defvar magit-repolist-column-version-regexp "\ 364 \\(?1:-\\(?2:[0-9]*\\)\ 365 \\(?3:-g[a-z0-9]*\\)\\)?\ 366 \\(?:-\\(?4:dirty\\)\\)\ 367 ?\\'") 368 369 (defvar magit-repolist-column-version-resume-regexp 370 "\\`Resume development\\'") 371 372 (defun magit-repolist-column-version (_) 373 "Insert a description of the repository's `HEAD' revision." 374 (and-let* ((v (or (magit-git-string "describe" "--tags" "--dirty") 375 ;; If there are no tags, use the date in MELPA format. 376 (magit-rev-format "%cd-g%h" nil 377 "--date=format:%Y%m%d.%H%M")))) 378 (save-match-data 379 (when (string-match magit-repolist-column-version-regexp v) 380 (magit--put-face (match-beginning 0) (match-end 0) 'shadow v) 381 (when (match-end 2) 382 (magit--put-face (match-beginning 2) (match-end 2) 'bold v)) 383 (when (match-end 4) 384 (magit--put-face (or (match-beginning 3) (match-beginning 4)) 385 (match-end 4) 'error v)) 386 (when (and (equal (match-string 2 v) "1") 387 (string-match-p magit-repolist-column-version-resume-regexp 388 (magit-rev-format "%s"))) 389 (setq v (replace-match (propertize "+" 'face 'shadow) t t v 1)))) 390 (if (and v (string-match "\\`[0-9]" v)) 391 (concat " " v) 392 (when (and v (string-match "\\`[^0-9]+" v)) 393 (magit--put-face 0 (match-end 0) 'shadow v)) 394 v)))) 395 396 (defun magit-repolist-version< (a b) 397 (save-match-data 398 (let ((re "[0-9]+\\(\\.[0-9]*\\)*")) 399 (setq a (and (string-match re a) (match-string 0 a))) 400 (setq b (and (string-match re b) (match-string 0 b))) 401 (cond ((and a b) (version< a b)) 402 (b nil) 403 (t t))))) 404 405 (defun magit-repolist-column-branch (_) 406 "Insert the current branch." 407 (let ((branch (magit-get-current-branch))) 408 (if (member branch magit-main-branch-names) 409 (magit--propertize-face branch 'shadow) 410 branch))) 411 412 (defun magit-repolist-column-upstream (_) 413 "Insert the upstream branch of the current branch." 414 (magit-get-upstream-branch)) 415 416 (defun magit-repolist-column-flag (_) 417 "Insert a flag as specified by `magit-repolist-column-flag-alist'. 418 419 By default this indicates whether there are uncommitted changes. 420 - N if there is at least one untracked file. 421 - U if there is at least one unstaged file. 422 - S if there is at least one staged file. 423 Only one letter is shown, the first that applies." 424 (seq-some (pcase-lambda (`(,fun . ,flag)) 425 (and (funcall fun) flag)) 426 magit-repolist-column-flag-alist)) 427 428 (defun magit-repolist-column-flags (_) 429 "Insert all flags as specified by `magit-repolist-column-flag-alist'. 430 This is an alternative to function `magit-repolist-column-flag', 431 which only lists the first one found." 432 (mapconcat (pcase-lambda (`(,fun . ,flag)) 433 (if (funcall fun) flag " ")) 434 magit-repolist-column-flag-alist 435 "")) 436 437 (defun magit-repolist-column-unpulled-from-upstream (spec) 438 "Insert number of upstream commits not in the current branch." 439 (and-let* ((br (magit-get-upstream-branch))) 440 (magit-repolist-insert-count (cadr (magit-rev-diff-count "HEAD" br)) spec))) 441 442 (defun magit-repolist-column-unpulled-from-pushremote (spec) 443 "Insert number of commits in the push branch but not the current branch." 444 (and-let* ((br (magit-get-push-branch nil t))) 445 (magit-repolist-insert-count (cadr (magit-rev-diff-count "HEAD" br)) spec))) 446 447 (defun magit-repolist-column-unpushed-to-upstream (spec) 448 "Insert number of commits in the current branch but not its upstream." 449 (and-let* ((br (magit-get-upstream-branch))) 450 (magit-repolist-insert-count (car (magit-rev-diff-count "HEAD" br)) spec))) 451 452 (defun magit-repolist-column-unpushed-to-pushremote (spec) 453 "Insert number of commits in the current branch but not its push branch." 454 (and-let* ((br (magit-get-push-branch nil t))) 455 (magit-repolist-insert-count (car (magit-rev-diff-count "HEAD" br)) spec))) 456 457 (defun magit-repolist-column-branches (spec) 458 "Insert number of branches." 459 (magit-repolist-insert-count (length (magit-list-local-branches)) 460 `((:normal-count 1) ,@spec))) 461 462 (defun magit-repolist-column-stashes (spec) 463 "Insert number of stashes." 464 (magit-repolist-insert-count (length (magit-list-stashes)) spec)) 465 466 (defun magit-repolist-insert-count (n spec) 467 (magit--propertize-face 468 (if (and (> n 9) (= (cadr (assq :width spec)) 1)) 469 "+" 470 (number-to-string n)) 471 (if (> n (or (cadr (assq :normal-count spec)) 0)) 'bold 'shadow))) 472 473 ;;; Read Repository 474 475 (defun magit-read-repository (&optional read-directory-name) 476 "Read a Git repository in the minibuffer, with completion. 477 478 The completion choices are the basenames of top-levels of 479 repositories found in the directories specified by option 480 `magit-repository-directories'. In case of name conflicts 481 the basenames are prefixed with the name of the respective 482 parent directories. The returned value is the actual path 483 to the selected repository. 484 485 If READ-DIRECTORY-NAME is non-nil or no repositories can be 486 found based on the value of `magit-repository-directories', 487 then read an arbitrary directory using `read-directory-name' 488 instead." 489 (if-let ((repos (and (not read-directory-name) 490 magit-repository-directories 491 (magit-repos-alist)))) 492 (let ((reply (magit-completing-read "Git repository" repos))) 493 (file-name-as-directory 494 (or (cdr (assoc reply repos)) 495 (if (file-directory-p reply) 496 (expand-file-name reply) 497 (user-error "Not a repository or a directory: %s" reply))))) 498 (file-name-as-directory 499 (read-directory-name "Git repository: " 500 (or (magit-toplevel) default-directory))))) 501 502 (defun magit-list-repos () 503 (cl-mapcan (pcase-lambda (`(,dir . ,depth)) 504 (magit-list-repos-1 dir depth)) 505 magit-repository-directories)) 506 507 (defun magit-list-repos-1 (directory depth) 508 (cond ((file-readable-p (expand-file-name ".git" directory)) 509 (list (file-name-as-directory directory))) 510 ((and (> depth 0) (file-accessible-directory-p directory)) 511 (--mapcat (and (file-directory-p it) 512 (magit-list-repos-1 it (1- depth))) 513 (directory-files directory t 514 directory-files-no-dot-files-regexp t))))) 515 516 (defun magit-list-repos-uniquify (alist) 517 (let (result (dict (make-hash-table :test #'equal))) 518 (dolist (a (delete-dups alist)) 519 (puthash (car a) (cons (cdr a) (gethash (car a) dict)) dict)) 520 (maphash 521 (lambda (key value) 522 (if (length= value 1) 523 (push (cons key (car value)) result) 524 (setq result 525 (append result 526 (magit-list-repos-uniquify 527 (--map (cons (concat 528 key "\\" 529 (file-name-nondirectory 530 (directory-file-name 531 (substring it 0 (- (1+ (length key))))))) 532 it) 533 value)))))) 534 dict) 535 result)) 536 537 (defun magit-repos-alist () 538 (magit-list-repos-uniquify 539 (--map (cons (file-name-nondirectory (directory-file-name it)) it) 540 (magit-list-repos)))) 541 542 ;;; _ 543 (provide 'magit-repos) 544 ;;; magit-repos.el ends here