├── .gitignore ├── LICENSE ├── Makefile ├── README.org ├── recipes ├── el-get │ └── torus.rcp └── melpa │ └── torus.melpa └── torus.el /.gitignore: -------------------------------------------------------------------------------- 1 | # vim: set filetype=conf 2 | 3 | # Emacs backup 4 | 5 | *~ 6 | 7 | # Compiled 8 | 9 | *.elc 10 | 11 | # Unison backup 12 | 13 | .unison 14 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | 3 | Version 2, June 1991 4 | 5 | Copyright (C) 1989, 1991 Free Software Foundation, Inc., 51 Franklin 6 | Street, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted 7 | to copy and distribute verbatim copies of this license document, but 8 | changing it is not allowed. 9 | 10 | Preamble 11 | 12 | The licenses for most software are designed to take away your freedom 13 | to share and change it. By contrast, the GNU General Public License is 14 | intended to guarantee your freedom to share and change free software--to 15 | make sure the software is free for all its users. This General Public 16 | License applies to most of the Free Software Foundation's software and 17 | to any other program whose authors commit to using it. (Some other Free 18 | Software Foundation software is covered by the GNU Lesser General Public 19 | License instead.) You can apply it to your programs, too. 20 | 21 | When we speak of free software, we are referring to freedom, not 22 | price. Our General Public Licenses are designed to make sure that you 23 | have the freedom to distribute copies of free software (and charge for 24 | this service if you wish), that you receive source code or can get it 25 | if you want it, that you can change the software or use pieces of it in 26 | new free programs; and that you know you can do these things. 27 | 28 | To protect your rights, we need to make restrictions that forbid anyone 29 | to deny you these rights or to ask you to surrender the rights. These 30 | restrictions translate to certain responsibilities for you if you 31 | distribute copies of the software, or if you modify it. 32 | 33 | For example, if you distribute copies of such a program, whether gratis or 34 | for a fee, you must give the recipients all the rights that you have. You 35 | must make sure that they, too, receive or can get the source code. And 36 | you must show them these terms so they know their rights. 37 | 38 | We protect your rights with two steps: (1) copyright the software, and 39 | (2) offer you this license which gives you legal permission to copy, 40 | distribute and/or modify the software. 41 | 42 | Also, for each author's protection and ours, we want to make certain 43 | that everyone understands that there is no warranty for this free 44 | software. If the software is modified by someone else and passed on, 45 | we want its recipients to know that what they have is not the original, 46 | so that any problems introduced by others will not reflect on the original 47 | authors' reputations. 48 | 49 | Finally, any free program is threatened constantly by software 50 | patents. We wish to avoid the danger that redistributors of a free 51 | program will individually obtain patent licenses, in effect making the 52 | program proprietary. To prevent this, we have made it clear that any 53 | patent must be licensed for everyone's free use or not licensed at all. 54 | 55 | The precise terms and conditions for copying, distribution and 56 | modification follow. 57 | 58 | GNU GENERAL PUBLIC LICENSE 59 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 60 | 61 | This License applies to any program or other work which contains a 62 | notice placed by the copyright holder saying it may be distributed 63 | under the terms of this General Public License. The "Program", below, 64 | refers to any such program or work, and a "work based on the Program" 65 | means either the Program or any derivative work under copyright law: 66 | that is to say, a work containing the Program or a portion of it, 67 | either verbatim or with modifications and/or translated into another 68 | language. (Hereinafter, translation is included without limitation 69 | in the term "modification".) Each licensee is addressed as "you". 70 | Activities other than copying, distribution and modification are not 71 | covered by this License; they are outside its scope. The act of running 72 | the Program is not restricted, and the output from the Program is covered 73 | only if its contents constitute a work based on the Program (independent 74 | of having been made by running the Program). Whether that is true depends 75 | on what the Program does. 76 | 77 | You may copy and distribute verbatim copies of the Program's source 78 | code as you receive it, in any medium, provided that you conspicuously 79 | and appropriately publish on each copy an appropriate copyright notice 80 | and disclaimer of warranty; keep intact all the notices that refer to 81 | this License and to the absence of any warranty; and give any other 82 | recipients of the Program a copy of this License along with the Program. 83 | You may charge a fee for the physical act of transferring a copy, and 84 | you may at your option offer warranty protection in exchange for a fee. 85 | 86 | You may modify your copy or copies of the Program or any portion of it, 87 | thus forming a work based on the Program, and copy and distribute such 88 | modifications or work under the terms of Section 1 above, provided that 89 | you also meet all of these conditions: a) You must cause the modified 90 | files to carry prominent notices stating that you changed the files and 91 | the date of any change. 92 | 93 | b) You must cause any work that you distribute or publish, that in whole 94 | or in part contains or is derived from the Program or any part thereof, 95 | to be licensed as a whole at no charge to all third parties under the 96 | terms of this License. 97 | 98 | c) If the modified program normally reads commands interactively when 99 | run, you must cause it, when started running for such interactive use in 100 | the most ordinary way, to print or display an announcement including an 101 | appropriate copyright notice and a notice that there is no warranty (or 102 | else, saying that you provide a warranty) and that users may redistribute 103 | the program under these conditions, and telling the user how to view a 104 | copy of this License. (Exception: if the Program itself is interactive 105 | but does not normally print such an announcement, your work based on the 106 | Program is not required to print an announcement.) These requirements 107 | apply to the modified work as a whole. If identifiable sections of that 108 | work are not derived from the Program, and can be reasonably considered 109 | independent and separate works in themselves, then this License, and 110 | its terms, do not apply to those sections when you distribute them as 111 | separate works. But when you distribute the same sections as part of 112 | a whole which is a work based on the Program, the distribution of the 113 | whole must be on the terms of this License, whose permissions for other 114 | licensees extend to the entire whole, and thus to each and every part 115 | regardless of who wrote it. 116 | 117 | Thus, it is not the intent of this section to claim rights or contest your 118 | rights to work written entirely by you; rather, the intent is to exercise 119 | the right to control the distribution of derivative or collective works 120 | based on the Program. 121 | 122 | In addition, mere aggregation of another work not based on the Program 123 | with the Program (or with a work based on the Program) on a volume of a 124 | storage or distribution medium does not bring the other work under the 125 | scope of this License. 126 | 127 | You may copy and distribute the Program (or a work based on it, under 128 | Section 2) in object code or executable form under the terms of Sections 1 129 | and 2 above provided that you also do one of the following: a) Accompany 130 | it with the complete corresponding machine-readable source code, which 131 | must be distributed under the terms of Sections 1 and 2 above on a medium 132 | customarily used for software interchange; or, 133 | 134 | b) Accompany it with a written offer, valid for at least three years, to 135 | give any third party, for a charge no more than your cost of physically 136 | performing source distribution, a complete machine-readable copy of the 137 | corresponding source code, to be distributed under the terms of Sections 138 | 1 and 2 above on a medium customarily used for software interchange; or, 139 | 140 | c) Accompany it with the information you received as to the offer to 141 | distribute corresponding source code. (This alternative is allowed only 142 | for noncommercial distribution and only if you received the program 143 | in object code or executable form with such an offer, in accord with 144 | Subsection b above.) The source code for a work means the preferred 145 | form of the work for making modifications to it. For an executable 146 | work, complete source code means all the source code for all modules it 147 | contains, plus any associated interface definition files, plus the scripts 148 | used to control compilation and installation of the executable. However, 149 | as a special exception, the source code distributed need not include 150 | anything that is normally distributed (in either source or binary 151 | form) with the major components (compiler, kernel, and so on) of the 152 | operating system on which the executable runs, unless that component 153 | itself accompanies the executable. 154 | 155 | If distribution of executable or object code is made by offering access 156 | to copy from a designated place, then offering equivalent access to 157 | copy the source code from the same place counts as distribution of the 158 | source code, even though third parties are not compelled to copy the 159 | source along with the object code. 160 | 161 | You may not copy, modify, sublicense, or distribute the Program except 162 | as expressly provided under this License. Any attempt otherwise to 163 | copy, modify, sublicense or distribute the Program is void, and will 164 | automatically terminate your rights under this License. However, parties 165 | who have received copies, or rights, from you under this License will 166 | not have their licenses terminated so long as such parties remain in 167 | full compliance. 168 | 169 | You are not required to accept this License, since you have not signed 170 | it. However, nothing else grants you permission to modify or distribute 171 | the Program or its derivative works. These actions are prohibited 172 | by law if you do not accept this License. Therefore, by modifying or 173 | distributing the Program (or any work based on the Program), you indicate 174 | your acceptance of this License to do so, and all its terms and conditions 175 | for copying, distributing or modifying the Program or works based on it. 176 | 177 | Each time you redistribute the Program (or any work based on the 178 | Program), the recipient automatically receives a license from the 179 | original licensor to copy, distribute or modify the Program subject to 180 | these terms and conditions. You may not impose any further restrictions 181 | on the recipients' exercise of the rights granted herein. You are not 182 | responsible for enforcing compliance by third parties to this License. 183 | 184 | If, as a consequence of a court judgment or allegation of patent 185 | infringement or for any other reason (not limited to patent issues), 186 | conditions are imposed on you (whether by court order, agreement or 187 | otherwise) that contradict the conditions of this License, they do not 188 | excuse you from the conditions of this License. If you cannot distribute 189 | so as to satisfy simultaneously your obligations under this License 190 | and any other pertinent obligations, then as a consequence you may not 191 | distribute the Program at all. For example, if a patent license would 192 | not permit royalty-free redistribution of the Program by all those who 193 | receive copies directly or indirectly through you, then the only way you 194 | could satisfy both it and this License would be to refrain entirely from 195 | distribution of the Program. 196 | 197 | If any portion of this section is held invalid or unenforceable under any 198 | particular circumstance, the balance of the section is intended to apply 199 | and the section as a whole is intended to apply in other circumstances. 200 | 201 | It is not the purpose of this section to induce you to infringe any 202 | patents or other property right claims or to contest validity of any such 203 | claims; this section has the sole purpose of protecting the integrity of 204 | the free software distribution system, which is implemented by public 205 | license practices. Many people have made generous contributions to the 206 | wide range of software distributed through that system in reliance on 207 | consistent application of that system; it is up to the author/donor to 208 | decide if he or she is willing to distribute software through any other 209 | system and a licensee cannot impose that choice. 210 | 211 | This section is intended to make thoroughly clear what is believed to 212 | be a consequence of the rest of this License. 213 | 214 | If the distribution and/or use of the Program is restricted in certain 215 | countries either by patents or by copyrighted interfaces, the original 216 | copyright holder who places the Program under this License may add an 217 | explicit geographical distribution limitation excluding those countries, 218 | so that distribution is permitted only in or among countries not thus 219 | excluded. In such case, this License incorporates the limitation as if 220 | written in the body of this License. 221 | 222 | The Free Software Foundation may publish revised and/or new versions of 223 | the General Public License from time to time. Such new versions will be 224 | similar in spirit to the present version, but may differ in detail to 225 | address new problems or concerns. 226 | 227 | Each version is given a distinguishing version number. If the Program 228 | specifies a version number of this License which applies to it and 229 | "any later version", you have the option of following the terms and 230 | conditions either of that version or of any later version published by 231 | the Free Software Foundation. If the Program does not specify a version 232 | number of this License, you may choose any version ever published by 233 | the Free Software Foundation. 234 | 235 | If you wish to incorporate parts of the Program into other free programs 236 | whose distribution conditions are different, write to the author to ask 237 | for permission. For software which is copyrighted by the Free Software 238 | Foundation, write to the Free Software Foundation; we sometimes make 239 | exceptions for this. Our decision will be guided by the two goals of 240 | preserving the free status of all derivatives of our free software and 241 | of promoting the sharing and reuse of software generally. 242 | 243 | NO WARRANTY 244 | 245 | BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY 246 | FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN 247 | OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES 248 | PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED 249 | OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 250 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK 251 | AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE 252 | PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, 253 | REPAIR OR CORRECTION. 254 | 255 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 256 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR 257 | REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, 258 | INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES 259 | ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT 260 | NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES 261 | SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE 262 | WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN 263 | ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 264 | 265 | END OF TERMS AND CONDITIONS 266 | 267 | How to Apply These Terms to Your New Programs 268 | If you develop a new program, and you want it to be of the greatest 269 | possible use to the public, the best way to achieve this is to make it 270 | free software which everyone can redistribute and change under these 271 | terms. 272 | 273 | To do so, attach the following notices to the program. It is safest 274 | to attach them to the start of each source file to most effectively 275 | convey the exclusion of warranty; and each file should have at least the 276 | "copyright" line and a pointer to where the full notice is found. 277 | 278 | 279 | Copyright (C) 280 | 281 | This program is free software; you can redistribute it and/or modify it 282 | under the terms of the GNU General Public License as published by the 283 | Free Software Foundation; either version 2 of the License, or (at your 284 | option) any later version. 285 | 286 | This program is distributed in the hope that it will be useful, but 287 | WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 288 | or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 289 | for more details. 290 | 291 | You should have received a copy of the GNU General Public License along 292 | with this program; if not, write to the Free Software Foundation, Inc., 293 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Also add 294 | information on how to contact you by electronic and paper mail. 295 | 296 | If the program is interactive, make it output a short notice like this 297 | when it starts in an interactive mode: 298 | 299 | Gnomovision version 69, Copyright (C) year name of author Gnomovision 300 | comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is 301 | free software, and you are welcome to redistribute it under certain 302 | conditions; type `show c' for details. The hypothetical commands show 303 | w' and show c' should show the appropriate parts of the General Public 304 | License. Of course, the commands you use may be called something other 305 | than show w' and show c'; they could even be mouse-clicks or menu 306 | items--whatever suits your program. 307 | 308 | You should also get your employer (if you work as a programmer) or 309 | your school, if any, to sign a "copyright disclaimer" for the program, 310 | if necessary. Here is a sample; alter the names: 311 | 312 | Yoyodyne, Inc., hereby disclaims all copyright interest in the program 313 | `Gnomovision' (which makes passes at compilers) written by James Hacker. 314 | 315 | , 1 April 1989 Ty Coon, President of Vice 316 | 317 | This General Public License does not permit incorporating your program 318 | into proprietary programs. If your program is a subroutine library, you 319 | may consider it more useful to permit linking proprietary applications 320 | with the library. If this is what you want to do, use the GNU Lesser 321 | General Public License instead of this License. 322 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | 2 | .DEFAULT_GOAL := all 3 | .PHONY: all install 4 | 5 | all: 6 | emacs --batch --eval '(byte-compile-file "torus.el")' --kill 7 | 8 | clean: 9 | rm -f *.elc 10 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | 2 | #+STARTUP: showall 3 | 4 | #+TAGS: TOC(t) 5 | 6 | * Table of contents :TOC_2_gh: 7 | - [[#news][News]] 8 | - [[#introduction][Introduction]] 9 | - [[#history][History]] 10 | - [[#goal][Goal]] 11 | - [[#installation][Installation]] 12 | - [[#melpa][MELPA]] 13 | - [[#el-get][El-get]] 14 | - [[#step-by-step][Step by Step]] 15 | - [[#first-circles][First Circles]] 16 | - [[#moving-around][Moving around]] 17 | - [[#square-the-circle][Square the Circle]] 18 | - [[#splits][Splits]] 19 | - [[#key-bindings][Key Bindings]] 20 | - [[#levels][Levels]] 21 | - [[#list-of-bindings][List of bindings]] 22 | - [[#shortcuts][Shortcuts]] 23 | - [[#mouse][Mouse]] 24 | - [[#on-the-tab-bar][On the tab bar]] 25 | - [[#configuration][Configuration]] 26 | - [[#use-package][Use-package]] 27 | - [[#changelog][Changelog]] 28 | - [[#author--licence][Author & Licence]] 29 | - [[#warning][Warning]] 30 | 31 | * News 32 | 33 | Version 2 is out ! Check the =README.org= of branch =version-2= on github or, 34 | if you have a local clone : 35 | 36 | #+BEGIN_SRC 37 | git checkout version-2 38 | #+END_SRC 39 | 40 | 41 | * Introduction 42 | 43 | If you ever dreamed about creating and switching buffer groups at will 44 | in Emacs, [[https://github.com/chimay/torus][Torus]] is the tool you want. 45 | 46 | In short, this plugin let you organize your buffers by creating as 47 | many buffer groups as you need, add the buffers you want to it and 48 | quickly navigate between : 49 | 50 | - Buffers of the same group 51 | 52 | - Buffer groups 53 | 54 | - Workspaces, ie sets of buffer groups 55 | 56 | Note that : 57 | 58 | - A location is a pair (filename . position) 59 | 60 | - A buffer group, in fact a location group, is called a circle 61 | 62 | - A set of buffer groups is called a torus (a circle of circles) 63 | 64 | 65 | ** History 66 | 67 | This project is inspired by MTorus. You can find the original sources 68 | on the links below : 69 | 70 | - The repository of Stefan Kamphausen, the orignal author, is 71 | available at https://www.skamphausen.de/cgi-bin/ska/mtorus 72 | 73 | - The rewrite by Sebastian Freundt is available on 74 | https://sourceforge.net/projects/mtorus.berlios/ 75 | 76 | - I’ve a personal fork of the second one : 77 | https://github.com/chimay/mtorus, but I won’t maintain it anymore 78 | 79 | The code I forked is complex, so I decided to write a new version from 80 | scratch, easier to maintain and enjoying more recent features of 81 | emacs. 82 | 83 | 84 | ** Goal 85 | 86 | Torus helps you to organize your files in groups that you create 87 | yourself, following your workflow. You only add the files you want, 88 | where you want. For instance, if you have a "organize" group with 89 | agenda & todo files, you can quickly alternate them, or display them 90 | in two windows. Then, if you suddenly got an idea to tune emacs, you 91 | switch to the "emacs" group with your favorites configuration files in 92 | it. Same process, to cycle, alternate or display the files. Note that 93 | the torus containing all these groups can be saved on a file and 94 | loaded later. Over time, your groups will grow and adapt to your 95 | style. 96 | 97 | 98 | * Installation 99 | 100 | 101 | ** MELPA 102 | 103 | Torus is available on MELPA. If you have this line on your init file : 104 | 105 | #+begin_src emacs-lisp 106 | (add-to-list 'package-archives '("melpa" . "http://melpa.org/packages/")) 107 | #+end_src 108 | 109 | you should be able to install it from the packages menu 110 | (~M-x list-packages~). 111 | 112 | 113 | ** El-get 114 | 115 | If you use el-get, just create a recipe file ~torus.rcp~ : 116 | 117 | #+begin_src emacs-lisp 118 | (:name torus 119 | :website "http://github.com/chimay/torus" 120 | :description "Torus : Circle of Circles of buffers" 121 | :type github 122 | :pkgname "chimay/torus") 123 | #+end_src 124 | 125 | and add it to a directory present in ~el-get-recipe-path~. Then, use 126 | ~M-x el-get-install torus~ or add : 127 | 128 | #+begin_src emacs-lisp 129 | (el-get-bundle torus) 130 | #+end_src 131 | 132 | to your init file. 133 | 134 | 135 | * Step by Step 136 | 137 | 138 | ** First Circles 139 | 140 | Let’s say we have the files =Juice=, =Tea=, =Coffe=. The first thing 141 | to do is to create a group (a circle) which will contain them. So, we 142 | launch ~torus-add-circle~ and answer =Drinks= to the prompt. Then, we 143 | go to =Juice= and use ~torus-add-location~ to add it to the circle. 144 | Same process with =Tea= and =Coffee=. We now have a circle =Drink= 145 | containing three files. 146 | 147 | If your files are not already opened in buffers, just use 148 | ~torus-add-file~ to add them in the circle. 149 | 150 | If you want to create another circle, let’s say =Fruits=, simply 151 | launch ~torus-add-circle~ again, and enter another name. You can then 152 | add the files =Apple=, =Pear= and =Orange= to it. You can even also 153 | add =Juice=, a file can be added to more than one circle. 154 | 155 | Now, suppose that in the =Juice= file, you have a Pineapple and a 156 | Mango sections, and you want to compare them. Just go to the Pineapple 157 | section, use ~torus-add-location~. It will add the location 158 | (=Juice . pineapple-position=) to the current circle. Then, go to 159 | the Mango section, and do the same. The (=Juice . mango-position=) 160 | will also be added to the circle. You can then easily alternate both, 161 | or display them in split windows. 162 | 163 | 164 | ** Moving around 165 | 166 | You can cycle the files of a circle with ~torus-next-location~ and 167 | ~torus-previous-location~. You can also switch file with completion by using 168 | ~torus-switch-location~. It works well with Helm. 169 | 170 | To cycle the circles, use ~torus-next-circle~ and 171 | ~torus-previous-circle~. To go to a given circle with completion, use 172 | ~torus-switch-circle~. 173 | 174 | 175 | ** Square the Circle 176 | 177 | Over time, the number of circles will grow. Completion is great, but 178 | if you just want to alternate the two last circles in history, you’ll 179 | probably prefer ~ŧorus-alternate-circles~. You can also alternate two 180 | last files inside the same circle with 181 | ~torus-alternate-in-same-circle~. So, you have the square : 182 | 183 | | circle 1, file 1 | circle 1, file 2 | 184 | | circle 2, file 3 | circle 2, file 4 | 185 | 186 | at your fingertips. 187 | 188 | Finally, ~torus-alternate-in-same-torus~ alternate two last history 189 | files, regardless of their circles. 190 | 191 | 192 | ** Splits 193 | 194 | If you prefix a torus navigation function by C-u, the asked file will 195 | be opened in a new window below. With C-u C-u, it will be in a new 196 | window on the right. 197 | 198 | If you want to see all the circle files in separate windows, use 199 | ~torus-layout-menu~ and chose between horizontal, vertical or grid 200 | splits. You also have layouts with main window on left, right, top or 201 | bottom side. 202 | 203 | Your choice is remembered by torus for the current circle. You can 204 | swith back to one window using the same layout function. The special 205 | choice "manual" ask Torus not to interfere in your layout. 206 | 207 | The maximum number of windows generated by the split functions 208 | are conxtrolled by the vars ~torus-maximum-horizontal-split~ and 209 | ~torus-maximum-vertical-split~. 210 | 211 | 212 | * Key Bindings 213 | 214 | All bindings are available after the prefix key == by 215 | default. You can see them by pressing , or by installing 216 | [[https://github.com/justbur/emacs-which-key][which-key]]. You can also define your own : 217 | 218 | #+begin_src emacs-lisp 219 | (define-key torus-map (kbd "i") 'torus-info) 220 | #+end_src 221 | 222 | 223 | ** Levels 224 | 225 | The option ~torus-binding-level~, an integer between 0 and 3, decide 226 | how many functions will be bound to keys : the higher it is, the more 227 | bindings available. Level 1 or 2 is fine for most usages. 228 | 229 | - Level 0 230 | 231 | + Adding 232 | 233 | + Deleting 234 | 235 | + Moving around 236 | 237 | + Save and load 238 | 239 | - Level 1 240 | 241 | + History 242 | 243 | + Renaming 244 | 245 | + Moving and copying things 246 | 247 | + Join 248 | 249 | + Layout 250 | 251 | - Level 2 252 | 253 | + Reverse 254 | 255 | + Prefix 256 | 257 | + Autogroup 258 | 259 | - Level 3 : you surely don’t want to use these 260 | 261 | + Print main internal variables 262 | 263 | + Reset main internal variables 264 | 265 | + Miscellaneous 266 | 267 | 268 | ** List of bindings 269 | 270 | Enter the prefix key, then : 271 | 272 | - =c= : create a new circle, add it to the torus 273 | 274 | - =l= : create the current location (file . position) to the current circle 275 | 276 | - =f= : add a file to the current circle ; more precisely, location (file . 1) 277 | 278 | - =i= : info about the current circle 279 | 280 | - =p= : print main variables content 281 | 282 | - == : next file (location) in circle 283 | 284 | - == : previous file in circle 285 | 286 | - ~=~ : switch file in circle 287 | 288 | - == : next circle 289 | 290 | - == : previous circle 291 | 292 | - == : switch circle 293 | 294 | - =s= : search file in all circles 295 | 296 | - == : older file in file history 297 | 298 | - == : newer file in file history 299 | 300 | - =a= : alternate menu 301 | 302 | + =m= : alternate last two visited files in all toruses (meta torus) 303 | 304 | + =t= : alternate last two visited files in current torus 305 | 306 | + =c= : alternate last two visited files in current circle 307 | 308 | + =T= : alternate last two toruses 309 | 310 | + =C= : alternate last two circles 311 | 312 | - =^= : alternate last two visited files in history of current torus 313 | 314 | - =<= : alternate last two circles in history 315 | 316 | - =>= : alternate last two files in same circle in history 317 | 318 | - =h= : search in the file history 319 | 320 | - =n= : rename circle 321 | 322 | - =d= : delete file from circle 323 | 324 | - =D= : delete circle from torus 325 | 326 | - =w= : write torus to a file as Lisp code (with ".el" extension) 327 | 328 | - =r= : read torus from a torus file 329 | 330 | - =e= : edit a torus file ; ask to load its content after saving it 331 | 332 | - =m= : move file in circle (not on disk) 333 | 334 | - =M= : move circle in torus 335 | 336 | - =v= : move file to another circle 337 | 338 | - =y= : copy, add the (file . position) to another circle 339 | 340 | - =j= : join the files of two circles, a new circle is created to 341 | contain them 342 | 343 | - =#= : layout menu 344 | 345 | + =m= : manual mode, leave unchanged 346 | 347 | + =o= : only one window, delete the others 348 | 349 | + =h= : split horizontally to display all files of the circles 350 | 351 | + =v= : split vertically to display all files of the circles 352 | 353 | + =g= : split in a grid to display all files of the circles 354 | 355 | - =o= : reverse menu 356 | 357 | + =l= : reverse location order (file order) in a circle 358 | 359 | + =c= : reverse circle order in the torus 360 | 361 | + =d= : deep reverse : reverse both locations and circle 362 | 363 | - =:= : prefix circles names 364 | 365 | - =!= : batch menu (be careful with this) 366 | 367 | + =e= : eval Elisp code on each file of the current circle 368 | 369 | + =c= : eval Elisp command on each file of the current circle 370 | 371 | + =!= : eval Shell command on each file of the current circle 372 | 373 | + =&= : eval Async Shell command on each file of the current circle 374 | 375 | 376 | *** Torus operations 377 | 378 | You can create new toruses, beginning with a copy of the current 379 | torus, and switch easily between them. A list of toruses, called Meta 380 | Torus, is available. Some actions, like joining or autogrouping, also 381 | create new toruses. 382 | 383 | - =+= : add a new torus to the torus list (variable ~torus-meta~) 384 | 385 | - =*= : add a new torus as a copy of the current torus 386 | 387 | - =C-n= : next torus 388 | 389 | - =C-p= : previous torus 390 | 391 | - =@= : switch torus 392 | 393 | - =S= : search file in all toruses 394 | 395 | - =N= : rename torus 396 | 397 | - =M-m= : move torus in meta torus 398 | 399 | - =V= : move circle to another torus 400 | 401 | - =Y= : copy circle to another torus 402 | 403 | - =J= : join the circles of two toruses, a new torus is created to 404 | contain them 405 | 406 | - =g= : autogroup files in a new torus 407 | 408 | + =p= : group files by path 409 | 410 | + =d= : group files by directories 411 | 412 | + =e= : group files by extensions 413 | 414 | - =-= : delete a torus 415 | 416 | 417 | ** Shortcuts 418 | 419 | I strongly suggest that you bind the functions you use most to quick 420 | shortcuts. Here are some examples : 421 | 422 | #+begin_src emacs-lisp 423 | (global-set-key (kbd "") 'torus-add-circle) 424 | (global-set-key (kbd "") 'torus-add-location) 425 | 426 | (global-set-key (kbd "") 'torus-delete-location) 427 | (global-set-key (kbd "") 'torus-delete-circle) 428 | 429 | (global-set-key (kbd "") 'torus-previous-location) 430 | (global-set-key (kbd "") 'torus-next-location) 431 | 432 | (global-set-key (kbd "") 'torus-previous-circle) 433 | (global-set-key (kbd "") 'torus-next-circle) 434 | 435 | (global-set-key (kbd "s-SPC") 'torus-switch-circle) 436 | (global-set-key (kbd "s-=") 'torus-switch-location) 437 | (global-set-key (kbd "s-^") 'torus-switch-torus) 438 | 439 | (global-set-key (kbd "s-*") 'torus-search) 440 | (global-set-key (kbd "s-/") 'torus-search-history) 441 | 442 | (global-set-key (kbd "") 'torus-history-newer) 443 | (global-set-key (kbd "") 'torus-history-older) 444 | 445 | (global-set-key (kbd "C-^") 'torus-alternate-in-same-torus) 446 | 447 | (global-set-key (kbd "") 'torus-alternate-circles) 448 | (global-set-key (kbd "") 'torus-alternate-in-same-circle) 449 | #+end_src 450 | 451 | 452 | * Mouse 453 | 454 | 455 | ** On the tab bar 456 | 457 | If you set ~torus-display-tab-bar~ to ~t~, a minimalist tab bar will 458 | take place on the top of your torus buffers. Appearence : 459 | 460 | #+begin_example 461 | current-torus-name >> current-circle-name > current-location | location-2 | location-3 | ... 462 | #+end_example 463 | 464 | You can click on it to navigate : 465 | 466 | - Torus name region 467 | 468 | + Left click : switch torus with completion 469 | 470 | + Right click : meta search on all files of all toruses 471 | 472 | + Wheel : next / previous torus 473 | 474 | - Circle name region 475 | 476 | + Left click : switch circle with completion 477 | 478 | + Right click : search on all files of the current torus 479 | 480 | + Wheel : next / previous circle 481 | 482 | - Location region 483 | 484 | + Left click 485 | 486 | * Current location : alternate two last locations in same circle 487 | 488 | * Other locations : go to that location 489 | 490 | + Right click : switch location with completion 491 | 492 | + Wheel : next / previous location 493 | 494 | 495 | * Configuration 496 | 497 | Here is a sample configuration : 498 | 499 | #+begin_src emacs-lisp 500 | 501 | (require 'torus) 502 | 503 | (setq torus-prefix-key "s-t") 504 | 505 | ;; Range 0 -> 3 506 | ;; The bigger it is, the more bindings. 507 | (setq torus-binding-level 1) 508 | 509 | ;; Created if non existent 510 | (setq torus-dirname "~/.emacs.d/torus/") 511 | 512 | ;; Set it to t if you want autoload of torus on Emacs startup 513 | (setq torus-load-on-startup t) 514 | 515 | ;; Set it to t if you want autosave of torus on Emacs exit 516 | (setq torus-save-on-exit t) 517 | 518 | ;; Where to auto load & save torus 519 | (setq torus-autoread-file "~/.emacs.d/torus/last.el") 520 | (setq torus-autowrite-file torus-autoread-file) 521 | 522 | ;; Number of backups you want 523 | ;; They will be numbered your-file.el.1 to your-file.el.N 524 | (setq torus-backup-number 5) 525 | 526 | (setq torus-history-maximum-elements 30) 527 | 528 | (setq torus-maximum-horizontal-split 3) 529 | (setq torus-maximum-vertical-split 4) 530 | 531 | ;; Format : 532 | ;; torus >> circle > [ file:line ] | file:line | file:line | ... 533 | (setq torus-display-tab-bar t) 534 | 535 | (torus-init) 536 | 537 | (torus-install-default-bindings) 538 | 539 | #+end_src 540 | 541 | 542 | ** Use-package 543 | 544 | If you declare Torus with ~use-package~ and want the start/quit hooks 545 | to load/save your torus file, you’ll have to add a ~:hook~ section to 546 | the declaration : 547 | 548 | #+begin_src emacs-lisp 549 | (use-package torus 550 | :bind-keymap ("s-t" . torus-map) 551 | :bind (("" . torus-add-circle) 552 | ("" . torus-add-location) 553 | ("" . torus-delete-location) 554 | ("" . torus-delete-circle) 555 | ("" . torus-previous-location) 556 | ("" . torus-next-location) 557 | ("" . torus-previous-circle) 558 | ("" . torus-next-circle) 559 | ("" . torus-history-newer) 560 | ("" . torus-history-older) 561 | ("C-^" . torus-alternate-in-same-torus) 562 | ("" . torus-alternate-circles) 563 | ("" . torus-alternate-in-same-circle) 564 | ("s-SPC" . torus-switch-circle) 565 | ("s-=" . torus-switch-location) 566 | ("s-^" . torus-switch-torus) 567 | ("s-*" . torus-search) 568 | ("s-/" . torus-search-history) 569 | :map torus-map 570 | ("t" . torus-copy-to-circle)) 571 | :hook ((emacs-startup . torus-start) 572 | (kill-emacs . torus-quit)) 573 | :custom ((torus-prefix-key "s-t") 574 | (torus-binding-level 3) 575 | (torus-verbosity 1) 576 | (torus-dirname (concat user-emacs-directory (file-name-as-directory "torus"))) 577 | (torus-load-on-startup t) 578 | (torus-save-on-exit t) 579 | (torus-autoread-file (concat torus-dirname "last.el")) 580 | (torus-autowrite-file torus-autoread-file) 581 | (torus-backup-number 5) 582 | (torus-history-maximum-elements 30) 583 | (torus-maximum-horizontal-split 3) 584 | (torus-maximum-vertical-split 4) 585 | (torus-display-tab-bar t) 586 | (torus-separator-torus-circle " >> ") 587 | (torus-separator-circle-location " > ") 588 | (torus-prefix-separator "/") 589 | (torus-join-separator " & ")) 590 | :config 591 | (torus-init) 592 | (torus-install-default-bindings)) 593 | #+end_src 594 | 595 | 596 | * Changelog 597 | 598 | - version 1.10 599 | 600 | + search in all toruses 601 | 602 | + previous and next torus 603 | 604 | + move torus 605 | 606 | + copy & move circle to torus 607 | 608 | + mouse support in tab bar 609 | 610 | + batch operations 611 | 612 | - version 1.9 : backup of torus files 613 | 614 | - version 1.8 : tab bar 615 | 616 | - version 1.7 : autogroups, layout 617 | 618 | - version 1.6 : join, ready for MELPA 619 | 620 | - version 1.2 - 1.5 : move, copy, reverse, history, split, alternate 621 | 622 | - version 1.1 : input history 623 | 624 | - version 1.0 : switch 625 | 626 | - before : lost in the mist of prehistory 627 | 628 | 629 | * Author & Licence 630 | 631 | - Copyright (C) 2019 Chimay 632 | - Licensed under GPL v2 633 | 634 | 635 | * Warning 636 | 637 | Despite abundant testing, some bugs might remain, so be careful. 638 | -------------------------------------------------------------------------------- /recipes/el-get/torus.rcp: -------------------------------------------------------------------------------- 1 | (:name torus 2 | :website "http://github.com/chimay/torus" 3 | :description "Torus : Circle of Circles of buffers" 4 | :type github 5 | :pkgname "chimay/torus") 6 | -------------------------------------------------------------------------------- /recipes/melpa/torus.melpa: -------------------------------------------------------------------------------- 1 | (torus :repo "chimay/torus" 2 | :fetcher github) 3 | -------------------------------------------------------------------------------- /torus.el: -------------------------------------------------------------------------------- 1 | ;;; torus.el --- A buffer groups manager -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2019 Chimay 4 | 5 | ;; Author : Chimay 6 | ;; Name: Torus 7 | ;; Package-Version: 1.10 8 | ;; Package-requires: ((emacs "26")) 9 | ;; Keywords: files, buffers, groups, persistent, history, layout, tabs 10 | ;; URL: https://github.com/chimay/torus 11 | 12 | ;;; Commentary: 13 | 14 | ;; If you ever dreamed about creating and switching buffer groups at will 15 | ;; in Emacs, Torus is the tool you want. 16 | ;; 17 | ;; In short, this plugin let you organize your buffers by creating as 18 | ;; many buffer groups as you need, add the files you want to it and 19 | ;; quickly navigate between : 20 | ;; 21 | ;; - Buffers of the same group 22 | ;; - Buffer groups 23 | ;; - Workspaces, ie sets of buffer groups 24 | ;; 25 | ;; Note that : 26 | ;; 27 | ;; - A location is a pair (buffer (or filename) . position) 28 | ;; - A buffer group, in fact a location group, is called a circle 29 | ;; - A set of buffer groups is called a torus (a circle of circles) 30 | ;; 31 | ;; Original idea by Stefan Kamphausen, see https://www.skamphausen.de/cgi-bin/ska/mtorus 32 | ;; 33 | ;; See https://github.com/chimay/torus/blob/master/README.org for more details 34 | 35 | ;;; License 36 | ;;; ------------------------------ 37 | 38 | ;; This file is not part of Emacs. 39 | 40 | ;; This program is free software; you can redistribute it and/or modify it 41 | ;; under the terms of the GNU General Public License as published by 42 | ;; the Free Software Foundation; either version 2, or (at your option) 43 | ;; any later version. 44 | 45 | ;; This program is distributed in the hope that it will be useful, but 46 | ;; WITHOUT ANY WARRANTY; without even the implied warranty of 47 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 48 | ;; General Public License for more details. 49 | 50 | ;; You should have received a copy of the GNU General Public License 51 | ;; along with this program; see the file COPYING. If not, write to the 52 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 53 | ;; Boston, MA 02111-1307, USA. 54 | 55 | ;;; Credits: 56 | ;;; ------------------------------ 57 | 58 | ;; Stefan Kamphausen, https://www.skamphausen.de/cgi-bin/ska/mtorus 59 | ;; Sebastian Freundt, https://sourceforge.net/projects/mtorus.berlios/ 60 | 61 | ;;; Code: 62 | ;;; ------------------------------------------------------------ 63 | 64 | ;;; Requires 65 | ;;; ------------------------------ 66 | 67 | (eval-when-compile 68 | (require 'cl-lib) 69 | (require 'cl-extra) 70 | (require 'seq) 71 | (require 'subr-x)) 72 | 73 | (declare-function cl-copy-seq "cl-lib") 74 | 75 | (declare-function cl-subseq "cl-extra") 76 | 77 | (declare-function cl-position "cl-lib") 78 | (declare-function cl-find "cl-lib") 79 | (declare-function cl-remove "cl-lib") 80 | 81 | (declare-function seq-intersection "seq") 82 | (declare-function seq-filter "seq") 83 | (declare-function seq-group-by "seq") 84 | 85 | (declare-function string-join "subr-x") 86 | 87 | ;;; Custom 88 | ;;; ------------------------------ 89 | 90 | (defgroup torus nil 91 | "An interface to navigating groups of buffers." 92 | :tag "Torus" 93 | :link '(url-link :tag "Home Page" 94 | "https://github.com/chimay/torus") 95 | :link '(emacs-commentary-link 96 | :tag "Commentary in torus.el" "torus.el") 97 | :prefix "torus-" 98 | :group 'environment 99 | :group 'extensions 100 | :group 'convenience) 101 | 102 | (defcustom torus-prefix-key "s-t" 103 | "Prefix key for the torus key mappings. 104 | Will be processed by `kbd'." 105 | :type 'string 106 | :group 'torus) 107 | 108 | (defcustom torus-binding-level 1 109 | "Whether to activate optional keybindings." 110 | :type 'integer 111 | :group 'torus) 112 | 113 | (defcustom torus-verbosity 1 114 | "Level of verbosity. 115 | 1 = normal 116 | 2 = light debug 117 | 3 = heavy debug." 118 | :type 'integer 119 | :group 'torus) 120 | 121 | (defcustom torus-dirname user-emacs-directory 122 | "The directory where the torus are read and written." 123 | :type 'string 124 | :group 'torus) 125 | 126 | (defcustom torus-load-on-startup nil 127 | "Whether to load torus on startup of Emacs." 128 | :type 'boolean 129 | :group 'torus) 130 | 131 | (defcustom torus-save-on-exit nil 132 | "Whether to save torus on exit of Emacs." 133 | :type 'boolean 134 | :group 'torus) 135 | 136 | (defcustom torus-autoread-file nil 137 | "The file to load on startup when `torus-load-on-startup' is t." 138 | :type 'string 139 | :group 'torus) 140 | 141 | (defcustom torus-autowrite-file nil 142 | "The file to write before quitting Emacs when `torus-save-on-exit' is t." 143 | :type 'string 144 | :group 'torus) 145 | 146 | (defcustom torus-backup-number 3 147 | "Number of backups of torus files." 148 | :type 'integer 149 | :group 'torus) 150 | 151 | (defcustom torus-history-maximum-elements 30 152 | "Maximum number of elements in `torus-history' and `torus-meta-history'." 153 | :type 'integer 154 | :group 'torus) 155 | 156 | (defcustom torus-maximum-horizontal-split 3 157 | "Maximum number of horizontal split, see `torus-split-horizontally'." 158 | :type 'integer 159 | :group 'torus) 160 | 161 | (defcustom torus-maximum-vertical-split 4 162 | "Maximum number of vertical split, see `torus-split-vertically'." 163 | :type 'integer 164 | :group 'torus) 165 | 166 | (defcustom torus-display-tab-bar nil 167 | "Whether to display a tab bar in `header-line-format'." 168 | :type 'boolean 169 | :group 'torus) 170 | 171 | (defcustom torus-separator-torus-circle " >> " 172 | "String between torus and circle in the dashboard." 173 | :type 'string 174 | :group 'torus) 175 | 176 | (defcustom torus-separator-circle-location " > " 177 | "String between circle and location(s) in the dashboard." 178 | :type 'string 179 | :group 'torus) 180 | 181 | (defcustom torus-location-separator " | " 182 | "String between location(s) in the dashboard." 183 | :type 'string 184 | :group 'torus) 185 | 186 | (defcustom torus-prefix-separator "/" 187 | "String between the prefix and the circle names. 188 | The name of the new circles will be of the form : 189 | \"User_input_prefix `torus-prefix-separator' Name_of_the_added_circle\" 190 | without the spaces. If the user enter a blank prefix, 191 | the added circle names remain untouched." 192 | :type 'string 193 | :group 'torus) 194 | 195 | (defcustom torus-join-separator " & " 196 | "String between the names when joining. 197 | The name of the new object will be of the form : 198 | \"Object-1 `torus-join-separator' Object-2\" 199 | without the spaces." 200 | :type 'string 201 | :group 'torus) 202 | 203 | ;;; Variables 204 | ;;; ------------------------------ 205 | 206 | (defvar torus-meta nil 207 | "List of existing toruses. 208 | You can create new torus with `torus-add-torus'or `torus-add-copy-of-torus'. 209 | Some functions also create a new torus to work with.") 210 | 211 | (defvar torus-torus nil 212 | "The torus is a list of circles. 213 | A circle is a list of locations, stored in the form : 214 | \(\"circle name\" locations) 215 | A location is a pair (file . position) 216 | Most recent entries are in the beginning of the lists.") 217 | 218 | (defvar torus-history nil 219 | "Alist containing the history of locations in the torus. 220 | Each element is of the form : 221 | \((file . position) . circle)") 222 | 223 | (defvar torus-layout nil 224 | "Alist containing split layout of circles. 225 | Each element is of the form: 226 | \(circle . layout)") 227 | 228 | (defvar torus-input-history nil 229 | "History of user input.") 230 | 231 | (defvar torus-index nil 232 | "Alist giving circles corresponding to torus locations. 233 | Each element has the form : 234 | \((file . position) . circle) 235 | Allow to search among all files of the torus.") 236 | 237 | (defvar torus-meta-history nil 238 | "Alist containing the history of locations in all toruses. 239 | Each element is of the form : 240 | \((file . position) . (circle . torus))") 241 | 242 | (defvar torus-meta-index nil 243 | "Alist giving circles and toruses corresponding to torus locations. 244 | Each element has the form : 245 | \((file . position) . (circle . torus)) 246 | Allows to search among all files of the meta torus.") 247 | 248 | (defvar torus-line-col nil 249 | "Alist storing locations and corresponding lines & columns in files. 250 | Each element is of the form : 251 | \((file . position) . (line . column)) 252 | Allows to display lines & columns.") 253 | 254 | (defvar torus-markers nil 255 | "Alist containing markers to opened files. 256 | Each element is of the form : 257 | \((file . position) . marker) 258 | Contain only the files opened in buffers.") 259 | 260 | (defvar torus-original-header-lines nil 261 | "Alist containing orginal header lines, before torus changed it. 262 | Each element is of the form : 263 | \(buffer . original-header-line)") 264 | 265 | ;;; Extensions 266 | ;;; ------------ 267 | 268 | (defvar torus-extension ".el" 269 | "Extension for torus files.") 270 | 271 | ;;; Prompts 272 | ;;; ------------ 273 | 274 | (defvar torus--message-reset-choice 275 | "Reset [a] all [m] meta [t] torus [h] history [H] meta-history [l] layout [n] input history\n\ 276 | [i] index [I] meta-index [p] line & col [C-m] markers [o] orig header line") 277 | 278 | (defvar torus--message-print-choice 279 | "Print [a] all [m] meta [t] torus [h] history [H] meta-history [l] layout [n] input history\n\ 280 | [i] index [I] meta-index [p] line & col [C-m] marker [o] orig header line") 281 | 282 | (defvar torus--message-alternate-choice 283 | "Alternate [m] in meta torus [t] in torus [c] in circle [T] toruses [C] circles") 284 | 285 | (defvar torus--message-reverse-choice 286 | "Reverse [l] locations [c] circle [d] deep : locations & circles") 287 | 288 | (defvar torus--message-autogroup-choice 289 | "Autogroup by [p] path [d] directory [e] extension") 290 | 291 | (defvar torus--message-batch-choice 292 | "Run on circle files [e] Elisp code [c] Elisp command \n\ 293 | [!] Shell command [&] Async Shell command") 294 | 295 | (defvar torus--message-layout-choice 296 | "Layout [m] manual [o] one window [h] horizontal [v] vertical [g] grid \n\ 297 | main window on [l] left [r] right [t] top [b] bottom") 298 | 299 | (defvar torus--message-file-does-not-exist 300 | "File %s does not exist anymore. It will be removed from the torus.") 301 | 302 | (defvar torus--message-empty-circle 303 | "No location in circle %s. You can use torus-add-location to fill the circle.") 304 | 305 | (defvar torus--message-empty-torus 306 | "Torus is empty. Please use torus-add-location.") 307 | 308 | (defvar torus--message-empty-meta 309 | "Meta Torus is empty. Please use torus-add-location.") 310 | 311 | (defvar torus--message-existent-location 312 | "Location %s already exists in circle %s") 313 | 314 | (defvar torus--message-prefix-circle 315 | "Prefix for the circle of torus %s (leave blank for none) ? ") 316 | 317 | (defvar torus--message-circle-name-collision 318 | "Circle name collision. Please add/adjust prefixes to avoid confusion.") 319 | 320 | (defvar torus--message-replace-torus 321 | "This will replace the current torus variables. Continue ? ") 322 | 323 | ;;; Mappings 324 | ;;; ------------------------------ 325 | 326 | (defvar torus-map) 327 | 328 | (define-prefix-command 'torus-map) 329 | 330 | (defvar torus-map-mouse-torus (make-sparse-keymap)) 331 | (defvar torus-map-mouse-circle (make-sparse-keymap)) 332 | (defvar torus-map-mouse-location (make-sparse-keymap)) 333 | 334 | ;;; Toolbox 335 | ;;; ------------------------------ 336 | 337 | (defun torus--eval-string (string) 338 | "Eval Elisp code in STRING." 339 | (eval (car (read-from-string (format "(progn %s)" string))))) 340 | 341 | (defun torus--equal-car-p (one two) 342 | "Whether the cars of ONE and TWO are equal." 343 | (equal (car one) (car two))) 344 | 345 | (defmacro torus--set-ref (ptr list) 346 | "Set pointer PTR as reference to LIST." 347 | `(setq ,ptr ,list)) 348 | 349 | ;; (defun torus--set-ref (ptr list) 350 | ;; "Set pointer PTR as reference to LIST. 351 | ;; PTR must be quoted." 352 | ;; (set ptr list)) 353 | 354 | (defun torus--set-deref (ptr list) 355 | "Change the list referenced by PTR to LIST." 356 | (setcar ptr (car list)) 357 | (setcdr ptr (cdr list)) 358 | ptr) 359 | 360 | (defun torus--value-assoc (key alist) 361 | "Return value associated with KEY in ALIST." 362 | (cdr (assoc key alist))) 363 | 364 | (defun torus--key-rassoc (value alist) 365 | "Return key associated with VALUE in ALIST." 366 | (car (rassoc value alist))) 367 | 368 | (defun torus--assoc-delete-all (key alist) 369 | "Remove all elements with key matching KEY in ALIST." 370 | (cl-remove key alist :test 'equal :key 'car)) 371 | 372 | (when (fboundp 'assoc-delete-all) 373 | (defalias 'torus--assoc-delete-all 'assoc-delete-all)) 374 | 375 | (defun torus--reverse-assoc-delete-all (value alist) 376 | "Remove all elements with value matching VALUE in ALIST." 377 | (cl-remove value alist :test 'equal :key 'cdr)) 378 | 379 | (defun torus--directory (object) 380 | "Return the last directory component of OBJECT." 381 | (let* ((filename (pcase object 382 | (`(,(and (pred stringp) one) . ,(pred integerp)) one) 383 | ((pred stringp) object))) 384 | (grandpa (file-name-directory (directory-file-name 385 | (file-name-directory 386 | (directory-file-name filename))))) 387 | (relative (file-relative-name filename grandpa))) 388 | (directory-file-name (file-name-directory relative)))) 389 | 390 | (defun torus--extension-description (object) 391 | "Return the extension description of OBJECT." 392 | (let* ((filename (pcase object 393 | (`(,(and (pred stringp) one) . ,(pred integerp)) one) 394 | ((pred stringp) object))) 395 | (extension (file-name-extension filename))) 396 | (when (> torus-verbosity 1) 397 | (message "filename extension : %s %s" filename extension)) 398 | (pcase extension 399 | ('nil "Nil") 400 | ('"" "Ends with a dot") 401 | ('"sh" "Shell POSIX") 402 | ('"zsh" "Shell Zsh") 403 | ('"bash" "Shell Bash") 404 | ('"org" "Org mode") 405 | ('"el" "Emacs Lisp") 406 | ('"vim" "Vim Script") 407 | ('"py" "Python") 408 | ('"rb" "Ruby") 409 | (_ extension)))) 410 | 411 | ;;; Private Functions 412 | ;;; ------------------------------ 413 | 414 | ;;; Strings 415 | ;;; ------------ 416 | 417 | (defun torus--buffer-or-filename (location) 418 | "Return buffer name of LOCATION if existent in `torus-markers', file basename otherwise." 419 | (unless (consp location) 420 | (error "Function torus--buffer-or-filename : wrong type argument")) 421 | (let* ((bookmark (cdr (assoc location torus-markers))) 422 | (buffer (when bookmark 423 | (marker-buffer bookmark)))) 424 | (if buffer 425 | (buffer-name buffer) 426 | (file-name-nondirectory (car location))))) 427 | 428 | (defun torus--position (location) 429 | "Return position in LOCATION in raw format or in line & column if available. 430 | Line & Columns are available in `torus-line-col'" 431 | (let ((entry (assoc location torus-line-col))) 432 | (if entry 433 | (format " at line %s col %s" (cadr entry) (cddr entry)) 434 | (format " at position %s" (cdr location))))) 435 | 436 | (defun torus--concise (object) 437 | "Return OBJECT in concise string format. 438 | If OBJECT is a string : simply returns OBJECT. 439 | If OBJECT is \(File . Position) : returns \"File at Position.\" 440 | If OBJECT is \((File . Position) . Circle) : returns 441 | \"Circle > File at Position.\"" 442 | (let ((location)) 443 | (pcase object 444 | (`((,(and (pred stringp) file) . ,(and (pred integerp) position)) . 445 | (,(and (pred stringp) circle) . ,(and (pred stringp) torus))) 446 | (setq location (cons file position)) 447 | (concat torus 448 | torus-separator-torus-circle 449 | circle 450 | torus-separator-circle-location 451 | (torus--buffer-or-filename location) 452 | (torus--position location))) 453 | (`((,(and (pred stringp) file) . ,(and (pred integerp) position)) . 454 | ,(and (pred stringp) circle)) 455 | (setq location (cons file position)) 456 | (concat circle 457 | torus-separator-circle-location 458 | (torus--buffer-or-filename location) 459 | (torus--position location))) 460 | (`(,(and (pred stringp) file) . ,(and (pred integerp) position)) 461 | (setq location (cons file position)) 462 | (concat (torus--buffer-or-filename location) 463 | (torus--position location))) 464 | ((pred stringp) object) 465 | (_ (error "Function torus--concise : wrong type argument"))))) 466 | 467 | (defun torus--equal-concise-p (one two) 468 | "Whether the concise representations of ONE and TWO are equal." 469 | (equal (torus--concise one) 470 | (torus--concise two))) 471 | 472 | (defun torus--short (location) 473 | "Return LOCATION in short string format. 474 | Shorter than concise. Used for dashboard and tabs." 475 | (unless (consp location) 476 | (error "Function torus--short : wrong type argument")) 477 | (let* ((entry (assoc location torus-line-col)) 478 | (position (if entry 479 | (format " : %s" (cadr entry)) 480 | (format " . %s" (cdr location))))) 481 | (if (equal location (cadar torus-torus)) 482 | (concat "[ " 483 | (torus--buffer-or-filename location) 484 | position 485 | " ]") 486 | (concat (torus--buffer-or-filename location) 487 | position)))) 488 | 489 | (defun torus--dashboard () 490 | "Display summary of current torus, circle and location." 491 | (if torus-meta 492 | (if (> (length (car torus-torus)) 1) 493 | (let* 494 | ((locations (string-join (mapcar #'torus--short 495 | (cdar torus-torus)) " | "))) 496 | (format (concat " %s" 497 | torus-separator-torus-circle 498 | "%s" 499 | torus-separator-circle-location 500 | "%s") 501 | (caar torus-meta) 502 | (caar torus-torus) 503 | locations)) 504 | (message torus--message-empty-circle (car (car torus-torus)))) 505 | (message torus--message-empty-meta))) 506 | 507 | (defun torus--prefix-circles (prefix torus-name) 508 | "Return vars of TORUS-NAME with PREFIX to the circle names." 509 | (unless (and (stringp prefix) (stringp torus-name)) 510 | (error "Function torus--prefix-circles : wrong type argument")) 511 | (let* ((entry (cdr (assoc torus-name torus-meta))) 512 | (torus (copy-tree (cdr (assoc "torus" entry)))) 513 | (history (copy-tree (cdr (assoc "history" entry))))) 514 | (if (> (length prefix) 0) 515 | (progn 516 | (message "Prefix is %s" prefix) 517 | (dolist (elem torus) 518 | (setcar elem 519 | (concat prefix torus-prefix-separator (car elem)))) 520 | (dolist (elem history) 521 | (setcdr elem 522 | (concat prefix torus-prefix-separator (cdr elem))))) 523 | (message "Prefix is blank")) 524 | (list torus history))) 525 | 526 | ;;; Files 527 | ;;; ------------ 528 | 529 | (defun torus--inside-p (&optional buffer) 530 | "Whether BUFFER (the current location if nil) belongs to the torus." 531 | (let ((filename (buffer-file-name (if buffer 532 | buffer 533 | (current-buffer)))) 534 | (locations (append (mapcar 'caar torus-meta-index) 535 | (mapcar 'caar torus-index)))) 536 | (member filename locations))) 537 | 538 | (defun torus--roll-backups (filename) 539 | "Roll backups of FILENAME." 540 | (unless (stringp filename) 541 | (error "Function torus--roll-backups : wrong type argument")) 542 | (let ((file-list (list filename)) 543 | (file-src) 544 | (file-dest)) 545 | (dolist (iter (number-sequence 1 torus-backup-number)) 546 | (push (concat filename "." (prin1-to-string iter)) file-list)) 547 | (while (> (length file-list) 1) 548 | (setq file-dest (pop file-list)) 549 | (setq file-src (car file-list)) 550 | (when (> torus-verbosity 2) 551 | (message "files %s %s" file-src file-dest)) 552 | (when (and file-src (file-exists-p file-src)) 553 | (when (> torus-verbosity 2) 554 | (message "copy %s -> %s" file-src file-dest)) 555 | (copy-file file-src file-dest t))))) 556 | 557 | ;;; Build 558 | ;;; ------------ 559 | 560 | (defun torus--build-index () 561 | "Build `torus-index'." 562 | (setq torus-index nil) 563 | (dolist (circle torus-torus) 564 | (dolist (location (cdr circle)) 565 | (let ((location-circle (cons location (car circle)))) 566 | (unless (member location-circle torus-index) 567 | (push location-circle torus-index))))) 568 | (setq torus-index (reverse torus-index))) 569 | 570 | (defun torus--build-meta-index () 571 | "Build `torus-meta-index'." 572 | (setq torus-meta-index nil) 573 | (let ((torus-name) 574 | (torus) 575 | (circle-torus) 576 | (index-entry)) 577 | (dolist (elem torus-meta) 578 | (setq torus-name (car elem)) 579 | (setq torus (cdr (assoc "torus" elem))) 580 | (dolist (circle torus) 581 | (setq circle-torus (cons (car circle) torus-name)) 582 | (dolist (location (cdr circle)) 583 | (setq index-entry (cons location circle-torus)) 584 | (unless (member index-entry torus-meta-index) 585 | (push index-entry torus-meta-index)))))) 586 | (setq torus-meta-index (reverse torus-meta-index))) 587 | 588 | ;;; Updates 589 | ;;; ------------ 590 | 591 | (defun torus--update-history () 592 | "Add current location to `torus-history'." 593 | (when (and torus-torus 594 | (listp torus-torus) 595 | (car torus-torus) 596 | (listp (car torus-torus)) 597 | (> (length (car torus-torus)) 1)) 598 | (let* ((circle (car torus-torus)) 599 | (circle-name (car circle)) 600 | (location (car (cdr circle))) 601 | (location-circle (cons location circle-name))) 602 | (push location-circle torus-history) 603 | (delete-dups torus-history) 604 | (setq torus-history 605 | (cl-subseq torus-history 0 606 | (min (length torus-history) 607 | torus-history-maximum-elements)))))) 608 | 609 | (defun torus--update-meta-history () 610 | "Add current location to `torus-meta-history'." 611 | (when (and torus-meta 612 | (listp torus-meta) 613 | (car torus-meta) 614 | (listp (car torus-meta)) 615 | (> (length (car torus-meta)) 1)) 616 | (let* ((circle (car torus-torus)) 617 | (circle-name (car circle)) 618 | (torus-name (caar torus-meta)) 619 | (location (car (cdr circle))) 620 | (location-circle-torus (cons location 621 | (cons circle-name torus-name)))) 622 | (when (> torus-verbosity 2) 623 | (message "Loc circ tor %s" location-circle-torus)) 624 | (push location-circle-torus torus-meta-history) 625 | (delete-dups torus-meta-history) 626 | (setq torus-meta-history 627 | (cl-subseq torus-meta-history 0 628 | (min (length torus-meta-history) 629 | torus-history-maximum-elements)))))) 630 | 631 | (defun torus--update-position () 632 | "Update position in current location. 633 | Do nothing if file does not match current buffer." 634 | (when (and torus-torus 635 | (listp torus-torus) 636 | (car torus-torus) 637 | (listp (car torus-torus)) 638 | (> (length (car torus-torus)) 1)) 639 | (let* ((torus-name (caar torus-meta)) 640 | (circle-name (caar torus-torus)) 641 | (circle-torus (cons circle-name torus-name)) 642 | (old-location (car (cdr (car torus-torus)))) 643 | (old-here (cdr old-location)) 644 | (old-location-circle (cons old-location circle-name)) 645 | (old-location-circle-torus (cons old-location circle-torus)) 646 | (file (car old-location)) 647 | (here (point)) 648 | (marker (point-marker)) 649 | (line-col (cons (line-number-at-pos) (current-column))) 650 | (new-location (cons file here)) 651 | (new-location-circle (cons new-location circle-name)) 652 | (new-location-circle-torus (cons new-location circle-torus)) 653 | (new-location-line-col (cons new-location line-col)) 654 | (new-location-marker (cons new-location marker))) 655 | (when (> torus-verbosity 2) 656 | (message "Update position -->") 657 | (message "here old : %s %s" here old-here) 658 | (message "old-location : %s" old-location) 659 | (message "loc history : %s" (caar torus-history)) 660 | (message "loc meta history : %s" (caar torus-meta-history)) 661 | (message "assoc index : %s" (assoc old-location torus-index)) 662 | (message "assoc meta index : %s" (assoc old-location torus-meta-index))) 663 | (when (and (equal file (buffer-file-name (current-buffer))) 664 | (equal old-location (caar torus-history)) 665 | (equal old-location (caar torus-meta-history)) 666 | (not (equal here old-here))) 667 | (when (> torus-verbosity 2) 668 | (message "Old location : %s" old-location) 669 | (message "New location : %s" new-location)) 670 | (setcar (cdr (car torus-torus)) new-location) 671 | (if (member old-location-circle torus-index) 672 | (setcar (member old-location-circle torus-index) 673 | new-location-circle) 674 | (torus--build-index)) 675 | (if (member old-location-circle-torus torus-meta-index) 676 | (setcar (member old-location-circle-torus torus-meta-index) 677 | new-location-circle-torus) 678 | (torus--build-meta-index)) 679 | (if (member old-location-circle torus-history) 680 | (setcar (member old-location-circle torus-history) 681 | new-location-circle) 682 | (torus--update-history)) 683 | (if (member old-location-circle-torus torus-meta-history) 684 | (setcar (member old-location-circle-torus torus-meta-history) 685 | new-location-circle-torus) 686 | (torus--update-meta-history)) 687 | (if (assoc old-location torus-line-col) 688 | (progn 689 | (setcdr (assoc old-location torus-line-col) line-col) 690 | (setcar (assoc old-location torus-line-col) new-location)) 691 | (push new-location-line-col torus-line-col)) 692 | (if (assoc old-location torus-markers) 693 | (progn 694 | (setcdr (assoc old-location torus-markers) marker) 695 | (setcar (assoc old-location torus-markers) new-location)) 696 | (push new-location-marker torus-markers)))))) 697 | 698 | (defun torus--update-layout () 699 | "Fill `torus-layout' from missing elements. Delete useless ones." 700 | (let ((circles (mapcar #'car torus-torus))) 701 | (dolist (elem circles) 702 | (unless (assoc elem torus-layout) 703 | (push (cons elem ?m) torus-layout))) 704 | (dolist (elem torus-layout) 705 | (unless (member (car elem) circles) 706 | (setq torus-layout (torus--assoc-delete-all (car elem) torus-layout)))) 707 | (setq torus-layout (reverse torus-layout)))) 708 | 709 | (defun torus--apply-or-fill-layout () 710 | "Apply layout of current circle, or add default is not present." 711 | (let ((circle-name (caar torus-torus))) 712 | (if (consp (assoc circle-name torus-layout)) 713 | (torus-layout-menu (cdr (assoc (caar torus-torus) torus-layout))) 714 | (push (cons circle-name ?m) torus-layout)))) 715 | 716 | (defun torus--update-input-history (name) 717 | "Add NAME to `torus-input-history' if not already there." 718 | (push name torus-input-history) 719 | (delete-dups torus-input-history) 720 | (setq torus-input-history 721 | (cl-subseq torus-input-history 0 722 | (min (length torus-input-history) 723 | torus-history-maximum-elements)))) 724 | 725 | (defun torus--update-meta () 726 | "Update current torus in `torus-meta'." 727 | (torus--update-position) 728 | (when torus-meta 729 | (let ((entry (cdar torus-meta))) 730 | (if (equal '("torus" "history" "layout" "input history") 731 | (mapcar 'car entry)) 732 | (progn 733 | (if (assoc "input history" entry) 734 | (setcdr (assoc "input history" (cdar torus-meta)) (cl-copy-seq torus-input-history)) 735 | (push (cons "input history" torus-input-history) (cdar torus-meta))) 736 | (if (assoc "layout" entry) 737 | (setcdr (assoc "layout" (cdar torus-meta)) (copy-tree torus-layout)) 738 | (push (cons "layout" torus-layout) (cdar torus-meta))) 739 | (if (assoc "history" entry) 740 | (setcdr (assoc "history" (cdar torus-meta)) (copy-tree torus-history)) 741 | (push (cons "history" torus-history) (cdar torus-meta))) 742 | (if (assoc "torus" entry) 743 | (setcdr (assoc "torus" (cdar torus-meta)) (copy-tree torus-torus)) 744 | (push (cons "torus" torus-torus) (cdar torus-meta)))) 745 | ;; Reordering if needed 746 | (push (cons "input history" torus-input-history) (cdar torus-meta)) 747 | (push (cons "layout" torus-layout) (cdar torus-meta)) 748 | (push (cons "history" torus-history) (cdar torus-meta)) 749 | (push (cons "torus" torus-torus) (cdar torus-meta)) 750 | (setf (cdar torus-meta) (cl-subseq (cdar torus-meta) 0 4)))))) 751 | 752 | (defun torus--update-from-meta () 753 | "Update main torus variables from `torus-meta'." 754 | (when (and torus-meta 755 | (listp torus-meta) 756 | (listp (car torus-meta))) 757 | (let ((entry (cdr (car torus-meta)))) 758 | (if (assoc "torus" entry) 759 | (setq torus-torus (copy-tree (cdr (assoc "torus" entry)))) 760 | (setq torus-torus nil)) 761 | (if (assoc "history" entry) 762 | (setq torus-history (copy-tree (cdr (assoc "history" entry)))) 763 | (setq torus-history nil)) 764 | (if (assoc "layout" entry) 765 | (setq torus-layout (copy-tree (cdr (assoc "layout" entry)))) 766 | (setq torus-layout nil)) 767 | (if (assoc "input history" entry) 768 | (setq torus-input-history (cl-copy-seq (cdr (assoc "input history" entry)))) 769 | (setq torus-input-history nil))))) 770 | 771 | (defun torus--jump () 772 | "Jump to current location (buffer & position) in torus. 773 | Add the location to `torus-markers' if not already present." 774 | (when (and torus-torus 775 | (listp torus-torus) 776 | (car torus-torus) 777 | (listp (car torus-torus)) 778 | (> (length (car torus-torus)) 1)) 779 | (let* ((location (car (cdr (car torus-torus)))) 780 | (circle-name (caar torus-torus)) 781 | (torus-name (caar torus-meta)) 782 | (circle-torus (cons circle-name torus-name)) 783 | (location-circle (cons location circle-name)) 784 | (location-circle-torus (cons location circle-torus)) 785 | (file (car location)) 786 | (position (cdr location)) 787 | (bookmark (cdr (assoc location torus-markers))) 788 | (buffer (when bookmark 789 | (marker-buffer bookmark)))) 790 | (if (and bookmark buffer (buffer-live-p buffer)) 791 | (progn 792 | (when (> torus-verbosity 2) 793 | (message "Found %s in markers" bookmark)) 794 | (when (not (equal buffer (current-buffer))) 795 | (switch-to-buffer buffer)) 796 | (goto-char bookmark)) 797 | (when (> torus-verbosity 2) 798 | (message "Found %s in torus" location)) 799 | (when bookmark 800 | (setq torus-markers (torus--assoc-delete-all location torus-markers))) 801 | (if (file-exists-p file) 802 | (progn 803 | (when (> torus-verbosity 1) 804 | (message "Opening file %s at %s" file position)) 805 | (find-file file) 806 | (goto-char position) 807 | (push (cons location (point-marker)) torus-markers)) 808 | (message (format torus--message-file-does-not-exist file)) 809 | (setcdr (car torus-torus) (cl-remove location (cdr (car torus-torus)))) 810 | (setq torus-line-col (torus--assoc-delete-all location torus-line-col)) 811 | (setq torus-markers (torus--assoc-delete-all location torus-markers)) 812 | (setq torus-index (cl-remove location-circle torus-index)) 813 | (setq torus-meta-index (cl-remove location-circle-torus torus-meta-index)) 814 | (setq torus-history (cl-remove location-circle torus-history)) 815 | (setq torus-meta-history (cl-remove location-circle-torus torus-meta-history)))) 816 | (torus--update-history) 817 | (torus--update-meta-history) 818 | (torus--tab-bar)) 819 | (recenter))) 820 | 821 | ;;; Switch 822 | ;;; ------------ 823 | 824 | (defun torus--switch (location-circle) 825 | "Jump to circle and location countained in LOCATION-CIRCLE." 826 | (unless (and location-circle 827 | (consp location-circle) 828 | (consp (car location-circle))) 829 | (error "Function torus--switch : wrong type argument")) 830 | (torus--update-position) 831 | (let* ((circle-name (cdr location-circle)) 832 | (circle (assoc circle-name torus-torus)) 833 | (index (cl-position circle torus-torus :test #'equal)) 834 | (before (cl-subseq torus-torus 0 index)) 835 | (after (cl-subseq torus-torus index))) 836 | (if index 837 | (setq torus-torus (append after before)) 838 | (message "Circle not found."))) 839 | (let* ((circle (cdr (car torus-torus))) 840 | (location (car location-circle)) 841 | (index (cl-position location circle :test #'equal)) 842 | (before (cl-subseq circle 0 index)) 843 | (after (cl-subseq circle index))) 844 | (if index 845 | (setcdr (car torus-torus) (append after before)) 846 | (message "Location not found."))) 847 | (torus--jump) 848 | (torus--apply-or-fill-layout)) 849 | 850 | (defun torus--meta-switch (location-circle-torus) 851 | "Jump to torus, circle and location countained in LOCATION-CIRCLE-TORUS." 852 | (unless (and location-circle-torus 853 | (consp location-circle-torus) 854 | (consp (car location-circle-torus)) 855 | (consp (cdr location-circle-torus))) 856 | (error "Function torus--switch : wrong type argument")) 857 | (when (> torus-verbosity 2) 858 | (message "meta switch : location-circle-torus : %s" location-circle-torus)) 859 | (torus--update-meta) 860 | (let* ((torus-name (cdr (cdr location-circle-torus))) 861 | (torus (assoc torus-name torus-meta)) 862 | (index (cl-position torus torus-meta :test #'equal)) 863 | (before (cl-subseq torus-meta 0 index)) 864 | (after (cl-subseq torus-meta index))) 865 | (if index 866 | (setq torus-meta (append after before)) 867 | (message "Torus not found."))) 868 | (torus--update-from-meta) 869 | (torus--build-index) 870 | (torus--build-meta-index) 871 | (torus--update-layout) 872 | (let* ((circle-name (car (cdr location-circle-torus))) 873 | (circle (assoc circle-name torus-torus)) 874 | (index (cl-position circle torus-torus :test #'equal)) 875 | (before (cl-subseq torus-torus 0 index)) 876 | (after (cl-subseq torus-torus index))) 877 | (if index 878 | (setq torus-torus (append after before)) 879 | (message "Circle not found."))) 880 | (let* ((circle (cdr (car torus-torus))) 881 | (location (car location-circle-torus)) 882 | (index (cl-position location circle :test #'equal)) 883 | (before (cl-subseq circle 0 index)) 884 | (after (cl-subseq circle index))) 885 | (if index 886 | (setcdr (car torus-torus) (append after before)) 887 | (message "Location not found."))) 888 | (torus--jump) 889 | (torus--apply-or-fill-layout)) 890 | 891 | ;;; Windows 892 | ;;; ------------ 893 | 894 | (defsubst torus--windows () 895 | "Windows displaying a torus buffer." 896 | (seq-filter (lambda (elem) (torus--inside-p (window-buffer elem))) 897 | (window-list))) 898 | 899 | (defun torus--main-windows () 900 | "Return main window of layout." 901 | (let* ((windows (torus--windows)) 902 | (columns (mapcar #'window-text-width windows)) 903 | (max-columns (when columns 904 | (eval `(max ,@columns)))) 905 | (widest) 906 | (lines) 907 | (max-lines) 908 | (biggest)) 909 | (when windows 910 | (dolist (index (number-sequence 0 (1- (length windows)))) 911 | (when (equal (nth index columns) max-columns) 912 | (push (nth index windows) widest))) 913 | (setq lines (mapcar #'window-text-height widest)) 914 | (setq max-lines (eval `(max ,@lines))) 915 | (dolist (index (number-sequence 0 (1- (length widest)))) 916 | (when (equal (nth index lines) max-lines) 917 | (push (nth index widest) biggest))) 918 | (when (> torus-verbosity 2) 919 | (message "toruw windows : %s" windows) 920 | (message "columns : %s" columns) 921 | (message "max-columns : %s" max-columns) 922 | (message "widest : %s" widest) 923 | (message "lines : %s" lines) 924 | (message "max-line : %s" max-lines) 925 | (message "biggest : %s" biggest)) 926 | biggest))) 927 | 928 | (defun torus--prefix-argument-split (prefix) 929 | "Handle prefix argument PREFIX. Used to split." 930 | (pcase prefix 931 | ('(4) 932 | (split-window-below) 933 | (other-window 1)) 934 | ('(16) 935 | (split-window-right) 936 | (other-window 1)))) 937 | 938 | ;;; Tab bar 939 | ;;; ------------ 940 | 941 | (defun torus--eval-tab () 942 | "Build tab bar." 943 | (when torus-meta 944 | (let* 945 | ((locations (mapcar #'torus--short (cdar torus-torus))) 946 | (tab-string)) 947 | (setq tab-string 948 | (propertize (format (concat " %s" 949 | torus-separator-torus-circle) 950 | (caar torus-meta)) 951 | 'keymap torus-map-mouse-torus)) 952 | (setq tab-string 953 | (concat tab-string 954 | (propertize (format (concat "%s" 955 | torus-separator-circle-location) 956 | (caar torus-torus)) 957 | 'keymap torus-map-mouse-circle))) 958 | (dolist (filepos locations) 959 | (setq tab-string 960 | (concat tab-string (propertize filepos 961 | 'keymap torus-map-mouse-location))) 962 | (setq tab-string (concat tab-string torus-location-separator))) 963 | tab-string))) 964 | 965 | (defun torus--tab-bar () 966 | "Display tab bar." 967 | (let* ((main-windows (torus--main-windows)) 968 | (current-window (selected-window)) 969 | (buffer (current-buffer)) 970 | (original (assoc buffer torus-original-header-lines)) 971 | (eval-tab '(:eval (torus--eval-tab)))) 972 | (when (> torus-verbosity 2) 973 | (pp torus-original-header-lines) 974 | (message "original : %s" original) 975 | (message "cdr original : %s" (cdr original))) 976 | (if (and torus-display-tab-bar 977 | (member current-window main-windows)) 978 | (progn 979 | (unless original 980 | (push (cons buffer header-line-format) 981 | torus-original-header-lines)) 982 | (unless (equal header-line-format eval-tab) 983 | (when (> torus-verbosity 2) 984 | (message "Set :eval in header-line-format.")) 985 | (setq header-line-format eval-tab))) 986 | (when original 987 | (setq header-line-format (cdr original)) 988 | (setq torus-original-header-lines 989 | (torus--assoc-delete-all buffer 990 | torus-original-header-lines))) 991 | (message (torus--dashboard))))) 992 | 993 | ;;; Hooks & Advices 994 | ;;; ------------------------------ 995 | 996 | ;;;###autoload 997 | (defun torus-quit () 998 | "Write torus before quit." 999 | (when torus-save-on-exit 1000 | (if torus-autowrite-file 1001 | (torus-write torus-autowrite-file) 1002 | (when (y-or-n-p "Write torus ? ") 1003 | (call-interactively 'torus-write)))) 1004 | ;; To be sure they will be nil at startup, even if some plugin saved 1005 | ;; global variables 1006 | (torus-reset-menu ?a)) 1007 | 1008 | ;;;###autoload 1009 | (defun torus-start () 1010 | "Read torus on startup." 1011 | (when torus-load-on-startup 1012 | (if torus-autoread-file 1013 | (torus-read torus-autoread-file) 1014 | (message "Set torus-autoread-file if you want to load it.")))) 1015 | 1016 | ;;;###autoload 1017 | (defun torus-after-save-torus-file () 1018 | "Ask whether to read torus file after edition." 1019 | (let* ((filename (buffer-file-name (current-buffer))) 1020 | (directory (file-name-directory filename)) 1021 | (torus-dir (expand-file-name (file-name-as-directory torus-dirname)))) 1022 | (when (> torus-verbosity 2) 1023 | (message "filename : %s" filename) 1024 | (message "filename directory : %s" directory) 1025 | (message "torus directory : %s" torus-dir)) 1026 | (when (equal directory torus-dir) 1027 | (when (y-or-n-p "Apply changes to current torus variables ? ") 1028 | (torus-read filename))))) 1029 | 1030 | ;;;###autoload 1031 | (defun torus-advice-switch-buffer (&rest args) 1032 | "Advice to `switch-to-buffer'. ARGS are irrelevant." 1033 | (when (> torus-verbosity 2) 1034 | (message "Advice called with args %s" args)) 1035 | (when (and torus-torus (torus--inside-p)) 1036 | (torus--update-position))) 1037 | 1038 | ;;; Commands 1039 | ;;; ------------------------------ 1040 | 1041 | ;;;###autoload 1042 | (defun torus-init () 1043 | "Initialize torus. Add hooks and advices. 1044 | Create `torus-dirname' if needed." 1045 | (interactive) 1046 | (add-hook 'emacs-startup-hook 'torus-start) 1047 | (add-hook 'kill-emacs-hook 'torus-quit) 1048 | (add-hook 'after-save-hook 'torus-after-save-torus-file) 1049 | (advice-add #'switch-to-buffer :before #'torus-advice-switch-buffer) 1050 | (unless (file-exists-p torus-dirname) 1051 | (make-directory torus-dirname))) 1052 | 1053 | ;;;###autoload 1054 | (defun torus-install-default-bindings () 1055 | "Install default keybindings." 1056 | (interactive) 1057 | ;; Keymap 1058 | (if (stringp torus-prefix-key) 1059 | (global-set-key (kbd torus-prefix-key) 'torus-map) 1060 | (global-set-key torus-prefix-key 'torus-map)) 1061 | (when (>= torus-binding-level 0) 1062 | (define-key torus-map (kbd "i") 'torus-info) 1063 | (define-key torus-map (kbd "c") 'torus-add-circle) 1064 | (define-key torus-map (kbd "l") 'torus-add-location) 1065 | (define-key torus-map (kbd "f") 'torus-add-file) 1066 | (define-key torus-map (kbd "+") 'torus-add-torus) 1067 | (define-key torus-map (kbd "*") 'torus-add-copy-of-torus) 1068 | (define-key torus-map (kbd "") 'torus-previous-circle) 1069 | (define-key torus-map (kbd "") 'torus-next-circle) 1070 | (define-key torus-map (kbd "") 'torus-previous-location) 1071 | (define-key torus-map (kbd "") 'torus-next-location) 1072 | (define-key torus-map (kbd "C-p") 'torus-previous-torus) 1073 | (define-key torus-map (kbd "C-n") 'torus-next-torus) 1074 | (define-key torus-map (kbd "SPC") 'torus-switch-circle) 1075 | (define-key torus-map (kbd "=") 'torus-switch-location) 1076 | (define-key torus-map (kbd "@") 'torus-switch-torus) 1077 | (define-key torus-map (kbd "s") 'torus-search) 1078 | (define-key torus-map (kbd "S") 'torus-meta-search) 1079 | (define-key torus-map (kbd "d") 'torus-delete-location) 1080 | (define-key torus-map (kbd "D") 'torus-delete-circle) 1081 | (define-key torus-map (kbd "-") 'torus-delete-torus) 1082 | (define-key torus-map (kbd "r") 'torus-read) 1083 | (define-key torus-map (kbd "w") 'torus-write) 1084 | (define-key torus-map (kbd "e") 'torus-edit)) 1085 | (when (>= torus-binding-level 1) 1086 | (define-key torus-map (kbd "") 'torus-history-older) 1087 | (define-key torus-map (kbd "") 'torus-history-newer) 1088 | (define-key torus-map (kbd "h") 'torus-search-history) 1089 | (define-key torus-map (kbd "H") 'torus-search-meta-history) 1090 | (define-key torus-map (kbd "a") 'torus-alternate-menu) 1091 | (define-key torus-map (kbd "^") 'torus-alternate-in-same-torus) 1092 | (define-key torus-map (kbd "<") 'torus-alternate-circles) 1093 | (define-key torus-map (kbd ">") 'torus-alternate-in-same-circle) 1094 | (define-key torus-map (kbd "n") 'torus-rename-circle) 1095 | (define-key torus-map (kbd "N") 'torus-rename-torus) 1096 | (define-key torus-map (kbd "m") 'torus-move-location) 1097 | (define-key torus-map (kbd "M") 'torus-move-circle) 1098 | (define-key torus-map (kbd "M-m") 'torus-move-torus) 1099 | (define-key torus-map (kbd "v") 'torus-move-location-to-circle) 1100 | (define-key torus-map (kbd "V") 'torus-move-circle-to-torus) 1101 | (define-key torus-map (kbd "y") 'torus-copy-location-to-circle) 1102 | (define-key torus-map (kbd "Y") 'torus-copy-circle-to-torus) 1103 | (define-key torus-map (kbd "j") 'torus-join-circles) 1104 | (define-key torus-map (kbd "J") 'torus-join-toruses) 1105 | (define-key torus-map (kbd "#") 'torus-layout-menu)) 1106 | (when (>= torus-binding-level 2) 1107 | (define-key torus-map (kbd "o") 'torus-reverse-menu) 1108 | (define-key torus-map (kbd ":") 'torus-prefix-circles-of-current-torus) 1109 | (define-key torus-map (kbd "g") 'torus-autogroup-menu) 1110 | (define-key torus-map (kbd "!") 'torus-batch-menu)) 1111 | (when (>= torus-binding-level 3) 1112 | (define-key torus-map (kbd "p") 'torus-print-menu) 1113 | (define-key torus-map (kbd "z") 'torus-reset-menu) 1114 | (define-key torus-map (kbd "C-d") 'torus-delete-current-location) 1115 | (define-key torus-map (kbd "M-d") 'torus-delete-current-circle)) 1116 | ;; Mouse 1117 | (define-key torus-map-mouse-torus [header-line mouse-1] 'torus-switch-torus) 1118 | (define-key torus-map-mouse-torus [header-line mouse-2] 'torus-alternate-toruses) 1119 | (define-key torus-map-mouse-torus [header-line mouse-3] 'torus-meta-search) 1120 | (define-key torus-map-mouse-torus [header-line mouse-4] 'torus-previous-torus) 1121 | (define-key torus-map-mouse-torus [header-line mouse-5] 'torus-next-torus) 1122 | (define-key torus-map-mouse-circle [header-line mouse-1] 'torus-switch-circle) 1123 | (define-key torus-map-mouse-circle [header-line mouse-2] 'torus-alternate-circles) 1124 | (define-key torus-map-mouse-circle [header-line mouse-3] 'torus-search) 1125 | (define-key torus-map-mouse-circle [header-line mouse-4] 'torus-previous-circle) 1126 | (define-key torus-map-mouse-circle [header-line mouse-5] 'torus-next-circle) 1127 | (define-key torus-map-mouse-location [header-line mouse-1] 'torus-tab-mouse) 1128 | (define-key torus-map-mouse-location [header-line mouse-2] 'torus-alternate-in-meta) 1129 | (define-key torus-map-mouse-location [header-line mouse-3] 'torus-switch-location) 1130 | (define-key torus-map-mouse-location [header-line mouse-4] 'torus-previous-location) 1131 | (define-key torus-map-mouse-location [header-line mouse-5] 'torus-next-location)) 1132 | 1133 | ;;;###autoload 1134 | (defun torus-reset-menu (choice) 1135 | "Reset CHOICE variables to nil." 1136 | (interactive 1137 | (list (read-key torus--message-reset-choice))) 1138 | (let ((varlist)) 1139 | (pcase choice 1140 | (?m (push 'torus-meta varlist)) 1141 | (?t (push 'torus-torus varlist)) 1142 | (?h (push 'torus-history varlist)) 1143 | (?H (push 'torus-meta-history varlist)) 1144 | (?l (push 'torus-layout varlist)) 1145 | (?n (push 'torus-input-history varlist)) 1146 | (?i (push 'torus-index varlist)) 1147 | (?I (push 'torus-meta-index varlist)) 1148 | (?p (push 'torus-line-col varlist)) 1149 | (?\^m (push 'torus-markers varlist)) 1150 | (?o (push 'torus-original-header-lines varlist)) 1151 | (?a (setq varlist (list 'torus-meta 1152 | 'torus-torus 1153 | 'torus-history 1154 | 'torus-meta-history 1155 | 'torus-layout 1156 | 'torus-input-history 1157 | 'torus-index 1158 | 'torus-meta-index 1159 | 'torus-line-col 1160 | 'torus-markers 1161 | 'torus-original-header-lines))) 1162 | (?\a (message "Reset cancelled by Ctrl-G.")) 1163 | (_ (message "Invalid key."))) 1164 | (dolist (var varlist) 1165 | (when (> torus-verbosity 1) 1166 | (message "%s -> nil" (symbol-name var))) 1167 | (set var nil)))) 1168 | 1169 | ;;; Print 1170 | ;;; ------------ 1171 | 1172 | ;;;###autoload 1173 | (defun torus-info () 1174 | "Print local info : circle name and locations." 1175 | (interactive) 1176 | (message (torus--dashboard))) 1177 | 1178 | ;;;###autoload 1179 | (defun torus-print-menu (choice) 1180 | "Print CHOICE variables." 1181 | (interactive 1182 | (list (read-key torus--message-print-choice))) 1183 | (let ((varlist) 1184 | (window (view-echo-area-messages))) 1185 | (pcase choice 1186 | (?m (push 'torus-meta varlist)) 1187 | (?t (push 'torus-torus varlist)) 1188 | (?h (push 'torus-history varlist)) 1189 | (?H (push 'torus-meta-history varlist)) 1190 | (?l (push 'torus-layout varlist)) 1191 | (?n (push 'torus-input-history varlist)) 1192 | (?i (push 'torus-index varlist)) 1193 | (?I (push 'torus-meta-index varlist)) 1194 | (?p (push 'torus-line-col varlist)) 1195 | (?\^m (push 'torus-markers varlist)) 1196 | (?o (push 'torus-original-header-lines varlist)) 1197 | (?a (setq varlist (list 'torus-meta 1198 | 'torus-torus 1199 | 'torus-index 1200 | 'torus-history 1201 | 'torus-meta-history 1202 | 'torus-layout 1203 | 'torus-input-history 1204 | 'torus-line-col 1205 | 'torus-markers 1206 | 'torus-original-header-lines))) 1207 | (?\a (delete-window window) 1208 | (message "Print cancelled by Ctrl-G.")) 1209 | (_ (message "Invalid key."))) 1210 | (dolist (var varlist) 1211 | (message "%s" (symbol-name var)) 1212 | (pp (symbol-value var))))) 1213 | 1214 | ;;; Add 1215 | ;;; ------------ 1216 | 1217 | ;;;###autoload 1218 | (defun torus-add-circle (circle-name) 1219 | "Add a new circle CIRCLE-NAME to torus." 1220 | (interactive 1221 | (list 1222 | (read-string "Name of the new circle : " 1223 | nil 1224 | 'torus-input-history))) 1225 | (unless (stringp circle-name) 1226 | (error "Function torus-add-circle : wrong type argument")) 1227 | (torus--update-input-history circle-name) 1228 | (let ((torus-name (car (car torus-meta)))) 1229 | (if (assoc circle-name torus-torus) 1230 | (message "Circle %s already exists in torus" circle-name) 1231 | (message "Adding circle %s to torus %s" circle-name torus-name) 1232 | (push (list circle-name) torus-torus) 1233 | (push (cons circle-name ?m) torus-layout)))) 1234 | 1235 | ;;;###autoload 1236 | (defun torus-add-location () 1237 | "Add current file and point to current circle." 1238 | (interactive) 1239 | (unless torus-meta 1240 | (when (y-or-n-p "Meta Torus is empty. Do you want to add a first torus ? ") 1241 | (call-interactively 'torus-add-torus))) 1242 | (unless torus-torus 1243 | (when (y-or-n-p "Torus is empty. Do you want to add a first circle ? ") 1244 | (call-interactively 'torus-add-circle))) 1245 | (if (and torus-meta 1246 | torus-torus) 1247 | (if (buffer-file-name) 1248 | (let* ((circle (car torus-torus)) 1249 | (pointmark (point-marker)) 1250 | (location (cons (buffer-file-name) 1251 | (marker-position pointmark))) 1252 | (location-marker (cons location pointmark)) 1253 | (location-circle (cons location (car circle))) 1254 | (location-line-col (cons location 1255 | (cons (line-number-at-pos) 1256 | (current-column))))) 1257 | (if (member location (cdr circle)) 1258 | (message torus--message-existent-location 1259 | (torus--concise location) (car circle)) 1260 | (message "Adding %s to circle %s" location (car circle)) 1261 | (if (> (length circle) 1) 1262 | (setcdr circle (append (list location) (cdr circle))) 1263 | (setf circle (append circle (list location)))) 1264 | (setf (car torus-torus) circle) 1265 | (unless (member location-circle torus-index) 1266 | (push location-circle torus-index)) 1267 | (torus--update-history) 1268 | (torus--update-meta-history) 1269 | (unless (member location-line-col torus-line-col) 1270 | (push location-line-col torus-line-col)) 1271 | (unless (member location-marker torus-markers) 1272 | (push location-marker torus-markers)) 1273 | (torus--tab-bar))) 1274 | (message "Buffer must have a filename to be added to the torus.")) 1275 | (message "Please add at least a first torus and a first circle."))) 1276 | 1277 | ;;;###autoload 1278 | (defun torus-add-file (filename) 1279 | "Add FILENAME to the current circle. 1280 | The location added will be (file . 1)." 1281 | (interactive (list (read-file-name "File to add : "))) 1282 | (if (file-exists-p filename) 1283 | (progn 1284 | (find-file filename) 1285 | (torus-add-location)) 1286 | (message "File %s does not exist." filename))) 1287 | 1288 | ;;;###autoload 1289 | (defun torus-add-torus (torus-name) 1290 | "Create a new torus named TORUS-NAME." 1291 | (interactive 1292 | (list (read-string "Name of the new torus : " 1293 | nil 1294 | 'torus-input-history))) 1295 | (torus--update-meta) 1296 | (setq torus-torus nil) 1297 | (setq torus-history nil) 1298 | (setq torus-layout nil) 1299 | (setq torus-input-history nil) 1300 | (push (list torus-name) torus-meta) 1301 | (push (list "input history") (cdr (car torus-meta))) 1302 | (push (list "layout") (cdr (car torus-meta))) 1303 | (push (list "history") (cdr (car torus-meta))) 1304 | (push (list "torus") (cdr (car torus-meta)))) 1305 | 1306 | ;;;###autoload 1307 | (defun torus-add-copy-of-torus (torus-name) 1308 | "Create a new torus named TORUS-NAME as copy of the current torus." 1309 | (interactive 1310 | (list (read-string "Name of the new torus : " 1311 | nil 1312 | 'torus-input-history))) 1313 | (torus--update-meta) 1314 | (if (and torus-torus torus-history torus-input-history) 1315 | (progn 1316 | (torus--update-input-history torus-name) 1317 | (if (assoc torus-name torus-meta) 1318 | (message "Torus %s already exists in torus-meta" torus-name) 1319 | (message "Creating torus %s" torus-name) 1320 | (push (list torus-name) torus-meta) 1321 | (push (cons "input history" torus-input-history) (cdr (car torus-meta))) 1322 | (push (cons "layout" torus-layout) (cdr (car torus-meta))) 1323 | (push (cons "history" torus-history) (cdr (car torus-meta))) 1324 | (push (cons "torus" torus-torus) (cdr (car torus-meta))))) 1325 | (message "Cannot create an empty torus. Please add at least a location."))) 1326 | 1327 | ;;; Navigate 1328 | ;;; ------------ 1329 | 1330 | ;;;###autoload 1331 | (defun torus-previous-circle () 1332 | "Jump to the previous circle." 1333 | (interactive) 1334 | (if torus-torus 1335 | (if (> (length torus-torus) 1) 1336 | (progn 1337 | (torus--prefix-argument-split current-prefix-arg) 1338 | (torus--update-position) 1339 | (setf torus-torus (append (last torus-torus) (butlast torus-torus))) 1340 | (torus--jump) 1341 | (torus--apply-or-fill-layout)) 1342 | (message "Only one circle in torus.")) 1343 | (message torus--message-empty-torus))) 1344 | 1345 | ;;;###autoload 1346 | (defun torus-next-circle () 1347 | "Jump to the next circle." 1348 | (interactive) 1349 | (if torus-torus 1350 | (if (> (length torus-torus) 1) 1351 | (progn 1352 | (torus--prefix-argument-split current-prefix-arg) 1353 | (torus--update-position) 1354 | (setf torus-torus (append (cdr torus-torus) (list (car torus-torus)))) 1355 | (torus--jump) 1356 | (torus--apply-or-fill-layout)) 1357 | (message "Only one circle in torus.")) 1358 | (message torus--message-empty-torus))) 1359 | 1360 | ;;;###autoload 1361 | (defun torus-previous-location () 1362 | "Jump to the previous location." 1363 | (interactive) 1364 | (if torus-torus 1365 | (if (> (length (car torus-torus)) 1) 1366 | (let ((circle (cdr (car torus-torus)))) 1367 | (torus--prefix-argument-split current-prefix-arg) 1368 | (torus--update-position) 1369 | (setf circle (append (last circle) (butlast circle))) 1370 | (setcdr (car torus-torus) circle) 1371 | (torus--jump)) 1372 | (message torus--message-empty-circle (car (car torus-torus)))) 1373 | (message torus--message-empty-torus))) 1374 | 1375 | ;;;###autoload 1376 | (defun torus-next-location () 1377 | "Jump to the next location." 1378 | (interactive) 1379 | (if torus-torus 1380 | (if (> (length (car torus-torus)) 1) 1381 | (let ((circle (cdr (car torus-torus)))) 1382 | (torus--prefix-argument-split current-prefix-arg) 1383 | (torus--update-position) 1384 | (setf circle (append (cdr circle) (list (car circle)))) 1385 | (setcdr (car torus-torus) circle) 1386 | (torus--jump)) 1387 | (message torus--message-empty-circle (car (car torus-torus)))) 1388 | (message torus--message-empty-torus))) 1389 | 1390 | ;;;###autoload 1391 | (defun torus-previous-torus () 1392 | "Jump to the previous torus." 1393 | (interactive) 1394 | (if torus-meta 1395 | (if (> (length torus-meta) 1) 1396 | (progn 1397 | (torus--prefix-argument-split current-prefix-arg) 1398 | (torus--update-meta) 1399 | (setf torus-meta (append (last torus-meta) (butlast torus-meta))) 1400 | (torus--update-from-meta) 1401 | (torus--build-index) 1402 | (torus--build-meta-index) 1403 | (torus--update-layout) 1404 | (torus--jump) 1405 | (torus--apply-or-fill-layout)) 1406 | (message "Only one torus in meta.")) 1407 | (message torus--message-empty-meta))) 1408 | 1409 | ;;;###autoload 1410 | (defun torus-next-torus () 1411 | "Jump to the next torus." 1412 | (interactive) 1413 | (if torus-meta 1414 | (if (> (length torus-meta) 1) 1415 | (progn 1416 | (torus--prefix-argument-split current-prefix-arg) 1417 | (torus--update-meta) 1418 | (setf torus-meta (append (cdr torus-meta) (list (car torus-meta)))) 1419 | (torus--update-from-meta) 1420 | (torus--build-index) 1421 | (torus--build-meta-index) 1422 | (torus--update-layout) 1423 | (torus--jump) 1424 | (torus--apply-or-fill-layout)) 1425 | (message "Only one torus in meta.")) 1426 | (message torus--message-empty-meta))) 1427 | 1428 | ;;;###autoload 1429 | (defun torus-switch-circle (circle-name) 1430 | "Jump to CIRCLE-NAME circle. 1431 | With prefix argument \\[universal-argument], open the buffer in a 1432 | horizontal split. 1433 | With prefix argument \\[universal-argument] \\[universal-argument], open the 1434 | buffer in a vertical split." 1435 | (interactive 1436 | (list (completing-read 1437 | "Go to circle : " 1438 | (mapcar #'car torus-torus) nil t))) 1439 | (torus--prefix-argument-split current-prefix-arg) 1440 | (torus--update-position) 1441 | (let* ((circle (assoc circle-name torus-torus)) 1442 | (index (cl-position circle torus-torus :test #'equal)) 1443 | (before (cl-subseq torus-torus 0 index)) 1444 | (after (cl-subseq torus-torus index))) 1445 | (setq torus-torus (append after before))) 1446 | (torus--jump) 1447 | (torus--apply-or-fill-layout)) 1448 | 1449 | ;;;###autoload 1450 | (defun torus-switch-location (location-name) 1451 | "Jump to LOCATION-NAME location. 1452 | With prefix argument \\[universal-argument], open the buffer in a 1453 | horizontal split. 1454 | With prefix argument \\[universal-argument] \\[universal-argument], open the 1455 | buffer in a vertical split." 1456 | (interactive 1457 | (list 1458 | (completing-read 1459 | "Go to location : " 1460 | (mapcar #'torus--concise (cdr (car torus-torus))) nil t))) 1461 | (torus--prefix-argument-split current-prefix-arg) 1462 | (torus--update-position) 1463 | (let* ((circle (cdr (car torus-torus))) 1464 | (index (cl-position location-name circle 1465 | :test #'torus--equal-concise-p)) 1466 | (before (cl-subseq circle 0 index)) 1467 | (after (cl-subseq circle index))) 1468 | (setcdr (car torus-torus) (append after before))) 1469 | (torus--jump)) 1470 | 1471 | ;;;###autoload 1472 | (defun torus-switch-torus (torus-name) 1473 | "Jump to TORUS-NAME torus. 1474 | With prefix argument \\[universal-argument], open the buffer in a 1475 | horizontal split. 1476 | With prefix argument \\[universal-argument] \\[universal-argument], open the 1477 | buffer in a vertical split." 1478 | (interactive 1479 | (list (completing-read 1480 | "Go to torus : " 1481 | (mapcar #'car torus-meta) nil t))) 1482 | (torus--prefix-argument-split current-prefix-arg) 1483 | (torus--update-meta) 1484 | (let* ((torus (assoc torus-name torus-meta)) 1485 | (index (cl-position torus torus-meta :test #'equal)) 1486 | (before (cl-subseq torus-meta 0 index)) 1487 | (after (cl-subseq torus-meta index))) 1488 | (if index 1489 | (setq torus-meta (append after before)) 1490 | (message "Torus not found."))) 1491 | (torus--update-from-meta) 1492 | (torus--build-index) 1493 | (torus--build-meta-index) 1494 | (torus--update-layout) 1495 | (torus--jump) 1496 | (torus--apply-or-fill-layout)) 1497 | 1498 | ;;; Search 1499 | ;;; ------------ 1500 | 1501 | ;;;###autoload 1502 | (defun torus-search (location-name) 1503 | "Search LOCATION-NAME in the torus. 1504 | Go to the first matching circle and location." 1505 | (interactive 1506 | (list 1507 | (completing-read 1508 | "Search location in torus : " 1509 | (mapcar #'torus--concise torus-index) nil t))) 1510 | (torus--prefix-argument-split current-prefix-arg) 1511 | (let* ((location-circle 1512 | (cl-find 1513 | location-name torus-index 1514 | :test #'torus--equal-concise-p))) 1515 | (torus--switch location-circle))) 1516 | 1517 | 1518 | ;;;###autoload 1519 | (defun torus-meta-search (location-name) 1520 | "Search LOCATION-NAME in the torus. 1521 | Go to the first matching torus, circle and location." 1522 | (interactive 1523 | (list 1524 | (completing-read 1525 | "Search location in torus : " 1526 | (mapcar #'torus--concise torus-meta-index) nil t))) 1527 | (torus--prefix-argument-split current-prefix-arg) 1528 | (let* ((location-circle-torus 1529 | (cl-find 1530 | location-name torus-meta-index 1531 | :test #'torus--equal-concise-p))) 1532 | (torus--meta-switch location-circle-torus))) 1533 | 1534 | ;;; History 1535 | ;;; ------------ 1536 | 1537 | ;;;###autoload 1538 | (defun torus-history-newer () 1539 | "Go to newer location in history." 1540 | (interactive) 1541 | (if torus-torus 1542 | (progn 1543 | (torus--prefix-argument-split current-prefix-arg) 1544 | (if torus-history 1545 | (progn 1546 | (setq torus-history (append (last torus-history) (butlast torus-history))) 1547 | (torus--switch (car torus-history))) 1548 | (message "History is empty."))) 1549 | (message torus--message-empty-torus))) 1550 | 1551 | ;;;###autoload 1552 | (defun torus-history-older () 1553 | "Go to older location in history." 1554 | (interactive) 1555 | (if torus-torus 1556 | (progn 1557 | (torus--prefix-argument-split current-prefix-arg) 1558 | (if torus-history 1559 | (progn 1560 | (setq torus-history (append (cdr torus-history) (list (car torus-history)))) 1561 | (torus--switch (car torus-history))) 1562 | (message "History is empty."))) 1563 | (message torus--message-empty-torus))) 1564 | 1565 | ;;;###autoload 1566 | (defun torus-search-history (location-name) 1567 | "Search LOCATION-NAME in `torus-history'." 1568 | (interactive 1569 | (list 1570 | (completing-read 1571 | "Search location in history : " 1572 | (mapcar #'torus--concise torus-history) nil t))) 1573 | (torus--prefix-argument-split current-prefix-arg) 1574 | (when torus-history 1575 | (let* ((index (cl-position location-name torus-history 1576 | :test #'torus--equal-concise-p)) 1577 | (before (cl-subseq torus-history 0 index)) 1578 | (element (nth index torus-history)) 1579 | (after (cl-subseq torus-history (1+ index)))) 1580 | (setq torus-history (append (list element) before after))) 1581 | (torus--switch (car torus-history)))) 1582 | 1583 | ;;;###autoload 1584 | (defun torus-search-meta-history (location-name) 1585 | "Search LOCATION-NAME in `torus-meta-history'." 1586 | (interactive 1587 | (list 1588 | (completing-read 1589 | "Search location in history : " 1590 | (mapcar #'torus--concise torus-meta-history) nil t))) 1591 | (torus--prefix-argument-split current-prefix-arg) 1592 | (when torus-meta-history 1593 | (let* ((index (cl-position location-name torus-meta-history 1594 | :test #'torus--equal-concise-p)) 1595 | (before (cl-subseq torus-meta-history 0 index)) 1596 | (element (nth index torus-meta-history)) 1597 | (after (cl-subseq torus-meta-history (1+ index)))) 1598 | (setq torus-meta-history (append (list element) before after))) 1599 | (torus--meta-switch (car torus-meta-history)))) 1600 | 1601 | ;;; Alternate 1602 | ;;; ------------ 1603 | 1604 | ;;;###autoload 1605 | (defun torus-alternate-in-meta () 1606 | "Alternate last two locations in meta history. 1607 | If outside the torus, just return inside, to the last torus location." 1608 | (interactive) 1609 | (if torus-meta 1610 | (progn 1611 | (torus--prefix-argument-split current-prefix-arg) 1612 | (if (torus--inside-p) 1613 | (if (and torus-meta-history 1614 | (>= (length torus-meta-history) 2)) 1615 | (progn 1616 | (torus--update-meta) 1617 | (setq torus-meta-history (append (list (car (cdr torus-meta-history))) 1618 | (list (car torus-meta-history)) 1619 | (nthcdr 2 torus-meta-history))) 1620 | (torus--meta-switch (car torus-meta-history))) 1621 | (message "Meta history has less than two elements.")) 1622 | (torus--jump))) 1623 | (message torus--message-empty-meta))) 1624 | 1625 | ;;;###autoload 1626 | (defun torus-alternate-in-same-torus () 1627 | "Alternate last two locations in history belonging to the current circle. 1628 | If outside the torus, just return inside, to the last torus location." 1629 | (interactive) 1630 | (if torus-torus 1631 | (progn 1632 | (torus--prefix-argument-split current-prefix-arg) 1633 | (if (torus--inside-p) 1634 | (if (and torus-history 1635 | (>= (length torus-history) 2)) 1636 | (progn 1637 | (torus--update-meta) 1638 | (setq torus-history (append (list (car (cdr torus-history))) 1639 | (list (car torus-history)) 1640 | (nthcdr 2 torus-history))) 1641 | (torus--switch (car torus-history))) 1642 | (message "History has less than two elements.")) 1643 | (torus--jump))) 1644 | (message torus--message-empty-torus))) 1645 | 1646 | ;;;###autoload 1647 | (defun torus-alternate-in-same-circle () 1648 | "Alternate last two locations in history belonging to the current circle. 1649 | If outside the torus, just return inside, to the last torus location." 1650 | (interactive) 1651 | (if torus-torus 1652 | (progn 1653 | (torus--prefix-argument-split current-prefix-arg) 1654 | (if (torus--inside-p) 1655 | (if (and torus-history 1656 | (>= (length torus-history) 2)) 1657 | (progn 1658 | (torus--update-meta) 1659 | (let ((history torus-history) 1660 | (circle (car (car torus-torus))) 1661 | (element) 1662 | (location-circle)) 1663 | (pop history) 1664 | (while (and (not location-circle) history) 1665 | (setq element (pop history)) 1666 | (when (equal circle (cdr element)) 1667 | (setq location-circle element))) 1668 | (if location-circle 1669 | (torus--switch location-circle) 1670 | (message "No alternate file in same circle in history.")))) 1671 | (message "History has less than two elements.")) 1672 | (torus--jump))) 1673 | (message torus--message-empty-torus))) 1674 | 1675 | ;;;###autoload 1676 | (defun torus-alternate-toruses () 1677 | "Alternate last two toruses in meta history. 1678 | If outside the torus, just return inside, to the last torus location." 1679 | (interactive) 1680 | (if torus-meta 1681 | (progn 1682 | (torus--prefix-argument-split current-prefix-arg) 1683 | (if (torus--inside-p) 1684 | (if (and torus-meta-history 1685 | (>= (length torus-meta-history) 2)) 1686 | (progn 1687 | (torus--update-meta) 1688 | (let ((history torus-meta-history) 1689 | (torus (car (car torus-meta))) 1690 | (element) 1691 | (location-circle-torus)) 1692 | (while (and (not location-circle-torus) history) 1693 | (setq element (pop history)) 1694 | (when (not (equal torus (cddr element))) 1695 | (setq location-circle-torus element))) 1696 | (if location-circle-torus 1697 | (torus--meta-switch location-circle-torus) 1698 | (message "No alternate torus in history.")))) 1699 | (message "Meta History has less than two elements.")) 1700 | (torus--jump))) 1701 | (message "Meta torus is empty."))) 1702 | 1703 | ;;;###autoload 1704 | (defun torus-alternate-circles () 1705 | "Alternate last two circles in history. 1706 | If outside the torus, just return inside, to the last torus location." 1707 | (interactive) 1708 | (if torus-torus 1709 | (progn 1710 | (torus--prefix-argument-split current-prefix-arg) 1711 | (if (torus--inside-p) 1712 | (if (and torus-history 1713 | (>= (length torus-history) 2)) 1714 | (progn 1715 | (torus--update-meta) 1716 | (let ((history torus-history) 1717 | (circle (car (car torus-torus))) 1718 | (element) 1719 | (location-circle)) 1720 | (while (and (not location-circle) history) 1721 | (setq element (pop history)) 1722 | (when (not (equal circle (cdr element))) 1723 | (setq location-circle element))) 1724 | (if location-circle 1725 | (torus--switch location-circle) 1726 | (message "No alternate circle in history.")))) 1727 | (message "History has less than two elements.")) 1728 | (torus--jump))) 1729 | (message torus--message-empty-torus))) 1730 | 1731 | ;;;###autoload 1732 | (defun torus-alternate-menu (choice) 1733 | "Alternate according to CHOICE." 1734 | (interactive 1735 | (list (read-key torus--message-alternate-choice))) 1736 | (pcase choice 1737 | (?m (funcall 'torus-alternate-in-meta)) 1738 | (?t (funcall 'torus-alternate-in-same-torus)) 1739 | (?c (funcall 'torus-alternate-in-same-circle)) 1740 | (?T (funcall 'torus-alternate-toruses)) 1741 | (?C (funcall 'torus-alternate-circles)) 1742 | (?\a (message "Alternate operation cancelled by Ctrl-G.")) 1743 | (_ (message "Invalid key.")))) 1744 | 1745 | ;;; Rename 1746 | ;;; ------------ 1747 | 1748 | ;;;###autoload 1749 | (defun torus-rename-circle () 1750 | "Rename current circle." 1751 | (interactive) 1752 | (if torus-torus 1753 | (let* 1754 | ((old-name (car (car torus-torus))) 1755 | (prompt (format "New name of circle %s : " old-name)) 1756 | (circle-name (read-string prompt nil 'torus-input-history))) 1757 | (torus--update-input-history circle-name) 1758 | (setcar (car torus-torus) circle-name) 1759 | (dolist (location-circle torus-index) 1760 | (when (equal (cdr location-circle) old-name) 1761 | (setcdr location-circle circle-name))) 1762 | (dolist (location-circle torus-history) 1763 | (when (equal (cdr location-circle) old-name) 1764 | (setcdr location-circle circle-name))) 1765 | (dolist (location-circle-torus torus-meta-history) 1766 | (when (equal (cadr location-circle-torus) old-name) 1767 | (setcar (cdr location-circle-torus) circle-name))) 1768 | (dolist (location-circle-torus torus-meta-index) 1769 | (when (equal (cadr location-circle-torus) old-name) 1770 | (setcar (cdr location-circle-torus) circle-name))) 1771 | (message "Renamed circle %s -> %s" old-name circle-name)) 1772 | (message "Torus is empty. Please add a circle first with torus-add-circle."))) 1773 | 1774 | ;;;###autoload 1775 | (defun torus-rename-torus () 1776 | "Rename current torus." 1777 | (interactive) 1778 | (if torus-meta 1779 | (let* 1780 | ((old-name (car (car torus-meta))) 1781 | (prompt (format "New name of torus %s : " old-name)) 1782 | (torus-name (read-string prompt nil 'torus-input-history))) 1783 | (torus--update-input-history torus-name) 1784 | (setcar (car torus-meta) torus-name) 1785 | (message "Renamed torus %s -> %s" old-name torus-name)) 1786 | (message torus--message-empty-meta))) 1787 | 1788 | ;;; Move 1789 | ;;; ------------ 1790 | 1791 | ;;;###autoload 1792 | (defun torus-move-circle (circle-name) 1793 | "Move current circle after CIRCLE-NAME." 1794 | (interactive 1795 | (list (completing-read 1796 | "Move current circle after : " 1797 | (mapcar #'car torus-torus) nil t))) 1798 | (torus--update-position) 1799 | (let* ((circle (assoc circle-name torus-torus)) 1800 | (index (1+ (cl-position circle torus-torus :test #'equal))) 1801 | (current (list (car torus-torus))) 1802 | (before (cl-subseq torus-torus 1 index)) 1803 | (after (cl-subseq torus-torus index))) 1804 | (setq torus-torus (append before current after)) 1805 | (torus-switch-circle (caar current)))) 1806 | 1807 | ;;;###autoload 1808 | (defun torus-move-location (location-name) 1809 | "Move current location after LOCATION-NAME." 1810 | (interactive 1811 | (list 1812 | (completing-read 1813 | "Move current location after : " 1814 | (mapcar #'torus--concise (cdr (car torus-torus))) nil t))) 1815 | (torus--update-position) 1816 | (let* ((circle (cdr (car torus-torus))) 1817 | (index (1+ (cl-position location-name circle 1818 | :test #'torus--equal-concise-p))) 1819 | (current (list (car circle))) 1820 | (before (cl-subseq circle 1 index)) 1821 | (after (cl-subseq circle index))) 1822 | (setcdr (car torus-torus) (append before current after)) 1823 | (torus-switch-location (car current)))) 1824 | 1825 | ;;;###autoload 1826 | (defun torus-move-torus (torus-name) 1827 | "Move current torus after TORUS-NAME." 1828 | (interactive 1829 | (list (completing-read 1830 | "Move current torus after : " 1831 | (mapcar #'car torus-meta) nil t))) 1832 | (torus--update-meta) 1833 | (let* ((torus (assoc torus-name torus-meta)) 1834 | (index (1+ (cl-position torus torus-meta :test #'equal))) 1835 | (current (copy-tree (list (car torus-meta)))) 1836 | (before (copy-tree (cl-subseq torus-meta 1 index))) 1837 | (after (copy-tree (cl-subseq torus-meta index)))) 1838 | (setq torus-meta (append before current after)) 1839 | (torus--update-from-meta) 1840 | (torus-switch-torus (caar current)))) 1841 | 1842 | ;;;###autoload 1843 | (defun torus-move-location-to-circle (circle-name) 1844 | "Move current location to CIRCLE-NAME." 1845 | (interactive 1846 | (list (completing-read 1847 | "Move current location to circle : " 1848 | (mapcar #'car torus-torus) nil t))) 1849 | (torus--update-position) 1850 | (let* ((location (car (cdr (car torus-torus)))) 1851 | (circle (cdr (assoc circle-name torus-torus))) 1852 | (old-name (car (car torus-torus))) 1853 | (old-pair (cons location old-name))) 1854 | (if (member location circle) 1855 | (message "Location %s already exists in circle %s." 1856 | (torus--concise location) 1857 | circle-name) 1858 | (message "Moving location %s to circle %s." 1859 | (torus--concise location) 1860 | circle-name) 1861 | (pop (cdar torus-torus)) 1862 | (setcdr (assoc circle-name torus-torus) 1863 | (push location circle)) 1864 | (dolist (location-circle torus-index) 1865 | (when (equal location-circle old-pair) 1866 | (setcdr location-circle circle-name))) 1867 | (dolist (location-circle torus-history) 1868 | (when (equal location-circle old-pair) 1869 | (setcdr location-circle circle-name))) 1870 | (torus--jump)))) 1871 | 1872 | 1873 | ;;;###autoload 1874 | (defun torus-move-circle-to-torus (torus-name) 1875 | "Move current circle to TORUS-NAME." 1876 | (interactive 1877 | (list (completing-read 1878 | "Move current circle to torus : " 1879 | (mapcar #'car torus-meta) nil t))) 1880 | (torus--update-position) 1881 | (let* ((circle (cl-copy-seq (car torus-torus))) 1882 | (torus (copy-tree 1883 | (cdr (assoc "torus" (assoc torus-name torus-meta))))) 1884 | (circle-name (car circle)) 1885 | (circle-torus (cons circle-name (caar torus-meta)))) 1886 | (if (member circle torus) 1887 | (message "Circle %s already exists in torus %s." 1888 | circle-name 1889 | torus-name) 1890 | (message "Moving circle %s to torus %s." 1891 | circle-name 1892 | torus-name) 1893 | (when (> torus-verbosity 2) 1894 | (message "circle-torus %s" circle-torus)) 1895 | (setcdr (assoc "torus" (assoc torus-name torus-meta)) 1896 | (push circle torus)) 1897 | (setq torus-torus (torus--assoc-delete-all circle-name torus-torus)) 1898 | (setq torus-index 1899 | (torus--reverse-assoc-delete-all circle-name torus-index)) 1900 | (setq torus-history 1901 | (torus--reverse-assoc-delete-all circle-name torus-history)) 1902 | (setq torus-markers 1903 | (torus--reverse-assoc-delete-all circle-name torus-markers)) 1904 | (setq torus-meta-index 1905 | (torus--reverse-assoc-delete-all circle-torus torus-meta-index)) 1906 | (setq torus-meta-history 1907 | (torus--reverse-assoc-delete-all circle-torus torus-meta-history)) 1908 | (torus--build-index) 1909 | (torus--build-meta-index) 1910 | (torus--jump)))) 1911 | 1912 | ;;;###autoload 1913 | (defun torus-copy-location-to-circle (circle-name) 1914 | "Copy current location to CIRCLE-NAME." 1915 | (interactive 1916 | (list (completing-read 1917 | "Copy current location to circle : " 1918 | (mapcar #'car torus-torus) nil t))) 1919 | (torus--update-position) 1920 | (let* ((location (car (cdr (car torus-torus)))) 1921 | (circle (cdr (assoc circle-name torus-torus)))) 1922 | (if (member location circle) 1923 | (message "Location %s already exists in circle %s." 1924 | (torus--concise location) 1925 | circle-name) 1926 | (message "Copying location %s to circle %s." 1927 | (torus--concise location) 1928 | circle-name) 1929 | (setcdr (assoc circle-name torus-torus) (push location circle)) 1930 | (torus--build-index) 1931 | (torus--build-meta-index)))) 1932 | 1933 | ;;;###autoload 1934 | (defun torus-copy-circle-to-torus (torus-name) 1935 | "Copy current circle to TORUS-NAME." 1936 | (interactive 1937 | (list (completing-read 1938 | "Copy current circle to torus : " 1939 | (mapcar #'car torus-meta) nil t))) 1940 | (torus--update-position) 1941 | (let* ((circle (cl-copy-seq (car torus-torus))) 1942 | (torus (copy-tree 1943 | (cdr (assoc "torus" (assoc torus-name torus-meta)))))) 1944 | (if (member circle torus) 1945 | (message "Circle %s already exists in torus %s." 1946 | (car circle) 1947 | torus-name) 1948 | (message "Copying circle %s to torus %s." 1949 | (car circle) 1950 | torus-name) 1951 | (setcdr (assoc "torus" (assoc torus-name torus-meta)) 1952 | (push circle torus))) 1953 | (torus--build-index) 1954 | (torus--build-meta-index))) 1955 | 1956 | ;;; Reverse 1957 | ;;; ------------ 1958 | 1959 | ;;;###autoload 1960 | (defun torus-reverse-circles () 1961 | "Reverse order of the circles." 1962 | (interactive) 1963 | (torus--update-position) 1964 | (setq torus-torus (reverse torus-torus)) 1965 | (torus--jump)) 1966 | 1967 | ;;;###autoload 1968 | (defun torus-reverse-locations () 1969 | "Reverse order of the locations in the current circles." 1970 | (interactive) 1971 | (torus--update-position) 1972 | (setcdr (car torus-torus) (reverse (cdr (car torus-torus)))) 1973 | (torus--jump)) 1974 | 1975 | ;;;###autoload 1976 | (defun torus-deep-reverse () 1977 | "Reverse order of the locations in each circle." 1978 | (interactive) 1979 | (torus--update-position) 1980 | (setq torus-torus (reverse torus-torus)) 1981 | (dolist (circle torus-torus) 1982 | (setcdr circle (reverse (cdr circle)))) 1983 | (torus--jump)) 1984 | 1985 | 1986 | ;;;###autoload 1987 | (defun torus-reverse-menu (choice) 1988 | "Split according to CHOICE." 1989 | (interactive 1990 | (list (read-key torus--message-reverse-choice))) 1991 | (pcase choice 1992 | (?c (funcall 'torus-reverse-circles)) 1993 | (?l (funcall 'torus-reverse-locations)) 1994 | (?d (funcall 'torus-deep-reverse)) 1995 | (?\a (message "Reverse operation cancelled by Ctrl-G.")) 1996 | (_ (message "Invalid key.")))) 1997 | 1998 | ;;; Join 1999 | ;;; ------------ 2000 | 2001 | ;;;###autoload 2002 | (defun torus-prefix-circles-of-current-torus (prefix) 2003 | "Add PREFIX to circle names of `torus-torus'." 2004 | (interactive 2005 | (list 2006 | (read-string (format torus--message-prefix-circle 2007 | (car (car torus-meta))) 2008 | nil 2009 | 'torus-input-history))) 2010 | (let ((varlist)) 2011 | (setq varlist (torus--prefix-circles prefix (car (car torus-meta)))) 2012 | (setq torus-torus (car varlist)) 2013 | (setq torus-history (car (cdr varlist)))) 2014 | (torus--build-index) 2015 | (torus--build-meta-index)) 2016 | 2017 | ;;;###autoload 2018 | (defun torus-join-circles (circle-name) 2019 | "Join current circle with CIRCLE-NAME." 2020 | (interactive 2021 | (list 2022 | (completing-read "Join current circle with circle : " 2023 | (mapcar #'car torus-torus) nil t))) 2024 | (let* ((current-name (car (car torus-torus))) 2025 | (join-name (concat current-name torus-join-separator circle-name)) 2026 | (user-choice 2027 | (read-string (format "Name of the joined torus [%s] : " join-name)))) 2028 | (when (> (length user-choice) 0) 2029 | (setq join-name user-choice)) 2030 | (torus-add-circle join-name) 2031 | (setcdr (car torus-torus) 2032 | (append (cdr (assoc current-name torus-torus)) 2033 | (cdr (assoc circle-name torus-torus)))) 2034 | (delete-dups (cdr (car torus-torus)))) 2035 | (torus--update-meta) 2036 | (torus--build-index) 2037 | (torus--build-meta-index) 2038 | (torus--jump)) 2039 | 2040 | ;;;###autoload 2041 | (defun torus-join-toruses (torus-name) 2042 | "Join current torus with TORUS-NAME in `torus-meta'." 2043 | (interactive 2044 | (list 2045 | (completing-read "Join current torus with torus : " 2046 | (mapcar #'car torus-meta) nil t))) 2047 | (torus--prefix-argument-split current-prefix-arg) 2048 | (torus--update-meta) 2049 | (let* ((current-name (car (car torus-meta))) 2050 | (join-name (concat current-name torus-join-separator torus-name)) 2051 | (user-choice 2052 | (read-string (format "Name of the joined torus [%s] : " join-name))) 2053 | (prompt-current 2054 | (format torus--message-prefix-circle current-name)) 2055 | (prompt-added 2056 | (format torus--message-prefix-circle torus-name)) 2057 | (prefix-current 2058 | (read-string prompt-current nil 'torus-input-history)) 2059 | (prefix-added 2060 | (read-string prompt-added nil 'torus-input-history)) 2061 | (varlist) 2062 | (torus-added) 2063 | (history-added) 2064 | (input-added)) 2065 | (when (> (length user-choice) 0) 2066 | (setq join-name user-choice)) 2067 | (torus--update-input-history prefix-current) 2068 | (torus--update-input-history prefix-added) 2069 | (torus-add-copy-of-torus join-name) 2070 | (torus-prefix-circles-of-current-torus prefix-current) 2071 | (setq varlist (torus--prefix-circles prefix-added torus-name)) 2072 | (setq torus-added (car varlist)) 2073 | (setq history-added (car (cdr varlist))) 2074 | (setq input-added (car (cdr (cdr varlist)))) 2075 | (if (seq-intersection torus-torus torus-added #'torus--equal-car-p) 2076 | (message torus--message-circle-name-collision) 2077 | (setq torus-torus (append torus-torus torus-added)) 2078 | (setq torus-history (append torus-history history-added)) 2079 | (setq torus-input-history (append torus-input-history input-added)))) 2080 | (torus--update-meta) 2081 | (torus--build-index) 2082 | (torus--build-meta-index) 2083 | (torus--jump)) 2084 | 2085 | ;;; Autogroup 2086 | ;;; ------------ 2087 | 2088 | ;;;###autoload 2089 | (defun torus-autogroup (quoted-function) 2090 | "Autogroup all torus locations according to the values of QUOTED-FUNCTION. 2091 | A new torus is created on `torus-meta' to contain the new circles. 2092 | The function must return the names of the new circles as strings." 2093 | (interactive) 2094 | (let ((torus-name 2095 | (read-string "Name of the autogroup torus : " 2096 | nil 2097 | 'torus-input-history)) 2098 | (all-locations)) 2099 | (if (assoc torus-name torus-meta) 2100 | (message "Torus %s already exists in torus-meta" torus-name) 2101 | (torus-add-copy-of-torus torus-name) 2102 | (dolist (circle torus-torus) 2103 | (dolist (location (cdr circle)) 2104 | (push location all-locations))) 2105 | (setq torus-torus (seq-group-by quoted-function all-locations)))) 2106 | (setq torus-history nil) 2107 | (setq torus-markers nil) 2108 | (setq torus-input-history nil) 2109 | (torus--build-index) 2110 | (torus--build-meta-index) 2111 | (torus--update-meta) 2112 | (torus--jump)) 2113 | 2114 | ;;;###autoload 2115 | (defun torus-autogroup-by-path () 2116 | "Autogroup all location of the torus by directories. 2117 | A new torus is created to contain the new circles." 2118 | (interactive) 2119 | (torus-autogroup (lambda (elem) (directory-file-name (file-name-directory (car elem)))))) 2120 | 2121 | ;;;###autoload 2122 | (defun torus-autogroup-by-directory () 2123 | "Autogroup all location of the torus by directories. 2124 | A new torus is created to contain the new circles." 2125 | (interactive) 2126 | (torus-autogroup #'torus--directory)) 2127 | 2128 | ;;;###autoload 2129 | (defun torus-autogroup-by-extension () 2130 | "Autogroup all location of the torus by extension. 2131 | A new torus is created to contain the new circles." 2132 | (interactive) 2133 | (torus-autogroup #'torus--extension-description)) 2134 | 2135 | ;;;###autoload 2136 | (defun torus-autogroup-by-git-repo () 2137 | "Autogroup all location of the torus by git repositories. 2138 | A new torus is created to contain the new circles." 2139 | ;; TODO 2140 | ) 2141 | 2142 | ;;;###autoload 2143 | (defun torus-autogroup-menu (choice) 2144 | "Autogroup according to CHOICE." 2145 | (interactive 2146 | (list (read-key torus--message-autogroup-choice))) 2147 | (pcase choice 2148 | (?p (funcall 'torus-autogroup-by-path)) 2149 | (?d (funcall 'torus-autogroup-by-directory)) 2150 | (?e (funcall 'torus-autogroup-by-extension)) 2151 | (?\a (message "Autogroup cancelled by Ctrl-G.")) 2152 | (_ (message "Invalid key.")))) 2153 | 2154 | ;;; Batch 2155 | ;;; ------------ 2156 | 2157 | 2158 | ;;;###autoload 2159 | (defun torus-run-elisp-code-on-circle (elisp-code) 2160 | "Run ELISP-CODE to all files of the circle." 2161 | (interactive (list (read-string 2162 | "Elisp code to run to all files of the circle : "))) 2163 | (dolist (iter (number-sequence 1 (length (cdar torus-torus)))) 2164 | (when (> torus-verbosity 1) 2165 | (message "%d. Applying %s to %s" iter elisp-code (cadar torus-torus)) 2166 | (message "Evaluated : %s" 2167 | (car (read-from-string (format "(progn %s)" elisp-code))))) 2168 | (torus--eval-string elisp-code) 2169 | (torus-next-location))) 2170 | 2171 | ;;;###autoload 2172 | (defun torus-run-elisp-command-on-circle (command) 2173 | "Run an Emacs Lisp COMMAND to all files of the circle." 2174 | (interactive (list (read-command 2175 | "Elisp command to run to all files of the circle : "))) 2176 | (dolist (iter (number-sequence 1 (length (cdar torus-torus)))) 2177 | (when (> torus-verbosity 1) 2178 | (message "%d. Applying %s to %s" iter command (cadar torus-torus))) 2179 | (funcall command) 2180 | (torus-next-location))) 2181 | 2182 | ;;;###autoload 2183 | (defun torus-run-shell-command-on-circle (command) 2184 | "Run a shell COMMAND to all files of the circle." 2185 | (interactive (list (read-string 2186 | "Shell command to run to all files of the circle : "))) 2187 | (let ((keep-value shell-command-dont-erase-buffer)) 2188 | (setq shell-command-dont-erase-buffer t) 2189 | (dolist (iter (number-sequence 1 (length (cdar torus-torus)))) 2190 | (when (> torus-verbosity 1) 2191 | (message "%d. Applying %s to %s" iter command (cadar torus-torus))) 2192 | (shell-command (format "%s %s" 2193 | command 2194 | (shell-quote-argument (buffer-file-name)))) 2195 | (torus-next-location)) 2196 | (setq shell-command-dont-erase-buffer keep-value))) 2197 | 2198 | ;;;###autoload 2199 | (defun torus-run-async-shell-command-on-circle (command) 2200 | "Run a shell COMMAND to all files of the circle." 2201 | (interactive (list (read-string 2202 | "Shell command to run to all files of the circle : "))) 2203 | (let ((keep-value async-shell-command-buffer)) 2204 | (setq async-shell-command-buffer 'new-buffer) 2205 | (dolist (iter (number-sequence 1 (length (cdar torus-torus)))) 2206 | (when (> torus-verbosity 1) 2207 | (message "%d. Applying %s to %s" iter command (cadar torus-torus))) 2208 | (async-shell-command (format "%s %s" 2209 | command 2210 | (shell-quote-argument (buffer-file-name)))) 2211 | (torus-next-location)) 2212 | (setq async-shell-command-buffer keep-value))) 2213 | 2214 | ;;;###autoload 2215 | (defun torus-batch-menu (choice) 2216 | "Split according to CHOICE." 2217 | (interactive 2218 | (list (read-key torus--message-batch-choice))) 2219 | (pcase choice 2220 | (?e (call-interactively 'torus-run-elisp-code-on-circle)) 2221 | (?c (call-interactively 'torus-run-elisp-command-on-circle)) 2222 | (?! (call-interactively 'torus-run-shell-command-on-circle)) 2223 | (?& (call-interactively 'torus-run-async-shell-command-on-circle)) 2224 | (?\a (message "Batch operation cancelled by Ctrl-G.")) 2225 | (_ (message "Invalid key.")))) 2226 | 2227 | ;;; Split 2228 | ;;; ------------ 2229 | 2230 | ;;;###autoload 2231 | (defun torus-split-horizontally () 2232 | "Split horizontally to view all buffers in current circle. 2233 | Split until `torus-maximum-horizontal-split' is reached." 2234 | (interactive) 2235 | (let* ((circle (cdr (car torus-torus))) 2236 | (numsplit (1- (length circle)))) 2237 | (when (> torus-verbosity 1) 2238 | (message "numsplit = %d" numsplit)) 2239 | (if (> numsplit (1- torus-maximum-horizontal-split)) 2240 | (message "Too many files to split.") 2241 | (delete-other-windows) 2242 | (dolist (iter (number-sequence 1 numsplit)) 2243 | (when (> torus-verbosity 2) 2244 | (message "iter = %d" iter)) 2245 | (split-window-below) 2246 | (balance-windows) 2247 | (other-window 1) 2248 | (torus-next-location)) 2249 | (other-window 1) 2250 | (torus-next-location)))) 2251 | 2252 | ;;;###autoload 2253 | (defun torus-split-vertically () 2254 | "Split vertically to view all buffers in current circle. 2255 | Split until `torus-maximum-vertical-split' is reached." 2256 | (interactive) 2257 | (let* ((circle (cdr (car torus-torus))) 2258 | (numsplit (1- (length circle)))) 2259 | (when (> torus-verbosity 1) 2260 | (message "numsplit = %d" numsplit)) 2261 | (if (> numsplit (1- torus-maximum-vertical-split)) 2262 | (message "Too many files to split.") 2263 | (delete-other-windows) 2264 | (dolist (iter (number-sequence 1 numsplit)) 2265 | (when (> torus-verbosity 2) 2266 | (message "iter = %d" iter)) 2267 | (split-window-right) 2268 | (balance-windows) 2269 | (other-window 1) 2270 | (torus-next-location)) 2271 | (other-window 1) 2272 | (torus-next-location)))) 2273 | 2274 | ;;;###autoload 2275 | (defun torus-split-main-left () 2276 | "Split with left main window to view all buffers in current circle." 2277 | (interactive) 2278 | (let* ((circle (cdr (car torus-torus))) 2279 | (numsplit (- (length circle) 2))) 2280 | (when (> torus-verbosity 1) 2281 | (message "numsplit = %d" numsplit)) 2282 | (if (> numsplit (1- torus-maximum-horizontal-split)) 2283 | (message "Too many files to split.") 2284 | (delete-other-windows) 2285 | (split-window-right) 2286 | (other-window 1) 2287 | (torus-next-location) 2288 | (dolist (iter (number-sequence 1 numsplit)) 2289 | (when (> torus-verbosity 2) 2290 | (message "iter = %d" iter)) 2291 | (split-window-below) 2292 | (balance-windows) 2293 | (other-window 1) 2294 | (torus-next-location)) 2295 | (other-window 1) 2296 | (torus-next-location)))) 2297 | 2298 | ;;;###autoload 2299 | (defun torus-split-main-right () 2300 | "Split with right main window to view all buffers in current circle." 2301 | (interactive) 2302 | (let* ((circle (cdr (car torus-torus))) 2303 | (numsplit (- (length circle) 2))) 2304 | (when (> torus-verbosity 1) 2305 | (message "numsplit = %d" numsplit)) 2306 | (if (> numsplit (1- torus-maximum-horizontal-split)) 2307 | (message "Too many files to split.") 2308 | (delete-other-windows) 2309 | (split-window-right) 2310 | (torus-next-location) 2311 | (dolist (iter (number-sequence 1 numsplit)) 2312 | (when (> torus-verbosity 2) 2313 | (message "iter = %d" iter)) 2314 | (split-window-below) 2315 | (balance-windows) 2316 | (other-window 1) 2317 | (torus-next-location)) 2318 | (other-window 1) 2319 | (torus-next-location)))) 2320 | 2321 | ;;;###autoload 2322 | (defun torus-split-main-top () 2323 | "Split with main top window to view all buffers in current circle." 2324 | (interactive) 2325 | (let* ((circle (cdr (car torus-torus))) 2326 | (numsplit (- (length circle) 2))) 2327 | (when (> torus-verbosity 1) 2328 | (message "numsplit = %d" numsplit)) 2329 | (if (> numsplit (1- torus-maximum-vertical-split)) 2330 | (message "Too many files to split.") 2331 | (delete-other-windows) 2332 | (split-window-below) 2333 | (other-window 1) 2334 | (torus-next-location) 2335 | (dolist (iter (number-sequence 1 numsplit)) 2336 | (when (> torus-verbosity 2) 2337 | (message "iter = %d" iter)) 2338 | (split-window-right) 2339 | (balance-windows) 2340 | (other-window 1) 2341 | (torus-next-location)) 2342 | (other-window 1) 2343 | (torus-next-location)))) 2344 | 2345 | ;;;###autoload 2346 | (defun torus-split-main-bottom () 2347 | "Split with main bottom window to view all buffers in current circle." 2348 | (interactive) 2349 | (let* ((circle (cdr (car torus-torus))) 2350 | (numsplit (- (length circle) 2))) 2351 | (when (> torus-verbosity 1) 2352 | (message "numsplit = %d" numsplit)) 2353 | (if (> numsplit (1- torus-maximum-vertical-split)) 2354 | (message "Too many files to split.") 2355 | (delete-other-windows) 2356 | (split-window-below) 2357 | (torus-next-location) 2358 | (dolist (iter (number-sequence 1 numsplit)) 2359 | (when (> torus-verbosity 2) 2360 | (message "iter = %d" iter)) 2361 | (split-window-right) 2362 | (balance-windows) 2363 | (other-window 1) 2364 | (torus-next-location)) 2365 | (other-window 1) 2366 | (torus-next-location)))) 2367 | 2368 | ;;;###autoload 2369 | (defun torus-split-grid () 2370 | "Split horizontally & vertically to view all current circle buffers in a grid." 2371 | (interactive) 2372 | (let* ((circle (cdr (car torus-torus))) 2373 | (len-circle (length circle)) 2374 | (max-iter (1- len-circle)) 2375 | (ratio (/ (float (frame-text-width)) 2376 | (float (frame-text-height)))) 2377 | (horizontal (sqrt (/ (float len-circle) ratio))) 2378 | (vertical (* ratio horizontal)) 2379 | (int-hor (min (ceiling horizontal) 2380 | torus-maximum-horizontal-split)) 2381 | (int-ver (min (ceiling vertical) 2382 | torus-maximum-vertical-split)) 2383 | (getout) 2384 | (num-hor-minus) 2385 | (num-hor) 2386 | (num-ver-minus) 2387 | (total 0)) 2388 | (if (< (* int-hor int-ver) len-circle) 2389 | (message "Too many files to split.") 2390 | (let ((dist-dec-hor) 2391 | (dist-dec-ver)) 2392 | (when (> torus-verbosity 2) 2393 | (message "ratio = %f" ratio) 2394 | (message "horizontal = %f" horizontal) 2395 | (message "vertical = %f" vertical) 2396 | (message "int-hor int-ver = %d %d" int-hor int-ver)) 2397 | (while (not getout) 2398 | (setq dist-dec-hor (abs (- (* (1- int-hor) int-ver) len-circle))) 2399 | (setq dist-dec-ver (abs (- (* int-hor (1- int-ver)) len-circle))) 2400 | (when (> torus-verbosity 2) 2401 | (message "Distance hor ver = %f %f" dist-dec-hor dist-dec-ver)) 2402 | (cond ((and (<= dist-dec-hor dist-dec-ver) 2403 | (>= (* (1- int-hor) int-ver) len-circle)) 2404 | (setq int-hor (1- int-hor)) 2405 | (when (> torus-verbosity 2) 2406 | (message "Decrease int-hor : int-hor int-ver = %d %d" 2407 | int-hor int-ver))) 2408 | ((and (>= dist-dec-hor dist-dec-ver) 2409 | (>= (* int-hor (1- int-ver)) len-circle)) 2410 | (setq int-ver (1- int-ver)) 2411 | (when (> torus-verbosity 2) 2412 | (message "Decrease int-ver : int-hor int-ver = %d %d" 2413 | int-hor int-ver))) 2414 | (t (setq getout t) 2415 | (when (> torus-verbosity 2) 2416 | (message "Getout : %s" getout) 2417 | (message "int-hor int-ver = %d %d" int-hor int-ver)))))) 2418 | (setq num-hor-minus (number-sequence 1 (1- int-hor))) 2419 | (setq num-hor (number-sequence 1 int-hor)) 2420 | (setq num-ver-minus (number-sequence 1 (1- int-ver))) 2421 | (when (> torus-verbosity 2) 2422 | (message "num-hor-minus = %s" num-hor-minus) 2423 | (message "num-hor = %s" num-hor) 2424 | (message "num-ver-minus = %s" num-ver-minus)) 2425 | (delete-other-windows) 2426 | (dolist (iter-hor num-hor-minus) 2427 | (when (> torus-verbosity 2) 2428 | (message "iter hor = %d" iter-hor)) 2429 | (setq max-iter (1- max-iter)) 2430 | (split-window-below) 2431 | (balance-windows) 2432 | (other-window 1)) 2433 | (other-window 1) 2434 | (dolist (iter-hor num-hor) 2435 | (dolist (iter-ver num-ver-minus) 2436 | (when (> torus-verbosity 2) 2437 | (message "iter hor ver = %d %d" iter-hor iter-ver) 2438 | (message "total max-iter = %d %d" total max-iter)) 2439 | (when (< total max-iter) 2440 | (setq total (1+ total)) 2441 | (split-window-right) 2442 | (balance-windows) 2443 | (other-window 1) 2444 | (torus-next-location))) 2445 | (when (< total max-iter) 2446 | (other-window 1) 2447 | (torus-next-location))) 2448 | (other-window 1) 2449 | (torus-next-location)))) 2450 | 2451 | ;;;###autoload 2452 | (defun torus-layout-menu (choice) 2453 | "Split according to CHOICE." 2454 | (interactive 2455 | (list (read-key torus--message-layout-choice))) 2456 | (torus--update-layout) 2457 | (let ((circle (caar torus-torus))) 2458 | (when (member choice '(?m ?o ?h ?v ?l ?r ?t ?b ?g)) 2459 | (setcdr (assoc circle torus-layout) choice)) 2460 | (pcase choice 2461 | (?m nil) 2462 | (?o (delete-other-windows)) 2463 | (?h (funcall 'torus-split-horizontally)) 2464 | (?v (funcall 'torus-split-vertically)) 2465 | (?l (funcall 'torus-split-main-left)) 2466 | (?r (funcall 'torus-split-main-right)) 2467 | (?t (funcall 'torus-split-main-top)) 2468 | (?b (funcall 'torus-split-main-bottom)) 2469 | (?g (funcall 'torus-split-grid)) 2470 | (?\a (message "Layout cancelled by Ctrl-G.")) 2471 | (_ (message "Invalid key."))))) 2472 | 2473 | ;;; Tabs 2474 | ;;; ------------ 2475 | 2476 | (defun torus-tab-mouse (event) 2477 | "Manage click EVENT on locations part of tab line." 2478 | (interactive "@e") 2479 | (let* ((index (cdar (nthcdr 4 (cadr event)))) 2480 | (before (substring-no-properties 2481 | (caar (nthcdr 4 (cadr event))) 0 index)) 2482 | (pipes (seq-filter (lambda (elem) (equal elem ?|)) before)) 2483 | (len-pipes (length pipes))) 2484 | (if (equal len-pipes 0) 2485 | (torus-alternate-in-same-circle) 2486 | (torus-switch-location (nth (length pipes) (cdar torus-torus)))))) 2487 | 2488 | ;;; Delete 2489 | ;;; ------------ 2490 | 2491 | ;;;###autoload 2492 | (defun torus-delete-circle (circle-name) 2493 | "Delete circle given by CIRCLE-NAME." 2494 | (interactive 2495 | (list 2496 | (completing-read "Delete circle : " 2497 | (mapcar #'car torus-torus) nil t))) 2498 | (when (y-or-n-p (format "Delete circle %s ? " circle-name)) 2499 | (setq torus-torus (torus--assoc-delete-all circle-name torus-torus)) 2500 | (setq torus-index 2501 | (torus--reverse-assoc-delete-all circle-name torus-index)) 2502 | (setq torus-history 2503 | (torus--reverse-assoc-delete-all circle-name torus-history)) 2504 | (setq torus-markers 2505 | (torus--reverse-assoc-delete-all circle-name torus-markers)) 2506 | (let ((circle-torus (cons (caar torus-torus) (caar torus-meta)))) 2507 | (setq torus-meta-index 2508 | (torus--reverse-assoc-delete-all circle-torus torus-meta-index)) 2509 | (setq torus-meta-history 2510 | (torus--reverse-assoc-delete-all circle-torus torus-meta-history))) 2511 | (torus--build-index) 2512 | (torus--build-meta-index) 2513 | (torus--jump))) 2514 | 2515 | ;;;###autoload 2516 | (defun torus-delete-location (location-name) 2517 | "Delete location given by LOCATION-NAME." 2518 | (interactive 2519 | (list 2520 | (completing-read 2521 | "Delete location : " 2522 | (mapcar #'torus--concise (cdr (car torus-torus))) nil t))) 2523 | (if (and 2524 | (> (length (car torus-torus)) 1) 2525 | (y-or-n-p 2526 | (format 2527 | "Delete %s from circle %s ? " 2528 | location-name 2529 | (car (car torus-torus))))) 2530 | (let* ((circle (cdr (car torus-torus))) 2531 | (index (cl-position location-name circle 2532 | :test #'torus--equal-concise-p)) 2533 | (location (nth index circle)) 2534 | (location-circle (cons location (caar torus-torus))) 2535 | (location-circle-torus (cons location (cons (caar torus-torus) 2536 | (caar torus-meta))))) 2537 | (setcdr (car torus-torus) (cl-remove location circle)) 2538 | (setq torus-index (cl-remove location-circle torus-index)) 2539 | (setq torus-history (cl-remove location-circle torus-history)) 2540 | (setq torus-markers (cl-remove location-circle torus-markers)) 2541 | (setq torus-meta-index (cl-remove location-circle-torus torus-meta-index)) 2542 | (setq torus-meta-history (cl-remove location-circle-torus torus-meta-history)) 2543 | (torus--jump)) 2544 | (message "No location in current circle."))) 2545 | 2546 | ;;;###autoload 2547 | (defun torus-delete-current-circle () 2548 | "Delete current circle." 2549 | (interactive) 2550 | (torus-delete-circle (torus--concise (car (car torus-torus))))) 2551 | 2552 | ;;;###autoload 2553 | (defun torus-delete-current-location () 2554 | "Remove current location from current circle." 2555 | (interactive) 2556 | (torus-delete-location (torus--concise (car (cdr (car torus-torus)))))) 2557 | 2558 | ;;;###autoload 2559 | (defun torus-delete-torus (torus-name) 2560 | "Delete torus given by TORUS-NAME." 2561 | (interactive 2562 | (list 2563 | (completing-read "Delete torus : " 2564 | (mapcar #'car torus-meta) nil t))) 2565 | (when (y-or-n-p (format "Delete torus %s ? " torus-name)) 2566 | (when (equal torus-name (car (car torus-meta))) 2567 | (torus-switch-torus (car (car (cdr torus-meta))))) 2568 | (setq torus-meta (torus--assoc-delete-all torus-name torus-meta)))) 2569 | 2570 | ;;; File R/W 2571 | ;;; ------------ 2572 | 2573 | ;;;###autoload 2574 | (defun torus-write (filename) 2575 | "Write main torus variables to FILENAME as Lisp code. 2576 | An adequate extension is added if needed. 2577 | If called interactively, ask for the variables to save (default : all)." 2578 | (interactive 2579 | (list 2580 | (read-file-name 2581 | "Torus file : " 2582 | (file-name-as-directory torus-dirname)))) 2583 | ;; We surely don’t want to load a file we’ve just written 2584 | (remove-hook 'after-save-hook 'torus-after-save-torus-file) 2585 | (if torus-meta 2586 | (let* 2587 | ((file-basename (file-name-nondirectory filename)) 2588 | (minus-len-ext (- (min (length torus-extension) 2589 | (length filename)))) 2590 | (buffer) 2591 | (varlist '(torus-torus 2592 | torus-history 2593 | torus-layout 2594 | torus-input-history 2595 | torus-meta 2596 | torus-index 2597 | torus-meta-history 2598 | torus-meta-index 2599 | torus-line-col))) 2600 | (torus--update-position) 2601 | (torus--update-input-history file-basename) 2602 | (unless (equal (cl-subseq filename minus-len-ext) torus-extension) 2603 | (setq filename (concat filename torus-extension))) 2604 | (unless torus-index 2605 | (torus--build-index)) 2606 | (unless torus-meta-index 2607 | (torus--build-meta-index)) 2608 | (torus--update-layout) 2609 | (torus--update-meta) 2610 | (if varlist 2611 | (progn 2612 | (torus--roll-backups filename) 2613 | (setq buffer (find-file-noselect filename)) 2614 | (with-current-buffer buffer 2615 | (erase-buffer) 2616 | (dolist (var varlist) 2617 | (when var 2618 | (insert (concat 2619 | "(setq " 2620 | (symbol-name var) 2621 | " (quote\n")) 2622 | (pp (symbol-value var) buffer) 2623 | (insert "))\n\n"))) 2624 | (save-buffer) 2625 | (kill-buffer))) 2626 | (message "Write cancelled : empty variables."))) 2627 | (message "Write cancelled : empty torus.")) 2628 | ;; Restore the hook 2629 | (add-hook 'after-save-hook 'torus-after-save-torus-file)) 2630 | 2631 | ;;;###autoload 2632 | (defun torus-read (filename) 2633 | "Read main torus variables from FILENAME as Lisp code." 2634 | (interactive 2635 | (list 2636 | (read-file-name 2637 | "Torus file : " 2638 | (file-name-as-directory torus-dirname)))) 2639 | (let* 2640 | ((file-basename (file-name-nondirectory filename)) 2641 | (minus-len-ext (- (min (length torus-extension) 2642 | (length filename)))) 2643 | (buffer)) 2644 | (unless (equal (cl-subseq filename minus-len-ext) torus-extension) 2645 | (setq filename (concat filename torus-extension))) 2646 | (when (or (and (not torus-meta) 2647 | (not torus-torus) 2648 | (not torus-index) 2649 | (not torus-history) 2650 | (not torus-layout) 2651 | (not torus-input-history) 2652 | (not torus-meta-index) 2653 | (not torus-meta-history)) 2654 | (y-or-n-p torus--message-replace-torus)) 2655 | (torus--update-input-history file-basename) 2656 | (if (file-exists-p filename) 2657 | (progn 2658 | (setq buffer (find-file-noselect filename)) 2659 | (eval-buffer buffer) 2660 | (kill-buffer buffer)) 2661 | (message "File %s does not exist." filename)))) 2662 | ;; Also saved in file 2663 | ;; (torus--update-meta) 2664 | ;; (torus--build-index) 2665 | ;; (torus--build-meta-index) 2666 | (torus--jump)) 2667 | 2668 | ;;;###autoload 2669 | (defun torus-edit (filename) 2670 | "Edit torus file FILENAME in the torus files dir. 2671 | Be sure to understand what you’re doing, and not leave some variables 2672 | in inconsistent state, or you might encounter strange undesired effects." 2673 | (interactive 2674 | (list 2675 | (read-file-name 2676 | "Torus file : " 2677 | (file-name-as-directory torus-dirname)))) 2678 | (find-file filename)) 2679 | 2680 | ;;; End 2681 | ;;; ------------------------------ 2682 | 2683 | (provide 'torus) 2684 | 2685 | ;; Local Variables: 2686 | ;; mode: emacs-lisp 2687 | ;; indent-tabs-mode: nil 2688 | ;; End: 2689 | 2690 | ;;; torus.el ends here 2691 | --------------------------------------------------------------------------------