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