├── .travis.yml ├── LICENSE ├── Makefile ├── README.md ├── gited-ci.el ├── gited-tests.el ├── gited.el └── screenshots ├── gited-remote-branches-verbose-screenshot.png └── gited-tags-screenshot.png /.travis.yml: -------------------------------------------------------------------------------- 1 | language: emacs-lisp 2 | 3 | notifications: 4 | email: 5 | on_success: never 6 | on_failure: always 7 | 8 | env: 9 | # - EVM_EMACS=emacs-24.3-travis # advice-add requires >= 24.4 10 | - EVM_EMACS=emacs-24.4-travis 11 | - EVM_EMACS=emacs-24.5-travis 12 | - EVM_EMACS=emacs-25.3-travis 13 | - EVM_EMACS=emacs-26.2-travis 14 | - EVM_EMACS=emacs-git-snapshot-travis 15 | 16 | before_install: 17 | - git clone https://github.com/rejeep/evm.git $HOME/.evm 18 | - export PATH=$HOME/.evm/bin:$PATH 19 | 20 | - evm config path /tmp 21 | - evm install $EVM_EMACS --use --skip 22 | 23 | script: 24 | - make test 25 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | The GNU General Public License is a free, copyleft license for 11 | software and other kinds of works. 12 | 13 | The licenses for most software and other practical works are designed 14 | to take away your freedom to share and change the works. By contrast, 15 | the GNU General Public License is intended to guarantee your freedom to 16 | share and change all versions of a program--to make sure it remains free 17 | software for all its users. We, the Free Software Foundation, use the 18 | GNU General Public License for most of our software; it applies also to 19 | any other work released this way by its authors. You can apply it to 20 | your programs, too. 21 | 22 | When we speak of free software, we are referring to freedom, not 23 | price. Our General Public Licenses are designed to make sure that you 24 | have the freedom to distribute copies of free software (and charge for 25 | them if you wish), that you receive source code or can get it if you 26 | want it, that you can change the software or use pieces of it in new 27 | free programs, and that you know you can do these things. 28 | 29 | To protect your rights, we need to prevent others from denying you 30 | these rights or asking you to surrender the rights. Therefore, you have 31 | certain responsibilities if you distribute copies of the software, or if 32 | you modify it: responsibilities to respect the freedom of others. 33 | 34 | For example, if you distribute copies of such a program, whether 35 | gratis or for a fee, you must pass on to the recipients the same 36 | freedoms that you received. You must make sure that they, too, receive 37 | or can get the source code. And you must show them these terms so they 38 | know their rights. 39 | 40 | Developers that use the GNU GPL protect your rights with two steps: 41 | (1) assert copyright on the software, and (2) offer you this License 42 | giving you legal permission to copy, distribute and/or modify it. 43 | 44 | For the developers' and authors' protection, the GPL clearly explains 45 | that there is no warranty for this free software. For both users' and 46 | authors' sake, the GPL requires that modified versions be marked as 47 | changed, so that their problems will not be attributed erroneously to 48 | authors of previous versions. 49 | 50 | Some devices are designed to deny users access to install or run 51 | modified versions of the software inside them, although the manufacturer 52 | can do so. This is fundamentally incompatible with the aim of 53 | protecting users' freedom to change the software. The systematic 54 | pattern of such abuse occurs in the area of products for individuals to 55 | use, which is precisely where it is most unacceptable. Therefore, we 56 | have designed this version of the GPL to prohibit the practice for those 57 | products. If such problems arise substantially in other domains, we 58 | stand ready to extend this provision to those domains in future versions 59 | of the GPL, as needed to protect the freedom of users. 60 | 61 | Finally, every program is threatened constantly by software patents. 62 | States should not allow patents to restrict development and use of 63 | software on general-purpose computers, but in those that do, we wish to 64 | avoid the special danger that patents applied to a free program could 65 | make it effectively proprietary. To prevent this, the GPL assures that 66 | patents cannot be used to render the program non-free. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | TERMS AND CONDITIONS 72 | 73 | 0. Definitions. 74 | 75 | "This License" refers to version 3 of the GNU General Public License. 76 | 77 | "Copyright" also means copyright-like laws that apply to other kinds of 78 | works, such as semiconductor masks. 79 | 80 | "The Program" refers to any copyrightable work licensed under this 81 | License. Each licensee is addressed as "you". "Licensees" and 82 | "recipients" may be individuals or organizations. 83 | 84 | To "modify" a work means to copy from or adapt all or part of the work 85 | in a fashion requiring copyright permission, other than the making of an 86 | exact copy. The resulting work is called a "modified version" of the 87 | earlier work or a work "based on" the earlier work. 88 | 89 | A "covered work" means either the unmodified Program or a work based 90 | on the Program. 91 | 92 | To "propagate" a work means to do anything with it that, without 93 | permission, would make you directly or secondarily liable for 94 | infringement under applicable copyright law, except executing it on a 95 | computer or modifying a private copy. Propagation includes copying, 96 | distribution (with or without modification), making available to the 97 | public, and in some countries other activities as well. 98 | 99 | To "convey" a work means any kind of propagation that enables other 100 | parties to make or receive copies. Mere interaction with a user through 101 | a computer network, with no transfer of a copy, is not conveying. 102 | 103 | An interactive user interface displays "Appropriate Legal Notices" 104 | to the extent that it includes a convenient and prominently visible 105 | feature that (1) displays an appropriate copyright notice, and (2) 106 | tells the user that there is no warranty for the work (except to the 107 | extent that warranties are provided), that licensees may convey the 108 | work under this License, and how to view a copy of this License. If 109 | the interface presents a list of user commands or options, such as a 110 | menu, a prominent item in the list meets this criterion. 111 | 112 | 1. Source Code. 113 | 114 | The "source code" for a work means the preferred form of the work 115 | for making modifications to it. "Object code" means any non-source 116 | form of a work. 117 | 118 | A "Standard Interface" means an interface that either is an official 119 | standard defined by a recognized standards body, or, in the case of 120 | interfaces specified for a particular programming language, one that 121 | is widely used among developers working in that language. 122 | 123 | The "System Libraries" of an executable work include anything, other 124 | than the work as a whole, that (a) is included in the normal form of 125 | packaging a Major Component, but which is not part of that Major 126 | Component, and (b) serves only to enable use of the work with that 127 | Major Component, or to implement a Standard Interface for which an 128 | implementation is available to the public in source code form. A 129 | "Major Component", in this context, means a major essential component 130 | (kernel, window system, and so on) of the specific operating system 131 | (if any) on which the executable work runs, or a compiler used to 132 | produce the work, or an object code interpreter used to run it. 133 | 134 | The "Corresponding Source" for a work in object code form means all 135 | the source code needed to generate, install, and (for an executable 136 | work) run the object code and to modify the work, including scripts to 137 | control those activities. However, it does not include the work's 138 | System Libraries, or general-purpose tools or generally available free 139 | programs which are used unmodified in performing those activities but 140 | which are not part of the work. For example, Corresponding Source 141 | includes interface definition files associated with source files for 142 | the work, and the source code for shared libraries and dynamically 143 | linked subprograms that the work is specifically designed to require, 144 | such as by intimate data communication or control flow between those 145 | subprograms and other parts of the work. 146 | 147 | The Corresponding Source need not include anything that users 148 | can regenerate automatically from other parts of the Corresponding 149 | Source. 150 | 151 | The Corresponding Source for a work in source code form is that 152 | same work. 153 | 154 | 2. Basic Permissions. 155 | 156 | All rights granted under this License are granted for the term of 157 | copyright on the Program, and are irrevocable provided the stated 158 | conditions are met. This License explicitly affirms your unlimited 159 | permission to run the unmodified Program. The output from running a 160 | covered work is covered by this License only if the output, given its 161 | content, constitutes a covered work. This License acknowledges your 162 | rights of fair use or other equivalent, as provided by copyright law. 163 | 164 | You may make, run and propagate covered works that you do not 165 | convey, without conditions so long as your license otherwise remains 166 | in force. You may convey covered works to others for the sole purpose 167 | of having them make modifications exclusively for you, or provide you 168 | with facilities for running those works, provided that you comply with 169 | the terms of this License in conveying all material for which you do 170 | not control copyright. Those thus making or running the covered works 171 | for you must do so exclusively on your behalf, under your direction 172 | and control, on terms that prohibit them from making any copies of 173 | your copyrighted material outside their relationship with you. 174 | 175 | Conveying under any other circumstances is permitted solely under 176 | the conditions stated below. Sublicensing is not allowed; section 10 177 | makes it unnecessary. 178 | 179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law. 180 | 181 | No covered work shall be deemed part of an effective technological 182 | measure under any applicable law fulfilling obligations under article 183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or 184 | similar laws prohibiting or restricting circumvention of such 185 | measures. 186 | 187 | When you convey a covered work, you waive any legal power to forbid 188 | circumvention of technological measures to the extent such circumvention 189 | is effected by exercising rights under this License with respect to 190 | the covered work, and you disclaim any intention to limit operation or 191 | modification of the work as a means of enforcing, against the work's 192 | users, your or third parties' legal rights to forbid circumvention of 193 | technological measures. 194 | 195 | 4. Conveying Verbatim Copies. 196 | 197 | You may convey verbatim copies of the Program's source code as you 198 | receive it, in any medium, provided that you conspicuously and 199 | appropriately publish on each copy an appropriate copyright notice; 200 | keep intact all notices stating that this License and any 201 | non-permissive terms added in accord with section 7 apply to the code; 202 | keep intact all notices of the absence of any warranty; and give all 203 | recipients a copy of this License along with the Program. 204 | 205 | You may charge any price or no price for each copy that you convey, 206 | and you may offer support or warranty protection for a fee. 207 | 208 | 5. Conveying Modified Source Versions. 209 | 210 | You may convey a work based on the Program, or the modifications to 211 | produce it from the Program, in the form of source code under the 212 | terms of section 4, provided that you also meet all of these conditions: 213 | 214 | a) The work must carry prominent notices stating that you modified 215 | it, and giving a relevant date. 216 | 217 | b) The work must carry prominent notices stating that it is 218 | released under this License and any conditions added under section 219 | 7. This requirement modifies the requirement in section 4 to 220 | "keep intact all notices". 221 | 222 | c) You must license the entire work, as a whole, under this 223 | License to anyone who comes into possession of a copy. This 224 | License will therefore apply, along with any applicable section 7 225 | additional terms, to the whole of the work, and all its parts, 226 | regardless of how they are packaged. This License gives no 227 | permission to license the work in any other way, but it does not 228 | invalidate such permission if you have separately received it. 229 | 230 | d) If the work has interactive user interfaces, each must display 231 | Appropriate Legal Notices; however, if the Program has interactive 232 | interfaces that do not display Appropriate Legal Notices, your 233 | work need not make them do so. 234 | 235 | A compilation of a covered work with other separate and independent 236 | works, which are not by their nature extensions of the covered work, 237 | and which are not combined with it such as to form a larger program, 238 | in or on a volume of a storage or distribution medium, is called an 239 | "aggregate" if the compilation and its resulting copyright are not 240 | used to limit the access or legal rights of the compilation's users 241 | beyond what the individual works permit. Inclusion of a covered work 242 | in an aggregate does not cause this License to apply to the other 243 | parts of the aggregate. 244 | 245 | 6. Conveying Non-Source Forms. 246 | 247 | You may convey a covered work in object code form under the terms 248 | of sections 4 and 5, provided that you also convey the 249 | machine-readable Corresponding Source under the terms of this License, 250 | in one of these ways: 251 | 252 | a) Convey the object code in, or embodied in, a physical product 253 | (including a physical distribution medium), accompanied by the 254 | Corresponding Source fixed on a durable physical medium 255 | customarily used for software interchange. 256 | 257 | b) Convey the object code in, or embodied in, a physical product 258 | (including a physical distribution medium), accompanied by a 259 | written offer, valid for at least three years and valid for as 260 | long as you offer spare parts or customer support for that product 261 | model, to give anyone who possesses the object code either (1) a 262 | copy of the Corresponding Source for all the software in the 263 | product that is covered by this License, on a durable physical 264 | medium customarily used for software interchange, for a price no 265 | more than your reasonable cost of physically performing this 266 | conveying of source, or (2) access to copy the 267 | Corresponding Source from a network server at no charge. 268 | 269 | c) Convey individual copies of the object code with a copy of the 270 | written offer to provide the Corresponding Source. This 271 | alternative is allowed only occasionally and noncommercially, and 272 | only if you received the object code with such an offer, in accord 273 | with subsection 6b. 274 | 275 | d) Convey the object code by offering access from a designated 276 | place (gratis or for a charge), and offer equivalent access to the 277 | Corresponding Source in the same way through the same place at no 278 | further charge. You need not require recipients to copy the 279 | Corresponding Source along with the object code. If the place to 280 | copy the object code is a network server, the Corresponding Source 281 | may be on a different server (operated by you or a third party) 282 | that supports equivalent copying facilities, provided you maintain 283 | clear directions next to the object code saying where to find the 284 | Corresponding Source. Regardless of what server hosts the 285 | Corresponding Source, you remain obligated to ensure that it is 286 | available for as long as needed to satisfy these requirements. 287 | 288 | e) Convey the object code using peer-to-peer transmission, provided 289 | you inform other peers where the object code and Corresponding 290 | Source of the work are being offered to the general public at no 291 | charge under subsection 6d. 292 | 293 | A separable portion of the object code, whose source code is excluded 294 | from the Corresponding Source as a System Library, need not be 295 | included in conveying the object code work. 296 | 297 | A "User Product" is either (1) a "consumer product", which means any 298 | tangible personal property which is normally used for personal, family, 299 | or household purposes, or (2) anything designed or sold for incorporation 300 | into a dwelling. In determining whether a product is a consumer product, 301 | doubtful cases shall be resolved in favor of coverage. For a particular 302 | product received by a particular user, "normally used" refers to a 303 | typical or common use of that class of product, regardless of the status 304 | of the particular user or of the way in which the particular user 305 | actually uses, or expects or is expected to use, the product. A product 306 | is a consumer product regardless of whether the product has substantial 307 | commercial, industrial or non-consumer uses, unless such uses represent 308 | the only significant mode of use of the product. 309 | 310 | "Installation Information" for a User Product means any methods, 311 | procedures, authorization keys, or other information required to install 312 | and execute modified versions of a covered work in that User Product from 313 | a modified version of its Corresponding Source. The information must 314 | suffice to ensure that the continued functioning of the modified object 315 | code is in no case prevented or interfered with solely because 316 | modification has been made. 317 | 318 | If you convey an object code work under this section in, or with, or 319 | specifically for use in, a User Product, and the conveying occurs as 320 | part of a transaction in which the right of possession and use of the 321 | User Product is transferred to the recipient in perpetuity or for a 322 | fixed term (regardless of how the transaction is characterized), the 323 | Corresponding Source conveyed under this section must be accompanied 324 | by the Installation Information. But this requirement does not apply 325 | if neither you nor any third party retains the ability to install 326 | modified object code on the User Product (for example, the work has 327 | been installed in ROM). 328 | 329 | The requirement to provide Installation Information does not include a 330 | requirement to continue to provide support service, warranty, or updates 331 | for a work that has been modified or installed by the recipient, or for 332 | the User Product in which it has been modified or installed. Access to a 333 | network may be denied when the modification itself materially and 334 | adversely affects the operation of the network or violates the rules and 335 | protocols for communication across the network. 336 | 337 | Corresponding Source conveyed, and Installation Information provided, 338 | in accord with this section must be in a format that is publicly 339 | documented (and with an implementation available to the public in 340 | source code form), and must require no special password or key for 341 | unpacking, reading or copying. 342 | 343 | 7. Additional Terms. 344 | 345 | "Additional permissions" are terms that supplement the terms of this 346 | License by making exceptions from one or more of its conditions. 347 | Additional permissions that are applicable to the entire Program shall 348 | be treated as though they were included in this License, to the extent 349 | that they are valid under applicable law. If additional permissions 350 | apply only to part of the Program, that part may be used separately 351 | under those permissions, but the entire Program remains governed by 352 | this License without regard to the additional permissions. 353 | 354 | When you convey a copy of a covered work, you may at your option 355 | remove any additional permissions from that copy, or from any part of 356 | it. (Additional permissions may be written to require their own 357 | removal in certain cases when you modify the work.) You may place 358 | additional permissions on material, added by you to a covered work, 359 | for which you have or can give appropriate copyright permission. 360 | 361 | Notwithstanding any other provision of this License, for material you 362 | add to a covered work, you may (if authorized by the copyright holders of 363 | that material) supplement the terms of this License with terms: 364 | 365 | a) Disclaiming warranty or limiting liability differently from the 366 | terms of sections 15 and 16 of this License; or 367 | 368 | b) Requiring preservation of specified reasonable legal notices or 369 | author attributions in that material or in the Appropriate Legal 370 | Notices displayed by works containing it; or 371 | 372 | c) Prohibiting misrepresentation of the origin of that material, or 373 | requiring that modified versions of such material be marked in 374 | reasonable ways as different from the original version; or 375 | 376 | d) Limiting the use for publicity purposes of names of licensors or 377 | authors of the material; or 378 | 379 | e) Declining to grant rights under trademark law for use of some 380 | trade names, trademarks, or service marks; or 381 | 382 | f) Requiring indemnification of licensors and authors of that 383 | material by anyone who conveys the material (or modified versions of 384 | it) with contractual assumptions of liability to the recipient, for 385 | any liability that these contractual assumptions directly impose on 386 | those licensors and authors. 387 | 388 | All other non-permissive additional terms are considered "further 389 | restrictions" within the meaning of section 10. If the Program as you 390 | received it, or any part of it, contains a notice stating that it is 391 | governed by this License along with a term that is a further 392 | restriction, you may remove that term. If a license document contains 393 | a further restriction but permits relicensing or conveying under this 394 | License, you may add to a covered work material governed by the terms 395 | of that license document, provided that the further restriction does 396 | not survive such relicensing or conveying. 397 | 398 | If you add terms to a covered work in accord with this section, you 399 | must place, in the relevant source files, a statement of the 400 | additional terms that apply to those files, or a notice indicating 401 | where to find the applicable terms. 402 | 403 | Additional terms, permissive or non-permissive, may be stated in the 404 | form of a separately written license, or stated as exceptions; 405 | the above requirements apply either way. 406 | 407 | 8. Termination. 408 | 409 | You may not propagate or modify a covered work except as expressly 410 | provided under this License. Any attempt otherwise to propagate or 411 | modify it is void, and will automatically terminate your rights under 412 | this License (including any patent licenses granted under the third 413 | paragraph of section 11). 414 | 415 | However, if you cease all violation of this License, then your 416 | license from a particular copyright holder is reinstated (a) 417 | provisionally, unless and until the copyright holder explicitly and 418 | finally terminates your license, and (b) permanently, if the copyright 419 | holder fails to notify you of the violation by some reasonable means 420 | prior to 60 days after the cessation. 421 | 422 | Moreover, your license from a particular copyright holder is 423 | reinstated permanently if the copyright holder notifies you of the 424 | violation by some reasonable means, this is the first time you have 425 | received notice of violation of this License (for any work) from that 426 | copyright holder, and you cure the violation prior to 30 days after 427 | your receipt of the notice. 428 | 429 | Termination of your rights under this section does not terminate the 430 | licenses of parties who have received copies or rights from you under 431 | this License. If your rights have been terminated and not permanently 432 | reinstated, you do not qualify to receive new licenses for the same 433 | material under section 10. 434 | 435 | 9. Acceptance Not Required for Having Copies. 436 | 437 | You are not required to accept this License in order to receive or 438 | run a copy of the Program. Ancillary propagation of a covered work 439 | occurring solely as a consequence of using peer-to-peer transmission 440 | to receive a copy likewise does not require acceptance. However, 441 | nothing other than this License grants you permission to propagate or 442 | modify any covered work. These actions infringe copyright if you do 443 | not accept this License. Therefore, by modifying or propagating a 444 | covered work, you indicate your acceptance of this License to do so. 445 | 446 | 10. Automatic Licensing of Downstream Recipients. 447 | 448 | Each time you convey a covered work, the recipient automatically 449 | receives a license from the original licensors, to run, modify and 450 | propagate that work, subject to this License. You are not responsible 451 | for enforcing compliance by third parties with this License. 452 | 453 | An "entity transaction" is a transaction transferring control of an 454 | organization, or substantially all assets of one, or subdividing an 455 | organization, or merging organizations. If propagation of a covered 456 | work results from an entity transaction, each party to that 457 | transaction who receives a copy of the work also receives whatever 458 | licenses to the work the party's predecessor in interest had or could 459 | give under the previous paragraph, plus a right to possession of the 460 | Corresponding Source of the work from the predecessor in interest, if 461 | the predecessor has it or can get it with reasonable efforts. 462 | 463 | You may not impose any further restrictions on the exercise of the 464 | rights granted or affirmed under this License. For example, you may 465 | not impose a license fee, royalty, or other charge for exercise of 466 | rights granted under this License, and you may not initiate litigation 467 | (including a cross-claim or counterclaim in a lawsuit) alleging that 468 | any patent claim is infringed by making, using, selling, offering for 469 | sale, or importing the Program or any portion of it. 470 | 471 | 11. Patents. 472 | 473 | A "contributor" is a copyright holder who authorizes use under this 474 | License of the Program or a work on which the Program is based. The 475 | work thus licensed is called the contributor's "contributor version". 476 | 477 | A contributor's "essential patent claims" are all patent claims 478 | owned or controlled by the contributor, whether already acquired or 479 | hereafter acquired, that would be infringed by some manner, permitted 480 | by this License, of making, using, or selling its contributor version, 481 | but do not include claims that would be infringed only as a 482 | consequence of further modification of the contributor version. For 483 | purposes of this definition, "control" includes the right to grant 484 | patent sublicenses in a manner consistent with the requirements of 485 | this License. 486 | 487 | Each contributor grants you a non-exclusive, worldwide, royalty-free 488 | patent license under the contributor's essential patent claims, to 489 | make, use, sell, offer for sale, import and otherwise run, modify and 490 | propagate the contents of its contributor version. 491 | 492 | In the following three paragraphs, a "patent license" is any express 493 | agreement or commitment, however denominated, not to enforce a patent 494 | (such as an express permission to practice a patent or covenant not to 495 | sue for patent infringement). To "grant" such a patent license to a 496 | party means to make such an agreement or commitment not to enforce a 497 | patent against the party. 498 | 499 | If you convey a covered work, knowingly relying on a patent license, 500 | and the Corresponding Source of the work is not available for anyone 501 | to copy, free of charge and under the terms of this License, through a 502 | publicly available network server or other readily accessible means, 503 | then you must either (1) cause the Corresponding Source to be so 504 | available, or (2) arrange to deprive yourself of the benefit of the 505 | patent license for this particular work, or (3) arrange, in a manner 506 | consistent with the requirements of this License, to extend the patent 507 | license to downstream recipients. "Knowingly relying" means you have 508 | actual knowledge that, but for the patent license, your conveying the 509 | covered work in a country, or your recipient's use of the covered work 510 | in a country, would infringe one or more identifiable patents in that 511 | country that you have reason to believe are valid. 512 | 513 | If, pursuant to or in connection with a single transaction or 514 | arrangement, you convey, or propagate by procuring conveyance of, a 515 | covered work, and grant a patent license to some of the parties 516 | receiving the covered work authorizing them to use, propagate, modify 517 | or convey a specific copy of the covered work, then the patent license 518 | you grant is automatically extended to all recipients of the covered 519 | work and works based on it. 520 | 521 | A patent license is "discriminatory" if it does not include within 522 | the scope of its coverage, prohibits the exercise of, or is 523 | conditioned on the non-exercise of one or more of the rights that are 524 | specifically granted under this License. You may not convey a covered 525 | work if you are a party to an arrangement with a third party that is 526 | in the business of distributing software, under which you make payment 527 | to the third party based on the extent of your activity of conveying 528 | the work, and under which the third party grants, to any of the 529 | parties who would receive the covered work from you, a discriminatory 530 | patent license (a) in connection with copies of the covered work 531 | conveyed by you (or copies made from those copies), or (b) primarily 532 | for and in connection with specific products or compilations that 533 | contain the covered work, unless you entered into that arrangement, 534 | or that patent license was granted, prior to 28 March 2007. 535 | 536 | Nothing in this License shall be construed as excluding or limiting 537 | any implied license or other defenses to infringement that may 538 | otherwise be available to you under applicable patent law. 539 | 540 | 12. No Surrender of Others' Freedom. 541 | 542 | If conditions are imposed on you (whether by court order, agreement or 543 | otherwise) that contradict the conditions of this License, they do not 544 | excuse you from the conditions of this License. If you cannot convey a 545 | covered work so as to satisfy simultaneously your obligations under this 546 | License and any other pertinent obligations, then as a consequence you may 547 | not convey it at all. For example, if you agree to terms that obligate you 548 | to collect a royalty for further conveying from those to whom you convey 549 | the Program, the only way you could satisfy both those terms and this 550 | License would be to refrain entirely from conveying the Program. 551 | 552 | 13. Use with the GNU Affero General Public License. 553 | 554 | Notwithstanding any other provision of this License, you have 555 | permission to link or combine any covered work with a work licensed 556 | under version 3 of the GNU Affero General Public License into a single 557 | combined work, and to convey the resulting work. The terms of this 558 | License will continue to apply to the part which is the covered work, 559 | but the special requirements of the GNU Affero General Public License, 560 | section 13, concerning interaction through a network will apply to the 561 | combination as such. 562 | 563 | 14. Revised Versions of this License. 564 | 565 | The Free Software Foundation may publish revised and/or new versions of 566 | the GNU General Public License from time to time. Such new versions will 567 | be similar in spirit to the present version, but may differ in detail to 568 | address new problems or concerns. 569 | 570 | Each version is given a distinguishing version number. If the 571 | Program specifies that a certain numbered version of the GNU General 572 | Public License "or any later version" applies to it, you have the 573 | option of following the terms and conditions either of that numbered 574 | version or of any later version published by the Free Software 575 | Foundation. If the Program does not specify a version number of the 576 | GNU General Public License, you may choose any version ever published 577 | by the Free Software Foundation. 578 | 579 | If the Program specifies that a proxy can decide which future 580 | versions of the GNU General Public License can be used, that proxy's 581 | public statement of acceptance of a version permanently authorizes you 582 | to choose that version for the Program. 583 | 584 | Later license versions may give you additional or different 585 | permissions. However, no additional obligations are imposed on any 586 | author or copyright holder as a result of your choosing to follow a 587 | later version. 588 | 589 | 15. Disclaimer of Warranty. 590 | 591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY 592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT 593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY 594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, 595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM 597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF 598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 599 | 600 | 16. Limitation of Liability. 601 | 602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS 604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY 605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE 606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF 607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD 608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), 609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF 610 | SUCH DAMAGES. 611 | 612 | 17. Interpretation of Sections 15 and 16. 613 | 614 | If the disclaimer of warranty and limitation of liability provided 615 | above cannot be given local legal effect according to their terms, 616 | reviewing courts shall apply local law that most closely approximates 617 | an absolute waiver of all civil liability in connection with the 618 | Program, unless a warranty or assumption of liability accompanies a 619 | copy of the Program in return for a fee. 620 | 621 | END OF TERMS AND CONDITIONS 622 | 623 | How to Apply These Terms to Your New Programs 624 | 625 | If you develop a new program, and you want it to be of the greatest 626 | possible use to the public, the best way to achieve this is to make it 627 | free software which everyone can redistribute and change under these terms. 628 | 629 | To do so, attach the following notices to the program. It is safest 630 | to attach them to the start of each source file to most effectively 631 | state the exclusion of warranty; and each file should have at least 632 | the "copyright" line and a pointer to where the full notice is found. 633 | 634 | {one line to give the program's name and a brief idea of what it does.} 635 | Copyright (C) {year} {name of author} 636 | 637 | This program is free software: you can redistribute it and/or modify 638 | it under the terms of the GNU General Public License as published by 639 | the Free Software Foundation, either version 3 of the License, or 640 | (at your option) any later version. 641 | 642 | This program is distributed in the hope that it will be useful, 643 | but WITHOUT ANY WARRANTY; without even the implied warranty of 644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 645 | GNU General Public License for more details. 646 | 647 | You should have received a copy of the GNU General Public License 648 | along with this program. If not, see . 649 | 650 | Also add information on how to contact you by electronic and paper mail. 651 | 652 | If the program does terminal interaction, make it output a short 653 | notice like this when it starts in an interactive mode: 654 | 655 | {project} Copyright (C) {year} {fullname} 656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 657 | This is free software, and you are welcome to redistribute it 658 | under certain conditions; type `show c' for details. 659 | 660 | The hypothetical commands `show w' and `show c' should show the appropriate 661 | parts of the General Public License. Of course, your program's commands 662 | might be different; for a GUI interface, you would use an "about box". 663 | 664 | You should also get your employer (if you work as a programmer) or school, 665 | if any, to sign a "copyright disclaimer" for the program, if necessary. 666 | For more information on this, and how to apply and follow the GNU GPL, see 667 | . 668 | 669 | The GNU General Public License does not permit incorporating your program 670 | into proprietary programs. If your program is a subroutine library, you 671 | may consider it more useful to permit linking proprietary applications with 672 | the library. If this is what you want to do, use the GNU Lesser General 673 | Public License instead of this License. But first, please read 674 | . 675 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | emacs ?= emacs 2 | 3 | LOAD = -l gited-ci.el -l gited.el 4 | 5 | all: test 6 | 7 | test: 8 | $(emacs) -batch $(LOAD) -l gited-tests.el -f ert-run-tests-batch-and-exit 9 | 10 | compile: 11 | $(emacs) -batch --eval "(progn (add-to-list 'load-path default-directory) (byte-compile-file \"gited.el\"))" 12 | 13 | clean: 14 | rm -f *.elc 15 | 16 | .PHONY: all compile clean test 17 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Gited: Operate on Git branches like dired 2 | 3 | [![Build Status](https://api.travis-ci.org/calancha/Gited.svg?branch=master)](https://travis-ci.org/calancha/Gited) 4 | 5 | This library lists the branches in a Git repository. Then you can 6 | operate on them with a dired-like interface. 7 | 8 | The command **gited-list-branches** prompts for the kind of branch 9 | (local branches, remote branches or tags) and lists them. 10 | This command is used quite often, thus it might be convenient 11 | to give it a key binding. For instance, if *gited.el* is in 12 | your *load-path*, then you can bind it to **C-x C-g** in Dired buffers 13 | by adding the following lines into your .emacs file: 14 | 15 | ``` 16 | (require 'gited) 17 | (define-key dired-mode-map "\C-x\C-g" 'gited-list-branches) 18 | ``` 19 | 20 | If you are familiar with Dired, then you already know how to use 21 | Gited; that's because most of the Gited commands with a Dired equivalent 22 | share same keybindings. 23 | For instance *gited-rename-branch* is bound to 'R' as *dired-do-rename*. 24 | Similarly, *gited-mark* is bound to 'm' as *dired-mark*. 25 | 26 | ## How to push to the remote repo. your local changes 27 | 28 | Suppose you want to update a file *foo* (*). 29 | 30 | From the Gited buffer: 31 | 32 | ``` 33 | c master RET ; Checkout master branch (**). 34 | *< ; Synchronize with remote repository. 35 | ``` 36 | 37 | Now, update *foo* with your changes and save it. 38 | 39 | From the Gited buffer: 40 | 41 | ``` 42 | A ; Stage your changes. 43 | ``` 44 | 45 | ``` 46 | C-c c "Updated foo" RET ; Commit them. 47 | ``` 48 | 49 | ``` 50 | *> ; Public your changes into the remote repository. 51 | ``` 52 | 53 | --- 54 | (*) We have restricted to 1 file for simplicity. The recipe works 55 | for N>=1 files. 56 | 57 | (**) For changes that require several commits you might prefer to 58 | work in a separated branch 'feature'. In that case you'd 59 | merge the master branch with 'feature' before ```*>```). 60 | 61 | 62 | ### Screenshots 63 | 64 | List the tags from the Emacs repository: 65 | 66 | ![ScreenShot](/screenshots/gited-tags-screenshot.png) 67 | 68 | List the remote branches from the Emacs repository with author and commit date: 69 | 70 | ![ScreenShot](/screenshots/gited-remote-branches-verbose-screenshot.png) 71 | 72 | ### Bugs/TODO 73 | 74 | * Currently, *origin* is assumed as the remote repository: 75 | Remove some hardcode *origin* around, and extend it 76 | to handle multiple remotes. 77 | 78 | * Pull requests are not implemented. 79 | -------------------------------------------------------------------------------- /gited-ci.el: -------------------------------------------------------------------------------- 1 | ;;; gited-ci.el --- Obtain CI status of the trunk branch -*- lexical-binding:t -*- 2 | ;; 3 | ;; Filename: gited-ci.el 4 | ;; Description: Obtain CI status of the trunk branch 5 | ;; 6 | ;; Author: Tino Calancha 7 | ;; Maintainer: Tino Calancha 8 | ;; URL: https://github.com/calancha/Gited 9 | ;; Copyright (C) 2016-2018, Tino Calancha, all rights reserved. 10 | ;; 11 | ;;; 12 | ;; Internal variables defined here: 13 | ;; 14 | ;; `gited-last-trunk-commit', `gited-trunk-ci-status', 15 | ;; `gited-trunk-ci-status-fail-face', `gited-trunk-ci-status-pending-face', 16 | ;; `gited-trunk-ci-status-running-face', 17 | ;; `gited-trunk-ci-status-success-face', 18 | ;; `gited-trunk-ci-status-unknown-face'. 19 | ;; 20 | ;; Coustom variables defined here: 21 | ;; 22 | ;; `gited-show-trunk-ci-status'. 23 | ;; 24 | ;; Non-interactive functions defined here: 25 | ;; 26 | ;; `gited--show-trunk-ci-status', `gited--trunk-ci-status', 27 | ;; `gited-parse-ci-status', `gited-pull-callback', 28 | ;; `gited-trunk-ci-last-commit-uri', `gited-trunk-ci-status'. 29 | ;; 30 | ;; Faces defined here: 31 | ;; 32 | ;; `gited-trunk-ci-status-fail', `gited-trunk-ci-status-pending', 33 | ;; `gited-trunk-ci-status-running', `gited-trunk-ci-status-success', 34 | ;; `gited-trunk-ci-status-unknown'. 35 | ;; 36 | ;; 37 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 38 | ;; 39 | ;; This file is NOT part of GNU Emacs. 40 | ;; 41 | ;; GNU Emacs is free software: you can redistribute it and/or modify 42 | ;; it under the terms of the GNU General Public License as published by 43 | ;; the Free Software Foundation, either version 3 of the License, or 44 | ;; (at your option) any later version. 45 | ;; 46 | ;; GNU Emacs is distributed in the hope that it will be useful, 47 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 48 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 49 | ;; GNU General Public License for more details. 50 | ;; 51 | ;; You should have received a copy of the GNU General Public License 52 | ;; along with GNU Emacs. If not, see . 53 | 54 | 55 | ;;; Commentary: 56 | ;; 57 | ;; Show the CI status of the trunk branch in the Gited buffer. 58 | ;; Different status displays the commit line with different 59 | ;; faces. For instance, green if all the test are OK and red 60 | ;; if any of them fails. 61 | ;; 62 | 63 | ;;; Code: 64 | 65 | 66 | 67 | ;; TODO: Support more CI services. 68 | (defcustom gited-show-trunk-ci-status nil 69 | "Show CI status for the last commit in the trunk branch. 70 | A list of elements (TOPLEVEL_DIR . CI-URI). 71 | TOPLEVEL_DIR is the toplevel directory for the local Git repository. 72 | CI_URI is the URI to access the Continous Integration system. 73 | 74 | Supported CI are Gitlab, Travis and CircleCI: for Gitlab, you need to provide 75 | all but the commit hash, for instance, in the case of the Emacs Gitlab CI, 76 | the value is 77 | `https://gitlab.com/emacs-ci/emacs/commit/'. 78 | For Travis, the format is as follows: 79 | `https://api.travis-ci.org/calancha/Gited.svg?branch=master'. 80 | For circleci: 81 | `https://circleci.com/gh/calancha/foo/tree/master'." 82 | :type '(repeat 83 | (choice 84 | (cons :tag "Show trunk CI status" 85 | (string :tag "gited-toplevel-dir" :value "") 86 | (string :tag "gited-ci-uri" :value "")))) 87 | :group 'gited) 88 | 89 | (defvar-local gited-trunk-ci-status nil 90 | "Status of the last commit in the trunk branch for the CI.") 91 | (put 'gited-trunk-ci-status 'permanent-local t) 92 | 93 | (defface gited-trunk-ci-status-fail 94 | '((t (:foreground "Red"))) 95 | "Face for trunk branch with last commit fail in the CI." 96 | :group 'gited :group 'font-lock-highlighting-faces) 97 | (defvar gited-trunk-ci-status-fail-face 'gited-trunk-ci-status-fail) 98 | 99 | (defface gited-trunk-ci-status-running 100 | '((t (:foreground "LightSkyBlue"))) 101 | "Face for trunk branch with last commit running in the CI." 102 | :group 'gited :group 'font-lock-highlighting-faces) 103 | (defvar gited-trunk-ci-status-running-face 'gited-trunk-ci-status-running) 104 | 105 | (defface gited-trunk-ci-status-success 106 | '((((background dark)) (:foreground "green")) 107 | (t (:foreground "white" :background "forest green"))) 108 | "Face for trunk branch with last commit succeded in the CI." 109 | :group 'gited :group 'font-lock-highlighting-faces) 110 | (defvar gited-trunk-ci-status-success-face 'gited-trunk-ci-status-success) 111 | 112 | (defface gited-trunk-ci-status-unknown 113 | '((((background dark)) (:foreground "orange")) 114 | (t (:foreground "black"))) 115 | "Face for trunk branch with last commit status in the CI unknown." 116 | :group 'gited :group 'font-lock-highlighting-faces) 117 | (defvar gited-trunk-ci-status-unknown-face 'gited-trunk-ci-status-unknown) 118 | 119 | (defface gited-trunk-ci-status-pending 120 | '((((background dark)) (:foreground "hotpink")) 121 | (t (:foreground "deeppink"))) 122 | "Face for trunk branch with last commit status in the CI pending." 123 | :group 'gited :group 'font-lock-highlighting-faces) 124 | (defvar gited-trunk-ci-status-pending-face 'gited-trunk-ci-status-pending) 125 | 126 | (defun gited-parse-ci-status (&rest args) 127 | "Parse the status of the trunk last commit in the Gitlab CI. 128 | `gited-buffer' is passed as the last element of ARGS list." 129 | (goto-char 1) 130 | (let* ((toplevel-dir (with-current-buffer (car (last args)) 131 | gited-toplevel-dir)) 132 | (ci-uri (cdr (assoc toplevel-dir gited-show-trunk-ci-status))) 133 | (success-regexp 134 | (cond ((string-match "gitlab" ci-uri) "ci-status-icon-success") 135 | ((string-match "\\(travis-ci\\)\\|\\(circleci\\)" ci-uri) "passing"))) 136 | (failed-regexp 137 | (cond ((string-match "gitlab" ci-uri) "ci-status-icon-failed") 138 | ((string-match "travis-ci" ci-uri) "failed") 139 | ((string-match "circleci" ci-uri) "failing"))) 140 | (pending-regexp 141 | (cond ((string-match "gitlab" ci-uri) "ci-status-icon-pending") 142 | ((string-match "travis-ci" ci-uri) "pending") 143 | ((string-match "circleci" ci-uri) "pending"))) 144 | (running-regexp 145 | (cond ((string-match "gitlab" ci-uri) "ci-status-icon-running") 146 | ((string-match "\\(travis-ci\\)\\|\\(circleci\\)" ci-uri) "running"))) ; This one always fail 147 | (ci-status 148 | (cond ((save-excursion 149 | (re-search-forward success-regexp nil t)) 150 | 'success) 151 | ((save-excursion 152 | (re-search-forward failed-regexp nil t)) 153 | 'failed) 154 | ((save-excursion 155 | (re-search-forward running-regexp nil t)) 156 | 'running) 157 | ((save-excursion 158 | (re-search-forward pending-regexp nil t)) 159 | 'pending) 160 | (t 'unknown)))) 161 | (message "Parse CI status done!") 162 | ;; Show the staus in the Gited buffer. 163 | (with-current-buffer (car (last args)) 164 | (setq gited-trunk-ci-status ci-status) 165 | (gited--show-trunk-ci-status)))) 166 | 167 | (declare-function gited--last-trunk-commit "gited.el") 168 | 169 | (defun gited-trunk-ci-last-commit-uri () 170 | (let ((ci-uri (cdr (assoc gited-toplevel-dir gited-show-trunk-ci-status)))) 171 | (cond ((string-match "\\(travis-ci\\)\\|\\(circleci\\)" ci-uri) ci-uri) 172 | ((string-match "gitlab" ci-uri) 173 | (format "%s%s" ci-uri (gited--last-trunk-commit))) 174 | (t (user-error "Dont know this CI service uri '%s'" ci-uri))))) 175 | 176 | (defun gited--trunk-ci-status () 177 | "Return the status of the Gitlab CI for the last commit in the trunk branch." 178 | (let ((url (gited-trunk-ci-last-commit-uri))) 179 | (url-retrieve url 'gited-parse-ci-status (list gited-buffer)))) 180 | 181 | (defun gited-trunk-ci-status () 182 | "Return the status of the CI for the last commit in the trunk branch." 183 | (unless (derived-mode-p 'gited-mode) (user-error "Not a Gited buffer")) 184 | (gited--trunk-ci-status)) 185 | 186 | (defun gited--show-trunk-ci-status () 187 | (save-excursion 188 | (gited-goto-branch (gited-trunk-branch)) 189 | (gited--move-to-column (1+ gited-commit-idx)) 190 | (let ((inhibit-read-only t)) 191 | (let* ((start (point)) 192 | (end (point-at-eol)) 193 | (status-face 194 | (cond ((eq gited-trunk-ci-status 'success) 195 | 'gited-trunk-ci-status-success) 196 | ((eq gited-trunk-ci-status 'failed) 197 | 'gited-trunk-ci-status-fail) 198 | ((eq gited-trunk-ci-status 'running) 199 | 'gited-trunk-ci-status-running) 200 | ((eq gited-trunk-ci-status 'pending) 201 | 'gited-trunk-ci-status-pending) 202 | (t 203 | 'gited-trunk-ci-status-unknown)))) 204 | (put-text-property start end 'face status-face) 205 | (put-text-property 206 | start end 'help-echo (format "CI status %S: %s" 207 | gited-trunk-ci-status 208 | (gited-trunk-ci-last-commit-uri))))))) 209 | 210 | 211 | (defvar-local gited-last-trunk-commit "" "Last commit hash in trunk branch.") 212 | (put 'gited-last-trunk-commit 'permanent-local t) 213 | 214 | ;; Update trunk CI status if `gited-show-trunk-ci-status' is non-nil 215 | ;; and we have fetched new commits from the trunk branch. 216 | (defun gited-pull-callback () 217 | "Run `gited-trunk-ci-status' after remote fetching or reverting buffer." 218 | (when (and gited-show-trunk-ci-status 219 | (car-safe (assoc gited-toplevel-dir gited-show-trunk-ci-status)) 220 | (equal (directory-file-name (car (assoc gited-toplevel-dir gited-show-trunk-ci-status))) 221 | (directory-file-name gited-toplevel-dir))) 222 | (let ((last-trunk-commit (gited--last-trunk-commit))) 223 | (if (equal gited-last-trunk-commit last-trunk-commit) 224 | (gited--show-trunk-ci-status) 225 | (setq gited-last-trunk-commit last-trunk-commit) 226 | (gited-trunk-ci-status))))) 227 | 228 | 229 | (provide 'gited-ci) 230 | ;;; gited-ci.el ends here 231 | -------------------------------------------------------------------------------- /gited-tests.el: -------------------------------------------------------------------------------- 1 | ;;; gited-tests.el --- Tests for gited.el -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2017-2019 Free Software Foundation, Inc. 4 | 5 | ;; Author: Tino Calancha , 6 | ;; Keywords: 7 | 8 | ;; This file is part of GNU Emacs. 9 | 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify 11 | ;; it 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 | ;; GNU Emacs is distributed in the hope that it will be useful, 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 | ;; GNU General Public License for more details. 19 | 20 | ;; You should have received a copy of the GNU General Public License 21 | ;; along with GNU Emacs. If not, see . 22 | 23 | ;;; Commentary: 24 | 25 | ;; 26 | 27 | ;;; code: 28 | 29 | (require 'ert) 30 | (require 'gited) 31 | (eval-when-compile (require 'cl-lib)) 32 | 33 | ;; Settings for a test repository. 34 | (defvar gited-user-name "John Doe") 35 | (defvar gited-user-email "john.doe@example.com") 36 | (defvar gited-initial-commit-msg "Initialize repository.") 37 | (defvar gited-initial-filename "foo") 38 | (defvar gited-initial-file-content "Test file") 39 | 40 | (defvar gited-remote-repo "https://github.com/calancha/foo") 41 | (defvar gited-remote-repo-branch "fail-say-foo-test") 42 | (defvar gited-remote-repo-file "do_not_delete.el") 43 | 44 | (defun gited-create-new-repo (dir) 45 | "Create a new repository at DIR and return its gited buffer." 46 | (let ((inhibit-message t)) 47 | (write-region gited-initial-file-content 48 | nil 49 | (expand-file-name gited-initial-filename dir)) 50 | (dired dir) 51 | (gited-git-command '("init")) 52 | (gited-git-command `("config" "user.email" ,gited-user-email)) 53 | (gited-git-command `("config" "user.name" ,gited-user-name)) 54 | (gited-git-command `("add" ,gited-initial-filename)) 55 | (gited-git-command `("commit" "-m" ,gited-initial-commit-msg)) 56 | (gited-list-branches "local") 57 | gited-buffer)) 58 | 59 | (defmacro with-gited-repo (dir &rest body) 60 | "Create a new Git repository at DIR and evaluate BODY. 61 | The repository consists of just one file with content 62 | `gited-initial-file-content'. 63 | The forms in BODY are evaluated with DIR as `default-directory'." 64 | (declare (indent 1) (debug (form body))) 65 | `(let* ((gited-expert t) 66 | (inhibit-message t)) 67 | (unwind-protect 68 | (progn 69 | (gited-create-new-repo ,dir) 70 | ,@body) 71 | (delete-directory ,dir 'recursive)))) 72 | 73 | (defmacro with-specified-completion-branch (branch &rest body) 74 | "Fix branch completions to BRANCH and evaluate BODY. 75 | This macro uses `cl-letf' to temporary fix the completions. 76 | Return the last evaled BODY form." 77 | (declare (indent 1) (debug (form body))) 78 | `(cl-letf (((symbol-function 'completing-read) 79 | (lambda (&rest _) ,branch))) 80 | ,@body)) 81 | 82 | (ert-deftest gited-test1 () 83 | (skip-unless (executable-find vc-git-program)) 84 | (let ((dir (make-temp-file "gited" 'dir))) 85 | (with-gited-repo dir 86 | (progn 87 | (should (gited-dir-under-Git-control-p)) 88 | (should (gited-buffer-p)) 89 | (should (equal gited-initial-commit-msg (gited--last-commit-title))) 90 | (should (equal "master" (gited-current-branch))) 91 | ;; Only master branch do exist 92 | (should-not (gited-branch-exists-p gited-initial-filename)) 93 | ;; Create a new branch (copy of master) 94 | (gited-copy-branch "master" gited-initial-filename) 95 | (should (gited-branch-exists-p gited-initial-filename)) 96 | (gited-toggle-marks) 97 | (should (= 2 (gited-number-marked))) 98 | (gited-unmark-all-marks) 99 | (should (zerop (gited-number-marked))) 100 | ;; Update the file in the current branch and commit the changes 101 | (gited-with-current-branch gited-initial-filename 102 | (write-region "Changed this file" nil gited-initial-filename) 103 | (gited-git-command `("add" ,gited-initial-filename)) 104 | (gited-git-command '("commit" "-m" "Update file")) 105 | (let ((hash 106 | (with-temp-buffer 107 | (gited-git-command 108 | '("rev-parse" "HEAD") (current-buffer)) 109 | (buffer-substring 1 (1- (point-max)))))) 110 | ;; gited-mark-branches-containing-commit 111 | (gited-mark-branches-containing-commit hash) 112 | (should (= 1 (gited-number-marked)))) 113 | ;; gited-mark-branches-regexp 114 | (gited-unmark-all-marks) 115 | (gited-mark-branches-regexp gited-initial-filename) 116 | (should (= 1 (gited-number-marked))) 117 | ;; gited-mark-branches-containing-regexp 118 | (gited-unmark-all-marks) 119 | (gited-mark-branches-containing-regexp "Update") 120 | (should (= 1 (gited-number-marked))) 121 | ;; gited-mark-branches-by-date 122 | (gited-unmark-all-marks) 123 | (gited-mark-branches-by-date 124 | (format-time-string "%F" (current-time))) 125 | (should (= (length (gited-listed-branches)) 126 | (gited-number-marked))) 127 | (gited-unmark-all-marks) 128 | (gited-mark-branches-by-date 129 | (format-time-string 130 | "%F" 131 | (time-add (current-time) (seconds-to-time (* 7 24 60 60))))) 132 | (should (zerop (gited-number-marked))) 133 | (gited-unmark-all-marks)) 134 | ;; Copy the updated branch into a new branch "bar" 135 | (gited-copy-branch gited-initial-filename "bar") 136 | ;; Test delete/rename branch features 137 | (gited-delete-branch gited-initial-filename 'force) 138 | (gited-update) 139 | (should-not (gited-branch-exists-p gited-initial-filename)) 140 | (gited-rename-branch "bar" gited-initial-filename) ; Asynchronous. 141 | (while gited-branch-after-op 142 | (sit-for 0.05)) 143 | (should (gited-branch-exists-p gited-initial-filename)))))) 144 | 145 | (ert-deftest gited-test2 () 146 | (skip-unless (executable-find vc-git-program)) 147 | (let* ((dir (make-temp-file "gited" 'dir)) 148 | (gited-expert t) 149 | (inhibit-message t) 150 | dired-buf) 151 | (cd dir) 152 | (unwind-protect 153 | (progn 154 | (gited-git-command `("clone" ,gited-remote-repo)) 155 | (setq dired-buf (dired (expand-file-name "foo"))) 156 | (gited-list-branches "local") 157 | (should (equal "origin" gited-current-remote-rep)) 158 | (should-error (gited-change-current-remote-rep)) ; Only 1 remote rep 159 | (gited-list-branches "remote") 160 | (gited-copy-branch (concat "origin/" gited-remote-repo-branch) 161 | gited-remote-repo-branch) 162 | (gited-list-branches "local") 163 | (gited-goto-branch "master") 164 | (with-specified-completion-branch gited-remote-repo-branch 165 | (gited-merge-branch "master")) 166 | (load-file gited-remote-repo-file) 167 | ;; Now it fails: At master branch, `say-foo' returns 'foo 168 | ;; But at branch `gited-remote-repo-file', `say-foo' returns 'bar. 169 | (should-not (eq 'foo (say-foo)))) 170 | (delete-directory dir 'recursive) 171 | (kill-buffer dired-buf)))) 172 | 173 | (ert-deftest gited-ci-load () 174 | "Tests to see whether gited-ci has been loaded." 175 | (should (fboundp 'gited-parse-ci-status))) 176 | 177 | (ert-deftest gited-test-add-patch-bug () 178 | "Tests for bug in `gited-add-patched-files'." 179 | (skip-unless (executable-find vc-git-program)) 180 | (let* ((dir1 (make-temp-file "gited-1" 'dir)) 181 | (dir2 (make-temp-file "gited-2" 'dir)) 182 | (gited-buffer-1 (gited-create-new-repo dir1)) 183 | (gited-buffer-2 (gited-create-new-repo dir2)) 184 | (inhibit-message t)) 185 | (unwind-protect 186 | (progn 187 | (pop-to-buffer gited-buffer-1) 188 | (write-region "Changed this file" nil gited-initial-filename) 189 | (pop-to-buffer gited-buffer-2) 190 | ;; Add a new file inside a subdirectory 191 | (mkdir (expand-file-name "subdir" dir2)) 192 | (write-region "New nested file" nil (concat "subdir/" gited-initial-filename)) 193 | (should (gited-add-patched-files (gited-untracked-files))) 194 | (pop-to-buffer gited-buffer-1) 195 | ;; The bug causes the following to fail 196 | (should (gited-add-patched-files (gited-modified-files)))) 197 | ;; Clean up 198 | (delete-directory dir1 'recursive) 199 | (delete-directory dir2 'recursive)))) 200 | 201 | (ert-deftest gited-diff-test () 202 | "Test for `gited-diff'. 203 | Create a repository with 2 identical branches, `master' and `foo'. 204 | Each branch contains just one file `foo'. Since this file has same name as one 205 | of the branches, then we must add '--' after the versions. 206 | For example, the Git command to get the diff between the 2 branches is as follows: 207 | git diff master foo --." 208 | (skip-unless (executable-find vc-git-program)) 209 | (let ((dir (make-temp-file "gited" 'dir)) 210 | (inhibit-message t)) 211 | (with-gited-repo dir 212 | (gited-copy-branch "master" gited-initial-filename) 213 | (with-specified-completion-branch gited-initial-filename 214 | (should-not (gited-diff "master")))))) 215 | 216 | (ert-deftest gited-output-buffer-default-directory-test () 217 | "Test that `gited-output-buffer' `default-directory' equals `gited-top-level-dir'." 218 | (skip-unless (executable-find vc-git-program)) 219 | (let* ((dir (make-temp-file "gited" 'dir)) 220 | (subdir (expand-file-name "subdir" dir)) 221 | (new-file (expand-file-name "new-file" subdir)) 222 | (inhibit-message t) 223 | toplevel-dir) 224 | (with-gited-repo dir 225 | (setq toplevel-dir gited-toplevel-dir) 226 | (make-directory subdir) 227 | (write-region "hello" nil new-file) 228 | (gited-git-command `("add" ,new-file)) 229 | (gited-git-command `("commit" "-m" "Add new-file inside a subdir")) 230 | ;; Create `gited-output-buffer' from subdir; this new buffer must 231 | ;; have `default-directory' set to `gited-toplevel-dir' 232 | (cd subdir) 233 | (with-current-buffer (gited--output-buffer) 234 | (should (equal default-directory toplevel-dir)))))) 235 | 236 | (provide 'gited-tests) 237 | ;;; gited-tests.el ends here 238 | -------------------------------------------------------------------------------- /gited.el: -------------------------------------------------------------------------------- 1 | ;;; gited.el --- Operate on Git branches like dired -*- lexical-binding:t -*- 2 | ;; 3 | ;; Filename: gited.el 4 | ;; Description: Operate on Git branches like dired 5 | ;; 6 | ;; Author: Tino Calancha 7 | ;; Maintainer: Tino Calancha 8 | ;; URL: https://github.com/calancha/Gited 9 | ;; Copyright (C) 2016-2019, Tino Calancha, all rights reserved. 10 | ;; Created: Sat Sep 14 09:32:17 CEST 2019 11 | ;; Compatibility: GNU Emacs: 24.4 12 | ;; Version: 0.6.0 13 | ;; Package-Requires: ((emacs "24.4") (cl-lib "0.5")) 14 | ;; Last-Updated: Sat Sep 14 17:54:26 CEST 2019 15 | ;; By: calancha 16 | ;; Update #: 701 17 | ;; 18 | ;; Features that might be required by this library: 19 | ;; 20 | ;; `vc-git', `cl-lib', `dired', `tabulated-list', 21 | ;; `find-func'. 22 | ;; 23 | ;; Keywords: git, vc, convenience 24 | ;; 25 | ;; 26 | 27 | ;;; Commentary: 28 | ;; 29 | ;; This library lists the branches in a Git repository. Then you can 30 | ;; operate on them with a dired-like interface. 31 | ;; 32 | ;; The command `gited-list-branches' prompts for the kind of branch 33 | ;; (local branches, remote branches or tags) and lists them. 34 | ;; This command is used quite often, thus it might be convenient 35 | ;; to give it a key binding. For instance, if `gited.el' is in 36 | ;; your `load-path', then you can bind it to `C-x C-g' in Dired buffers 37 | ;; by adding the following lines into your .emacs file: 38 | ;; 39 | ;; (require 'gited) 40 | ;; (define-key dired-mode-map "\C-x\C-g" 'gited-list-branches) 41 | ;; 42 | ;; If you are familiar with Dired, then you already know how to use 43 | ;; Gited; that's because most of the Gited commands with a Dired equivalent 44 | ;; share same keybindings. 45 | ;; For instance `gited-rename-branch' is bound to `R' as `dired-do-rename'. 46 | ;; Similarly, `gited-mark' is bound to `m' as `dired-mark'. 47 | ;; 48 | ;; === How to push to the remote repo. your local changes === 49 | ;; 50 | ;; Suppose you want to update a file 'foo' (*). 51 | ;; From the Gited buffer: 52 | ;; 0) c master RET ; Checkout master branch (**). 53 | ;; *< ; Synchronize with remote repository. 54 | ;; 55 | ;; <<< Update 'foo' with your changes and save it. >>> 56 | ;; 57 | ;; From the Gited buffer: 58 | ;; 1) A ; Stage your changes. 59 | ;; 2) C-c c "Updated foo" RET ; Commit them. 60 | ;; 3) *> ; Public your changes into the remote repository. 61 | ;; --- 62 | ;; (*) We have restricted to 1 file for simplicity. The recipe works 63 | ;; for N>=1 files. 64 | ;; (**) For changes that require several commits you might prefer to 65 | ;; work in a separated branch 'feature'. In that case you'd 66 | ;; merge the master branch with 'feature' before 3). 67 | ;; 68 | ;; 69 | ;; Bugs/TODO 70 | ;; ========= 71 | ;; * Currently, 'origin' is assumed as the remote repository: 72 | ;; Remove some hardcode 'origin' around, and extend it 73 | ;; to handle multiple remotes. 74 | ;; 75 | ;; * Pull requests are not implemented. 76 | 77 | ;; 78 | ;; Internal variables defined here: 79 | ;; 80 | ;; `gited--hide-details-set', `gited--last-remote-prune', 81 | ;; `gited--op', `gited--revert-commit', 82 | ;; `gited--running-async-op', `gited-actual-switches', 83 | ;; `gited-after-change-hook', `gited-async-operation-callback', 84 | ;; `gited-author-face', `gited-author-idx', 85 | ;; `gited-bisect-buf-name', `gited-bisect-buffer', 86 | ;; `gited-bisect-buffer', `gited-bisect-output-name', 87 | ;; `gited-branch-after-op', `gited-branch-alist', 88 | ;; `gited-branch-idx', `gited-branch-name-face', 89 | ;; `gited-buffer', `gited-buffer-name', 90 | ;; `gited-commit-idx', `gited-commit-msg-face', 91 | ;; `gited-current-branch', `gited-current-remote-rep', 92 | ;; `gited-date-idx', `gited-date-regexp', 93 | ;; `gited-date-time-face', `gited-del-char', 94 | ;; `gited-deletion-branch-face', `gited-deletion-face', 95 | ;; `gited-edit-commit-mode-map', `gited-flag-mark-face', 96 | ;; `gited-flag-mark-line-face', `gited-header', 97 | ;; `gited-list-format', `gited-list-refs-format-command', 98 | ;; `gited-log-buffer', `gited-mark-col-size', 99 | ;; `gited-mark-face', `gited-mark-idx', 100 | ;; `gited-marker-char', `gited-mode', 101 | ;; `gited-mode-map', `gited-modified-branch', 102 | ;; `gited-new-or-deleted-files-re', `gited-op-string', 103 | ;; `gited-original-buffer', `gited-output-buffer', 104 | ;; `gited-output-buffer-name', `gited-re-mark', 105 | ;; `gited-ref-kind', `gited-section-highlight-face', 106 | ;; `gited-toplevel-dir', `gited-trunk-branch'. 107 | ;; 108 | ;; Coustom variables defined here: 109 | ;; 110 | ;; `gited-add-untracked-files', `gited-author-col-size', 111 | ;; `gited-branch-col-size', `gited-commit-col-size', 112 | ;; `gited-current-branch-face', `gited-date-col-size', 113 | ;; `gited-date-format', `gited-delete-unmerged-branches', 114 | ;; `gited-expert', `gited-one-trunk-repository', 115 | ;; `gited-patch-options', `gited-patch-program', 116 | ;; `gited-protected-branches', `gited-prune-remotes', 117 | ;; `gited-reset-mode', `gited-short-log-cmd', 118 | ;; `gited-show-commit-hash', `gited-switches', 119 | ;; `gited-use-header-line', `gited-verbose'. 120 | ;; 121 | ;; Macros defined here: 122 | ;; 123 | ;; `gited-map-over-marks', `gited-mark-if', 124 | ;; `gited-with-current-branch'. 125 | ;; 126 | ;; Commands defined here: 127 | ;; 128 | ;; `gited--mark-merged-branches-spec', `gited--mark-unmerged-branches-spec', 129 | ;; `gited-add-patched-files', `gited-amend-commit', 130 | ;; `gited-apply-add-and-commit-patch', `gited-apply-patch', 131 | ;; `gited-async-operation', `gited-bisect', 132 | ;; `gited-branch-clear', `gited-change-current-remote-rep', 133 | ;; `gited-checkout-branch', `gited-commit', 134 | ;; `gited-copy-branch', `gited-copy-branchname-as-kill', 135 | ;; `gited-delete-all-stashes', `gited-delete-branch', 136 | ;; `gited-diff', `gited-do-delete', 137 | ;; `gited-do-flagged-delete', `gited-do-kill-lines', 138 | ;; `gited-do-sync-with-trunk', `gited-edit-commit-mode', 139 | ;; `gited-extract-patches', `gited-fetch-remote-tags', 140 | ;; `gited-finish-commit-edit', `gited-flag-branch-deletion', 141 | ;; `gited-goto-branch', `gited-goto-first-branch', 142 | ;; `gited-goto-last-branch', `gited-kill-line', 143 | ;; `gited-list', `gited-list-branches', 144 | ;; `gited-log', `gited-log-last-n-commits', 145 | ;; `gited-mark', `gited-mark-branches-by-date', 146 | ;; `gited-mark-branches-containing-commit', 147 | ;; `gited-mark-branches-containing-regexp', `gited-mark-branches-regexp', 148 | ;; `gited-mark-local-tags', `gited-mark-merged-branches', 149 | ;; `gited-mark-unmerged-branches', `gited-merge-branch', 150 | ;; `gited-move-to-author', `gited-move-to-branchname', 151 | ;; `gited-move-to-date', `gited-move-to-end-of-author', 152 | ;; `gited-move-to-end-of-branchname', `gited-move-to-end-of-date', 153 | ;; `gited-next-line', `gited-next-marked-branch', 154 | ;; `gited-number-marked', `gited-origin', 155 | ;; `gited-prev-line', `gited-prev-marked-branch', 156 | ;; `gited-pull', `gited-push', 157 | ;; `gited-remote-tag-delete', `gited-rename-branch', 158 | ;; `gited-reset-branch', `gited-revert-commit', 159 | ;; `gited-set-object-upstream', `gited-show-commit', 160 | ;; `gited-stash', `gited-stash-apply', 161 | ;; `gited-stash-branch', `gited-stash-drop', 162 | ;; `gited-stash-pop', `gited-status', 163 | ;; `gited-summary', `gited-sync-with-trunk', 164 | ;; `gited-tag-add', `gited-tag-delete', 165 | ;; `gited-toggle-current-remote-rep', `gited-toggle-marks', 166 | ;; `gited-unmark', `gited-unmark-all-branches', 167 | ;; `gited-unmark-all-marks', `gited-unmark-backward', 168 | ;; `gited-update', `gited-visit-branch-sources', 169 | ;; `gited-why'. 170 | ;; 171 | ;; Non-interactive functions defined here: 172 | ;; 173 | ;; `gited--advice-sort-by-column', `gited--bisect-after-run', 174 | ;; `gited--bisect-executable-p', `gited--case-ref-kind', 175 | ;; `gited--check-unmerged-marked-branches', `gited--clean-previous-patches', 176 | ;; `gited--col-branch-name', `gited--extract-from-commit', 177 | ;; `gited--fill-branch-alist', `gited--fontify-current-row', 178 | ;; `gited--fontify-current-row-1', `gited--format-time', 179 | ;; `gited--get-branch-info', `gited--get-branches-from-command', 180 | ;; `gited--get-column', `gited--get-mark-for-entry', 181 | ;; `gited--get-merged-branches', `gited--get-patch-or-commit-buffers', 182 | ;; `gited--get-unmerged-branches', `gited--goto-column', 183 | ;; `gited--goto-first-branch', `gited--handle-new-or-delete-files', 184 | ;; `gited--last-commit-author', `gited--last-commit-date', 185 | ;; `gited--last-commit-hash', `gited--last-commit-msg', 186 | ;; `gited--last-commit-title', `gited--last-trunk-commit', 187 | ;; `gited--list-files', `gited--list-format-init', 188 | ;; `gited--list-refs-format', `gited--mark-branches-in-region', 189 | ;; `gited--mark-merged-or-unmerged-branches', 190 | ;; `gited--mark-merged-or-unmerged-branches-spec', `gited--merged-branch-p', 191 | ;; `gited--move-to-column', `gited--move-to-end-of-column', 192 | ;; `gited--output-buffer', `gited--patch-or-commit-buffer', 193 | ;; `gited--set-output-buffer-mode', `gited--stash-branch', 194 | ;; `gited--sync-with-trunk-target-name', `gited--update-header-line', 195 | ;; `gited--update-padding', `gited--valid-ref-p', 196 | ;; `gited-all-branches', `gited-async-operation-sentinel', 197 | ;; `gited-at-header-line-p', `gited-bisecting-p', 198 | ;; `gited-branch-exists-p', `gited-buffer-p', 199 | ;; `gited-current-branch', `gited-current-branches-with-marks', 200 | ;; `gited-current-state-list', `gited-dir-under-Git-control-p', 201 | ;; `gited-edit-commit', `gited-fontify-current-branch', 202 | ;; `gited-format-columns-of-files', `gited-get-branches', 203 | ;; `gited-get-branchname', `gited-get-commit', 204 | ;; `gited-get-date', `gited-get-element-in-row', 205 | ;; `gited-get-last-commit-time', `gited-get-mark', 206 | ;; `gited-get-marked-branches', `gited-git-checkout', 207 | ;; `gited-git-command', `gited-git-command-on-region', 208 | ;; `gited-hide-details-update-invisibility-spec', 209 | ;; `gited-insert-marker-char', `gited-internal-do-deletions', 210 | ;; `gited-listed-branches', `gited-log-msg', 211 | ;; `gited-log-summary', `gited-map-lines', 212 | ;; `gited-mark-pop-up', `gited-mark-remembered', 213 | ;; `gited-modified-files', `gited-modified-files-p', 214 | ;; `gited-next-branch', `gited-number-of-commits', 215 | ;; `gited-plural-s', `gited-prev-branch', 216 | ;; `gited-print-entry', `gited-remember-marks', 217 | ;; `gited-remote-prune', `gited-remote-repository-p', 218 | ;; `gited-remote-tags', `gited-repeat-over-lines', 219 | ;; `gited-stashes', `gited-tabulated-list-entries', 220 | ;; `gited-trunk-branch', `gited-trunk-branches', 221 | ;; `gited-untracked-files'. 222 | ;; 223 | ;; Faces defined here: 224 | ;; 225 | ;; `gited-author', `gited-branch-name', 226 | ;; `gited-commit-msg', `gited-date-time', 227 | ;; `gited-deletion', `gited-deletion-branch', 228 | ;; `gited-flag-mark', `gited-flag-mark-line', 229 | ;; `gited-header', `gited-mark', 230 | ;; `gited-modified-branch', `gited-section-highlight', 231 | ;; `gited-status-branch-local', `gited-status-tag'. 232 | ;; 233 | ;; 234 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 235 | ;; 236 | ;; This file is NOT part of GNU Emacs. 237 | ;; 238 | ;; GNU Emacs is free software: you can redistribute it and/or modify 239 | ;; it under the terms of the GNU General Public License as published by 240 | ;; the Free Software Foundation, either version 3 of the License, or 241 | ;; (at your option) any later version. 242 | ;; 243 | ;; GNU Emacs is distributed in the hope that it will be useful, 244 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 245 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 246 | ;; GNU General Public License for more details. 247 | ;; 248 | ;; You should have received a copy of the GNU General Public License 249 | ;; along with GNU Emacs. If not, see . 250 | 251 | ;;; Code: 252 | 253 | 254 | (require 'gited-ci) 255 | (require 'cl-lib) 256 | (require 'tabulated-list) 257 | (require 'dired) 258 | (require 'vc-git) 259 | (require 'find-func) ; `find-library-name' 260 | 261 | (defgroup gited nil 262 | "Git branch editing." 263 | :version "26.1" 264 | :group 'vc) 265 | 266 | (defvar-local gited-mode nil 267 | "Variable saving the status of `gited-mode'.") 268 | (put 'gited-mode 'permanent-local t) 269 | 270 | (defvar-local gited-current-branch nil 271 | "The branch currently checked out.") 272 | (put 'gited-current-branch 'permanent-local t) 273 | 274 | (defvar-local gited-current-remote-rep "origin" 275 | "The remote repository where we are pulling/pushing.") 276 | (put 'gited-current-remote-rep 'permanent-local t) 277 | 278 | (defvar-local gited-toplevel-dir nil 279 | "Absolute path of the top-level directory for the current repository.") 280 | (put 'gited-toplevel-dir 'permanent-local t) 281 | 282 | (defcustom gited-one-trunk-repository nil 283 | "If non-nil, all repositories use just 1 trunk branch. 284 | When this variable is non-nil and `gited-trunk-branch' is set to the 285 | trunk branch, then you are not prompted anymore about which is the trunk 286 | branch. 287 | The default is nil. This is because generally you want to 288 | pull from several remote branches, for instance, the next release branch, 289 | and the development branch. Then, you will be prompted whenever 290 | a function need to use the trunk branch." 291 | :type 'boolean 292 | :group 'gited) 293 | 294 | (defvar-local gited-trunk-branch nil 295 | "The branch name from where to pull.") 296 | (put 'gited-trunk-branch 'permanent-local t) 297 | 298 | ;; Stolen from ediff-ptch.el 299 | (defcustom gited-patch-program "patch" 300 | "Name of the program that applies patches. 301 | It is recommended to use GNU-compatible versions." 302 | :type 'string 303 | :group 'gited) 304 | 305 | ;; Stolen from ediff-ptch.el 306 | (defcustom gited-patch-options "-f" 307 | "Options to pass to `gited-patch-program'. 308 | 309 | It is recommended to pass the `-f' option to the patch program, so it won't ask 310 | questions. However, some implementations don't accept this option, in which 311 | case the default value for this variable should be changed." 312 | :type 'string 313 | :group 'gited) 314 | 315 | (defcustom gited-use-header-line t 316 | "If non-nil, use the header line to display Gited column titles." 317 | :type 'boolean 318 | :group 'gited) 319 | 320 | (defcustom gited-verbose nil 321 | "If non-nil, show the author name and commit date." 322 | :type 'boolean 323 | :group 'gited) 324 | 325 | (defvar-local gited--hide-details-set nil) 326 | 327 | (defvar-local gited-ref-kind nil 328 | "The kind of Git reference displayed in `gited-buffer'. 329 | It must be `local', `remote' or `tags'.") 330 | (put 'gited-ref-kind 'permanent-local t) 331 | 332 | (defvar gited-mark-idx 0 333 | "Position of marker char in array `tabulated-list-entries'.") 334 | 335 | (defvar gited-author-idx 1 336 | "Position of author in array `tabulated-list-entries'.") 337 | 338 | (defvar gited-date-idx 2 339 | "Position of date in array `tabulated-list-entries'.") 340 | 341 | (defvar gited-branch-idx 3 342 | "Position of branch name in array `tabulated-list-entries'.") 343 | 344 | (defvar gited-commit-idx 4 345 | "Position of newest commit tittle in array `tabulated-list-entries'.") 346 | 347 | (defvar gited-after-change-hook nil 348 | "Hook run after make a change in the list of branches.") 349 | 350 | (defvar gited-branch-after-op nil 351 | "Branch where to set point after an asynchronous operation.") 352 | 353 | (defvar gited-op-string nil 354 | "String to describe the actual operation.") 355 | 356 | (defvar gited-marker-char ?* 357 | "In gited, the current mark character. 358 | This is what the do-commands look for, and what the mark-commands store.") 359 | 360 | (defvar gited-del-char ?D 361 | "Character used to flag branches for deletion.") 362 | 363 | ;; "Regexp matching a marked line. 364 | (defvar gited-re-mark "^[^ \n]") 365 | 366 | (defvar-local gited-branch-alist nil 367 | "Alist with elements (INDEX MARK TIME BRANCH-NAME AUTHOR-NAME TITLE). 368 | INDEX identify each row in the table. 369 | MARK is the mark character shown in the table for that row. 370 | TIME is the time of the last commit in that branch. 371 | BRANCH-NAME is the name of the branch. 372 | AUTHOR-NAME is the author of the last commit in that branch. 373 | TITLE is the title of the last commit.") 374 | 375 | (defvar gited-buffer-name "*gited*" 376 | "Name of the buffer where to list the repository branches.") 377 | 378 | (defvar-local gited-buffer nil 379 | "Buffer where to list the repository branches.") 380 | (put 'gited-buffer 'permanent-local t) 381 | 382 | (defvar gited-output-buffer-name "*gited-output*" 383 | "Name of the buffer where to show output from Git commands.") 384 | 385 | (defvar-local gited-output-buffer nil 386 | "Output buffer for Git commands.") 387 | (put 'gited-output-buffer 'permanent-local t) 388 | 389 | (defvar gited-bisect-buf-name "*gited-bisect*" 390 | "Name of the buffer where to show bisect output.") 391 | 392 | (defvar-local gited-bisect-buffer nil 393 | "Output buffer for Git bisects.") 394 | (put 'gited-bisect-buffer 'permanent-local t) 395 | 396 | (defvar gited-bisect-output-name "*gited-bisect*" 397 | "Name of the output buffer for Git bisects.") 398 | 399 | (defvar-local gited-bisect-buffer nil 400 | "Output buffer for Git bisects.") 401 | (put 'gited-bisect-buffer 'permanent-local t) 402 | 403 | (defvar gited-list-refs-format-command 404 | '("for-each-ref" "--format='(%%(%s:raw) \"%%(refname:short)\" \"%%(%s)\")'" "refs/%s") 405 | "Format strings to build a Git command to list references.") 406 | 407 | (defvar gited-date-regexp (concat "\\(" 408 | (substring 409 | directory-listing-before-filename-regexp 410 | (length "\\([0-9][BkKMGTPEZY]? "))) 411 | "Regular expression to match a date in `gited-buffer' buffer.") 412 | 413 | (defcustom gited-switches "-g" 414 | "Control how to sort `gited-branch-alist'. 415 | Option -r reverse order while sorting. 416 | Option -g do not show the author name." 417 | :type '(choice 418 | (const :tag "Unset" nil) string) 419 | :group 'gited) 420 | 421 | (defvar-local gited-actual-switches gited-switches 422 | "Switches used on this buffer.") 423 | (put 'gited-actual-switches 'permanent-local t) 424 | 425 | (defvar-local gited-list-format nil 426 | "Format of the columns in the branch list.") 427 | 428 | (defcustom gited-reset-mode "mixed" 429 | "Default mode of a Git reset." 430 | :type '(choice 431 | (const :tag "soft" "soft") 432 | (const :tag "mixed" "mixed") 433 | (const :tag "hard" "hard") 434 | (const :tag "merge" "merge") 435 | (const :tag "keep" "keep")) 436 | :group 'gited) 437 | 438 | (defvar gited-mark-col-size 2 439 | "Size of mark column.") 440 | 441 | (defcustom gited-author-col-size 16 442 | "Size of author column." 443 | :type 'integer 444 | :group 'gited) 445 | 446 | (defcustom gited-date-col-size 17 447 | "Size of date column." 448 | :type '(choice 449 | (const :tag "Short" 17) 450 | (const :tag "Full" 24)) 451 | :group 'gited) 452 | 453 | (defcustom gited-branch-col-size 50 454 | "Size of branch column." 455 | :type 'integer 456 | :group 'gited) 457 | 458 | (defcustom gited-commit-col-size 65 459 | "Size of commit column." 460 | :type 'integer 461 | :group 'gited) 462 | 463 | ;; Must be parseable by `date-to-time'. 464 | (defcustom gited-date-format "%F %R" 465 | "Format to display the date in `gited-buffer'. 466 | If you change this option, then you might want to change 467 | `gited-date-col-size' as well." 468 | :type '(choice 469 | (const :tag "Short" "%F %R") 470 | (const :tag "Full" "%FT%T%z")) 471 | :group 'gited) 472 | 473 | (defun gited--col-branch-name () 474 | (pcase gited-ref-kind 475 | ("tags" "Tags") 476 | ("remote" "Remote Branches") 477 | (_ (format "Branches (remote repository: %s)" gited-current-remote-rep)))) 478 | 479 | (defun gited--list-format-init (&optional col-names col-sizes) 480 | "Initialize `gited-list-format'. 481 | Optional arguments COL-NAMES and COL-SIZES are the column names 482 | and sizes." 483 | (setq gited-actual-switches gited-switches) 484 | (setq gited-list-format 485 | (vector `(,(if col-names (nth 0 col-names) "M") 486 | ,(if col-sizes (nth 0 col-sizes) gited-mark-col-size) t) 487 | `(,(if col-names (nth 1 col-names) "Authors") 488 | ,(if col-sizes (nth 1 col-sizes) gited-author-col-size) t) 489 | `(,(if col-names (nth 2 col-names) "Date") 490 | ,(if col-sizes (nth 2 col-sizes) gited-date-col-size) 491 | (lambda (row1 row2) 492 | (let* ((reverse-order 493 | (member "-r" (split-string gited-actual-switches))) 494 | (t1 (aref (cadr row1) gited-date-idx)) 495 | (t2 (aref (cadr row2) gited-date-idx)) 496 | (earlierp 497 | (time-less-p (date-to-time t1) (date-to-time t2)))) 498 | (if reverse-order 499 | earlierp 500 | (not earlierp))))) 501 | `(,(if col-names (nth 3 col-names) (gited--col-branch-name)) 502 | ,(if col-sizes (nth 3 col-sizes) gited-branch-col-size) t) 503 | `(,(if col-names (nth 4 col-names) "Last Commit") 504 | ,(if col-sizes (nth 4 col-sizes) gited-commit-col-size) t)))) 505 | 506 | (setq gited-list-format (gited--list-format-init)) 507 | 508 | (defcustom gited-expert nil 509 | "If non-nil, don't ask for confirmation for some operations on branches." 510 | :type 'boolean 511 | :group 'gited) 512 | 513 | (defcustom gited-add-untracked-files nil 514 | "If non-nil, `gited-add-patched-files' adds untracked files as well." 515 | :type 'boolean 516 | :group 'gited) 517 | 518 | (defcustom gited-show-commit-hash t 519 | "If non-nil, show the SHA1 in the 'Last Commit' column'." 520 | :type 'boolean 521 | :group 'gited) 522 | 523 | (defcustom gited-delete-unmerged-branches nil 524 | "If non-nil, `gited-do-delete' delete non-fully merged branches. 525 | Otherwise, deletion of unmerged branches require call `gited-do-delete' 526 | with a prefix." 527 | :type 'boolean 528 | :group 'gited) 529 | 530 | (defvar-local gited--last-remote-prune nil "Time when was run `gited-remote-prune'.") 531 | (put 'gited--last-remote-prune 'permanent-local t) 532 | 533 | (defcustom gited-prune-remotes 'daily 534 | "Whether if remove references to deleted remote branches." 535 | :type '(choice 536 | (const :tag "Never" nil) 537 | (const :tag "Always" t) 538 | (const :tag "daily" daily)) 539 | :group 'gited) 540 | 541 | (defcustom gited-current-branch-face 'font-lock-keyword-face 542 | "Face used for displaying current checkout branch." 543 | :type 'face 544 | :group 'gited) 545 | 546 | (defface gited-section-highlight 547 | '((((class color) (background light)) :background "grey95") 548 | (((class color) (background dark)) :background "grey20")) 549 | "Face for highlighting the current branch." 550 | :group 'gited) 551 | (defvar gited-section-highlight-face 'gited-section-highlight) 552 | 553 | (defface gited-flag-mark-line 554 | '((((background dark)) (:background "#787831311414")) ; ~ dark red brown 555 | (t (:background "Skyblue"))) 556 | "Face used for flagged and marked lines in Gited buffers." 557 | :group 'gited :group 'font-lock-highlighting-faces) 558 | (defvar gited-flag-mark-line-face 'gited-flag-mark-line) 559 | 560 | (defface gited-flag-mark 561 | '((((background dark)) 562 | (:foreground "Blue" :background "#7575D4D41D1D")) ; ~ olive green 563 | (t (:foreground "Yellow" :background "Blueviolet"))) 564 | "Face used for flags and marks (except D) in Gited buffers." 565 | :group 'gited :group 'font-lock-highlighting-faces) 566 | (defvar gited-flag-mark-face 'gited-flag-mark) 567 | 568 | (defface gited-deletion-branch 569 | '((t (:foreground "Red"))) 570 | "Face used for branches flagged for deletion in Gited buffers." 571 | :group 'gited :group 'font-lock-highlighting-faces) 572 | (defvar gited-deletion-branch-face 'gited-deletion-branch) 573 | 574 | (defface gited-deletion 575 | '((t (:foreground "Yellow" :background "Red"))) 576 | "Face used for deletion flags (D) in Gited buffers." 577 | :group 'gited :group 'font-lock-highlighting-faces) 578 | (defvar gited-deletion-face 'gited-deletion) 579 | 580 | (defface gited-header 581 | '((t (:inherit font-lock-type-face))) 582 | "Face used used for header when listing Git branches." 583 | :group 'gited) 584 | 585 | (defface gited-status-branch-local ; Same as magit-branch-local. 586 | '((((class color) (background light)) :foreground "SkyBlue4") 587 | (((class color) (background dark)) :foreground "LightSkyBlue1")) 588 | "Face for local branches in status." 589 | :group 'gited) 590 | 591 | (defface gited-status-tag ; Same as gited-tag. 592 | '((((class color) (background light)) :foreground "Goldenrod4") 593 | (((class color) (background dark)) :foreground "LightGoldenrod2")) 594 | "Face for tag labels shown in log buffer." 595 | :group 'gited) 596 | 597 | (defcustom gited-protected-branches nil 598 | "Name of protected branches. 599 | These branches cannot be deleted or renamed." 600 | :type '(repeat (string :tag "Branch name")) 601 | :group 'gited) 602 | 603 | (defcustom gited-short-log-cmd 604 | '("log" "--pretty=format:'%h %an %ad | %s%d'" "--graph" "--date=short") 605 | "Default short format for Git log." 606 | :type 'string 607 | :group 'gited) 608 | 609 | (defvar gited-header 'gited-header 610 | "Face name used for header when listing Git branches.") 611 | 612 | (defface gited-modified-branch 613 | '((((background dark)) (:foreground "green1")) 614 | (t (:foreground "red"))) 615 | "*Face used for branches with unstaged/uncommitted changes." 616 | :group 'gited :group 'font-lock-highlighting-faces) 617 | (defvar gited-modified-branch 'gited-modified-branch) 618 | 619 | (defface gited-mark 620 | '((t (:inherit font-lock-constant-face))) 621 | "Face used for Gited marks." 622 | :group 'gited-faces) 623 | (defvar gited-mark-face 'gited-mark 624 | "Face name used for Gited marks.") 625 | 626 | (defface gited-author 627 | '((((background dark)) (:foreground "orange")) 628 | (t (:foreground "black"))) 629 | "*Face used for AUTHOR in Gited buffers." 630 | :group 'gited :group 'font-lock-highlighting-faces) 631 | (defvar gited-author-face 'gited-author) 632 | 633 | (defface gited-date-time 634 | '((((background dark)) (:foreground "#74749A9AF7F7")) ; ~ med blue 635 | (t (:foreground "DarkGoldenrod4"))) 636 | "Face used for date and time in Gited buffers." 637 | :group 'gited :group 'font-lock-highlighting-faces) 638 | (defvar gited-date-time-face 'gited-date-time) 639 | 640 | (defface gited-branch-name 641 | '((((background dark)) (:foreground "Yellow")) 642 | (t (:foreground "Blue"))) 643 | "Face used for branch names in Gited buffers." 644 | :group 'gited :group 'font-lock-highlighting-faces) 645 | (defvar gited-branch-name-face 'gited-branch-name) 646 | 647 | (defface gited-commit-msg ; Same as magit-branch-remote. 648 | '((((class color) (background light)) :foreground "DarkOliveGreen4") 649 | (((class color) (background dark)) :foreground "DarkSeaGreen2")) 650 | "Face used for commit-msg in Gited buffers." 651 | :group 'gited :group 'font-lock-highlighting-faces) 652 | (defvar gited-commit-msg-face 'gited-commit-msg) 653 | 654 | 655 | 656 | ;;; `vc-git-checkout' has 2nd argument EDITABLE for Emacs < 25. 657 | ;;; For Emacs >= 25 that argument doesn't exit. 658 | (defun gited-git-checkout (file rev) 659 | "Like `vc-git-checkout' with arguments FILE and REV. 660 | In Emacs version < 25 `vc-git-checkout' has 3 arguments." 661 | (with-no-warnings 662 | (if (< emacs-major-version 25) 663 | (vc-git-checkout file nil rev) 664 | (vc-git-checkout file rev)))) 665 | 666 | 667 | ;;; Macros. 668 | 669 | (defmacro gited-with-current-branch (branch &rest body) 670 | "Set BRANCH temporarily current and execute forms in BODY. 671 | BRANCH must be the name of an existing branch. 672 | The value returned is the value of the last form in BODY." 673 | (declare (indent 1) (debug t)) 674 | (let ((cur-branch (make-symbol "cur-branch"))) 675 | `(let ((,cur-branch gited-current-branch)) 676 | (when (gited-modified-files-p) 677 | (user-error "Cannot checkout a new branch: there are modified files")) 678 | (unwind-protect 679 | (progn 680 | (gited-git-checkout nil ,branch) 681 | (setq gited-current-branch ,branch) 682 | ,@body) 683 | ;; Restore original current branch. 684 | (gited-git-checkout nil ,cur-branch) 685 | (setq gited-current-branch ,cur-branch))))) 686 | 687 | ;;; Map over marks. 688 | (defmacro gited-map-over-marks (body arg) 689 | "Eval BODY with point on each marked line. Return a list of BODY's results. 690 | If no marked branch could be found, execute BODY on the current 691 | line. ARG, if non-nil, specifies the branches to use instead of the 692 | marked branches. 693 | 694 | If ARG is an integer, use the next ARG (or previous -ARG, if 695 | ARG<0) files. In that case, point is dragged along. This is so 696 | that commands on the next ARG (instead of the marked) files can 697 | be chained easily. 698 | For any other non-nil value of ARG, use the current file. 699 | 700 | Search starts at the beginning of the buffer, thus the car of the 701 | list corresponds to the line nearest to the buffer's bottom. 702 | This is also true for (positive and negative) integer values of 703 | ARG. 704 | 705 | BODY should not be too long as it is expanded four times. 706 | 707 | If DISTINGUISH-ONE-MARKED is non-nil, then if we find just one 708 | marked file, return (t FILENAME) instead of (FILENAME)." 709 | `(prog1 710 | (let ((inhibit-read-only t) case-fold-search found results) 711 | (if ,arg 712 | (if (integerp ,arg) 713 | (progn ;; no save-excursion, want to move point. 714 | (gited-repeat-over-lines 715 | ,arg 716 | (lambda () 717 | (setq results (cons ,body results)))) 718 | (if (< ,arg 0) 719 | (nreverse results) 720 | results)) 721 | ;; non-nil, non-integer ARG means use current file: 722 | (list ,body)) 723 | (let ((regexp 724 | (concat "^" 725 | (regexp-quote 726 | (char-to-string gited-marker-char)))) 727 | next-position) 728 | (save-excursion 729 | (goto-char (point-min)) 730 | ;; remember position of next marked file before BODY 731 | ;; can insert lines before the just found file, 732 | ;; confusing us by finding the same marked file again 733 | ;; and again and... 734 | (setq next-position (and (re-search-forward regexp nil t) 735 | (point-marker)) 736 | found (not (null next-position))) 737 | (while next-position 738 | (goto-char next-position) 739 | (setq results (cons ,body results)) 740 | ;; move after last match 741 | (goto-char next-position) 742 | (forward-line) 743 | (set-marker next-position nil) 744 | (setq next-position (and (re-search-forward regexp nil t) 745 | (point-marker))))) 746 | (if found 747 | results 748 | (list ,body))))) 749 | ;; save-excursion loses, again 750 | (gited-move-to-branchname))) 751 | 752 | (defmacro gited-mark-if (predicate msg) 753 | "Mark all branches for which PREDICATE eval to non-nil. 754 | PREDICATE is evaluated on each line, with point at beginning of line. 755 | MSG is a noun phrase for the type of branches being marked. 756 | It should end with a noun that can be pluralized by adding `s'. 757 | Return value is the number of files marked, or nil if none were marked." 758 | `(let ((inhibit-read-only t) count) 759 | (save-excursion 760 | (setq count 0) 761 | (when ,msg 762 | (message "%s %ss%s..." 763 | (cond ((eq gited-marker-char ?\s) "Unmarking") 764 | ((eq gited-marker-char gited-del-char) 765 | "Flagging") 766 | (t "Marking")) 767 | ,msg 768 | (if (eq gited-marker-char gited-del-char) 769 | " for deletion" 770 | ""))) 771 | (gited--goto-first-branch) 772 | (while (not (eobp)) 773 | (if ,predicate 774 | (progn 775 | (gited-insert-marker-char) 776 | (gited--fontify-current-row) 777 | (cl-incf count))) 778 | (forward-line)) 779 | (if ,msg (message "%s %s%s %s%s." 780 | count 781 | ,msg 782 | (gited-plural-s count) 783 | (if (eq gited-marker-char ?\s) "un" "") 784 | (if (eq gited-marker-char gited-del-char) 785 | "flagged" "marked")))) 786 | (and (> count 0) count))) 787 | 788 | 789 | ;;; Convenience functions. 790 | ;; Following functions are stolen from Dired. 791 | ;; To avoid code duplication we just bind `dired-log-buffer' to 792 | ;; `gited-log-buffer' and use the original definitions in dired.el. 793 | (defvar gited-log-buffer "*Gited log*") 794 | 795 | (defalias 'gited-plural-s 'dired-plural-s) 796 | 797 | (defun gited-why () 798 | "Pop up a buffer with error log output from Gited. 799 | A group of errors from a single command ends with a formfeed. 800 | Thus, use \\[backward-page] to find the beginning of a group of errors." 801 | (interactive) 802 | (let ((dired-log-buffer gited-log-buffer)) 803 | (dired-why))) 804 | 805 | (defun gited-summary () 806 | "Summarize basic Gited commands and show recent Gited errors." 807 | (interactive) 808 | (gited-why) 809 | (message 810 | "d-elete, u-ndelete, x-punge, f-ind, o-rigin, R-ename, C-opy, h-elp")) 811 | 812 | (defun gited-log-msg (log &rest args) 813 | (let ((dired-log-buffer gited-log-buffer)) 814 | (dired-log log args))) 815 | 816 | (defun gited-log-summary (string failures) 817 | (let ((dired-log-buffer gited-log-buffer)) 818 | (dired-log-summary string failures))) 819 | 820 | (defun gited-format-columns-of-files (branches) 821 | (let ((beg (point))) 822 | (completion--insert-strings branches) 823 | (put-text-property beg (point) 'mouse-face nil))) 824 | 825 | (defun gited-next-branch () 826 | "Return name of next branch." 827 | (save-excursion 828 | (forward-line) 829 | (ignore-errors 830 | (gited-get-branchname)))) 831 | 832 | (defun gited-prev-branch () 833 | "Return name of previous branch." 834 | (save-excursion 835 | (forward-line -1) 836 | (ignore-errors 837 | (gited-get-branchname)))) 838 | 839 | (defun gited-current-branch () 840 | "Return name of current branch." 841 | (car (vc-git-branches))) 842 | 843 | (defun gited-get-last-commit-time (branch) 844 | "Return last commit time of BRANCH." 845 | (cl-block nil 846 | (pcase-dolist (`(_ _ ,date ,cur-branch _ _) gited-branch-alist) 847 | (when (equal cur-branch branch) 848 | (cl-return (date-to-time date)))))) 849 | 850 | (defun gited--get-column (col) 851 | (mapcar (lambda (x) 852 | (elt (cadr x) col)) 853 | tabulated-list-entries)) 854 | 855 | (defun gited-listed-branches () 856 | "Return a list with all listed branches/tags names." 857 | (gited--get-column gited-branch-idx)) 858 | 859 | (defalias 'gited-get-branches 'gited-listed-branches) 860 | 861 | (defun gited-git-command (args &optional buffer display unquote) 862 | "Execute a Git command with arguments ARGS. 863 | Optional arg BUFFER is the output buffer. 864 | Optional arg DISPLAY means redisplay buffer as output is inserted. 865 | Optional arg UNQUOTE removes single quotes from the output." 866 | (prog1 867 | (apply #'process-file vc-git-program nil buffer display args) 868 | (when (and unquote buffer (buffer-live-p buffer)) 869 | (with-current-buffer buffer 870 | ;; Drop single quotes. 871 | (save-excursion 872 | (goto-char (point-min)) 873 | (while (re-search-forward "^'\\(.*\\)'$" nil t) 874 | (replace-match "\\1"))))))) 875 | 876 | (defun gited--update-header-line () 877 | "Update header line with current remote repository." 878 | (let ((regexp "Branches (remote repository: \\([^)]+\\))")) 879 | (when (string-match regexp header-line-format) 880 | (setq header-line-format 881 | (replace-match 882 | gited-current-remote-rep nil nil header-line-format 1)) 883 | (force-mode-line-update)))) 884 | 885 | (defun gited-change-current-remote-rep () 886 | "Toggle `gited-current-remote-rep'." 887 | (interactive) 888 | (unless (derived-mode-p 'gited-mode) 889 | (user-error "Not a Gited buffer")) 890 | (let ((remote-repositories 891 | (with-temp-buffer 892 | (gited-git-command '("remote") (current-buffer)) 893 | (split-string (buffer-string) nil 'omit-nulls)))) 894 | (cond ((null (cdr remote-repositories)) 895 | (user-error "Only one remote repository!")) 896 | ((null (cddr remote-repositories)) 897 | (setq gited-current-remote-rep 898 | (car (delete gited-current-remote-rep remote-repositories)))) 899 | (t 900 | (let ((remote-rep 901 | (completing-read 902 | (format "Choose remote repository") 903 | remote-repositories 904 | nil t))) 905 | (setq gited-current-remote-rep remote-rep)))) 906 | (gited--update-header-line) 907 | (message "Updated remote repository to '%s'" gited-current-remote-rep))) 908 | 909 | (defalias 'gited-toggle-current-remote-rep 'gited-change-current-remote-rep) 910 | 911 | (defun gited-git-command-on-region (args &optional buffer display) 912 | "Execute a Git command with arguments ARGS and region as input. 913 | Optional arg BUFFER is the output buffer. 914 | Optional arg DISPLAY means redisplay buffer as output is inserted." 915 | ;; Adapted from `project--process-file-region' in project.el 916 | (if (not (file-remote-p default-directory)) 917 | (apply #'call-process-region 918 | nil nil vc-git-program nil buffer display args) 919 | (let ((infile (make-temp-file "ggcor"))) 920 | (unwind-protect 921 | (progn 922 | (write-region nil nil infile nil 'silent) 923 | (apply #'process-file vc-git-program infile buffer display args)) 924 | (delete-file infile))))) 925 | 926 | (defun gited-all-branches () 927 | "Return a list with all (local and remote) branches and tags." 928 | (let ((args '("for-each-ref" "--format='%(refname:short)'" "refs/heads" 929 | "refs/remotes" "refs/tags"))) 930 | (with-temp-buffer 931 | (gited-git-command args (current-buffer) nil 'unquote) 932 | (split-string (buffer-string) "\n" 'omit-nulls)))) 933 | 934 | (defun gited-copy-branchname-as-kill () 935 | "Copy names of marked branches into the kill ring. 936 | The names are separated by a space. 937 | 938 | If on a subdir headerline, use absolute subdirname instead; 939 | prefix arg and marked files are ignored in this case. 940 | 941 | You can then feed the file name(s) to other commands with \\[yank]." 942 | (interactive) 943 | (let ((string 944 | (mapconcat (function identity) 945 | (or (gited-get-marked-branches) 946 | (list (gited-get-branchname))) 947 | " "))) 948 | (unless (string= string "") 949 | (if (eq last-command 'kill-region) 950 | (kill-append string nil) 951 | (kill-new string)) 952 | (message "%s" string)))) 953 | 954 | (defun gited--output-buffer (&optional buf-name) 955 | (unless buf-name 956 | (setq buf-name gited-output-buffer-name)) 957 | (let* ((buf 958 | (cond ((equal buf-name gited-bisect-buf-name) 959 | (and (buffer-live-p gited-bisect-buffer) gited-bisect-buffer)) 960 | (t 961 | (and (buffer-live-p gited-output-buffer) gited-output-buffer)))) 962 | (res (or (and (buffer-live-p buf) 963 | (equal default-directory 964 | (buffer-local-value 'default-directory buf)) 965 | buf) 966 | (let* ((toplevel-dir gited-toplevel-dir) 967 | (new-buffer (generate-new-buffer buf-name))) 968 | (with-current-buffer new-buffer 969 | ;; Set default directory as `gited-toplevel-dir'; this helps 970 | ;; `diff-apply-hunk' or `diff-goto-source' to find the target file. 971 | (setq default-directory toplevel-dir)) 972 | new-buffer)))) 973 | (if (equal buf-name gited-bisect-buf-name) 974 | (setq gited-bisect-buffer res) 975 | (setq gited-output-buffer res)))) 976 | 977 | 978 | ;;; Predicates. 979 | 980 | (defun gited--list-files (regexp) 981 | "List modified or untracked files according with REGEXP." 982 | (let ((case-fold-search) res) 983 | (with-temp-buffer 984 | (gited-git-command '("status" "--porcelain") (current-buffer)) 985 | (goto-char (point-min)) 986 | (while (re-search-forward regexp nil t) 987 | (push (match-string-no-properties 1) res))) 988 | (nreverse res))) 989 | 990 | (defun gited-modified-files () 991 | "Return a list with all unstaged files." 992 | (gited--list-files 993 | "^\\(?:[[:blank:]][MAUD]\\|[MAU]+\\)[[:blank:]]*\\(.+\\)")) 994 | 995 | (defun gited-modified-files-p () 996 | "Return non-nil if there are unstaged changes." 997 | (and (gited-modified-files) t)) 998 | 999 | (defun gited-dir-under-Git-control-p () 1000 | "Return non-nil if current directory is under Git version control." 1001 | (zerop (gited-git-command '("status")))) 1002 | 1003 | (defun gited-branch-exists-p (branch) 1004 | "Return non-nil if BRANCH exists." 1005 | (member branch (gited-listed-branches))) 1006 | 1007 | (defun gited-buffer-p () 1008 | "Return non-nil if current buffer is a gited buffer." 1009 | (string-prefix-p gited-buffer-name 1010 | (buffer-name (current-buffer)))) 1011 | 1012 | (defun gited-at-header-line-p () 1013 | "Return non-nil if point is at header line." 1014 | (and (not gited-use-header-line) 1015 | (= 1 (line-number-at-pos (point))))) 1016 | 1017 | (defun gited-remote-repository-p () 1018 | "Return non-nil if current repository is remote." 1019 | (let ((regexp "^remote\.")) 1020 | (with-temp-buffer 1021 | (gited-git-command '("config" "--local" "--list") (current-buffer)) 1022 | (goto-char 1) 1023 | (and (re-search-forward regexp nil t) t)))) 1024 | 1025 | 1026 | ;;; Operations on branches (copy, merge, ...). 1027 | 1028 | (defun gited--get-branches-from-command (cmd) 1029 | (when (equal gited-ref-kind "remote") 1030 | (setq cmd (append cmd (list "--remote")))) 1031 | (with-temp-buffer 1032 | (gited-git-command cmd (current-buffer) nil 'unquote) 1033 | (goto-char (point-min)) 1034 | (while (re-search-forward "^\\( \\|\\* \\)" nil t) 1035 | (replace-match "")) 1036 | (split-string (buffer-string) "\n" 'omit-nulls))) 1037 | 1038 | (defun gited-trunk-branches () 1039 | "Return a list with branch names tracked from a remote repository." 1040 | (let ((regexp "^branch\.\\([^.]+\\)\.merge=") 1041 | res) 1042 | (with-temp-buffer 1043 | (gited-git-command '("config" "--local" "--list") (current-buffer)) 1044 | (goto-char 1) 1045 | (while (re-search-forward regexp nil t) 1046 | (push (match-string-no-properties 1) res)) 1047 | (nreverse res)))) 1048 | 1049 | (defun gited-trunk-branch () 1050 | "Return the trunk branch for this repository. 1051 | If `gited-trunk-branch' is non-nil, then return it. Otherwise, 1052 | call `gited-trunk-branches'; if there are > 1 possible trunk, then 1053 | ask the user to pick up the right one." 1054 | (if gited-trunk-branch 1055 | gited-trunk-branch 1056 | (let* ((branches (gited-trunk-branches)) 1057 | (trunk 1058 | (cond ((null branches) 1059 | (user-error "No trunk branch found in repository")) 1060 | ((null (cdr branches)) (car branches)) 1061 | (t (completing-read 1062 | "Choose the trunk branch: " 1063 | branches nil t nil nil (car branches)))))) 1064 | (prog1 trunk 1065 | (when gited-one-trunk-repository 1066 | (setq gited-trunk-branch trunk)))))) 1067 | 1068 | (defun gited--get-unmerged-branches () 1069 | (let ((args `("branch" "--no-merged" ,(gited-trunk-branch)))) 1070 | (gited--get-branches-from-command args))) 1071 | 1072 | (defun gited--get-merged-branches () 1073 | (let ((args `("branch" "--merged" ,(gited-trunk-branch)))) 1074 | (gited--get-branches-from-command args))) 1075 | 1076 | (defun gited--check-unmerged-marked-branches (&optional marker) 1077 | (let ((marked-branches (or (gited-get-marked-branches marker) 1078 | (list (gited-get-branchname))))) 1079 | (dolist (b marked-branches) 1080 | (let ((unmerged (ignore-errors (gited--get-unmerged-branches)))) 1081 | (dolist (x unmerged) 1082 | (when (string= b x) 1083 | (user-error "Cannot delete unmerged branches. Try C-u %s" 1084 | (substitute-command-keys (this-command-keys))))))))) 1085 | 1086 | (defun gited--merged-branch-p (branch) 1087 | (and (member branch (gited--get-merged-branches)) 1088 | t)) 1089 | 1090 | (defun gited-untracked-files () 1091 | "Return a list with all untracked files." 1092 | (gited--list-files "^[?]\\{2\\}[[:blank:]]+\\(.+\\)")) 1093 | 1094 | (defun gited-stashes () 1095 | "Return a list with all the stashes." 1096 | (let ((args '("stash" "list")) 1097 | res) 1098 | (with-temp-buffer 1099 | (gited-git-command args (current-buffer)) 1100 | (goto-char (point-min)) 1101 | (while (not (eobp)) 1102 | (push (buffer-substring (point-at-bol) (point-at-eol)) res) 1103 | (forward-line))) 1104 | (nreverse res))) 1105 | 1106 | (defun gited--extract-from-commit (commit data) 1107 | "Return some data from COMMIT, a string. 1108 | DATA is a string to specify what we want to extract. For instance: 1109 | '%s', the title. 1110 | '%B', the raw commit message. 1111 | '%an', the author name. 1112 | '%ai', the author date, ISO 8601-like format. 1113 | '%ae', the author email." 1114 | (let ((args `("log" ,(format "--pretty=format:'%s'" data) "-n1" ,commit))) 1115 | (with-temp-buffer 1116 | (gited-git-command args (current-buffer) nil 'unquote) 1117 | (buffer-string)))) 1118 | 1119 | (defun gited--last-commit-msg (&optional branch) 1120 | "Return the last commit." 1121 | (gited--extract-from-commit (or branch "HEAD") "%B")) 1122 | 1123 | (defun gited--last-commit-title (&optional branch) 1124 | "Return title of the last commit." 1125 | (gited--extract-from-commit (or branch "HEAD") "%s")) 1126 | 1127 | (defun gited--last-commit-author (&optional branch) 1128 | "Return the last commit." 1129 | (gited--extract-from-commit (or branch "HEAD") "%an <%ae>")) 1130 | 1131 | (defun gited--last-commit-date (&optional branch) 1132 | "Return the last commit." 1133 | (gited--extract-from-commit (or branch "HEAD") "%ai")) 1134 | 1135 | (defun gited--last-commit-hash (&optional branch) 1136 | "Return the last commit hash string." 1137 | (gited--extract-from-commit (or branch "HEAD") "%H")) 1138 | 1139 | (defun gited--last-trunk-commit () 1140 | (gited--last-commit-hash (gited-trunk-branch))) 1141 | 1142 | ;; Non-nil while running an asynchronous Gited subprocess. 1143 | (defvar-local gited--running-async-op nil) 1144 | 1145 | (defvar gited-async-operation-callback nil 1146 | "A function to call once the current async process sucessfully completes.") 1147 | 1148 | (defun gited-async-operation (command &optional remote-op-p buffer callback) 1149 | "Run COMMAND asynchronously. 1150 | COMMAND perform a branch operation, i.e., rename or delete a branch. 1151 | Optional arg REMOTE-OP-P, means the operation modify the remote 1152 | repository. Otherwise, the operation just change local branches. 1153 | Optional arg BUFFER is the output buffer for the operation. Otherwise, 1154 | use `gited-output-buffer'. 1155 | Optional arg CALLBACK is called if COMMAND completes successfully." 1156 | (interactive) 1157 | (if gited--running-async-op 1158 | (user-error "Cannot run 2 Gited async process in parallel") 1159 | (let* ((gited-buf (current-buffer)) 1160 | (out-buf (or buffer (gited--output-buffer))) 1161 | (directory default-directory) 1162 | proc) 1163 | (with-current-buffer out-buf 1164 | ;; Always display out-buf for remote operations. This is to prompt 1165 | ;; for Git user/password. 1166 | (when remote-op-p 1167 | (display-buffer out-buf '(nil (allow-no-window . t)))) 1168 | (setq default-directory directory 1169 | proc (start-file-process-shell-command 1170 | "*gited-async-operation*" out-buf command) 1171 | mode-line-process '(":%s")) 1172 | (with-current-buffer gited-buf 1173 | (setq gited--running-async-op t)) 1174 | (with-no-warnings 1175 | (require 'shell) (shell-mode)) 1176 | (setq gited-async-operation-callback callback) 1177 | (set-process-sentinel proc 'gited-async-operation-sentinel) 1178 | (set-process-filter proc 'comint-output-filter) 1179 | ;; Associate out-buf with gited-buf; this is used in the sentinel. 1180 | (setq gited-buffer gited-buf))))) 1181 | 1182 | (defun gited-async-operation-sentinel (proc state) 1183 | "Sentinel for asynchronous operations on branches. 1184 | PROC is the process. 1185 | STATE is the state of process PROC." 1186 | (let* ((buf (process-buffer proc)) 1187 | (gited-buf (and (buffer-live-p buf) 1188 | (buffer-local-value 'gited-buffer buf))) 1189 | (op-string gited-op-string) 1190 | (inhibit-read-only t)) 1191 | (when (memq (process-status proc) '(exit signal)) 1192 | (with-current-buffer gited-buf 1193 | (setq gited--running-async-op nil) 1194 | (when (gited-bisecting-p) 1195 | (gited--bisect-after-run (process-buffer proc))))) 1196 | (when (buffer-live-p gited-buf) 1197 | (set-buffer gited-buf) 1198 | (run-hooks 'gited-after-change-hook) 1199 | (when gited-branch-after-op 1200 | (gited-goto-branch gited-branch-after-op) 1201 | (setq gited-branch-after-op nil 1202 | gited-op-string nil)) 1203 | ;; State is 'finished\n' when the process exit with code 0. 1204 | (if (string-prefix-p "finished" state) 1205 | (progn 1206 | (message "%s done!" op-string) 1207 | (when gited-async-operation-callback 1208 | (prog1 1209 | (funcall gited-async-operation-callback) 1210 | (setq gited-async-operation-callback nil)))) 1211 | (beep) 1212 | (message "Process exited with non-zero status. Please check") 1213 | (display-buffer gited-output-buffer))))) 1214 | 1215 | (define-minor-mode gited-hide-details-mode 1216 | "Toggle visibility of detailed information in current Gited buffer. 1217 | When this minor mode is enabled, details such as last commit author and 1218 | date are hidden from view." 1219 | :group 'gited 1220 | (unless (derived-mode-p 'gited-mode) 1221 | (user-error "Not a Gited buffer")) 1222 | (setq gited-verbose (not gited-hide-details-mode)) 1223 | (gited-hide-details-update-invisibility-spec)) 1224 | 1225 | (put 'gited-hide-details-mode 'permanent-local t) 1226 | 1227 | (defun gited-update () 1228 | "Update `gited-branch-alist' and redisplay the list of branches." 1229 | (interactive) 1230 | (unless (derived-mode-p major-mode 'gited-mode) 1231 | (user-error "Cannot enable Gited mode in this buffer")) 1232 | (let ((marks (gited-remember-marks 1 (point-max))) 1233 | (target-br (ignore-errors (gited-get-branchname))) 1234 | (at-headr-p (gited-at-header-line-p)) 1235 | (hide-details gited-hide-details-mode)) 1236 | (gited-list-branches gited-ref-kind nil 'update) 1237 | (gited-hide-details-mode (if hide-details 1 0)) 1238 | (when marks (gited-mark-remembered marks)) ; Preserve marks. 1239 | (if (not at-headr-p) 1240 | (gited-goto-branch target-br) 1241 | (gited-goto-branch gited-current-branch)))) 1242 | 1243 | (add-hook 'gited-after-change-hook 'gited-update) 1244 | 1245 | (defun gited-rename-branch (old-name new-name) 1246 | "Rename branch OLD-NAME to NEW-NAME." 1247 | (interactive 1248 | (let* ((old (gited-get-branchname)) 1249 | (new (read-string 1250 | (format "Rename %s to: " old) 1251 | nil nil old))) 1252 | (list old new))) 1253 | (when (member old-name gited-protected-branches) 1254 | (user-error "Cannot rename a protected branch")) 1255 | (let ((buf (gited--output-buffer)) 1256 | (inhibit-read-only t) remote-op-p) 1257 | (setq gited-output-buffer buf) 1258 | (with-current-buffer buf (erase-buffer)) 1259 | (if (and (not gited-expert) 1260 | (not (y-or-n-p 1261 | (format "Rename branch '%s' to '%s'? " 1262 | old-name new-name)))) 1263 | (message "OK, rename canceled") 1264 | (if (gited-async-operation 1265 | (pcase gited-ref-kind 1266 | ("remote" 1267 | (let ((old (substring old-name (length "origin/"))) 1268 | (new (if (string-prefix-p "origin/" new-name) 1269 | (substring new-name (length "origin/")) 1270 | new-name))) 1271 | (setq remote-op-p t) 1272 | (format "%s push origin origin/%s:refs/heads/%s :%s" 1273 | vc-git-program old new old))) 1274 | ("local" (format "%s branch --move %s %s" 1275 | vc-git-program old-name new-name)) 1276 | ("tags" (user-error "Rename tags not implemented!")) 1277 | (_ (user-error "Unsupported gited-ref-kind: must be \ 1278 | local, remote or tags"))) 1279 | remote-op-p) 1280 | (progn 1281 | (setq gited-branch-after-op new-name 1282 | gited-op-string 1283 | (format "Rename branch '%s' to '%s'" old-name new-name))) 1284 | (error "Cannot rename branch '%s' to '%s'" old-name new-name))))) 1285 | 1286 | (defun gited-merge-branch (branch) 1287 | "Merge BRANCH with another one. 1288 | That means, changes from another branch are added into BRANCH." 1289 | (interactive 1290 | (list (gited-get-branchname))) 1291 | (let ((branch-new 1292 | (completing-read 1293 | (format "Merge %s with: " branch) 1294 | (gited-listed-branches) 1295 | nil t))) 1296 | (gited-with-current-branch branch 1297 | (if (zerop (gited-git-command `("merge" ,branch-new))) 1298 | (message "Merged %s into %s!" branch-new branch) 1299 | (error "Cannot merge '%s' into '%s'" branch-new branch))))) 1300 | 1301 | (defun gited-reset-branch (commit &optional mode) 1302 | "Reset current branch to an earlier state. 1303 | 1304 | COMMIT is a SHA1 string or HEAD~N, to reset BRANCH to that commit. 1305 | Interactively prompt for the limit commit: 0 means HEAD, 1306 | 1 means HEAD~, and so on. 1307 | Interactively with a prefix argument prompts for the reset mode. 1308 | Defaults to `gited-reset-mode'." 1309 | (interactive 1310 | (let* ((alist 1311 | '(("s" . "soft") ("m" . "mixed") ("h" . "hard") 1312 | ("g" . "merged") ("k" . "keep"))) 1313 | (mode 1314 | (if current-prefix-arg 1315 | (cdr (assoc 1316 | (completing-read 1317 | "Reset mode (s = soft, m = mixed, h = hard, \ 1318 | g = merged, k = keep): " 1319 | '("s" "m" "h" "g" "k") 1320 | nil 'mustmatch nil nil "h") 1321 | alist)) 1322 | gited-reset-mode)) 1323 | (input 1324 | (read-string 1325 | (format "Reset --%s to commit (0 = HEAD, \ 1326 | 1 = HEAD~1, ... or SHA1): " mode) 1327 | nil nil "0"))) 1328 | (list (if (gited--valid-ref-p input) 1329 | input 1330 | (concat "HEAD~" input)) 1331 | mode))) 1332 | (unless mode (setq mode gited-reset-mode)) 1333 | (let ((branch (gited-current-branch)) 1334 | (args `("reset" ,(concat "--" mode) ,commit))) 1335 | (if (not (y-or-n-p 1336 | (format "Reset --%s '%s' to '%s'? " mode branch commit))) 1337 | (message "OK, reset canceled") 1338 | (if (zerop (gited-git-command args)) 1339 | (message "Reseted --%s '%s' to '%s'!" mode branch commit) 1340 | (error "Cannot reset --%s '%s' to '%s'" mode branch commit))))) 1341 | 1342 | (defun gited-remote-prune () 1343 | "Remove references to deleted remote branches/tags." 1344 | (setq gited--last-remote-prune (current-time)) 1345 | (message "Prunning remote branches ...") 1346 | (gited-git-command '("fetch" "--all" "--prune"))) 1347 | 1348 | (defun gited-delete-branch (branch &optional force) 1349 | "Delete branch BRANCH. 1350 | BRANCH default to the branch at current line. 1351 | Optional arg FORCE, if non-nil then delete non-fully merged branches 1352 | as well." 1353 | (interactive 1354 | (list (gited-get-branchname) current-prefix-arg)) 1355 | (let ((br-after (or (gited-next-branch) 1356 | (gited-prev-branch) 1357 | (gited-current-branch))) 1358 | (buf (gited--output-buffer)) 1359 | (force (or gited-delete-unmerged-branches force)) 1360 | (inhibit-read-only t)) 1361 | (setq gited-output-buffer buf) 1362 | (with-current-buffer buf (erase-buffer)) 1363 | (when (string= branch gited-current-branch) 1364 | (user-error "Cannot delete the current branch")) 1365 | (when (member branch gited-protected-branches) 1366 | (user-error "Cannot delete a protected branch")) 1367 | (if (and (not gited-expert) 1368 | (not (y-or-n-p (format "Delete branch '%s'? " branch)))) 1369 | (message "OK, deletion canceled") 1370 | (pcase gited-ref-kind 1371 | ("tags" (user-error "Delete tags not implemented!")) 1372 | ("local" 1373 | (if (zerop (gited-git-command 1374 | ;; --delete --force as shortcut of -D doesn't exist 1375 | ;; in old Git versions. 1376 | `("branch" 1377 | ,(if force "-D" "--delete") 1378 | ,branch) 1379 | buf)) 1380 | (progn 1381 | (gited-goto-branch br-after) 1382 | (message "Delete branch '%s'!" branch)) 1383 | (user-error "Cannot delete unmerged branch '%s'. Try C-u %s" 1384 | branch 1385 | (substitute-command-keys "\\[gited-do-flagged-delete\]")))) 1386 | ("remote" 1387 | (gited-async-operation 1388 | (format "%s push origin :%s" 1389 | vc-git-program 1390 | (substring branch (length "origin/"))) 'remote-op-p) 1391 | (setq gited-branch-after-op br-after 1392 | gited-op-string (format "Delete branch '%s'" branch))) 1393 | (_ (user-error "Unsupported gited-ref-kind: must be \ 1394 | local, remote or tags")))))) 1395 | 1396 | (defun gited-do-delete (&optional arg force) 1397 | "Delete all marked (or next ARG) branches. 1398 | Optional arg FORCE, if non-nil then delete non-fully merged branches 1399 | as well." 1400 | (interactive 1401 | (let ((prefix current-prefix-arg)) 1402 | (list prefix (equal prefix '(4))))) 1403 | (setq force (or gited-delete-unmerged-branches force)) 1404 | (unless force 1405 | (gited--check-unmerged-marked-branches gited-del-char)) 1406 | (gited-internal-do-deletions 1407 | ;; this may move point if ARG is an integer 1408 | (gited-map-over-marks (cons (or (gited-get-branchname) 1409 | (error "No branch on this line")) 1410 | (point)) 1411 | arg) 1412 | arg force) 1413 | (run-hooks 'gited-after-change-hook)) 1414 | 1415 | (defun gited-mark-pop-up (buffer-or-name op-symbol branches function &rest args) 1416 | "Return FUNCTION's result on ARGS after showing which branches are marked. 1417 | Displays the branch names in a window showing a buffer named 1418 | BUFFER-OR-NAME; the default name being \" *Marked Branches*\". The 1419 | window is not shown if there is just one branch, `gited-no-confirm' 1420 | is t, or OP-SYMBOL is a member of the list in `gited-no-confirm'. 1421 | 1422 | By default, Gited shrinks the display buffer to fit the marked branches. 1423 | To disable this, use the Customization interface to add a new rule 1424 | to `display-buffer-alist' where condition regexp is 1425 | \"^ \\*Marked Branches\\*$\", 1426 | action argument symbol is `window-height' and its value is nil. 1427 | 1428 | BRANCHES is the list of marked branches. It can also be (t BRANCHNAME) 1429 | in the case of one marked branch, to distinguish that from using 1430 | just the current branch. 1431 | 1432 | FUNCTION should not manipulate branches, just read input (an 1433 | argument or confirmation)." 1434 | (if (= (length branches) 1) 1435 | (apply function args) 1436 | (let ((buffer (get-buffer-create (or buffer-or-name " *Marked Branches*"))) 1437 | ;; Mark *Marked Branches* window as softly-dedicated, to prevent 1438 | ;; other buffers e.g. *Completions* from reusing it (bug#17554). 1439 | (display-buffer-mark-dedicated 'soft)) 1440 | (ignore op-symbol) ; ignore unused symbol. 1441 | (with-current-buffer buffer 1442 | (with-current-buffer-window 1443 | buffer 1444 | (cons 'display-buffer-below-selected 1445 | '((window-height . fit-window-to-buffer))) 1446 | #'(lambda (window _value) 1447 | (with-selected-window window 1448 | (unwind-protect 1449 | (apply function args) 1450 | (when (window-live-p window) 1451 | (quit-restore-window window 'kill))))) 1452 | (gited-format-columns-of-files 1453 | branches) 1454 | (remove-text-properties (point-min) (point-max) 1455 | '(mouse-face nil help-echo nil))))))) 1456 | 1457 | (defun gited-internal-do-deletions (l arg &optional force) 1458 | ;; L is an alist of branches to delete, with their buffer positions. 1459 | ;; ARG is the prefix arg. 1460 | ;; FORCE, if non-nil then delete non-fully merged branches as well. 1461 | ;; (car L) *must* be the *last* (bottommost) branch in the gited buffer. 1462 | ;; That way as changes are made in the buffer they do not shift the 1463 | ;; lines still to be changed, so the (point) values in L stay valid. 1464 | ;; Also, for subdirs in natural order, a subdir's branches are deleted 1465 | ;; before the subdir itself - the other way around would not work. 1466 | (let* ((branches (mapcar (function car) l)) 1467 | (count (length l)) 1468 | (succ 0)) 1469 | ;; canonicalize branch list for pop up 1470 | (if (or gited-expert 1471 | (gited-mark-pop-up 1472 | " *Deletions*" 'delete branches 'y-or-n-p 1473 | (format "%s %s " 1474 | "Delete" 1475 | (replace-regexp-in-string 1476 | "files" 1477 | (if (equal gited-ref-kind "tags") "tags" "branches") 1478 | (dired-mark-prompt arg branches))))) 1479 | (save-excursion 1480 | (let ((progress-reporter 1481 | (make-progress-reporter 1482 | "Deleting..." 1483 | succ count)) 1484 | failures) ;; branches better be in reverse order for this loop! 1485 | (while l 1486 | (goto-char (cdar l)) 1487 | (let ((inhibit-read-only t)) 1488 | (condition-case err 1489 | (let ((fn (caar l)) 1490 | (gited-expert t)) ;; Don't ask confirmation again. 1491 | (if (equal gited-ref-kind "tags") 1492 | (gited-tag-delete fn) 1493 | (gited-delete-branch fn force)) 1494 | ;; if we get here, removing worked 1495 | (cl-incf succ) 1496 | (progress-reporter-update progress-reporter succ)) 1497 | (error ;; catch errors from failed deletions 1498 | (gited-log-msg "%s\n" err) 1499 | (setq failures (cons (caar l) failures))))) 1500 | (setq l (cdr l))) 1501 | (if (not failures) 1502 | (progress-reporter-done progress-reporter) 1503 | (gited-log-summary 1504 | (format "%d of %d deletion%s failed" 1505 | (length failures) count 1506 | (gited-plural-s count)) 1507 | failures)))) 1508 | (message "(No deletions performed)"))) 1509 | (gited-goto-branch gited-current-branch)) 1510 | 1511 | (defun gited-do-flagged-delete (&optional force) 1512 | "In Gited, delete the branches flagged for deletion. 1513 | Optional arg FORCE, if non-nil then delete non-fully merged branches 1514 | as well." 1515 | (interactive "P") 1516 | (let* ((gited-marker-char gited-del-char) 1517 | (regexp (concat "^" (regexp-quote (char-to-string gited-marker-char)))) 1518 | (force (or gited-delete-unmerged-branches force)) 1519 | case-fold-search) 1520 | (unless force 1521 | (gited--check-unmerged-marked-branches gited-del-char)) 1522 | (if (save-excursion (goto-char (point-min)) 1523 | (re-search-forward regexp nil t)) 1524 | (progn 1525 | (gited-internal-do-deletions 1526 | ;; this can't move point since ARG is nil 1527 | (gited-map-over-marks (cons (gited-get-branchname) (point)) 1528 | nil) 1529 | nil force) 1530 | (run-hooks 'gited-after-change-hook)) 1531 | (message "(No deletions requested)")))) 1532 | 1533 | (defun gited-copy-branch (old new &optional commit) 1534 | "Copy branch OLD to branch NEW. 1535 | OLD default to branch at current line. 1536 | 1537 | Optional arg COMMIT, if non-nil then is a SHA1 string or 1538 | HEAD~N, to copy OLD until that commit, inclusive. 1539 | When called with a prefix, prompt for the limit commit: 0 means HEAD, 1540 | 1 means HEAD~, and so on." 1541 | (interactive 1542 | (let* ((old-br (gited-get-branchname)) 1543 | (new-br (read-string 1544 | (format "Copy %s to: " old-br) 1545 | nil nil old-br)) 1546 | (ask current-prefix-arg) 1547 | (num-or-sha1 1548 | (if ask 1549 | (read-string "Show commit (0 = HEAD, 1 = HEAD~1, ... or SHA1): " 1550 | nil nil "0") 1551 | "HEAD"))) 1552 | (list old-br new-br num-or-sha1))) 1553 | (unless commit (setq commit "HEAD")) 1554 | (unless (gited--valid-ref-p commit) 1555 | (setq commit (concat old "~" commit))) 1556 | (let ((cmd1 `("checkout" ,old)) 1557 | (cmd2 `("checkout" "-b" ,new ,commit)) 1558 | (cmd3 `("checkout" ,gited-current-branch))) 1559 | (if (and (zerop (gited-git-command cmd1)) 1560 | (zerop (gited-git-command cmd2)) 1561 | (zerop (gited-git-command cmd3))) 1562 | (progn 1563 | (message "Copied %s to %s!" old new) 1564 | (run-hooks 'gited-after-change-hook) 1565 | (gited-goto-branch new)) 1566 | (error "Cannot copy '%s' to '%s'" old new)))) 1567 | 1568 | 1569 | ;;; Checkout/visit sources. 1570 | 1571 | (defun gited-visit-branch-sources (&optional other-window) 1572 | "Visit source code for current revision. 1573 | If optional arg OTHER-WINDOW is non-nil, then use another window." 1574 | (interactive "P") 1575 | (when (and (gited-modified-files-p) 1576 | (not (equal gited-current-branch (gited-get-branchname)))) 1577 | (user-error "Cannot checkout a new branch: there are modified files")) 1578 | (let* ((branch (gited-get-branchname)) 1579 | (visit-sources 1580 | (y-or-n-p (format "Visit '%s' branch sources? " branch)))) 1581 | (if (not visit-sources) 1582 | (message "OK, canceled") 1583 | (let ((gited-expert visit-sources)) 1584 | (gited-checkout-branch branch) 1585 | (if other-window 1586 | (dired-other-window default-directory) 1587 | (dired default-directory)) 1588 | (dired-revert))))) 1589 | 1590 | (defun gited--fontify-current-row-1 () 1591 | (remove-text-properties 1592 | (point-at-bol) (point-at-eol) '(face)) 1593 | (let ((inhibit-read-only t) pos) 1594 | (save-excursion 1595 | (gited-move-to-author) 1596 | (setq pos (point)) 1597 | (gited-move-to-end-of-author) 1598 | (put-text-property 1599 | pos (point) 'face gited-author-face) 1600 | (gited-move-to-date) 1601 | (setq pos (point)) 1602 | (gited-move-to-end-of-date) 1603 | (put-text-property 1604 | pos (point) 'face gited-date-time-face) 1605 | (gited-move-to-branchname) 1606 | (setq pos (point)) 1607 | (gited-move-to-end-of-branchname) 1608 | (put-text-property 1609 | pos (point) 'face gited-branch-name-face) 1610 | (setq pos (point)) 1611 | (put-text-property 1612 | pos (point-at-eol) 'face gited-commit-msg-face)))) 1613 | 1614 | (defun gited--fontify-current-row (&optional mark) 1615 | "Fontify the current row." 1616 | (let ((marker (or mark (string-to-char (gited-get-mark)))) 1617 | (inhibit-read-only t)) 1618 | (gited-move-to-branchname) 1619 | (remove-text-properties 1620 | (point-at-bol) (point-at-eol) '(face)) 1621 | (cond ((eq marker ?\s) 1622 | (if (string= (gited-get-branchname) 1623 | gited-current-branch) 1624 | (put-text-property 1625 | (point-at-bol) 1626 | (point-at-eol) 1627 | 'face gited-section-highlight-face) 1628 | (gited--fontify-current-row-1))) 1629 | ((eq marker gited-marker-char) 1630 | (put-text-property 1631 | (point-at-bol) (1+ (point-at-bol)) 'face gited-flag-mark-face) 1632 | (put-text-property 1633 | (1+ (point-at-bol)) 1634 | (point-at-eol) 1635 | 'face gited-flag-mark-line-face)) 1636 | ((eq marker gited-del-char) 1637 | (put-text-property 1638 | (point-at-bol) (1+ (point-at-bol)) 'face gited-deletion-face) 1639 | (put-text-property 1640 | (1+ (point-at-bol)) 1641 | (point-at-eol) 1642 | 'face gited-deletion-branch-face))))) 1643 | 1644 | (defun gited-checkout-branch (branch) 1645 | "Checkout BRANCH. 1646 | If the gited buffer lists local branches and BRANCH is not 1647 | local, then prompt for a branch name where to check out BRANCH." 1648 | (interactive 1649 | (list (completing-read "Checkout branch: " 1650 | (gited-all-branches) 1651 | nil 'mustmatch (gited-get-branchname) nil))) 1652 | (when (and (gited-modified-files-p) 1653 | (not (equal gited-current-branch (gited-get-branchname)))) 1654 | (user-error "Cannot checkout a new branch: there are modified files")) 1655 | (let* ((cur-br gited-current-branch) 1656 | (new-branch-p (and (equal gited-ref-kind "local") 1657 | (not (member branch (gited-get-branches))))) 1658 | (inhibit-read-only t) 1659 | (local-branch (if new-branch-p 1660 | (read-string 1661 | "Checkout in local branch: " 1662 | nil nil (file-name-nondirectory branch)) 1663 | branch))) 1664 | (save-excursion 1665 | (gited-goto-branch cur-br) 1666 | ;; Fontify the previous current branch correctly. 1667 | (let ((gited-current-branch "")) (gited--fontify-current-row)) 1668 | (if (not new-branch-p) 1669 | (gited-git-checkout nil branch) 1670 | (gited-git-command `("checkout" "-b" ,local-branch ,branch)) 1671 | (run-hooks 'gited-after-change-hook)) 1672 | (setq gited-current-branch local-branch)) 1673 | (gited-fontify-current-branch) 1674 | (when new-branch-p 1675 | (gited-goto-branch gited-current-branch))) 1676 | (message "Current branch is %s" gited-current-branch)) 1677 | 1678 | 1679 | 1680 | ;;; Apply patches. 1681 | 1682 | (defun gited--patch-or-commit-buffer (&optional commit) 1683 | (let ((regexp 1684 | (if commit 1685 | "\\`\\*gited-commit-\\([0-9]+\\)\\*\\'" 1686 | "\\`\\*gited-patch-\\([0-9]+\\)\\*\\'"))) 1687 | (get-buffer 1688 | (completing-read 1689 | (if commit 1690 | "Use commit message in buffer: " 1691 | "Apply patch from buffer: ") 1692 | (cl-delete-if-not 1693 | (lambda (x) (string-match regexp x)) 1694 | (mapcar #'buffer-name (buffer-list))))))) 1695 | 1696 | (defconst gited-new-or-deleted-files-re 1697 | (format "^\\(%s\\|%s\\|%s\\|%s\\|%s\\|%s\\)" 1698 | "deleted file mode" 1699 | "new file mode" 1700 | "copy from" 1701 | "copy to" 1702 | "rename from" 1703 | "rename to") 1704 | "Regexp to match new or deleted files in a Git diff.") 1705 | 1706 | ;; Currently just handle new files. 1707 | (defun gited--handle-new-or-delete-files (patch-buf) 1708 | (let ((new-files)) 1709 | (goto-char 1) 1710 | (with-current-buffer patch-buf 1711 | (while (re-search-forward gited-new-or-deleted-files-re nil t) 1712 | (unless (or (string= "new file mode" (match-string-no-properties 0)) 1713 | (string= "deleted file mode" (match-string-no-properties 0))) 1714 | (user-error "Only creation/deletion of files is implemented: %s" 1715 | (match-string-no-properties 0))) 1716 | (let* ((str (buffer-substring-no-properties 1717 | (point-at-bol 0) (point-at-eol 0))) 1718 | (file 1719 | (progn 1720 | (string-match "diff --git a/\\(.*\\) b/.*" str) 1721 | (match-string-no-properties 1 str)))) 1722 | (push file new-files)))) 1723 | (if (zerop (gited-git-command `("add" ,@new-files))) 1724 | (message "Sucessfully staged new files: %s" 1725 | (mapconcat #'shell-quote-argument new-files " ")) 1726 | (error "Cannot stage some new files. Please check")))) 1727 | 1728 | (defun gited-apply-patch (buf-patch &optional update) 1729 | "Apply patch at BUF-PATCH into current branch. 1730 | If optional arg UPDATE is non-nil, then call `gited-update' 1731 | after checkout." 1732 | (interactive 1733 | (list (gited--patch-or-commit-buffer) 1734 | current-prefix-arg)) 1735 | (let ((toplevel gited-toplevel-dir) 1736 | create-or-del-files-p) 1737 | (with-temp-buffer 1738 | ;; Apply patches from top-level dir. 1739 | (setq default-directory (file-name-as-directory toplevel)) 1740 | (insert-buffer-substring-no-properties buf-patch) 1741 | (goto-char 1) 1742 | (setq create-or-del-files-p 1743 | (re-search-forward gited-new-or-deleted-files-re nil t)) 1744 | (if (not (zerop (gited-git-command-on-region '("apply" "--check")))) 1745 | (error "Cannot apply patch at '%s'. Please check" 1746 | (buffer-name buf-patch)) 1747 | (gited-git-command-on-region '("apply")) 1748 | (when create-or-del-files-p 1749 | (gited--handle-new-or-delete-files (current-buffer))) 1750 | (and update (gited-update)) 1751 | (message "Patch applied successfully!"))))) 1752 | 1753 | (defun gited-add-patched-files (files &optional _untracked-ok ask) 1754 | "Stage FILES for next commit. 1755 | 1756 | If optional arg UNTRACKED-OK is non-nil, then stage untracked 1757 | files. Otherwise ignore them. 1758 | To always stage untracked files, you can customize the option 1759 | `gited-add-untracked-files'. 1760 | 1761 | If optional arg ASK is non-nil, then prompt the user before 1762 | to add every hunk, and display the output buffer in other window. 1763 | 1764 | Interactively, with a prefix C-u stage the untracked files as well. 1765 | Interactively, with 2 prefices C-u C-u set arg ASK non-nil." 1766 | (interactive 1767 | (let* ((prefix current-prefix-arg) 1768 | (untracked-ok (equal '(4) prefix)) 1769 | (ask (equal '(16) prefix)) 1770 | (files 1771 | (if (or untracked-ok gited-add-untracked-files) 1772 | (nconc (gited-modified-files) (gited-untracked-files)) 1773 | (gited-modified-files)))) 1774 | (list files untracked-ok ask))) 1775 | (if (not files) 1776 | (let ((untracked (gited-untracked-files))) 1777 | (beep) 1778 | (if untracked 1779 | (message "Only untracked files. Call 'C-u %s' to add them." 1780 | (substitute-command-keys "\\[gited-add-patched-files]")) 1781 | (message "No modified files"))) 1782 | (let ((buf (gited--output-buffer))) 1783 | (cond (ask 1784 | ;; Output buffer must be editable. 1785 | (with-current-buffer buf 1786 | (setq buffer-read-only nil) 1787 | (erase-buffer)) 1788 | (gited-async-operation (format "%s add --patch" vc-git-program) 1789 | nil buf) 1790 | (setq gited-op-string "add --patch") 1791 | (display-buffer buf)) 1792 | (t 1793 | (let ((toplevel gited-toplevel-dir)) 1794 | (with-temp-buffer 1795 | ;; Add files from top-level dir. 1796 | (setq default-directory (file-name-as-directory toplevel)) 1797 | (if (not (zerop (gited-git-command `("add" ,@files)))) 1798 | (error "Cannot add files. Please check") 1799 | (message "Successfully added files: %s" 1800 | (mapconcat #'shell-quote-argument files " ")))))))))) 1801 | 1802 | (defun gited-amend-commit (&optional author date) 1803 | "Amend the last commit message. 1804 | If optional arg AUTHOR is non-nil, then update the author 1805 | and keep the original message. 1806 | If optional arg DATE is non-nil, then update just the date 1807 | and keep the original message. 1808 | 1809 | Called with a prefix argument prompt to AUTHOR, and update it. 1810 | Called with a 2 prefices prompts to DATE, and update it." 1811 | (interactive 1812 | (let* ((prefix current-prefix-arg) 1813 | (author (and (equal prefix '(4)) (read-string "Author: " (gited--last-commit-author)))) 1814 | (date (and (equal prefix '(16)) (read-string "Date: " (gited--last-commit-date))))) 1815 | (list author date))) 1816 | (let* ((buf (gited--output-buffer)) 1817 | (msg (and (or author date) (gited--last-commit-msg))) 1818 | (cmd (format "%s commit --amend%s%s%s%s" vc-git-program 1819 | (if msg " -m " "") 1820 | (if msg msg "") 1821 | (if author (concat " --author=" (shell-quote-argument author)) "") 1822 | (if date (concat " --date=" (shell-quote-argument date)) ""))) 1823 | (inhibit-read-only t)) 1824 | (setq gited-output-buffer buf 1825 | gited-op-string 1826 | (format "git commit --amend%s" 1827 | (cond (msg (or (and date " --date") 1828 | (and author " --author"))) 1829 | (t "")))) 1830 | (with-current-buffer buf (erase-buffer)) 1831 | (gited-async-operation cmd))) 1832 | 1833 | (defun gited-commit (comment &optional author) 1834 | "Commit latest changes using COMMENT as the message. 1835 | Optional argument AUTHOR is the author of the commit. 1836 | A prefix argument prompts for AUTHOR." 1837 | (interactive 1838 | (let ((_files (or (gited-modified-files) (user-error "No changes to commit"))) 1839 | (name (and current-prefix-arg (read-string "Author: "))) 1840 | (msg (read-string "Message: "))) 1841 | (list msg name))) 1842 | (or (gited-modified-files) (user-error "No changes to commit")) 1843 | (let* ((buf (generate-new-buffer "*git-commit*")) 1844 | (args 1845 | (delete "" 1846 | `("commit" ,(if author (format "--author=\"%s\"" author) "") 1847 | "-m" 1848 | ,comment)))) 1849 | (unless (zerop (gited-git-command args buf)) 1850 | (display-buffer buf) 1851 | (error "Commit failt: please check %s" (buffer-name buf))) 1852 | (with-current-buffer buf 1853 | (insert (format "\nCommit successfully with message:\n\n\"%s\"" comment))) 1854 | (gited--set-output-buffer-mode buf) 1855 | (display-buffer buf))) 1856 | 1857 | (defun gited-apply-add-and-commit-patch (buf-patch buf-commit) 1858 | "Apply patch at BUF-PATCH, stage it and commit it with message BUF-COMMIT." 1859 | (interactive 1860 | (list 1861 | (gited--patch-or-commit-buffer) 1862 | (gited--patch-or-commit-buffer 'commit))) 1863 | (if (null (ignore-errors (gited-apply-patch buf-patch))) 1864 | (error "Cannot apply patch at %s" (buffer-name buf-patch)) 1865 | (let ((cur-buf (current-buffer))) 1866 | ;; Stage changes. 1867 | (gited-add-patched-files (gited-modified-files)) ; Switch to another buf. 1868 | (switch-to-buffer cur-buf) 1869 | (let* ((commit-msg 1870 | (with-current-buffer buf-commit 1871 | (buffer-string))) 1872 | (args `("commit" "-m" ,commit-msg))) 1873 | (if (zerop (gited-git-command args)) 1874 | (message "Patch applied and committed successfully!") 1875 | (error "Cannot commit patch at %s" (buffer-name buf-patch))))))) 1876 | 1877 | 1878 | 1879 | ;;; Revert a commit. 1880 | ;; Following is inspired `edit-kbd-macro'. 1881 | (defvar gited-original-buffer) 1882 | (defvar gited--revert-commit) 1883 | 1884 | (defvar gited-edit-commit-mode-map 1885 | (let ((map (make-sparse-keymap))) 1886 | (define-key map "\C-c\C-c" 'gited-finish-commit-edit) 1887 | map)) 1888 | 1889 | (defun gited-finish-commit-edit () 1890 | "Finish the revert and commit it." 1891 | (interactive) 1892 | (unless (eq major-mode 'gited-edit-commit-mode) 1893 | (error 1894 | "This command is valid only in buffers created by `gited-edit-commit-mode'")) 1895 | (goto-char 1) 1896 | (while (re-search-forward "^#.* 1897 | ?" nil t) 1898 | (replace-match "")) 1899 | (unless (zerop (gited-git-command `("revert" "--no-commit" ,gited--revert-commit))) 1900 | (error "Cannot revert commit %s" gited--revert-commit)) 1901 | (unless (zerop (gited-git-command `("commit" "-m" ,(buffer-string)))) 1902 | (error "Reverted commit %s but cannot commit the revert" gited--revert-commit)) 1903 | (switch-to-buffer gited-original-buffer) 1904 | (run-hooks 'gited-after-change-hook)) 1905 | 1906 | (defun gited-edit-commit-mode () 1907 | (interactive) 1908 | (user-error "This mode can be enabled only by `gited-edit-commit'")) 1909 | (put 'gited-edit-commit-mode 'mode-class 'special) 1910 | 1911 | (defun gited-edit-commit (commit) 1912 | "Edit message to revert a commit." 1913 | (let ((string (format "Revert '%s'\n\nThis reverts commit %s\n\n%s\n%s\n%s\n" 1914 | (gited--extract-from-commit commit "%s") 1915 | commit 1916 | "# Please enter the commit message for your changes. Lines starting" 1917 | "# with '#' will be ignored, and an empty message aborts the commit." 1918 | "# Press 'C-c C-c' once done to commit. Press C-x k RET to cancel."))) 1919 | (let ((oldbuf (current-buffer)) 1920 | (buf (get-buffer-create "*Edit Commit*"))) 1921 | (switch-to-buffer buf) 1922 | (kill-all-local-variables) 1923 | (use-local-map gited-edit-commit-mode-map) 1924 | (setq buffer-read-only nil) 1925 | (setq major-mode 'gited-edit-commit-mode) 1926 | (setq mode-name "Edit Commit") 1927 | (set (make-local-variable 'gited-original-buffer) oldbuf) 1928 | (set (make-local-variable 'gited--revert-commit) commit) 1929 | (erase-buffer) 1930 | (insert string) 1931 | (recenter '(4))))) 1932 | 1933 | ;; FIXME: Probably this should be (&rest commits) not just one commit. 1934 | (defun gited-revert-commit (commit) 1935 | "Revert COMMIT." 1936 | (interactive 1937 | (let ((last-commit 1938 | (with-temp-buffer 1939 | (gited-git-command '("rev-parse" "HEAD") (current-buffer)) 1940 | (buffer-substring 1 (1- (point-max)))))) 1941 | (list (read-string "Revert commit: " last-commit)))) 1942 | (gited-edit-commit commit)) 1943 | 1944 | ;;; Common operations on Git repositiores: pull, diff, log, etc. 1945 | 1946 | (defun gited-number-of-commits () 1947 | "Return number of Git commits in current buffer." 1948 | (let ((regexp "^commit[:]? \\([[:xdigit:]]+\\)")) 1949 | (save-excursion 1950 | (goto-char (point-min)) 1951 | (let ((count 0)) 1952 | (while (re-search-forward regexp nil t) 1953 | (cl-incf count)) 1954 | (if (called-interactively-p 'interactive) 1955 | (message "%d commits in current buffer" count) 1956 | count))))) 1957 | 1958 | (defun gited--case-ref-kind () 1959 | (pcase gited-ref-kind 1960 | ("remote" "remotes/") 1961 | ("local" "heads/") 1962 | ("tags" "tags/") 1963 | (_ (user-error "Unsupported gited-ref-kind: must be local, remote or tags")))) 1964 | 1965 | (defun gited--set-output-buffer-mode (buffer &optional mode editable) 1966 | (let ((win (get-buffer-window buffer))) 1967 | (when win (set-window-point win (point-min)))) 1968 | (with-current-buffer buffer 1969 | (goto-char (point-min)) 1970 | (set-buffer-modified-p nil) 1971 | (or editable (setq buffer-read-only t)) 1972 | (pcase mode 1973 | (`diff (diff-mode)) 1974 | (`outline (outline-mode)) 1975 | (_ (fundamental-mode))))) 1976 | 1977 | (defun gited-diff (ref) 1978 | "Show diff of REF with another ref. 1979 | REF defaults to the branch at current line. 1980 | 1981 | The actual diff run is: 1982 | diff OLD-REF REF." 1983 | (interactive 1984 | (list (gited-get-branchname))) 1985 | (let ((old-ref 1986 | (completing-read (format "Diff %s with: " ref) 1987 | (gited-listed-branches) 1988 | nil nil (if (equal ref gited-current-branch) 1989 | (concat gited-current-branch "^") 1990 | gited-current-branch))) 1991 | (buf (gited--output-buffer))) 1992 | (setq gited-output-buffer buf) 1993 | (with-current-buffer buf 1994 | (let ((inhibit-read-only t)) 1995 | (erase-buffer) 1996 | (gited-git-command `("diff" ,old-ref ,ref "--") (current-buffer))) 1997 | (display-buffer buf)) 1998 | (gited--set-output-buffer-mode buf 'diff))) 1999 | 2000 | (defun gited--valid-ref-p (str) 2001 | ;; Explicitely reject when STR is just a digit, like "0", "1", "2", etc. 2002 | ;; For some repositories `git rev-parse 1' might returns success, with 2003 | ;; that reference pointing to something different that HEAD~1. 2004 | (unless (string-match "\\`[0-9]+\\'" str) 2005 | (let ((args `("rev-parse" ,str))) 2006 | (zerop (gited-git-command args))))) 2007 | 2008 | (defun gited-show-commit (branch &optional commit) 2009 | "Show a commit of BRANCH. 2010 | BRANCH default to the branch at current line. 2011 | 2012 | Optional arg COMMIT, if non-nil then is a SHA1 string or 2013 | HEAD~N, to indicate which commit to display. 2014 | Interactively prompt for the limit commit: 0 means HEAD, 2015 | 1 means HEAD~, and so on." 2016 | (interactive 2017 | (let* ((branch (gited-get-branchname)) 2018 | (num-or-sha1 2019 | (read-string "Show commit (0 = HEAD, 1 = HEAD~1, ... or SHA1): " 2020 | nil nil "0"))) 2021 | (list branch num-or-sha1))) 2022 | (let ((buf (gited--output-buffer)) 2023 | (args (if (gited--valid-ref-p commit) 2024 | `("show" ,commit) 2025 | (list "show" (concat (gited--case-ref-kind) 2026 | branch "~" commit))))) 2027 | (setq gited-output-buffer buf) 2028 | (with-current-buffer buf 2029 | (let ((inhibit-read-only t)) 2030 | (erase-buffer) 2031 | (gited-git-command args (current-buffer))) 2032 | (display-buffer buf)) 2033 | (gited--set-output-buffer-mode buf 'diff))) 2034 | 2035 | (defun gited-status () 2036 | "Show repository status. 2037 | If `magit' is installed, then this calls `magit-status'. Otherwise, 2038 | show similar info as that command." 2039 | (interactive) 2040 | (let ((buf (gited--output-buffer)) 2041 | (branch gited-current-branch) 2042 | (gited-buf gited-buffer)) 2043 | (setq gited-output-buffer buf) 2044 | (if (ignore-errors (find-library-name "magit")) 2045 | (with-no-warnings (magit-status-internal default-directory)) 2046 | (with-current-buffer buf 2047 | (let ((inhibit-read-only t) 2048 | (untracked (gited-untracked-files)) 2049 | (unstaged (gited-modified-files)) 2050 | (bisectingp (gited-bisecting-p)) 2051 | (stashes (gited-stashes))) 2052 | (erase-buffer) 2053 | ;; (outline-mode) 2054 | (insert (format "Head: %s %s\n" 2055 | (propertize branch 2056 | 'font-lock-face 'gited-status-branch-local) 2057 | (gited--last-commit-title))) 2058 | ;; (insert (format "Tag: %s (%s)\n" tag tag-id)) 2059 | (when bisectingp 2060 | (insert (format "\n%s\nCall C-u C-u %s to reset\n" 2061 | (propertize 2062 | "You are bisecting:" 2063 | 'font-lock-face 'gited-status-tag) 2064 | (with-current-buffer gited-buf 2065 | (substitute-command-keys "\\[gited-bisect]")))) 2066 | (let ((nentries -1) 2067 | bad-commit res) 2068 | (with-temp-buffer 2069 | (gited-git-command '("bisect" "log") (current-buffer)) 2070 | (goto-char (point-min)) 2071 | (save-excursion 2072 | (when (re-search-forward 2073 | "# first bad commit: \\[\\([[:xdigit:]]+\\)\\]" 2074 | nil t) 2075 | (setq bad-commit (match-string-no-properties 1)))) 2076 | (while (re-search-forward "^[^#]+$" nil t) 2077 | (push (buffer-substring-no-properties (point-at-bol) (point)) 2078 | res)) 2079 | (setq res (nreverse res) nentries (length res))) 2080 | (insert (format "\n%s (%d)\n" 2081 | (propertize 2082 | "Bisect Log:" 2083 | 'font-lock-face 'gited-status-tag) 2084 | (1+ nentries))) 2085 | (while res 2086 | (insert (concat (pop res) "\n"))) 2087 | (when bad-commit 2088 | (insert (concat bad-commit " is the first bad commit\n"))))) 2089 | (when untracked 2090 | (insert (format "\n%s (%d)\n" 2091 | (propertize "Untracked files" 2092 | 'font-lock-face 'gited-status-tag) 2093 | (length untracked))) 2094 | (insert (mapconcat 'identity untracked "\n"))) 2095 | (when unstaged 2096 | (insert (format "\n\n%s (%d)\n" 2097 | (propertize "Unstaged changes" 2098 | 'font-lock-face 'gited-status-tag) 2099 | (length unstaged))) 2100 | (insert (mapconcat 'identity unstaged "\n"))) 2101 | (when stashes 2102 | (insert (format "\n\n%s (%d)\n" 2103 | (propertize "Stashes" 2104 | 'font-lock-face 'gited-status-tag) 2105 | (length stashes))) 2106 | (insert (mapconcat 'identity stashes "\n"))) 2107 | (display-buffer buf) 2108 | (gited--set-output-buffer-mode buf 'outline)))))) 2109 | 2110 | (defun gited-pull () 2111 | "Pull from current remote repository." 2112 | (interactive) 2113 | (if (not (or gited-expert 2114 | (y-or-n-p (format "Pull from remote repository '%s'? " 2115 | gited-current-remote-rep)))) 2116 | (message "OK, pull canceled") 2117 | (let ((buf (gited--output-buffer)) 2118 | (last-trunk-commit (gited--last-trunk-commit)) 2119 | (cmd (format "%s pull %s" 2120 | vc-git-program 2121 | gited-current-remote-rep)) 2122 | (inhibit-read-only t)) 2123 | (setq gited-output-buffer buf 2124 | gited-op-string cmd) 2125 | (with-current-buffer buf (erase-buffer)) 2126 | (setq gited-last-trunk-commit last-trunk-commit) 2127 | (gited-async-operation cmd 'remote-op-p nil #'gited-pull-callback)))) 2128 | 2129 | (defun gited-push (&optional force-with-lease) 2130 | "Run git push in current branch. 2131 | If optional arg FORCE-WITH-LEASE is non-nil, then use Git flag 2132 | --force-with-lease. Otherwise, reject the pull if the remote 2133 | ref is not ancestor of the local ref." 2134 | (interactive "P") 2135 | (if (not (or gited-expert 2136 | (y-or-n-p (format "Push '%s' branch? " 2137 | gited-current-branch)))) 2138 | (message "OK, push canceled") 2139 | (let ((buf (gited--output-buffer)) 2140 | (cmd (format "%s push %s %s %s" 2141 | vc-git-program gited-current-remote-rep (gited-current-branch) 2142 | (if force-with-lease "--force-with-lease" "")))) 2143 | (setq gited-output-buffer buf 2144 | gited-op-string cmd) 2145 | (with-current-buffer buf 2146 | (setq buffer-read-only nil) ; Editable, they can ask username. 2147 | (erase-buffer)) 2148 | (gited-async-operation cmd 'remote-op-p)))) 2149 | 2150 | (defun gited-set-object-upstream (object) 2151 | "Push OBJECT to origin. 2152 | OBJECT is a local branch or tag." 2153 | (interactive 2154 | (list (gited-get-branchname))) 2155 | (when (string= gited-ref-kind "remote") 2156 | (user-error "Gited should be listing local branches or tags")) 2157 | (if (not (or gited-expert 2158 | (y-or-n-p (format "Push '%s' %s upstream? " 2159 | (if (equal gited-ref-kind "local") "branch" "tag") 2160 | object)))) 2161 | (message "OK, push canceled") 2162 | (let ((buf (gited--output-buffer)) 2163 | (cmd (format "%s push %sorigin %s%s" 2164 | vc-git-program 2165 | (if (equal gited-ref-kind "local") "--set-upstream " "") 2166 | (if (equal gited-ref-kind "local") "" "tag ") 2167 | object)) 2168 | (inhibit-read-only t)) 2169 | (setq gited-output-buffer buf 2170 | gited-op-string (format "Set %s '%s' upstream" 2171 | (if (equal gited-ref-kind "local") "branch" "tag ") 2172 | object)) 2173 | (with-current-buffer buf 2174 | (setq buffer-read-only nil) ; Editable, they can ask username. 2175 | (erase-buffer)) 2176 | (gited-async-operation cmd 'remote-op-p)))) 2177 | 2178 | (defun gited-origin (branch &optional no-display) 2179 | "Run git log origin..BRANCH. 2180 | BRANCH defaults to the branch at point. 2181 | If optional arg NO-DISPLAY is non-nil, then don't display the 2182 | output buffer. 2183 | Return output buffer. 2184 | 2185 | Note that this command only has sense if you have a remote branch 2186 | called origin in your Git configuration. Otherwise, if you wish to 2187 | see the newest N commits then use `\\[gited-log-last-n-commits\]'." 2188 | (interactive 2189 | (list (gited-get-branchname) current-prefix-arg)) 2190 | (unless (string= gited-ref-kind "local") 2191 | (user-error "Not listing local branches")) 2192 | (unless (gited-remote-repository-p) 2193 | (user-error "Not a remote repository. Try '%s' or '%s'" 2194 | (substitute-command-keys "\\[gited-log\]") 2195 | (substitute-command-keys "\\[gited-log-last-n-commits\]"))) 2196 | (let ((buf (gited--output-buffer)) 2197 | (args (list "log" (concat "origin.." (gited--case-ref-kind) branch))) 2198 | (gited-buf gited-buffer) count) 2199 | (setq gited-output-buffer buf) 2200 | (with-current-buffer buf 2201 | (let ((inhibit-read-only t) res) 2202 | (erase-buffer) 2203 | (setq res (gited-git-command args (current-buffer))) 2204 | (unless (zerop res) 2205 | (with-current-buffer gited-buf 2206 | (error "Command 'git log origin..BRANCH' fails. Try '%s' or '%s'" 2207 | (substitute-command-keys "\\[gited-log\]") 2208 | (substitute-command-keys "\\[gited-log-last-n-commits\]")))) 2209 | (goto-char (point-min))) 2210 | (setq count (gited-number-of-commits)) 2211 | (or no-display (display-buffer buf))) 2212 | (gited--set-output-buffer-mode buf 'diff) 2213 | (message "%d commit%s in '%s'" 2214 | count (if (> count 1) "s" "") (buffer-name buf)) 2215 | buf)) 2216 | 2217 | (defun gited-log (branch start-date end-date &optional short) 2218 | "Show Git log for BRANCH between START-DATE and END-DATE. 2219 | If optional arg SHORT is non-nil, then use a short format. 2220 | 2221 | Interactively, prompt for START-DATE and END-DATE." 2222 | (interactive 2223 | (let* ((branch (gited-get-branchname)) 2224 | (last-commit-time 2225 | (gited-get-last-commit-time branch)) 2226 | (default 2227 | (format-time-string 2228 | "%F" 2229 | (time-subtract 2230 | last-commit-time 2231 | (days-to-time 7)))) 2232 | (start (read-string "start-date: " default nil nil nil)) 2233 | (default (format-time-string "%F")) 2234 | (end (read-string "end-date: " default nil nil nil))) 2235 | (list branch start end current-prefix-arg))) 2236 | (let ((buf (gited--output-buffer)) 2237 | (args (append (if short gited-short-log-cmd '("log")) 2238 | (list (concat (gited--case-ref-kind) branch))))) 2239 | (setq gited-output-buffer buf) 2240 | (with-current-buffer buf 2241 | (let ((inhibit-read-only t)) 2242 | (erase-buffer) 2243 | (setq args (append args 2244 | (list (format "--after=\"%s\"" start-date)) 2245 | (list (format "--before=\"%s\"" end-date)))) 2246 | (gited-git-command args buf)) 2247 | (display-buffer buf)) 2248 | (gited--set-output-buffer-mode buf 'outline))) 2249 | 2250 | (defun gited-log-last-n-commits (branch n &optional short) 2251 | "Show newest N log entries for BRANCH. 2252 | When N is of the form N1-N2, then skip the N1 newest log entries 2253 | and show the remaining newest N2 entries. 2254 | The actual command run in this case is as follows: 2255 | git-log --skip=N1 --max-count=N2. 2256 | If optional arg SHORT is non-nil use a short format." 2257 | (interactive 2258 | (list (gited-get-branchname) 2259 | (read-string "Show newest N commits, or those in (N1, N1 + N2]: " 2260 | nil nil "1") 2261 | current-prefix-arg)) 2262 | (let ((buf (gited--output-buffer))) 2263 | (setq gited-output-buffer buf) 2264 | (with-current-buffer buf 2265 | (let* ((inhibit-read-only t) 2266 | (skip (and (string-match "\\([0-9]+\\)-\\([0-9]+\\)" n) 2267 | (string-to-number (match-string-no-properties 1 n)))) 2268 | (max (string-to-number (if skip (match-string-no-properties 2 n) n))) 2269 | (args (append (if short gited-short-log-cmd '("log")) 2270 | (and skip (list (format "--skip=%d" skip))) 2271 | (list (format "--max-count=%d" max)) 2272 | (list branch)))) 2273 | (erase-buffer) 2274 | (gited-git-command args buf)) 2275 | (display-buffer buf)) 2276 | (gited--set-output-buffer-mode buf 'outline))) 2277 | 2278 | ;;; Extract patches 2279 | 2280 | (defun gited--clean-previous-patches () 2281 | (mapc (lambda (x) 2282 | (when (buffer-live-p x) 2283 | (kill-buffer x))) 2284 | (nconc 2285 | (gited--get-patch-or-commit-buffers) 2286 | (gited--get-patch-or-commit-buffers 'commit)))) 2287 | 2288 | (defun gited-extract-patches (n &optional origin write-file) 2289 | "Extract the patches from the N newest commits. 2290 | Optional arg ORIGIN, means extract the patches from all commits accesible 2291 | from the trunk, and not being in the trunk. 2292 | Optional arg WRITE-FILE if non-nil, then write the patches to disk." 2293 | (interactive 2294 | (let* ((prefix current-prefix-arg) 2295 | (num (unless prefix 2296 | (read-string "Extract N newest patches: " 2297 | nil nil "1"))) 2298 | (from-origin (and prefix (equal prefix '(4)))) 2299 | (write (and prefix (equal prefix '(16))))) 2300 | (list num from-origin write))) 2301 | (let* ((branch (gited-get-branchname)) 2302 | (buffer (if origin 2303 | (gited-origin branch 'no-display) 2304 | (gited-log-last-n-commits branch n) 2305 | gited-output-buffer)) 2306 | num-commits count) 2307 | (with-current-buffer buffer 2308 | (if (zerop (buffer-size)) 2309 | (user-error "No new patches") 2310 | ;; Previous patch buffers must be deleted. 2311 | (gited--clean-previous-patches) 2312 | (save-excursion 2313 | (goto-char (point-min)) 2314 | (setq num-commits (gited-number-of-commits) 2315 | count num-commits)))) 2316 | ;; Following form must be evalled with branch temporary current. 2317 | (gited-with-current-branch branch 2318 | (dotimes (i num-commits) 2319 | (let ((buf-patch (get-buffer-create (format "*gited-patch-%d*" count))) 2320 | (buf-commit (get-buffer-create 2321 | (format "*gited-commit-%d*" count)))) 2322 | (with-current-buffer buf-patch 2323 | (gited-git-command 2324 | `("format-patch" "-1" ,(format "HEAD~%d" i) "--stdout") 2325 | (current-buffer)) 2326 | (gited--set-output-buffer-mode (current-buffer) 'diff 'editable)) 2327 | (with-current-buffer buf-commit 2328 | (gited-git-command `("show" "-s" "--format=%B" ,(format "HEAD~%d" i)) 2329 | (current-buffer)) 2330 | (while (looking-at "^$") ; Delete empty lines. 2331 | (delete-char -1))) 2332 | (when write-file 2333 | (with-temp-file (expand-file-name 2334 | (substring (buffer-name buf-patch) 1 -1) 2335 | temporary-file-directory) 2336 | (insert 2337 | (with-current-buffer buf-patch 2338 | (buffer-string))))) 2339 | (cl-decf count)))) 2340 | (if write-file 2341 | (message "Extracted %d patches and saved in %s" 2342 | num-commits temporary-file-directory) 2343 | (message "Extracted %d patches" num-commits))) t) 2344 | 2345 | (defun gited--get-patch-or-commit-buffers (&optional commit) 2346 | (let ((regexp 2347 | (if commit 2348 | "\\`\\*gited-commit-\\([0-9]+\\)\\*\\'" 2349 | "\\`\\*gited-patch-\\([0-9]+\\)\\*\\'"))) 2350 | (sort 2351 | (cl-delete-if-not 2352 | (lambda (x) 2353 | (string-match regexp (buffer-name x))) 2354 | (buffer-list)) 2355 | (lambda (x y) 2356 | (string< (buffer-name x) (buffer-name y))) 2357 | ))) 2358 | 2359 | (defun gited--sync-with-trunk-target-name (&optional branch) 2360 | (unless branch (setq branch (gited-get-branchname))) 2361 | (if (string-match "-new\\([0-9]*\\)\\'" branch) 2362 | (format "%s%d" (substring branch 0 (match-beginning 1)) 2363 | (1+ (string-to-number (match-string-no-properties 1 branch)))) 2364 | (concat branch "-new1"))) 2365 | 2366 | (defun gited-sync-with-trunk (branch-target) 2367 | "Extract latest patches in branch at point and apply then into BRANCH-TARGET. 2368 | BRANCH-TARGET is a new branch copied from (gited-trunk-branch). 2369 | 2370 | The effect is similar than merge the branch at point with the trunk; 2371 | one difference is that we don't modify the trunk, instead we copy it; 2372 | another difference is that we don't get a 'Merge branch...' commit in the log. 2373 | This command sets BRANCH-TARGET current." 2374 | (interactive 2375 | (let* ((br (gited-get-branchname)) 2376 | (prompt 2377 | (format "Syncronized '%s' into new branch: " br)) 2378 | (def (gited--sync-with-trunk-target-name br))) 2379 | (list 2380 | (completing-read prompt 2381 | (gited-listed-branches) 2382 | nil nil def)))) 2383 | ;; Previous patch buffers must be deleted. 2384 | (gited--clean-previous-patches) 2385 | (unless (gited-remote-repository-p) 2386 | (user-error "This command only works for repositories \ 2387 | tracking a remote repository")) 2388 | (when (gited-branch-exists-p branch-target) 2389 | (user-error "Branch '%s' already exists" branch-target)) 2390 | (if (null (ignore-errors (gited-extract-patches nil t))) 2391 | (user-error "No new patches to apply") 2392 | ;; If branch-target doesn't exists create it as copy of master. 2393 | (unless (member branch-target (gited-listed-branches)) 2394 | (cond ((gited-trunk-branches) 2395 | (gited-copy-branch (gited-trunk-branch) branch-target)) 2396 | (t (user-error "I don't know what is your master branch")))) 2397 | (let (num-commits) 2398 | (gited-with-current-branch branch-target 2399 | (let* ((buf-patches 2400 | (gited--get-patch-or-commit-buffers)) 2401 | (buf-commits 2402 | (gited--get-patch-or-commit-buffers 'commit))) 2403 | (setq num-commits (length buf-patches)) 2404 | (while buf-patches 2405 | (gited-apply-add-and-commit-patch (car buf-patches) 2406 | (car buf-commits)) 2407 | (setq buf-patches (cdr buf-patches) 2408 | buf-commits (cdr buf-commits))))) 2409 | (gited-checkout-branch branch-target) 2410 | (message "Successfully applied and committed %d commits!" 2411 | num-commits)))) 2412 | 2413 | ;; FIXME: This command changes the current branch. Should be preserved? 2414 | (defun gited-do-sync-with-trunk (&optional dont-ask) 2415 | "Run `gited-sync-with-trunk' in the marked branches. 2416 | If optional arg DONT-ASK is non-nil, then do not prompt user for the 2417 | target branch. Otherwise, prompt user. 2418 | If no marked files use the branch at point. 2419 | Called interactively with a prefix set DONT-ASK to non-nil." 2420 | (interactive "P") 2421 | (dolist (br (or (gited-get-marked-branches) (list (gited-get-branchname)))) 2422 | (let* ((prompt 2423 | (format "Syncronized '%s' into new branch: " br)) 2424 | (def (gited--sync-with-trunk-target-name br)) 2425 | (target 2426 | (if dont-ask def 2427 | (completing-read 2428 | prompt (gited-listed-branches) 2429 | nil nil def)))) 2430 | (gited-goto-branch br) 2431 | (gited-sync-with-trunk target))) 2432 | (gited-update)) 2433 | 2434 | (defun gited-bisecting-p () 2435 | "Return non-nil if a Git bisect is on process." 2436 | (zerop (gited-git-command '("bisect" "log")))) 2437 | 2438 | (defun gited--bisect-executable-p (command) 2439 | (let ((file (car (split-string command)))) 2440 | (unless (file-executable-p file) 2441 | (user-error "File '%s' not executable" file)))) 2442 | 2443 | (defun gited--bisect-after-run (buffer) 2444 | (let ((regexp "^[[:xdigit:]]+ is the first bad commit") 2445 | pos window) 2446 | (gited--set-output-buffer-mode buffer) 2447 | (with-current-buffer buffer 2448 | (save-excursion 2449 | (goto-char (point-min)) 2450 | (when (re-search-forward regexp nil t) 2451 | (setq pos (match-beginning 0)) 2452 | (put-text-property (match-beginning 0) 2453 | (match-end 0) 2454 | 'font-lock-face 'gited-status-tag)))) 2455 | (setq window (display-buffer buffer)) 2456 | (when pos (set-window-point window pos)))) 2457 | 2458 | (defun gited-bisect (&optional script reset) 2459 | "Execute a Git bisect. 2460 | Optional arg SCRIPT if non-nil, then is a script to pass to 2461 | git bisect run. 2462 | Optional arg RESET if non-nil, then means abort the current bisect. 2463 | Interactively, a prefix 'C-u' prompts for SCRIPT; a prefix 'C-u C-u' 2464 | set RESET non-nil." 2465 | (interactive 2466 | (let ((prefix current-prefix-arg)) 2467 | (list (equal prefix '(4)) 2468 | (equal prefix '(16))))) 2469 | (let ((bisectingp (gited-bisecting-p)) 2470 | (obuf (gited--output-buffer gited-bisect-buf-name)) 2471 | (branch (gited-get-branchname))) 2472 | ;; Ensure output buffer is editable. 2473 | (with-current-buffer obuf (setq buffer-read-only nil)) 2474 | (cond (reset 2475 | (if (not bisectingp) 2476 | (message "Not bisecting. Nothing to do") 2477 | (setq gited--running-async-op nil) 2478 | (gited-git-command '("bisect" "reset") obuf) 2479 | (message "Successfully reseted git bisect!"))) 2480 | ((not bisectingp) 2481 | (with-current-buffer obuf 2482 | (erase-buffer)) 2483 | (let ((bad (read-string "Start bisect with bad/new revision: " 2484 | nil nil branch)) 2485 | (good (read-string "Good/Old revision: " nil nil branch)) 2486 | (cmd (and script 2487 | (read-shell-command "Bisect shell command: ")))) 2488 | (and cmd 2489 | (gited--bisect-executable-p cmd)) ; File must be executable. 2490 | (gited-git-command `("bisect" "start" ,bad ,good) obuf) 2491 | (when cmd 2492 | ;; (when (zerop (gited-git-command `("bisect" "run" ,cmd) obuf)) 2493 | ;; (gited--bisect-after-run obuf)) 2494 | (gited-async-operation 2495 | (format "%s bisect run %s" vc-git-program cmd) nil obuf) 2496 | (setq gited-op-string "bisect run")) 2497 | (display-buffer obuf))) 2498 | ((and bisectingp script) 2499 | (let ((cmd 2500 | (and script (read-shell-command "Bisect shell command: ")))) 2501 | (and cmd 2502 | (gited--bisect-executable-p cmd)) ; File must be executable. 2503 | ;; (when (zerop (gited-git-command `("bisect" "run" ,cmd) obuf)) 2504 | ;; (gited--bisect-after-run obuf)) 2505 | (gited-async-operation 2506 | (format "%s bisect run %s" vc-git-program cmd) nil obuf) 2507 | (setq gited-op-string "bisect run")) 2508 | (display-buffer obuf)) 2509 | (t 2510 | (let* ((is-badp (y-or-n-p "Is current revision Bad/New? ")) 2511 | (is-goodp (and (not is-badp) 2512 | (y-or-n-p "Is current revision Good/Old? "))) 2513 | (skip (and (not (or is-badp is-goodp)) 2514 | (y-or-n-p "Do you want to skip this commit? "))) 2515 | (args 2516 | (cond (is-badp '("bisect" "bad")) 2517 | (is-goodp '("bisect" "good")) 2518 | (skip '("bisect" "skip")) 2519 | (t (user-error "Commit should be either bad, \ 2520 | good or skip"))))) 2521 | (gited-git-command args obuf) 2522 | (display-buffer obuf)))))) 2523 | 2524 | 2525 | ;;; Git Stash commands. 2526 | (defun gited-stash (&optional untracked) 2527 | "Stash the changes in a dirty working directory away. 2528 | If called with prefix argument, then include untracked files. With two 2529 | prefix arguments includes the ignored files as well." 2530 | (interactive 2531 | (let ((prefix current-prefix-arg)) 2532 | (list (cond ((and prefix (equal prefix '(4))) "--include-untracked") 2533 | ((and prefix (equal prefix '(16))) "--all"))))) 2534 | (let* ((msg (read-string 2535 | "Stash message: " 2536 | (format "WIP on %s: " (gited-current-branch)))) 2537 | (args (append '("stash") '("save") `(,msg) 2538 | (and untracked `(,untracked))))) 2539 | (gited-git-command args))) 2540 | 2541 | (defun gited-stash-apply () 2542 | "Apply a stash to the working tree." 2543 | (interactive) 2544 | (if (null (gited-stashes)) 2545 | (message "Empty stash list") 2546 | (let* ((stash 2547 | (read-string "Apply stash: " nil nil "stash@{0}")) 2548 | (args `("stash" "apply" ,stash))) 2549 | (gited-git-command args)))) 2550 | 2551 | (defun gited-stash-pop () 2552 | "Apply a stash to the working tree and remove it from stash list." 2553 | (interactive) 2554 | (if (null (gited-stashes)) 2555 | (message "Empty stash list") 2556 | (let* ((stash 2557 | (read-string "Apply pop: " nil nil "stash@{0}")) 2558 | (args `("stash" "pop" ,stash))) 2559 | (gited-git-command args)))) 2560 | 2561 | (defun gited--stash-branch () 2562 | (cond ((null (gited-stashes)) 2563 | (user-error "Empty stash list")) 2564 | ((gited-modified-files) 2565 | (user-error "Commit your local changes before you switch branches")) 2566 | (t))) 2567 | 2568 | (defun gited-stash-branch (branch stash) 2569 | "Create and checkout a new BRANCH from STASH." 2570 | (interactive 2571 | (let ((stash 2572 | (and (gited--stash-branch) 2573 | (read-string "Branch stash: " nil nil "stash@{0}"))) 2574 | (br (read-string "Branch name: "))) 2575 | (list br stash))) 2576 | (when (gited--stash-branch) 2577 | (let ((args `("stash" "branch" ,branch ,stash))) 2578 | (if (not (zerop (gited-git-command args))) 2579 | (error "Cannot apply stash in branch '%s'. Please check" branch) 2580 | (gited-update))))) 2581 | 2582 | (defun gited-stash-drop () 2583 | "Remove a stash from the stash list." 2584 | (interactive) 2585 | (if (null (gited-stashes)) 2586 | (message "Empty stash list") 2587 | (let* ((stash 2588 | (read-string "Drop stash: " nil nil "stash@{0}")) 2589 | (args `("stash" "drop" ,stash))) 2590 | (gited-git-command args)))) 2591 | 2592 | (defun gited-branch-clear () 2593 | "Remove all stashes from the stash list." 2594 | (interactive) 2595 | (if (null (gited-stashes)) 2596 | (message "Empty stash list") 2597 | (if (y-or-n-p "Remove all stashes? ") 2598 | (gited-git-command '("stash" "clear")) 2599 | (message "OK, canceled")))) 2600 | 2601 | (defalias 'gited-delete-all-stashes 'gited-branch-clear) 2602 | 2603 | 2604 | ;;; Commands handling tags. 2605 | (defun gited-tag-add (name commit &optional arg) 2606 | "Create a new tag with name NAME at COMMIT. 2607 | Called with a prefix argument C-u, annotate the tag. 2608 | Called with a numeric prefix ARG > 0, make a GPG-signed tag using the default 2609 | e-mail address's key. 2610 | Called with a numeric prefix ARG < 0, prompt for the key and make a GPG-signed tag." 2611 | (interactive 2612 | (let ((commit (gited-get-branchname)) 2613 | (name (read-string "Tag name: "))) 2614 | (list name commit current-prefix-arg))) 2615 | (let* ((num (prefix-numeric-value arg)) 2616 | (buf (gited--output-buffer)) 2617 | (args (list "tag" 2618 | (cond ((consp arg) "--annotate") 2619 | ((and arg (> num 0)) "--sign") 2620 | ((and arg (< num 0)) (concat "-u" (read-string "Key-id: ")))) 2621 | name commit))) 2622 | (with-current-buffer buf (setq buffer-read-only nil)) 2623 | (gited-async-operation 2624 | (mapconcat 'identity (append (list vc-git-program) (delq nil args)) " ") 2625 | nil buf) 2626 | (setq gited-op-string (format "Add '%s' tag" name)))) 2627 | 2628 | (defun gited-tag-delete (name) 2629 | "Delete local tag NAME. 2630 | This does not delete the remote tag with same name. 2631 | 2632 | After this command, you can fetch the remote tag again with: 2633 | \\[gited-fetch-remote-tags\]." 2634 | (interactive (list (gited-get-branchname))) 2635 | (let ((buf (gited--output-buffer))) 2636 | (with-current-buffer buf (setq buffer-read-only nil)) 2637 | (if (zerop (gited-git-command `("tag" "-d" ,name) buf)) 2638 | (run-hooks 'gited-after-change-hook) 2639 | (error "Cannot delete tag. Please check")))) 2640 | 2641 | (defun gited-fetch-remote-tags () 2642 | "Call `gited-remote-prune' and update the Gited buffer. 2643 | If the Gited buffer is listing tags and you have deleted a local 2644 | tag TAG hat also exists remotely, then after this command a 2645 | local TAG is recreated." 2646 | (interactive) 2647 | (gited-remote-prune) 2648 | (gited-update)) 2649 | 2650 | (defun gited-remote-tag-delete (name) 2651 | "Delete remote tag NAME. 2652 | This does not delete the local tag with same name." 2653 | (interactive (list (gited-get-branchname))) 2654 | (let ((remote-tags (gited-remote-tags))) 2655 | (unless (member name remote-tags) 2656 | (user-error "Tag '%s' is local" name)) 2657 | (if (not (or gited-expert 2658 | (y-or-n-p (format "Delete remote tag '%s' " name)))) 2659 | (message "OK, push canceled") 2660 | (let ((buf (gited--output-buffer)) 2661 | (cmd (format "%s push origin :%s" vc-git-program name)) 2662 | (inhibit-read-only t)) 2663 | (setq gited-output-buffer buf 2664 | gited-op-string (format "Delete remote tag '%s'" name)) 2665 | (with-current-buffer buf 2666 | (setq buffer-read-only nil) ; Editable, they can ask username. 2667 | (erase-buffer)) 2668 | (gited-async-operation cmd 'remote-op-p))))) 2669 | 2670 | (defun gited-remote-tags () 2671 | "Return list of remote tags." 2672 | (let ((buf (gited--output-buffer)) res) 2673 | (with-current-buffer buf (erase-buffer)) 2674 | (message "Collecting remote tags...") 2675 | (gited-git-command '("ls-remote" "--tags") buf) 2676 | (with-current-buffer buf 2677 | (goto-char 1) 2678 | (while (re-search-forward "refs/tags/\\(.*\\)" nil t) 2679 | (let ((match (match-string-no-properties 1))) 2680 | (unless (string-match-p "\\^{}$" match) 2681 | (push match res))))) 2682 | (message "Done!") 2683 | (nreverse res))) 2684 | 2685 | (defun gited-mark-local-tags () 2686 | "Return list of local tags. 2687 | These are tags that only exist in the local repository." 2688 | (interactive) 2689 | (if (not (equal gited-ref-kind "tags")) 2690 | (user-error "Not listing tags") 2691 | (let* ((tags (gited-listed-branches)) 2692 | (remote-tags (gited-remote-tags)) 2693 | (local-tags (cl-set-difference tags remote-tags :test 'string=))) 2694 | (gited-mark-if 2695 | (and (not (eolp)) 2696 | local-tags 2697 | (let* ((fn (gited-get-branchname)) 2698 | (localp (and (member fn local-tags)))) 2699 | (prog1 2700 | localp 2701 | (setq local-tags (delete fn local-tags))))) 2702 | "matching local tag")))) 2703 | 2704 | ;;; Moving around. 2705 | 2706 | (defun gited-next-line (&optional arg) 2707 | "Go to start of branch name in next ARG lines." 2708 | (interactive "p") 2709 | (forward-line arg) 2710 | (condition-case nil 2711 | (gited-move-to-branchname) 2712 | (error 2713 | (forward-line -1) 2714 | (gited-move-to-branchname) 2715 | (message "At last branch!") 2716 | (ding) 2717 | (sit-for 1) 2718 | (message nil)))) 2719 | 2720 | (defun gited-prev-line (&optional arg) 2721 | "Go to start of branch name in previous ARG lines." 2722 | (interactive "p") 2723 | (let ((oline (line-number-at-pos)) 2724 | nb-line) 2725 | (when (natnump arg) (setq arg (- arg))) 2726 | (forward-line arg) 2727 | (gited-move-to-branchname) 2728 | (setq nb-line (line-number-at-pos)) 2729 | (when (or (= oline nb-line) 2730 | (< (- oline (abs arg)) nb-line)) 2731 | (message "At first branch!") 2732 | (ding) 2733 | (sit-for 1) 2734 | (message nil)))) 2735 | 2736 | (defun gited--goto-first-branch () 2737 | (goto-char (point-min)) 2738 | (when (overlays-at (point-min)) 2739 | (forward-line))) 2740 | 2741 | (defun gited-goto-first-branch () 2742 | "Go to first branch in current Gited buffer." 2743 | (interactive) 2744 | (gited--goto-first-branch) 2745 | (gited-move-to-branchname)) 2746 | 2747 | (defun gited-goto-last-branch () 2748 | "Go to last branch in current Gited buffer." 2749 | (interactive) 2750 | (goto-char (point-max)) 2751 | (forward-line -1) 2752 | (gited-move-to-branchname)) 2753 | 2754 | (defun gited--goto-column (col) 2755 | (forward-line 0) 2756 | (dotimes (_ (1- col)) 2757 | (goto-char 2758 | (next-single-property-change 2759 | (point) 2760 | 'tabulated-list-column-name)))) 2761 | 2762 | (defun gited-goto-branch (branch) 2763 | "Go to line describing BRANCH in this Gited buffer. 2764 | Return buffer position on success, else nil." 2765 | (interactive 2766 | (let ((cur-branch gited-current-branch)) 2767 | (list (completing-read "Jump to branch: " 2768 | (gited-listed-branches) 2769 | nil t nil nil cur-branch)))) 2770 | (when (gited-branch-exists-p branch) 2771 | (let ((row (cl-position branch (gited-listed-branches) :test #'equal))) 2772 | (goto-char (point-min)) 2773 | (forward-line (if (overlays-at (point-min)) (1+ row) row)) 2774 | (gited--goto-column (1+ gited-branch-idx)) 2775 | (point)))) 2776 | 2777 | (defun gited-next-marked-branch (arg &optional wrap opoint) 2778 | "Move to the next ARG marked branch. 2779 | If WRAP is non-nil, wrap around to the beginning of the buffer if 2780 | we reach the end." 2781 | (interactive "p\np") 2782 | (or opoint (setq opoint (point)));; return to where interactively started 2783 | (if (if (> arg 0) 2784 | (re-search-forward gited-re-mark nil t arg) 2785 | (beginning-of-line) 2786 | (re-search-backward gited-re-mark nil t (- arg))) 2787 | (gited-move-to-branchname) 2788 | (if (null wrap) 2789 | (progn 2790 | (goto-char opoint) 2791 | (user-error "No next marked branch")) 2792 | (message "(Wraparound for next marked branch)") 2793 | (goto-char (if (> arg 0) (point-min) (point-max))) 2794 | (gited-next-marked-branch arg nil opoint)))) 2795 | 2796 | (defun gited-prev-marked-branch (arg &optional wrap) 2797 | "Move to the previous ARG marked branch. 2798 | If WRAP is non-nil, wrap around to the end of the buffer if we 2799 | reach the beginning of the buffer." 2800 | (interactive "p\np") 2801 | (gited-next-marked-branch (- arg) wrap)) 2802 | 2803 | 2804 | ;; Fill and return `gited-branch-alist'. 2805 | 2806 | (defun gited-get-element-in-row (idx) 2807 | (let ((row (tabulated-list-get-entry))) 2808 | (if row 2809 | (aref row idx) 2810 | (user-error "No branch at point")))) 2811 | 2812 | (defun gited-get-branchname () 2813 | (gited-get-element-in-row gited-branch-idx)) 2814 | 2815 | (defun gited-get-mark () 2816 | (gited-get-element-in-row gited-mark-idx)) 2817 | 2818 | (defun gited-get-date () 2819 | (gited-get-element-in-row gited-date-idx)) 2820 | 2821 | (defun gited-get-commit () 2822 | (gited-get-element-in-row gited-commit-idx)) 2823 | 2824 | (defalias 'gited--move-to-column #'gited--goto-column) 2825 | 2826 | (defun gited--move-to-end-of-column (col) 2827 | (gited--move-to-column col) 2828 | (goto-char (next-single-property-change (point) 'tabulated-list-column-name))) 2829 | 2830 | (defun gited--list-refs-format (pattern) 2831 | (let ((refs-fmt (append (butlast gited-list-refs-format-command) 2832 | (list (format (car (last gited-list-refs-format-command)) 2833 | (if pattern 2834 | (pcase pattern 2835 | ("local" "heads") 2836 | ("remote" "remotes") 2837 | (_ pattern)) 2838 | "heads")))))) 2839 | (setf (cadr refs-fmt) 2840 | (format (cadr refs-fmt) 2841 | (if (equal pattern "tags") "taggerdate" "authordate") 2842 | (if (equal pattern "tags") "taggername" "authorname"))) 2843 | refs-fmt)) 2844 | 2845 | (defun gited--get-branch-info (&optional pattern) 2846 | "Return alist with branches infor." 2847 | (let ((args (gited--list-refs-format pattern)) 2848 | branch-info) 2849 | (with-temp-buffer 2850 | (insert "(\n") 2851 | (unless (zerop (gited-git-command args (current-buffer) 2852 | nil 'unquote)) 2853 | (user-error "No Git repository in current directory")) 2854 | (insert ")") 2855 | (setq branch-info (car (read-from-string (buffer-string)))) 2856 | (mapcar (lambda (x) 2857 | (when (stringp (car x)) ; No time: set it to beginning of epoch. 2858 | (push "1970-01-01 00:00" x)) 2859 | (when (= (length x) 4) ; Group time an time zone within alist. 2860 | (setf (car x) (cons (car x) (cadr x))) 2861 | (setf (cdr x) (cddr x))) 2862 | (when (and (stringp (car (last x))) ; If no Author, set it Unknown. 2863 | (string= "" (car (last x)))) 2864 | (setf (car (last x)) "Unknown")) 2865 | x) 2866 | branch-info)))) 2867 | 2868 | (defun gited--format-time (time-secs &optional zone) 2869 | (let ((zone-ok (>= emacs-major-version 25))) 2870 | (cond (zone-ok 2871 | (format-time-string 2872 | gited-date-format 2873 | (apply #'encode-time 2874 | (with-no-warnings 2875 | (decode-time (seconds-to-time time-secs) zone))) 2876 | ;; FIXME: Would work for a zone as: +0530 ? 2877 | (and zone (* 36 zone)))) 2878 | (t ;; HACK: Workaround for Emacs versions < 25 that don't accept 2879 | ;; ZONE arg in functions like `decode-time'; 2880 | ;; or `format-time-string', where ZONE has less general meaning. 2881 | (let ((time (decode-time 2882 | (seconds-to-time time-secs))) 2883 | (gited-date-format 2884 | (if (string= gited-date-format "%F %R") 2885 | "%F %R" 2886 | "%FT%T")) 2887 | date-str) 2888 | (when zone 2889 | (setf (car (last time)) (* 3600 zone))) 2890 | (setq date-str 2891 | (format-time-string 2892 | gited-date-format 2893 | (apply #'encode-time time))) 2894 | (when (and (not (string= gited-date-format "%F %R")) zone) 2895 | (if (= 0 zone) 2896 | (setq date-str (format "%s+0000" date-str)) 2897 | (setq date-str (format "%s%s%s%d" 2898 | date-str 2899 | (if (> zone 0) "+" "-") 2900 | (if (> (abs zone) 999) "" "0") 2901 | (abs zone))))) 2902 | date-str))))) 2903 | 2904 | (defun gited--get-mark-for-entry (entry) 2905 | (if (ignore-errors (gited-goto-branch (nth 1 entry))) 2906 | `(,(gited-get-mark)) 2907 | '(" "))) 2908 | 2909 | (defun gited--fill-branch-alist (&optional pattern) 2910 | (let* ((alist (gited--get-branch-info pattern)) 2911 | (prep (make-progress-reporter 2912 | "Collecting branch info..." 2913 | 0 (length alist)))) 2914 | ;; Get title of latest commit for each listed branch. 2915 | (setq gited-branch-alist 2916 | (cl-loop for entry the elements of alist using (index idx) collect 2917 | (progn 2918 | (progress-reporter-update prep idx) 2919 | (let* ((args (list "log" 2920 | (if gited-show-commit-hash 2921 | "--pretty=format:%h | %s" 2922 | "--pretty=format:%s") 2923 | (cadr entry) "-n1" "--")) 2924 | (title (with-temp-buffer 2925 | (gited-git-command args (current-buffer) nil) 2926 | (buffer-string)))) 2927 | ;; Format time in seconds as `gited-date-format'. 2928 | (when (consp (car entry)) 2929 | (setf (car entry) (gited--format-time (caar entry) (cdar entry)))) 2930 | `(,(1+ idx) ,@(gited--get-mark-for-entry entry) ,@entry ,title))))) 2931 | (progress-reporter-done prep) 2932 | gited-branch-alist)) 2933 | 2934 | 2935 | ;;; Toggles. 2936 | 2937 | (defun gited-hide-details-update-invisibility-spec () 2938 | (let ((col-names 2939 | (if gited-hide-details-mode 2940 | `("M" ,(gited--col-branch-name) "" "" "Last Commit") 2941 | `("M" "Authors" "Date" ,(gited--col-branch-name) "Last Commit"))) 2942 | (col-sizes 2943 | (if gited-hide-details-mode 2944 | (list gited-mark-col-size gited-branch-col-size 2945 | -1 -1 gited-commit-col-size) 2946 | (list gited-mark-col-size gited-author-col-size gited-date-col-size 2947 | gited-branch-col-size gited-commit-col-size)))) 2948 | (gited--list-format-init col-names col-sizes) 2949 | (setq tabulated-list-format gited-list-format) 2950 | (funcall (if gited-hide-details-mode 2951 | 'add-to-invisibility-spec 2952 | 'remove-from-invisibility-spec) 2953 | 'gited-hide-details-author) 2954 | (funcall (if gited-hide-details-mode 2955 | 'add-to-invisibility-spec 2956 | 'remove-from-invisibility-spec) 2957 | 'gited-hide-details-date) 2958 | (tabulated-list-init-header) 2959 | (gited--update-padding (not gited-hide-details-mode)))) 2960 | 2961 | (defun gited--update-padding (undo) 2962 | "Update columns padding after `gited-hide-details-mode'." 2963 | (let ((inhibit-read-only t) 2964 | (align-to (if undo 2965 | (+ gited-mark-col-size 2966 | gited-author-col-size 2967 | gited-date-col-size 2968 | gited-branch-col-size 4) 2969 | (+ gited-mark-col-size gited-branch-col-size 2)))) 2970 | (save-excursion 2971 | (gited-goto-first-branch) 2972 | (while (not (eobp)) 2973 | (gited-move-to-end-of-branchname) 2974 | (skip-chars-backward " \t") 2975 | (forward-char 1) 2976 | (unless (= (current-column) align-to) 2977 | (put-text-property (point) (1+ (point)) 2978 | 'display `(space :align-to ,align-to)) 2979 | (delete-region (1+ (point)) 2980 | (gited-move-to-end-of-branchname))) 2981 | (forward-line 1))) nil)) 2982 | 2983 | 2984 | ;;; Marked branches. 2985 | (defun gited-map-lines (fn) 2986 | "Map FN on each Gited line." 2987 | (let (br-name mark) 2988 | (save-excursion 2989 | (gited--goto-first-branch) 2990 | (while (ignore-errors 2991 | (setq br-name (gited-get-branchname) 2992 | mark (gited-get-mark))) 2993 | (funcall fn br-name mark) 2994 | (forward-line))))) 2995 | 2996 | (defun gited-get-marked-branches (&optional marker) 2997 | "Return a list of branches currently marked." 2998 | (delq nil 2999 | (mapcar (lambda (e) 3000 | (when (equal (string-to-char (cdr e)) 3001 | (or marker gited-marker-char)) 3002 | (car e))) 3003 | (gited-current-state-list)))) 3004 | 3005 | (defun gited-current-state-list (&optional pos) 3006 | "Return a list like (BRANCH . MARK) of all branches in an Gited buffer. 3007 | If POS is non-nil, return a list like (BRANCH MARK POINT), where POINT is 3008 | the value of point at the beginning of the line for that buffer." 3009 | (let ((gited-current-state-list-tmp '())) 3010 | (if pos 3011 | (gited-map-lines 3012 | (lambda (branch mark) 3013 | (push (list branch mark (point)) 3014 | gited-current-state-list-tmp))) 3015 | (gited-map-lines 3016 | (lambda (branch mark) 3017 | (push (cons branch mark) gited-current-state-list-tmp)))) 3018 | (nreverse gited-current-state-list-tmp))) 3019 | 3020 | (defun gited-current-branches-with-marks () 3021 | "Return a list like (BRANCH . MARK) of all listed branches." 3022 | (let ((branches (gited-current-state-list))) 3023 | (mapcar (lambda (x) 3024 | (let ((e (assoc x branches))) 3025 | (if e 3026 | e 3027 | (cons x ?\s)))) 3028 | (gited-listed-branches)))) 3029 | 3030 | 3031 | ;;; Mark/unmark. 3032 | 3033 | (defun gited-remember-marks (beg end) 3034 | "Return alist of branches and their marks, from BEG to END." 3035 | (if selective-display ; must unhide to make this work. 3036 | (let ((inhibit-read-only t)) 3037 | (subst-char-in-region beg end ?\r ?\n))) 3038 | (let (branch chr alist) 3039 | (save-excursion 3040 | (goto-char beg) 3041 | (while (re-search-forward gited-re-mark end t) 3042 | (when (setq branch (gited-get-branchname)) 3043 | (setq chr (preceding-char) 3044 | alist (cons (cons branch chr) alist))))) 3045 | alist)) 3046 | 3047 | (defun gited-mark-remembered (alist) 3048 | "Mark all branches remembered in ALIST. 3049 | Each element of ALIST looks like (BRANCH . MARKERCHAR)." 3050 | (let (elt branch chr) 3051 | (save-excursion 3052 | (while alist 3053 | (setq elt (car alist) 3054 | alist (cdr alist) 3055 | branch (car elt) 3056 | chr (cdr elt)) 3057 | (when (gited-goto-branch branch) 3058 | (beginning-of-line) 3059 | (gited-insert-marker-char chr) 3060 | (gited--fontify-current-row chr)))))) 3061 | 3062 | (defun gited-fontify-current-branch () 3063 | "Set font for current branch." 3064 | (let ((inhibit-read-only t)) 3065 | (save-excursion 3066 | (gited-goto-branch gited-current-branch) 3067 | (when (string= " " (gited-get-mark)) 3068 | (remove-text-properties 3069 | (point-at-bol) (point-at-eol) '(face)) 3070 | (put-text-property 3071 | (point) 3072 | (gited-move-to-end-of-branchname) 3073 | 'face gited-current-branch-face) 3074 | (put-text-property 3075 | (point-at-bol) 3076 | (point-at-eol) 3077 | 'face gited-section-highlight-face))))) 3078 | 3079 | (defun gited-insert-marker-char (&optional marker) 3080 | (tabulated-list-set-col gited-mark-idx 3081 | (char-to-string (or marker gited-marker-char)) 3082 | 'change)) 3083 | 3084 | (defun gited-flag-branch-deletion (arg &optional interactive) 3085 | "In Gited, flag the branch at current line (or next ARG) for deletion. 3086 | If the region is active, flag all branches in the region. 3087 | Otherwise, with a prefix arg, flag branches on the next ARG lines. 3088 | 3089 | If the region is active in Transient Mark mode, flag all branches 3090 | in the active region." 3091 | (interactive (list current-prefix-arg t)) 3092 | (gited-mark arg gited-del-char interactive)) 3093 | 3094 | (defun gited-toggle-marks () 3095 | "Toggle marks: marked branches become unmarked, and vice versa. 3096 | Branches marked with other flags (such as `D') are not affected. 3097 | As always, hidden subdirs are not affected." 3098 | (interactive) 3099 | (save-excursion 3100 | (gited--goto-first-branch) 3101 | (while (not (eobp)) 3102 | (let* ((mark (string-to-char (gited-get-mark))) 3103 | (flag 3104 | (cond ((eq ?\s mark) gited-marker-char) 3105 | ((eq gited-marker-char mark) ?\s) 3106 | (t nil)))) 3107 | (when flag 3108 | (gited-insert-marker-char flag) 3109 | (gited--fontify-current-row flag))) 3110 | (forward-line)))) 3111 | 3112 | (defun gited-kill-line (&optional arg) 3113 | "Kill the current line or next ARG lines (not the branches). 3114 | With a prefix argument, kill that many lines starting with the current line. 3115 | \(A negative argument kills backward.)" 3116 | (interactive "P") 3117 | (setq arg (prefix-numeric-value arg)) 3118 | (let (buffer-read-only branch) 3119 | (while (/= 0 arg) 3120 | (setq branch (gited-get-branchname)) 3121 | (if (not branch) 3122 | (user-error "Can only kill branch lines") 3123 | (setq tabulated-list-entries 3124 | (assq-delete-all 3125 | (car (tabulated-list-delete-entry)) 3126 | tabulated-list-entries)) 3127 | (if (> arg 0) 3128 | (cl-decf arg) 3129 | (cl-incf arg) 3130 | (forward-line -1)))) 3131 | (gited-move-to-branchname))) 3132 | 3133 | (defun gited-do-kill-lines (&optional arg fmt) 3134 | "Kill all marked lines (not the branches). 3135 | With a prefix argument, kill that many lines starting with the current line. 3136 | \(A negative argument kills backward.)" 3137 | ;; Returns count of killed lines. FMT="" suppresses message. 3138 | (interactive "P") 3139 | (if arg 3140 | (gited-kill-line arg) 3141 | (save-excursion 3142 | (gited--goto-first-branch) 3143 | (let (buffer-read-only 3144 | (count 0) 3145 | (regexp 3146 | (concat "^" (regexp-quote (char-to-string gited-marker-char))))) 3147 | (while (and (not (eobp)) 3148 | (re-search-forward regexp nil t)) 3149 | (cl-incf count) 3150 | (setq tabulated-list-entries 3151 | (assq-delete-all 3152 | (car (tabulated-list-delete-entry)) 3153 | tabulated-list-entries))) 3154 | (or (equal "" fmt) 3155 | (message (or fmt "Killed %d line%s.") count (gited-plural-s count))) 3156 | count)))) 3157 | 3158 | (defun gited-mark-branches-regexp (regexp &optional marker-char) 3159 | "Mark all branches matching REGEXP for use in later commands. 3160 | A prefix argument means to unmark them instead." 3161 | (interactive 3162 | (list (read-regexp (concat (if current-prefix-arg "Unmark" "Mark") 3163 | " branches (regexp): ") 3164 | nil) 3165 | (and current-prefix-arg ?\s))) 3166 | (let ((gited-marker-char (or marker-char gited-marker-char))) 3167 | (gited-mark-if 3168 | (and (not (eolp)) ; empty line 3169 | (let ((fn (gited-get-branchname))) 3170 | (and fn (string-match-p regexp fn)))) 3171 | "matching branch"))) 3172 | 3173 | (defun gited-mark-branches-by-date (min-time &optional marker-char) 3174 | "Mark all branches whose last commit time was after MIN-TIME. 3175 | Interactively, a prefix argument means to unmark them instead. 3176 | MIN-TIME must be a string suitable for `date-to-time' like 3177 | \"2017-06-05 20:32:32\"." 3178 | (interactive 3179 | (let* ((prefix current-prefix-arg) 3180 | ;; Default to 1 week before the last commit time in current row. 3181 | (default (format-time-string 3182 | "%F" 3183 | (time-subtract (date-to-time (gited-get-date)) (* 7 24 60 60)))) 3184 | (min-time (read-string 3185 | (concat (if current-prefix-arg "Unmark" "Mark") 3186 | " branches with last commit after time: ") 3187 | default))) 3188 | (list min-time (and prefix ?\s)))) 3189 | (let ((gited-marker-char (or marker-char gited-marker-char)) 3190 | (time (funcall (lambda (x) ; Default HH:MM:SS to 00:00:00. 3191 | (setq x (parse-time-string x)) 3192 | (or (car x) (setf (car x) 0)) 3193 | (or (cadr x) (setf (cadr x) 0)) 3194 | (or (cadr (cdr x)) (setf (cadr (cdr x)) 0)) 3195 | (apply 'encode-time x)) 3196 | min-time))) 3197 | (gited-mark-if 3198 | (and (not (eolp)) 3199 | (let ((commit-time (date-to-time (gited-get-date)))) 3200 | (time-less-p time commit-time))) 3201 | "matching branch"))) 3202 | 3203 | (defun gited-mark-branches-containing-regexp (regexp &optional marker-char days) 3204 | "Mark all branches containing REGEXP in some commit message. 3205 | A prefix argument means to unmark them instead. 3206 | 3207 | Optional arg DAYS, if non-nil then limit the search to DAYS before the 3208 | newest commit. Otherwise, limit the search to commits until 1 month earlier 3209 | than the newest commit. 3210 | In interactive calls, a prefix C-u C-u prompts for DAYS." 3211 | (interactive 3212 | (let ((def current-prefix-arg) 3213 | regex marker interval) 3214 | (pcase def 3215 | (`(16) (setq interval 3216 | (string-to-number 3217 | (read-string "Number of days before newest commit: " 3218 | nil nil "30")) 3219 | marker (pcase (read-number "Mark (0) or Unmark (1): " 0) 3220 | (0 gited-marker-char) 3221 | (1 ?\s) 3222 | (_ gited-marker-char)) 3223 | regex (read-string 3224 | (format "%s branches containing regexp: " 3225 | (if (char-equal marker gited-marker-char) 3226 | "Mark" "UNmark"))))) 3227 | (_ (setq interval 30 3228 | marker (if current-prefix-arg 3229 | ?\s 3230 | gited-marker-char) 3231 | regex (read-string 3232 | (format "%s branches containing regexp: " 3233 | (if (char-equal marker gited-marker-char) 3234 | "Mark" "UNmark")))))) 3235 | (list regex marker interval))) 3236 | (let ((gited-marker-char (or marker-char gited-marker-char))) 3237 | (gited-mark-if 3238 | (and (not (eolp)) 3239 | (gited-get-branchname) 3240 | (let* ((branch-name (gited-get-branchname)) 3241 | (time-max 3242 | (cl-block nil 3243 | (pcase-dolist (`(_ _ ,date ,cur-branch _ _) gited-branch-alist) 3244 | (when (equal cur-branch branch-name) 3245 | (cl-return (date-to-time date)))))) 3246 | (time-min (time-subtract time-max (days-to-time (or days 30)))) 3247 | (args (list "log" 3248 | (format "--after=%s" 3249 | (format-time-string "%F" time-min)) 3250 | (format "--before=%s" 3251 | (format-time-string "%F" time-max)) 3252 | (format "--grep=%s" regexp) 3253 | branch-name "--"))) 3254 | (with-temp-buffer 3255 | (gited-git-command args (current-buffer)) 3256 | (not (string= "" (buffer-string)))))) 3257 | "matching branch"))) 3258 | 3259 | (defun gited-mark-branches-containing-commit (commit &optional marker-char) 3260 | "Mark all branches containing COMMIT. 3261 | A prefix argument means to unmark them instead. 3262 | COMMIT is the sha1 of the commit." 3263 | (interactive 3264 | (list (read-string (format "%s branches containing sha1 commit: " 3265 | (if current-prefix-arg "UNmark" "Mark"))) 3266 | (and current-prefix-arg ?\s))) 3267 | (let* ((args `("branch" ,(concat "--contains=" commit))) 3268 | (branches (gited--get-branches-from-command args)) 3269 | (gited-marker-char (or marker-char gited-marker-char))) 3270 | (gited-mark-if 3271 | (and (not (eolp)) 3272 | (let ((fn (gited-get-branchname))) 3273 | (and fn (member fn branches)))) 3274 | "matching branch"))) 3275 | 3276 | (defvar gited--op nil) 3277 | (defun gited--mark-merged-or-unmerged-branches-spec (op-val) 3278 | (setq gited--op op-val) 3279 | (read-string (format "%s branches %s with branch: " 3280 | (if current-prefix-arg "UNmark" "Mark") 3281 | (pcase gited--op 3282 | (`merged "merged") 3283 | (_ "unmerged"))) 3284 | nil nil gited-current-branch)) 3285 | 3286 | (defun gited--mark-merged-branches-spec (branch prefix) 3287 | (interactive "i\nP") 3288 | (ignore branch prefix) 3289 | (list 3290 | (gited--mark-merged-or-unmerged-branches-spec 'merged) 3291 | (if current-prefix-arg ?\s gited-marker-char))) 3292 | 3293 | (defun gited--mark-unmerged-branches-spec (branch prefix) 3294 | (interactive "i\nP") 3295 | (ignore branch prefix) 3296 | (list 3297 | (gited--mark-merged-or-unmerged-branches-spec 'unmerged) 3298 | (if current-prefix-arg ?\s gited-marker-char))) 3299 | 3300 | (defun gited--mark-merged-or-unmerged-branches (branch op marker-char) 3301 | (let* ((args 3302 | (list "branch" 3303 | (if (string= op "merged") "--merged" "--no-merged") 3304 | branch)) 3305 | (branches (gited--get-branches-from-command args)) 3306 | (gited-marker-char (or marker-char gited-marker-char))) 3307 | (gited-mark-if 3308 | (and (not (eolp)) 3309 | (let ((fn (gited-get-branchname))) 3310 | (and fn (member fn branches)))) 3311 | "matching branch"))) 3312 | 3313 | (defun gited-mark-merged-branches (branch &optional marker-char) 3314 | "Mark all merged branches with BRANCH. 3315 | A prefix argument means to unmark them instead." 3316 | (interactive 3317 | (call-interactively #'gited--mark-merged-branches-spec)) 3318 | (gited--mark-merged-or-unmerged-branches branch "merged" marker-char)) 3319 | 3320 | (defun gited-mark-unmerged-branches (branch &optional marker-char) 3321 | "Mark all unmerged branches with BRANCH. 3322 | A prefix argument means to unmark them instead." 3323 | (interactive 3324 | (call-interactively #'gited--mark-unmerged-branches-spec)) 3325 | (gited--mark-merged-or-unmerged-branches branch "unmerged" marker-char)) 3326 | 3327 | (defun gited-repeat-over-lines (arg function) 3328 | ;; This version skips non-file lines. 3329 | (let ((pos (make-marker))) 3330 | (beginning-of-line) 3331 | (while (and (> arg 0) (not (eobp))) 3332 | (cl-decf arg) 3333 | (beginning-of-line) 3334 | (when (gited-at-header-line-p) (forward-line)) 3335 | (save-excursion 3336 | (forward-line) 3337 | (move-marker pos (1+ (point)))) 3338 | (save-excursion (funcall function)) 3339 | ;; Advance to the next line--actually, to the line that *was* next. 3340 | ;; (If FUNCTION inserted some new lines in between, skip them.) 3341 | (goto-char pos)) 3342 | (while (and (< arg 0) (not (bobp))) 3343 | (cl-incf arg) 3344 | (forward-line -1) 3345 | (while (not (gited-at-header-line-p)) (forward-line -1)) 3346 | (beginning-of-line) 3347 | (save-excursion (funcall function))) 3348 | (move-marker pos nil) 3349 | (ignore-errors (gited-move-to-branchname)) 3350 | (when (eobp) 3351 | (forward-line -1) 3352 | (ignore-errors (gited-move-to-branchname))))) 3353 | 3354 | (defun gited-mark (arg mark &optional interactive) 3355 | "Mark the branch at point in the Gited buffer with MARK. 3356 | If the region is active, mark all branches in the region. 3357 | Otherwise, with a prefix arg, mark branches on the next ARG lines. 3358 | 3359 | Use \\[gited-unmark-all-branches] to remove all marks 3360 | and \\[gited-unmark] on a subdir to remove the marks in 3361 | this subdir." 3362 | (interactive (list current-prefix-arg gited-marker-char t)) 3363 | (cond 3364 | ;; Mark branches in the active region. 3365 | ((and interactive (use-region-p)) 3366 | (save-excursion 3367 | (let ((beg (region-beginning)) 3368 | (end (region-end))) 3369 | (gited--mark-branches-in-region 3370 | (progn (goto-char beg) (point-at-bol)) 3371 | (progn (goto-char end) (point-at-bol)) 3372 | mark)))) 3373 | ;; Mark the current (or next ARG) branches. 3374 | (t 3375 | (let ((inhibit-read-only t)) 3376 | (gited-repeat-over-lines 3377 | (prefix-numeric-value arg) 3378 | (lambda () 3379 | (when (ignore-errors (gited-get-branchname)) 3380 | (gited-insert-marker-char mark) 3381 | (gited--fontify-current-row mark)))))))) 3382 | 3383 | (defun gited--mark-branches-in-region (start end mark) 3384 | (when (> start end) 3385 | (user-error "Wrong input values: start, end, <")) 3386 | (goto-char start) ; assumed at beginning of line 3387 | (while (< (point) end) 3388 | (when (gited-get-branchname) 3389 | (gited-insert-marker-char mark) 3390 | (gited--fontify-current-row mark)) 3391 | (forward-line))) 3392 | 3393 | (defun gited-unmark-backward () 3394 | "Unmark the branches in the region, or ARG branches." 3395 | (interactive) 3396 | (forward-line -1) 3397 | (when (gited-get-branchname) 3398 | (gited-insert-marker-char ?\s) 3399 | (gited--fontify-current-row ?\s) 3400 | (gited-move-to-branchname))) 3401 | 3402 | (defun gited-unmark-all-branches (mark) 3403 | "Remove all branches with flag MARK." 3404 | (interactive "cRemove marks (RET means all):") 3405 | (save-excursion 3406 | (gited--goto-first-branch) 3407 | (while (not (eobp)) 3408 | (let ((str (aref (tabulated-list-get-entry) 3409 | gited-mark-idx))) 3410 | (when (and (gited-get-branchname) 3411 | (or (and (eq mark ?\r) (not (string= str " "))) 3412 | (string= (char-to-string mark) str))) 3413 | (gited-insert-marker-char ?\s) 3414 | (gited--fontify-current-row ?\s)) 3415 | (forward-line))))) 3416 | 3417 | (defun gited-unmark-all-marks () 3418 | "Remove all marks from all marked branches in the Gited buffer." 3419 | (interactive) 3420 | (gited-unmark-all-branches ?\r)) 3421 | 3422 | (defun gited-move-to-branchname () 3423 | "Move point to the beginning of the Branches column in current row." 3424 | (interactive) 3425 | (when (tabulated-list-get-id) 3426 | (gited--move-to-column (1+ gited-branch-idx)))) 3427 | 3428 | ;; Return point. 3429 | (defun gited-move-to-end-of-branchname () 3430 | "Move point to the end of the Branches column in current row." 3431 | (interactive) 3432 | (when (tabulated-list-get-id) 3433 | (gited--move-to-end-of-column (1+ gited-branch-idx)))) 3434 | 3435 | (defun gited-move-to-author () 3436 | "Move point to the beginning of the Authors column in current row." 3437 | (interactive) 3438 | (when (tabulated-list-get-id) 3439 | (gited--move-to-column (1+ gited-author-idx)))) 3440 | 3441 | (defun gited-move-to-end-of-author () 3442 | "Move point to the end of the Authors column in current row." 3443 | (interactive) 3444 | (when (tabulated-list-get-id) 3445 | (gited--move-to-end-of-column (1+ gited-author-idx)))) 3446 | 3447 | (defun gited-move-to-date () 3448 | "Move point to the beginning of the Date column in current row." 3449 | (interactive) 3450 | (when (tabulated-list-get-id) 3451 | (gited--move-to-column (1+ gited-date-idx)))) 3452 | 3453 | (defun gited-move-to-end-of-date () 3454 | "Move point to the end of the Date column in current row." 3455 | (interactive) 3456 | (when (tabulated-list-get-id) 3457 | (gited--move-to-end-of-column (1+ gited-date-idx)))) 3458 | 3459 | (defun gited-unmark (arg &optional interactive) 3460 | "Unmark the branch at point in the Gited buffer. 3461 | If the region is active, unmark all branches in the region. 3462 | Otherwise, with a prefix arg, unmark branches on the next ARG lines. 3463 | 3464 | If the region is active in Transient Mark mode, unmark all branches 3465 | in the active region." 3466 | (interactive (list current-prefix-arg t)) 3467 | (gited-mark arg ?\s interactive)) 3468 | 3469 | (defun gited-number-marked () 3470 | "Return number of marked files." 3471 | (interactive) 3472 | (save-excursion 3473 | (goto-char (point-min)) 3474 | (let ((count 0)) 3475 | (while (not (eobp)) 3476 | (unless (looking-at "^[[:blank:]]") 3477 | (cl-incf count)) 3478 | (forward-line)) 3479 | (prog1 count 3480 | (if (zerop count) 3481 | (message "No marked branches") 3482 | (message "%d marked %s" 3483 | count 3484 | (if (> count 1) 3485 | "branches" "branch"))))))) 3486 | 3487 | 3488 | ;;; Mode map. 3489 | (defvar gited-mode-map 3490 | (let ((map (make-keymap))) 3491 | (define-key map (kbd "t") 'gited-toggle-marks) 3492 | (define-key map (kbd "(") 'gited-hide-details-mode) 3493 | (define-key map (kbd "u") 'gited-unmark) 3494 | (define-key map (kbd "=") 'gited-diff) 3495 | (define-key map (kbd "j") 'gited-goto-branch) 3496 | (define-key map (kbd "DEL") 'gited-unmark-backward) 3497 | (define-key map (kbd "U") 'gited-unmark-all-marks) 3498 | (define-key map (kbd "M-DEL") 'gited-unmark-all-branches) 3499 | (define-key map (kbd "x") 'gited-do-flagged-delete) 3500 | ;; moving 3501 | (define-key map (kbd "<") 'gited-goto-first-branch) 3502 | (define-key map (kbd ">") 'gited-goto-last-branch) 3503 | (define-key map (kbd "M-<") 'gited-goto-first-branch) 3504 | (define-key map (kbd "M->") 'gited-goto-last-branch) 3505 | (define-key map (kbd "n") 'gited-next-line) 3506 | (define-key map (kbd "SPC") 'next-line) 3507 | (define-key map (kbd "p") 'gited-prev-line) 3508 | (define-key map (kbd "M-}") 'gited-next-marked-branch) 3509 | (define-key map (kbd "M-{") 'gited-prev-marked-branch) 3510 | ;; immediate operations 3511 | (define-key map (kbd "a") 'gited-apply-patch) 3512 | (define-key map (kbd "A") 'gited-add-patched-files) 3513 | (define-key map (kbd "B") 'gited-bisect) 3514 | (define-key map (kbd "C-c c") 'gited-commit) 3515 | (define-key map (kbd "w") 'gited-copy-branchname-as-kill) 3516 | (define-key map (kbd "e") 'gited-extract-patches) 3517 | (define-key map (kbd "T") 'gited-do-sync-with-trunk) 3518 | (define-key map (kbd "M") 'gited-merge-branch) 3519 | (define-key map (kbd "c") 'gited-checkout-branch) 3520 | (define-key map (kbd "v") 'gited-visit-branch-sources) 3521 | (define-key map (kbd "f") 'gited-visit-branch-sources) 3522 | (define-key map (kbd "s") 'gited-show-commit) 3523 | (define-key map (kbd "S") 'gited-status) 3524 | (define-key map (kbd "RET") 'gited-visit-branch-sources) 3525 | (define-key map (kbd "g") 'gited-update) 3526 | (define-key map "\C-x\C-g" 'gited-list-branches) 3527 | (define-key map (kbd "k") 'gited-do-kill-lines) 3528 | (define-key map (kbd "P") 'gited-pull) 3529 | (define-key map (kbd "r") 'gited-reset-branch) 3530 | (define-key map (kbd "* p") 'gited-set-object-upstream) 3531 | (define-key map (kbd "* <") 'gited-pull) 3532 | (define-key map (kbd "* >") 'gited-push) 3533 | (define-key map (kbd "* r") 'gited-change-current-remote-rep) 3534 | (define-key map (kbd "o") 'gited-origin) 3535 | (define-key map (kbd "l") 'gited-log) 3536 | (define-key map (kbd "L") 'gited-log-last-n-commits) 3537 | ;; Tags 3538 | (define-key map (kbd "* t a") 'gited-tag-add) 3539 | (define-key map (kbd "* t d") 'gited-tag-delete) 3540 | (define-key map (kbd "* t D") 'gited-remote-tag-delete) 3541 | (define-key map (kbd "* t f") 'gited-fetch-remote-tags) 3542 | ;; marking banches 3543 | (define-key map (kbd "m") 'gited-mark) 3544 | (define-key map (kbd "% n") 'gited-mark-branches-regexp) 3545 | (define-key map (kbd "% t") 'gited-mark-branches-by-date) 3546 | (define-key map (kbd "% c") 'gited-mark-branches-containing-commit) 3547 | (define-key map (kbd "% g") 'gited-mark-branches-containing-regexp) 3548 | (define-key map (kbd "% m") 'gited-mark-merged-branches) 3549 | (define-key map (kbd "% M") 'gited-mark-unmerged-branches) 3550 | (define-key map (kbd "d") 'gited-flag-branch-deletion) 3551 | (define-key map (kbd "% l") 'gited-mark-local-tags) ; Local tags. 3552 | ;; Git stash 3553 | (define-key map (kbd "* s s") 'gited-stash) 3554 | (define-key map (kbd "* s a") 'gited-stash-apply) 3555 | (define-key map (kbd "* s A") 'gited-stash-pop) 3556 | (define-key map (kbd "* s b") 'gited-stash-branch) 3557 | (define-key map (kbd "* s d") 'gited-stash-drop) 3558 | ;; marked operations 3559 | (define-key map (kbd "* N") 'gited-number-marked) 3560 | (define-key map (kbd "R") 'gited-rename-branch) 3561 | (define-key map (kbd "C") 'gited-copy-branch) 3562 | (define-key map (kbd "D") 'gited-do-delete) 3563 | (define-key map (kbd "?") 'gited-summary) 3564 | map)) 3565 | 3566 | 3567 | 3568 | ;;;###autoload 3569 | (defun gited-list-branches (&optional pattern other-window update) 3570 | "List all branches or tags for the current repository. 3571 | Optional arg PATTERN if non-nil, then must be \"local\", \"remote\", 3572 | or \"tags\". That lists local branches, remote branches and tags, 3573 | respectively. When PATTERN is nil, then list the local branches. 3574 | Optional arg OTHER-WINDOW means to display the Gited buffer in another window. 3575 | Optional arg UPDATE if non-nil, then force to update the gited buffer. 3576 | Otherwise, just switch to the Gited buffer if already exists. 3577 | When called interactively prompt for PATTERN. 3578 | When called interactively with a prefix set OTHER-WINDOW non-nil." 3579 | (interactive 3580 | (progn 3581 | (unless (gited-dir-under-Git-control-p) 3582 | (user-error "No Git repository in current directory")) 3583 | (let* ((opts '("local" "remote" "tags")) 3584 | (patt (completing-read 3585 | "List (local, remote, tags): " 3586 | opts nil t nil nil "local"))) 3587 | (list patt current-prefix-arg nil)))) 3588 | (if (and (buffer-live-p gited-buffer) 3589 | (not update) 3590 | (or (not pattern) 3591 | (equal pattern gited-ref-kind))) 3592 | (switch-to-buffer gited-buffer) 3593 | (unless (gited-dir-under-Git-control-p) 3594 | (user-error "No Git repository in current directory")) 3595 | (let ((buf (or (and (buffer-live-p gited-buffer) gited-buffer) 3596 | (setq gited-buffer (generate-new-buffer gited-buffer-name))))) 3597 | (unless (equal pattern gited-ref-kind) 3598 | (setq gited-ref-kind pattern)) 3599 | (if other-window 3600 | (switch-to-buffer-other-window buf) 3601 | (switch-to-buffer buf)) 3602 | (or gited-mode (gited-mode)) 3603 | ;; Set `gited-toplevel-dir' if not set yet. 3604 | (unless gited-toplevel-dir 3605 | (setq gited-toplevel-dir 3606 | (with-temp-buffer 3607 | (gited-git-command '("rev-parse" "--show-toplevel") 3608 | (current-buffer)) 3609 | (file-name-as-directory 3610 | (buffer-substring 1 (1- (point-max))))))) 3611 | (setq tabulated-list-use-header-line gited-use-header-line 3612 | gited-buffer buf 3613 | gited-ref-kind pattern 3614 | gited-current-branch (gited-current-branch) 3615 | tabulated-list-printer #'gited-print-entry) 3616 | ;; Ignore dired-hide-details-* value of invisible text property by default. 3617 | (when (eq buffer-invisibility-spec t) 3618 | (setq buffer-invisibility-spec (list t))) 3619 | ;; Check if we must prune remotes. 3620 | (when (and (equal gited-ref-kind "remote") 3621 | (or (eq t gited-prune-remotes) 3622 | (and (eq 'daily gited-prune-remotes) 3623 | (or (not gited--last-remote-prune) 3624 | (time-less-p (seconds-to-time (* 24 60 60)) 3625 | (time-subtract (current-time) gited--last-remote-prune)))))) 3626 | (gited-remote-prune)) 3627 | (gited-tabulated-list-entries) 3628 | (tabulated-list-print) 3629 | ;; Go to `gited-current-branch' when it is shown. 3630 | (when (gited-branch-exists-p gited-current-branch) 3631 | (gited-goto-branch gited-current-branch) 3632 | (gited-fontify-current-branch)) 3633 | (unless gited--hide-details-set 3634 | (or gited-verbose (gited-hide-details-mode 1)) 3635 | (setq gited--hide-details-set t)) 3636 | ;; For local branches, show the CI status of the trunk branch. 3637 | (when (string= pattern "local") (gited-pull-callback))))) 3638 | 3639 | 3640 | ;;;###autoload 3641 | (defalias 'gited-list 'gited-list-branches) 3642 | 3643 | (defun gited-print-entry (id cols) 3644 | "Insert a Gited entry at point. 3645 | ID is a Lisp object identifying the entry to print, and COLS is a vector 3646 | of column descriptors." 3647 | (let ((beg (point)) 3648 | (x (max tabulated-list-padding 0)) 3649 | (ncols (length tabulated-list-format)) 3650 | (inhibit-read-only t)) 3651 | (if (> tabulated-list-padding 0) 3652 | (insert (make-string x ?\s))) 3653 | (dotimes (n ncols) 3654 | (let ((pos (point))) 3655 | (setq x (tabulated-list-print-col n (aref cols n) x)) 3656 | (cond 3657 | ((= n gited-author-idx) 3658 | (add-text-properties 3659 | pos (point) 3660 | `(invisible gited-hide-details-author 3661 | font-lock-face ,gited-author-face))) 3662 | ((= n gited-date-idx) 3663 | (add-text-properties 3664 | pos (point) 3665 | `(invisible gited-hide-details-date 3666 | font-lock-face ,gited-date-time-face))) 3667 | ((= n gited-branch-idx) 3668 | (put-text-property 3669 | pos (point) 3670 | 'font-lock-face gited-branch-name-face)) 3671 | ((= n gited-commit-idx) 3672 | (put-text-property 3673 | pos (point) 3674 | 'font-lock-face gited-commit-msg-face)) 3675 | (t nil)) 3676 | )) 3677 | (insert ?\n) 3678 | ;; Ever so slightly faster than calling `put-text-property' twice. 3679 | (add-text-properties 3680 | beg (point) 3681 | `(tabulated-list-id ,id tabulated-list-entry ,cols)))) 3682 | 3683 | (defun gited-tabulated-list-entries () 3684 | (let ((alist (gited--fill-branch-alist gited-ref-kind)) 3685 | result) 3686 | (pcase-dolist (`(,id . (,mark ,date ,branch ,author ,commit)) alist) 3687 | (push (list id (vector mark author date branch commit)) result)) 3688 | (setq tabulated-list-entries (nreverse result)) 3689 | (tabulated-list-init-header))) 3690 | 3691 | ;;; Define minor mode. 3692 | (define-derived-mode gited-mode tabulated-list-mode "Gited" 3693 | "Toggle gited-mode. 3694 | Interactively with no argument, this command toggles the mode. 3695 | A positive prefix argument enables the mode, any other prefix 3696 | argument disables it. From Lisp, argument omitted or nil enables 3697 | the mode, `toggle' toggles the state. 3698 | 3699 | Mode to edit Git branches as Dired." 3700 | (unless (gited-buffer-p) 3701 | (user-error "Gited mode cannot be enabled in this buffer")) 3702 | (gited--list-format-init) 3703 | (setq tabulated-list-format gited-list-format) 3704 | (add-hook 'tabulated-list-revert-hook 'gited-tabulated-list-entries nil t) 3705 | (setq tabulated-list-sort-key (or tabulated-list-sort-key '("Date")))) 3706 | 3707 | ;; We need this advice to sort by one of the last columns 3708 | ;; when `gited-hide-details-mode' is enabled. 3709 | (defun gited--advice-sort-by-column (orig-fun &rest args) 3710 | (if (not (derived-mode-p 'gited-mode)) 3711 | (apply orig-fun args) 3712 | (cond (gited-hide-details-mode 3713 | (gited-hide-details-mode 0) 3714 | (apply orig-fun args) 3715 | (gited-hide-details-mode 1)) 3716 | (t (apply orig-fun args))) 3717 | (when (gited-branch-exists-p gited-current-branch) 3718 | (gited-fontify-current-branch)))) 3719 | 3720 | (advice-add 'tabulated-list-col-sort :around 'gited--advice-sort-by-column) 3721 | 3722 | (provide 'gited) 3723 | ;;; gited.el ends here 3724 | -------------------------------------------------------------------------------- /screenshots/gited-remote-branches-verbose-screenshot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/calancha/Gited/5ea8f8748950d459b5502be910c8077d4b8648ac/screenshots/gited-remote-branches-verbose-screenshot.png -------------------------------------------------------------------------------- /screenshots/gited-tags-screenshot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/calancha/Gited/5ea8f8748950d459b5502be910c8077d4b8648ac/screenshots/gited-tags-screenshot.png --------------------------------------------------------------------------------