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