├── .gitignore
├── ChangeLog.org
├── LICENSE
├── README.org
├── Rakefile
├── images
└── screenshot1.png
├── org-working-set.el
├── rake_config.yml
└── test
├── .nosearch
└── owst.el
/.gitignore:
--------------------------------------------------------------------------------
1 | *.elc
2 | *.new
3 | \#*#
4 | .#*
5 | *~
6 | elpa
7 | org-id-locations-for-test
8 | owst-ert-work.org
9 | backup
--------------------------------------------------------------------------------
/ChangeLog.org:
--------------------------------------------------------------------------------
1 | * 2.5 until 2021-05-24 Mo
2 |
3 | - Allow inline tasks in working set
4 | - `kill' as a synonym for `delete'
5 |
6 | * 2.4 until 2021-03-20 Sa
7 |
8 | - todo-state can be changed from working set menu
9 | - working set is kept in least-recently-used order
10 | - Wrapping org-id-find and org-id-goto more often
11 |
12 | * 2.3 until 2020-09-14 Mo
13 |
14 | - Renamed 'log of working-set nodes' into 'journal'
15 | - Create org-working-set-dispatch-keymap for easier customization
16 | - Reorganized keys (but you may change it if you like)
17 | - In-prompt display of settings for clock-in and land-at
18 | - Added a 'Fictional User-Story' to the documentation
19 | - Running tests under unix
20 |
21 | * 2.2 until 2020-07-20 Mo
22 |
23 | - Moved org-id-cleanup to its own package
24 | - Improved handling of missing ids in working set
25 | - Refactoring
26 | - Fixes
27 |
28 | * 2.1 until 2020-05-16 Sa
29 |
30 | - Added org-id-cleanup to clean up unreferenced IDs without attachments
31 |
32 | * 2.0 until 2020-04-13 Mo
33 |
34 | - Added a log of working set nodes
35 | - The node designated by org-working-set-id will be used to store this log
36 | - Simplified handling of clocking
37 | - Retired property working-set-nodes-do-not-clock
38 | - Renamed custom-variable org-working-set-clock-into-working-set into
39 | org-working-set-clock-in
40 | - Renamed org-working-set-show-working-set-overlay into
41 | org-working-set-show-overlay
42 | - Renamed org-working-set-goto-bottom-in-working-set into
43 | org-working-set-goto-bottom
44 |
45 | * 1.1 until 2020-02-07 Fr
46 |
47 | - Moved functions for working set into its own file
48 | - Show breadcrumbs in working-set-menu
49 | - Prepare for melpa
50 |
51 |
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | GNU GENERAL PUBLIC LICENSE
2 | Version 2, June 1991
3 |
4 | Copyright (C) 1989, 1991 Free Software Foundation, Inc.,
5 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
6 | Everyone is permitted to copy and distribute verbatim copies
7 | of this license document, but changing it is not allowed.
8 |
9 | Preamble
10 |
11 | The licenses for most software are designed to take away your
12 | freedom to share and change it. By contrast, the GNU General Public
13 | License is intended to guarantee your freedom to share and change free
14 | software--to make sure the software is free for all its users. This
15 | General Public License applies to most of the Free Software
16 | Foundation's software and to any other program whose authors commit to
17 | using it. (Some other Free Software Foundation software is covered by
18 | the GNU Lesser General Public License instead.) You can apply it to
19 | 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
26 | in 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
29 | anyone to deny you these rights or to ask you to surrender the rights.
30 | These 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
34 | gratis or for a fee, you must give the recipients all the rights that
35 | you have. You must make sure that they, too, receive or can get the
36 | source code. And you must show them these terms so they know their
37 | rights.
38 |
39 | We protect your rights with two steps: (1) copyright the software, and
40 | (2) offer you this license which gives you legal permission to copy,
41 | distribute and/or modify the software.
42 |
43 | Also, for each author's protection and ours, we want to make certain
44 | that everyone understands that there is no warranty for this free
45 | software. If the software is modified by someone else and passed on, we
46 | want its recipients to know that what they have is not the original, so
47 | that any problems introduced by others will not reflect on the original
48 | authors' reputations.
49 |
50 | Finally, any free program is threatened constantly by software
51 | patents. We wish to avoid the danger that redistributors of a free
52 | program will individually obtain patent licenses, in effect making the
53 | program proprietary. To prevent this, we have made it clear that any
54 | patent must be licensed for everyone's free use or not licensed at all.
55 |
56 | The precise terms and conditions for copying, distribution and
57 | modification follow.
58 |
59 | GNU GENERAL PUBLIC LICENSE
60 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
61 |
62 | 0. This License applies to any program or other work which contains
63 | a notice placed by the copyright holder saying it may be distributed
64 | under the terms of this General Public License. The "Program", below,
65 | refers to any such program or work, and a "work based on the Program"
66 | means either the Program or any derivative work under copyright law:
67 | that is to say, a work containing the Program or a portion of it,
68 | either verbatim or with modifications and/or translated into another
69 | language. (Hereinafter, translation is included without limitation in
70 | the term "modification".) Each licensee is addressed as "you".
71 |
72 | Activities other than copying, distribution and modification are not
73 | covered by this License; they are outside its scope. The act of
74 | running the Program is not restricted, and the output from the Program
75 | is covered only if its contents constitute a work based on the
76 | Program (independent of having been made by running the Program).
77 | Whether that is true depends on what the Program does.
78 |
79 | 1. You may copy and distribute verbatim copies of the Program's
80 | source code as you receive it, in any medium, provided that you
81 | conspicuously and appropriately publish on each copy an appropriate
82 | copyright notice and disclaimer of warranty; keep intact all the
83 | notices that refer to this License and to the absence of any warranty;
84 | and give any other recipients of the Program a copy of this License
85 | along with the Program.
86 |
87 | You may charge a fee for the physical act of transferring a copy, and
88 | you may at your option offer warranty protection in exchange for a fee.
89 |
90 | 2. You may modify your copy or copies of the Program or any portion
91 | of it, thus forming a work based on the Program, and copy and
92 | distribute such modifications or work under the terms of Section 1
93 | above, provided that you also meet all of these conditions:
94 |
95 | a) You must cause the modified files to carry prominent notices
96 | stating that you changed the files and the date of any change.
97 |
98 | b) You must cause any work that you distribute or publish, that in
99 | whole or in part contains or is derived from the Program or any
100 | part thereof, to be licensed as a whole at no charge to all third
101 | parties under the terms of this License.
102 |
103 | c) If the modified program normally reads commands interactively
104 | when run, you must cause it, when started running for such
105 | interactive use in the most ordinary way, to print or display an
106 | announcement including an appropriate copyright notice and a
107 | notice that there is no warranty (or else, saying that you provide
108 | a warranty) and that users may redistribute the program under
109 | these conditions, and telling the user how to view a copy of this
110 | License. (Exception: if the Program itself is interactive but
111 | does not normally print such an announcement, your work based on
112 | the Program is not required to print an announcement.)
113 |
114 | These requirements apply to the modified work as a whole. If
115 | identifiable sections of that work are not derived from the Program,
116 | and can be reasonably considered independent and separate works in
117 | themselves, then this License, and its terms, do not apply to those
118 | sections when you distribute them as separate works. But when you
119 | distribute the same sections as part of a whole which is a work based
120 | on the Program, the distribution of the whole must be on the terms of
121 | this License, whose permissions for other licensees extend to the
122 | entire whole, and thus to each and every part regardless of who wrote it.
123 |
124 | Thus, it is not the intent of this section to claim rights or contest
125 | your rights to work written entirely by you; rather, the intent is to
126 | exercise the right to control the distribution of derivative or
127 | collective works based on the Program.
128 |
129 | In addition, mere aggregation of another work not based on the Program
130 | with the Program (or with a work based on the Program) on a volume of
131 | a storage or distribution medium does not bring the other work under
132 | the scope of this License.
133 |
134 | 3. You may copy and distribute the Program (or a work based on it,
135 | under Section 2) in object code or executable form under the terms of
136 | Sections 1 and 2 above provided that you also do one of the following:
137 |
138 | a) Accompany it with the complete corresponding machine-readable
139 | source code, which must be distributed under the terms of Sections
140 | 1 and 2 above on a medium customarily used for software interchange; or,
141 |
142 | b) Accompany it with a written offer, valid for at least three
143 | years, to give any third party, for a charge no more than your
144 | cost of physically performing source distribution, a complete
145 | machine-readable copy of the corresponding source code, to be
146 | distributed under the terms of Sections 1 and 2 above on a medium
147 | customarily used for software interchange; or,
148 |
149 | c) Accompany it with the information you received as to the offer
150 | to distribute corresponding source code. (This alternative is
151 | allowed only for noncommercial distribution and only if you
152 | received the program in object code or executable form with such
153 | an offer, in accord with Subsection b above.)
154 |
155 | The source code for a work means the preferred form of the work for
156 | making modifications to it. For an executable work, complete source
157 | code means all the source code for all modules it contains, plus any
158 | associated interface definition files, plus the scripts used to
159 | control compilation and installation of the executable. However, as a
160 | special exception, the source code distributed need not include
161 | anything that is normally distributed (in either source or binary
162 | form) with the major components (compiler, kernel, and so on) of the
163 | operating system on which the executable runs, unless that component
164 | itself accompanies the executable.
165 |
166 | If distribution of executable or object code is made by offering
167 | access to copy from a designated place, then offering equivalent
168 | access to copy the source code from the same place counts as
169 | distribution of the source code, even though third parties are not
170 | compelled to copy the source along with the object code.
171 |
172 | 4. You may not copy, modify, sublicense, or distribute the Program
173 | except as expressly provided under this License. Any attempt
174 | otherwise to copy, modify, sublicense or distribute the Program is
175 | void, and will automatically terminate your rights under this License.
176 | However, parties who have received copies, or rights, from you under
177 | this License will not have their licenses terminated so long as such
178 | parties remain in full compliance.
179 |
180 | 5. You are not required to accept this License, since you have not
181 | signed it. However, nothing else grants you permission to modify or
182 | distribute the Program or its derivative works. These actions are
183 | prohibited by law if you do not accept this License. Therefore, by
184 | modifying or distributing the Program (or any work based on the
185 | Program), you indicate your acceptance of this License to do so, and
186 | all its terms and conditions for copying, distributing or modifying
187 | the Program or works based on it.
188 |
189 | 6. Each time you redistribute the Program (or any work based on the
190 | Program), the recipient automatically receives a license from the
191 | original licensor to copy, distribute or modify the Program subject to
192 | these terms and conditions. You may not impose any further
193 | restrictions on the recipients' exercise of the rights granted herein.
194 | You are not responsible for enforcing compliance by third parties to
195 | this License.
196 |
197 | 7. If, as a consequence of a court judgment or allegation of patent
198 | infringement or for any other reason (not limited to patent issues),
199 | conditions are imposed on you (whether by court order, agreement or
200 | otherwise) that contradict the conditions of this License, they do not
201 | excuse you from the conditions of this License. If you cannot
202 | distribute so as to satisfy simultaneously your obligations under this
203 | License and any other pertinent obligations, then as a consequence you
204 | may not distribute the Program at all. For example, if a patent
205 | license would not permit royalty-free redistribution of the Program by
206 | all those who receive copies directly or indirectly through you, then
207 | the only way you could satisfy both it and this License would be to
208 | refrain entirely from distribution of the Program.
209 |
210 | If any portion of this section is held invalid or unenforceable under
211 | any particular circumstance, the balance of the section is intended to
212 | apply and the section as a whole is intended to apply in other
213 | circumstances.
214 |
215 | It is not the purpose of this section to induce you to infringe any
216 | patents or other property right claims or to contest validity of any
217 | such claims; this section has the sole purpose of protecting the
218 | integrity of the free software distribution system, which is
219 | implemented by public license practices. Many people have made
220 | generous contributions to the wide range of software distributed
221 | through that system in reliance on consistent application of that
222 | system; it is up to the author/donor to decide if he or she is willing
223 | to distribute software through any other system and a licensee cannot
224 | impose that choice.
225 |
226 | This section is intended to make thoroughly clear what is believed to
227 | be a consequence of the rest of this License.
228 |
229 | 8. If the distribution and/or use of the Program is restricted in
230 | certain countries either by patents or by copyrighted interfaces, the
231 | original copyright holder who places the Program under this License
232 | may add an explicit geographical distribution limitation excluding
233 | those countries, so that distribution is permitted only in or among
234 | countries not thus excluded. In such case, this License incorporates
235 | the limitation as if written in the body of this License.
236 |
237 | 9. The Free Software Foundation may publish revised and/or new versions
238 | of the General Public License from time to time. Such new versions will
239 | be similar in spirit to the present version, but may differ in detail to
240 | address new problems or concerns.
241 |
242 | Each version is given a distinguishing version number. If the Program
243 | specifies a version number of this License which applies to it and "any
244 | later version", you have the option of following the terms and conditions
245 | either of that version or of any later version published by the Free
246 | Software Foundation. If the Program does not specify a version number of
247 | this License, you may choose any version ever published by the Free Software
248 | Foundation.
249 |
250 | 10. If you wish to incorporate parts of the Program into other free
251 | programs whose distribution conditions are different, write to the author
252 | to ask for permission. For software which is copyrighted by the Free
253 | Software Foundation, write to the Free Software Foundation; we sometimes
254 | make exceptions for this. Our decision will be guided by the two goals
255 | of preserving the free status of all derivatives of our free software and
256 | of promoting the sharing and reuse of software generally.
257 |
258 | NO WARRANTY
259 |
260 | 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
261 | FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
262 | OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
263 | PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
264 | OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
265 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
266 | TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
267 | PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
268 | REPAIR OR CORRECTION.
269 |
270 | 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
271 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
272 | REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
273 | INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
274 | OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
275 | TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
276 | YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
277 | PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
278 | POSSIBILITY OF SUCH DAMAGES.
279 |
280 | END OF TERMS AND CONDITIONS
281 |
282 | How to Apply These Terms to Your New Programs
283 |
284 | If you develop a new program, and you want it to be of the greatest
285 | possible use to the public, the best way to achieve this is to make it
286 | free software which everyone can redistribute and change under these terms.
287 |
288 | To do so, attach the following notices to the program. It is safest
289 | to attach them to the start of each source file to most effectively
290 | convey the exclusion of warranty; and each file should have at least
291 | the "copyright" line and a pointer to where the full notice is found.
292 |
293 | {description}
294 | Copyright (C) {year} {fullname}
295 |
296 | This program is free software; you can redistribute it and/or modify
297 | it under the terms of the GNU General Public License as published by
298 | the Free Software Foundation; either version 2 of the License, or
299 | (at your option) any later version.
300 |
301 | This program is distributed in the hope that it will be useful,
302 | but WITHOUT ANY WARRANTY; without even the implied warranty of
303 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
304 | GNU General Public License for more details.
305 |
306 | You should have received a copy of the GNU General Public License along
307 | with this program; if not, write to the Free Software Foundation, Inc.,
308 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
309 |
310 | Also add information on how to contact you by electronic and paper mail.
311 |
312 | If the program is interactive, make it output a short notice like this
313 | when it starts in an interactive mode:
314 |
315 | Gnomovision version 69, Copyright (C) year name of author
316 | Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
317 | This is free software, and you are welcome to redistribute it
318 | under certain conditions; type `show c' for details.
319 |
320 | The hypothetical commands `show w' and `show c' should show the appropriate
321 | parts of the General Public License. Of course, the commands you use may
322 | be called something other than `show w' and `show c'; they could even be
323 | mouse-clicks or menu items--whatever suits your program.
324 |
325 | You should also get your employer (if you work as a programmer) or your
326 | school, if any, to sign a "copyright disclaimer" for the program, if
327 | necessary. Here is a sample; alter the names:
328 |
329 | Yoyodyne, Inc., hereby disclaims all copyright interest in the program
330 | `Gnomovision' (which makes passes at compilers) written by James Hacker.
331 |
332 | {signature of Ty Coon}, 1 April 1989
333 | Ty Coon, President of Vice
334 |
335 | This General Public License does not permit incorporating your program into
336 | proprietary programs. If your program is a subroutine library, you may
337 | consider it more useful to permit linking proprietary applications with the
338 | library. If this is what you want to do, use the GNU Lesser General
339 | Public License instead of this License.
340 |
341 |
--------------------------------------------------------------------------------
/README.org:
--------------------------------------------------------------------------------
1 | * org-working-set
2 |
3 | Manage a working-set of org-nodes
4 |
5 | org-working-set is a package for org-mode within emacs.
6 |
7 | Read below for a description.
8 |
9 | The current version is 2.5.0.
10 |
11 | ** Table of Contents
12 |
13 | - [[#about-this-package][About this Package]]
14 | - [[#screenshot][Screenshot]]
15 | - [[#files][Files]]
16 | - [[#releasing-a-new-version][Releasing a new version]]
17 | - [[#latest-change-log][Latest Change Log]]
18 |
19 | ** About this Package
20 |
21 | *** Purpose
22 |
23 | Manage a small subset of org-nodes to visit them with ease.
24 |
25 | On a busy day org-working-set allows to jump quickly between the nodes
26 | associated with different tasks. It provides an answer to the question:
27 | What have I been doing before beeing interrupted in the middle of an
28 | interruption ?
29 |
30 | The working-set is a small set of nodes; you may add nodes (which
31 | means: their ids) to your working-set, if you want to visit them
32 | frequently; the node visited last is called the current node. The
33 | working-set is volatile and expected to change each day or even hour.
34 |
35 | Once you have added nodes to your working set, there are two ways to
36 | traverse them (both accessible through the central function
37 | `org-working-set'): circling through your working set is the quickest
38 | way to return to the current node or visit others; alternatively, the
39 | working-set menu produces a editable list of all working-set nodes,
40 | allowing visits too.
41 |
42 | Please note, that org-working-set adds an id-property to all nodes in
43 | the working-set; but it does not move or change the nodes in any other
44 | way.
45 |
46 | The list of ids from the nodes of your working-set is stored within the
47 | property-drawer of a distinguished node specified via
48 | `org-working-set-id'; this node will also collect an ever-growing
49 | journal of nodes added to the working-set, which may serve as a
50 | reference later.
51 |
52 | *** Similar Packages
53 |
54 | Depending on your needs you might find these packages interesting too
55 | as they provide similar functionality: org-now and org-mru-clock.
56 |
57 | *** User-Story
58 |
59 | Assume, you come into the office in the morning and start your Emacs
60 | with org-mode, because you keep all your notes in org. Yesterday
61 | evening you only worked within the org-node 'Feature Request';
62 | therefore your working-set only contains this node (which means: its
63 | id).
64 |
65 | So, you invoke the working-set menu (or even quicker, the circle) and
66 | jump to the node 'Feature Request' where you continue to work. Short
67 | after that, your Boss asks for an urgent status-report. You immediately
68 | stop work on 'Feature Request' and find your way to the neglected node
69 | 'Status Report', The working set cannot help you to find this node
70 | initially, but then you add it for quicker access from now on. Your
71 | working set now contains two nodes.
72 |
73 | Next you attend your scrum-meeting, which means you open the node
74 | 'Daily Scrum'. You add it to your working set, because you expect to
75 | make short excursions to other nodes and want to come back quickly.
76 | After the meeting you remove its node from your working set and
77 | continue to work on 'Status Report', which you find through your
78 | working-set quickly.
79 |
80 | When done with the report you have a look at your agenda, and realize
81 | that 'Organize Team-Event' is scheduled for today. So you decide to add
82 | it to your working-set (in case you get interrupted by a phone call)
83 | and start to work on this for an hour or so. The rest of the day passes
84 | like this with work, interruptions and task-switches.
85 |
86 | If this sounds like your typical work-day, you might indeed benefit
87 | from org-working-set.
88 |
89 | *** Setup
90 |
91 | - org-working-set can be installed with package.el
92 | - Invoke `org-working-set', it will explain and assist in setting the
93 | customizable variable `org-working-set-id'
94 | - Optional: Bind `org-working-set' to a key, e.g. C-c w
95 |
96 | ** Screenshot
97 |
98 | The screenshot shows a public sample-text about emacs/orgmode/gtd (upper window)
99 | and the working set menu with three nodes from this text (lower window).
100 |
101 | [[images/screenshot1.png]]
102 |
103 | ** Files
104 |
105 | *** Implementation
106 |
107 | - org-working-set.el :: The complete lisp source
108 |
109 | *** Building
110 |
111 | - Rakefile :: Helpful Ruby-Tasks for building
112 |
113 | *** Tests
114 |
115 | In subdir tests.
116 |
117 | - owst.el :: ert-tests for org-working-set
118 | - run-tests.ps1 :: Windows command file to start an emacs, which
119 | is specifically prepared for the tests
120 | - run-tests.el :: Customizations for the tests
121 |
122 | ** Releasing a new version
123 |
124 | *** Testing and checking
125 |
126 | - rake test
127 | - (byte-compile-file "org-working-set.el")
128 | - elint-current-buffer
129 | - checkdoc
130 | - package-lint-current-buffer ;; ignore messages about org-ws--prefix
131 |
132 | *** Preparing
133 |
134 | - Update Version number in org-working-set.el
135 | - Update Change Log in org-working-set.el
136 | - Check and update Commentary in org-working-set.el
137 | - Run rake to:
138 | - copy those pieces of information into README.org and
139 | ChangeLog.org
140 | - run tests
141 | - git add/commit as appropriate
142 | - v=x.y.z ; git tag -a -m $v $v ; git push ; git push --tags
143 |
144 | ** Latest Change Log
145 |
146 | See ChangeLog.org for older entries.
147 |
148 | *** 2.5
149 |
150 | - Allow inline tasks in working set
151 | - `kill' as a synonym for `delete'
152 |
153 | *** 2.4
154 |
155 | - todo-state can be changed from working set menu
156 | - working set is kept in least-recently-used order
157 | - Wrapping org-id-find and org-id-goto more often
158 |
159 | *** 2.3
160 |
161 | - Renamed 'log of working-set nodes' into 'journal'
162 | - Create org-working-set-dispatch-keymap for easier customization
163 | - Reorganized keys (but you may change it if you like)
164 | - In-prompt display of settings for clock-in and land-at
165 | - Added a 'Fictional User-Story' to the documentation
166 | - Running tests under unix
167 |
168 | *** 2.2
169 |
170 | - Moved org-id-cleanup to its own package
171 | - Improved handling of missing ids in working set
172 | - Refactoring
173 | - Fixes
174 |
175 | *** 2.1
176 |
177 | - Added org-id-cleanup to clean up unreferenced IDs without attachments
178 |
179 | *** 2.0
180 |
181 | - Added a log of working set nodes
182 | - The node designated by org-working-set-id will be used to store this log
183 | - Simplified handling of clocking
184 | - Retired property working-set-nodes-do-not-clock
185 | - Renamed custom-variable org-working-set-clock-into-working-set into
186 | org-working-set-clock-in
187 | - Renamed org-working-set-show-working-set-overlay into
188 | org-working-set-show-overlay
189 | - Renamed org-working-set-goto-bottom-in-working-set into
190 | org-working-set-goto-bottom
191 |
192 | *** 1.1
193 |
194 | - Moved functions for working set into its own file
195 | - Show breadcrumbs in working-set-menu
196 | - Prepare for melpa
197 |
198 |
--------------------------------------------------------------------------------
/Rakefile:
--------------------------------------------------------------------------------
1 | #!/usr/bin/ruby
2 |
3 | #
4 | # Common Rakefile for multiple elisp-projects; updates itself (if dir exists) from
5 | #
6 | # ../rakefile-for-elisp/Rakefile
7 | #
8 | # and vice versa.
9 | #
10 | # Configure via rake_config.yml
11 | #
12 |
13 | require 'fileutils'
14 | include FileUtils
15 | require 'yaml'
16 | require 'set'
17 | require 'open3'
18 |
19 | #
20 | # Global variables
21 | #
22 | # Configuration and options
23 | $conf = YAML::load(File.open('rake_config.yml'))
24 | $conf.transform_keys!(&:to_sym)
25 | $conf[:file] = 'rake_config.yml'
26 | $v = (verbose == true)
27 |
28 | # Shared information between tasks
29 | # from lisp-source
30 | $version_lisp = nil
31 | $commentary_lisp = Hash.new
32 | $changelog_lisp = Hash.new
33 | # from changelog
34 | $changelog = Hash.new
35 | $changelog_until = Hash.new
36 |
37 | #
38 | # Helper functions
39 | #
40 | def heading text, large = false, warn = false
41 | if large
42 | puts "\n"
43 | print "\e[32m"
44 | dash = "==="
45 | puts dash * 12
46 | puts "#{dash} #{text}"
47 | puts dash * 12
48 | else
49 | print "\e[#{warn ? 35 : 33}m"
50 | puts "--- #{text}"
51 | end
52 | print "\e[0m"
53 | end
54 |
55 |
56 | def compare_semver one,two
57 | vs = [one, two].map do |x|
58 | x.match(/(\d+)\.(\d+)/) || abort("Argument '#{x}' does not contain a semantic version number")
59 | end
60 | ( 2*(vs[0][1].to_i<=>vs[1][1].to_i) + (vs[0][2].to_i<=>vs[1][2].to_i) ) <=> 0
61 | end
62 |
63 |
64 | def accept fname,nname
65 | heading "Accept changes to #{fname} ?"
66 | system "diff #{fname} #{nname}"
67 | if $? == 0
68 | puts "No differences between #{fname} and #{nname}."
69 | rm nname
70 | else
71 | puts "\n\n"
72 | system "ls -l #{fname} #{nname}"
73 | heading "Changes to #{fname}.\nPlease review 'diff old new' and output of 'ls'\nType RETURN to accept or Ctrl-c Ctrl-c to reject:"
74 | $stdin.gets
75 | make_backup fname
76 | mv nname,fname
77 | end
78 | end
79 |
80 |
81 | def make_backup file
82 | dir = File.dirname(file) + '/backup'
83 | mkdir dir,{:verbose => $v} unless File.directory?(dir)
84 | backs = [ file ] + (1..12).map {|i| dir + '/' + File.basename(file) + "_" + i.to_s}
85 | pairs = backs[0..-2].zip(backs[1..-1]).reverse
86 | pairs.each do |p|
87 | next unless File.exist?(p[0])
88 | cp p[0],p[1],{:verbose => $v}
89 | end
90 | end
91 |
92 |
93 | def maybe_copy from,to
94 | puts "Maybe copy #{from} to #{to}" if $v
95 | [from, to].each {|f| return false unless File.exist?(f)}
96 | return false if File.mtime(to) > File.mtime(from)
97 | system("diff -q #{from} #{to} >/dev/null 2>&1")
98 | return false if $?.exitstatus == 0
99 | make_backup to
100 | cp from,to,{:verbose => $v}
101 | return true
102 | end
103 |
104 |
105 | def brushup text
106 | text.sub!(/\A[\s\n]+/,'')
107 | text.sub!(/[\s\n]+\Z/,'')
108 | text.chomp!
109 | end
110 |
111 |
112 | def write_as_org file, level, hash, &compare
113 | keys = hash.keys
114 | keys = keys.sort(&compare) if compare
115 | keys.each do |key|
116 | file.puts '*' * level + " #{key}\n\n"
117 | hash[key].lines.each {|l| file.puts (' ' * (level+1) + l).rstrip}
118 | file.puts "\n"
119 | end
120 | pp hash if $v
121 | end
122 |
123 |
124 | def forward_to file, text
125 | line = nil
126 | begin
127 | line = file.gets
128 | end until !line || line.start_with?(text)
129 | line
130 | end
131 |
132 | #
133 | # Individual tasks
134 | #
135 | #
136 | # Tasks, that collect information, no desc to avoid them beeing listed with -T
137 | #
138 |
139 | # Compare with rakefile in other dir and update
140 | task :update_rake do
141 | this_rf = __FILE__
142 | parent_rf = File.expand_path('..', File.dirname(this_rf)) + '/rakefile-for-elisp/Rakefile'
143 | system("touch -t 190001010000 #{parent_rf} >/dev/null 2>&1") unless File.exist?(parent_rf)
144 |
145 | if maybe_copy this_rf, parent_rf
146 | heading "Updated #{parent_rf} from #{this_rf}"
147 | elsif maybe_copy parent_rf, this_rf
148 | heading "This rakefile #{this_rf} has been updated from #{parent_rf}; please rerun"
149 | exit
150 | end
151 | end
152 |
153 |
154 |
155 | # Extract version from sourcefile
156 | task :extract_version => [:update_rake] do
157 |
158 | heading "Extract version from #{$conf[:source]}"
159 |
160 | File.open($conf[:source]).each do |line|
161 | if line.match(/^;; Version: (\d+\.\d+\.\d+)\s*/)
162 | $version_lisp = Regexp.last_match[1]
163 | puts $version_lisp
164 | break
165 | end
166 | end
167 | end
168 |
169 |
170 | # Extract commentary from sourcefile
171 | task :extract_commentary => [:update_rake] do
172 |
173 | heading "Extract commentary from #{$conf[:source]}"
174 |
175 | commentary_keys_matcher = Regexp.new('^;; (' + $conf[:required_pieces_commentary].join('|') + '):\s*$')
176 | key = nil
177 |
178 | File.open($conf[:source]).
179 | drop_while { |line| !line.start_with?(';;; Commentary:') }.
180 | drop(2).take_while { |line| line.start_with?(';;') }.each do |line|
181 | if line.match(commentary_keys_matcher)
182 | key = Regexp.last_match[1]
183 | $commentary_lisp[key] = ''
184 | puts key
185 | else
186 | $commentary_lisp[key] += line.sub(/^;;( )?/,'').rstrip + "\n" if key
187 | end
188 | end
189 |
190 | $commentary_lisp.each_key do |key|
191 | brushup $commentary_lisp[key]
192 | end
193 | pp $commentary_lisp if $v
194 |
195 | pieces_seen = Set.new($commentary_lisp.keys)
196 | pieces_required = Set.new($conf[:required_pieces_commentary])
197 | abort "ERROR: Pieces of commentary seen #{pieces_seen} does not equal pieces of commentary required #{pieces_required}" unless pieces_seen == pieces_required
198 | end
199 |
200 |
201 | # Extract change log from sourcefile
202 | task :extract_changelog_lisp => [:extract_version] do
203 |
204 | heading "Extract Changelog from #{$conf[:source]}"
205 | version = offset = nil
206 |
207 | File.open($conf[:source]).each.
208 | drop_while { |line| !line.start_with?(';;; Change Log:') }.
209 | drop(2).
210 | take_while { |line| line.start_with?(';;') }.each do |line|
211 | if line.match(/^(;;\s+)Version (\d+\.\d+)\s*/)
212 | version = Regexp.last_match[2]
213 | $changelog_lisp[version] = ''
214 | offset = Regexp.last_match[1]
215 | puts version
216 | elsif version
217 | $changelog_lisp[version] += (line[offset.length..-1] || '').rstrip + "\n"
218 | end
219 | end
220 |
221 | $changelog_lisp.each_key do |version|
222 | brushup $changelog_lisp[version]
223 | end
224 |
225 | pp $changelog_lisp if $v
226 |
227 | version_lisp_latest = $changelog_lisp.keys.max {|a,b| compare_semver(a,b)}
228 | abort "Mismatch in #{$conf[:source]}: Latest version from Changelog '#{version_lisp_latest}' does not match version specified in header '#{$version_lisp}'" unless $version_lisp.sub(/\.\d+$/,'') == version_lisp_latest
229 |
230 | end
231 |
232 |
233 | # Extract change log from changelog
234 | task :extract_changelog => [:extract_changelog_lisp] do
235 |
236 | fname = 'ChangeLog.org'
237 | heading "Extract Changelog from #{fname}"
238 |
239 | version = nil
240 |
241 | File.open(fname).each do |line|
242 | if mdata = line.match(/^\* (\d+\.\d+) until (\S.*\S)/)
243 | version = mdata[1]
244 | $changelog[version] = ''
245 | $changelog_until[version] = mdata[2]
246 | puts version
247 | else
248 | $changelog[version] += (line[2..-1] || '').rstrip + "\n" if version
249 | end
250 | end
251 |
252 | now = Time.now.strftime("%Y-%m-%d %a")[0..-2]
253 | $changelog_lisp.each_key do |version|
254 | $changelog[version] = $changelog_lisp[version]
255 | $changelog_until[version] ||= now
256 | end
257 | version_latest = $changelog.keys.max {|a,b| compare_semver(a,b)}
258 | $changelog_until[version_latest] = now
259 |
260 | $changelog.each_key do |version|
261 | brushup $changelog[version]
262 | end
263 | pp $changelog if $v
264 |
265 | end
266 |
267 |
268 | #
269 | # Tasks, that update files with collected information
270 | #
271 | desc 'Update Changelog with information from sourcefile'
272 | task :update_changelog => [:extract_changelog, :extract_version] do
273 |
274 | fname = 'ChangeLog.org'
275 | heading "Update #{fname}",true
276 | nname = fname + '.new'
277 |
278 | File.open(nname,'w') do |nfile|
279 | $changelog.keys.sort {|a,b| compare_semver(b,a)}.each do |version|
280 | nfile.puts "* #{version} until #{$changelog_until[version]}\n\n"
281 | $changelog[version].lines.each {|l| nfile.puts " #{l}".rstrip}
282 | nfile.puts "\n"
283 | end
284 | end
285 | accept fname,nname
286 |
287 | end
288 |
289 |
290 | desc 'Update Readme with information from sourcefile'
291 | task :update_readme => [:extract_changelog, :extract_version, :extract_commentary] do
292 |
293 | fname = 'README.org'
294 | heading "Update #{fname}",true
295 | nname = fname + ".new"
296 |
297 | toc = File.read(fname).lines.select {|l| l.start_with?('** ')}.map {|l| l[3..-1].chomp}
298 | unseen = Set.new([:version, :toc, :about, :changelog])
299 | tcvi = ' The current version is '
300 |
301 | File.open(nname,'w') do |nfile|
302 | File.open(fname) do |file|
303 |
304 | loop do
305 | line ||= file.gets
306 | break unless line
307 |
308 | # content of line will in any case written at bottom of loop, until then:
309 | # Write something else, replace content of line or leave as is
310 |
311 | if line.start_with?(tcvi)
312 | heading 'Version'
313 | line = tcvi + $version_lisp + '.'
314 | unseen.delete(:version)
315 | end
316 |
317 | if line.start_with?('** Table of Contents')
318 | heading 'Table of contents'
319 | nfile.puts line + "\n"
320 | toc.drop(1).each {|t| nfile.puts " - [[##{t.downcase.tr(' ','-')}][#{t}]]"}
321 | nfile.puts "\n"
322 | line = forward_to(file,'** ')
323 | unseen.delete(:toc)
324 | end
325 |
326 | if line.start_with?('** About this Package')
327 | heading 'Commentary'
328 | nfile.puts line + "\n"
329 | write_as_org nfile,3,$commentary_lisp
330 | line = forward_to(file,'** ')
331 | unseen.delete(:about)
332 | end
333 |
334 | if line.start_with?('** Latest Change Log')
335 | heading 'Latest Change log'
336 | nfile.puts line + "\n See ChangeLog.org for older entries.\n\n"
337 | write_as_org nfile,3,$changelog_lisp
338 | line = forward_to(file,'* ')
339 | unseen.delete(:changelog)
340 | end
341 |
342 | # now write whatever current content of line is
343 | nfile.puts line if line
344 | end
345 |
346 | end
347 | end
348 | abort "Did not see #{unseen.inspect} in #{fname}" if unseen.length > 0
349 |
350 | accept fname,nname
351 |
352 | end
353 |
354 |
355 | desc 'Update sourcefile with information from sourcefile'
356 | task :update_lisp => [:extract_changelog, :extract_version, :extract_commentary] do
357 |
358 | fname = $conf[:source]
359 | heading "Update #{fname}",true
360 | nname = fname + ".new"
361 |
362 | unseen = Set.new([:version, :commentary])
363 | tiv = 'This is version'
364 |
365 | File.open(nname,'w') do |nfile|
366 | File.open(fname) do |file|
367 |
368 | loop do
369 | line ||= file.gets
370 | break unless line
371 |
372 | # content of line will in any case written at bottom of loop, until then:
373 | # Write something else, replace content of line or leave as is
374 |
375 | if line.start_with?("(defvar #{$conf[:package]}-version")
376 | heading 'Version'
377 | line.sub!(/\d+\.\d+\.\d+/,$version_lisp)
378 | unseen.delete(:version)
379 | end
380 |
381 | if line['For Rake: Insert here']
382 | heading 'Commentary'
383 | nfile.write line
384 | first = true
385 | $conf[:pieces_for_docstring].each do |piece|
386 | abort "ERROR: Configuration item 'pieces_for_docstring' from $conf[:file] has unkonwn docstring-piece #{piece}" unless $commentary_lisp[piece]
387 | nfile.print first ? " \"" : "\n\n#{piece}:\n\n"
388 | nfile.print $commentary_lisp[piece]
389 | first = false
390 | end
391 | forward_to(file,tiv)
392 | line = "\n\n#{tiv} #{$version_lisp} of #{$conf[:source]}.\n"
393 | unseen.delete(:commentary)
394 | end
395 |
396 | # now write whatever current content of line is
397 | nfile.puts line if line
398 | end
399 |
400 | end
401 | end
402 | abort "Did not see #{unseen.inspect} in #{fname}" if unseen.length > 0
403 |
404 | accept fname,nname
405 |
406 | end
407 |
408 |
409 | desc 'Describe building process'
410 | task :h => [:extract_version] do
411 | within = false
412 | doc = File.open(%x{git rev-parse --show-toplevel}.chomp + '/README.org').each do |line|
413 | within = line.include?('Preparing') if line.start_with?('*')
414 | print line if within
415 | end
416 | puts "Version from lisp: #{$version_lisp}"
417 | puts "Latest tag from git: " + %x(git describe).chomp
418 | end
419 |
420 |
421 | desc 'Run all tests from directory test'
422 | task :test => [:update_rake] do
423 |
424 | heading "Run tests",true
425 | command = <<-END.lines.map {|l| l.strip!}.join(' ')
426 | emacs
427 | --no-init-file
428 | --no-site-file
429 | --no-site-lisp
430 | --eval "(set-variable 'make-backup-files nil)"
431 | --eval "(set-variable 'auto-save-default nil)"
432 | --eval "(set-variable 'create-lockfiles nil)"
433 | --eval "(menu-bar-mode -1)"
434 | --eval "(setq load-prefer-newer t)"
435 | --eval "(add-to-list 'load-path \\\".\\\")"
436 | --eval "(setq package-user-dir \\\"#{File.dirname(__FILE__)+"/elpa"}\\\")"
437 | --eval "(setq base-dir \\\"#{File.dirname(__FILE__)}\\\")"
438 | --eval "(package-initialize)"
439 | --load ert
440 | --load #{File.dirname(__FILE__)+"/test/"+$conf[:testfile]}
441 | test/#{$conf[:testfile]}
442 | #{$conf[:source]}
443 | --eval "(ert-run-tests-batch-and-exit)"
444 | --batch
445 | END
446 |
447 | puts command
448 | at_summary = false
449 | Open3.popen2e(command) do |stdin, stdout_stderr, status_thread|
450 | stdout_stderr.each_line do |line|
451 | at_summary = true if line.match?(/^Ran \d+ /)
452 | if at_summary
453 | puts line
454 | elsif line.lstrip.start_with?('passed')
455 | heading line
456 | elsif line.lstrip.start_with?('FAILED')
457 | heading line,false,true
458 | elsif $v
459 | puts line
460 | end
461 | end
462 | abort "ERROR: Command ended with error.\nRerun with '-v' for details." unless status_thread.value.success?
463 | end
464 |
465 | end
466 |
467 |
468 | desc 'Update all files'
469 | task :update => [:update_changelog, :update_readme, :update_lisp, :test] do
470 | end
471 |
472 |
473 | desc 'Update all files and run tests'
474 | task :default => [:update, :test] do
475 | end
476 |
--------------------------------------------------------------------------------
/images/screenshot1.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/marcIhm/org-working-set/c83a63f34829dca137941bc06e29c34bf056a43b/images/screenshot1.png
--------------------------------------------------------------------------------
/org-working-set.el:
--------------------------------------------------------------------------------
1 | ;;; org-working-set.el --- Manage and visit a small and changing set of org-nodes that you work on -*- lexical-binding: t; -*-
2 |
3 | ;; Copyright (C) 2019-2022 Free Software Foundation, Inc.
4 |
5 | ;; Author: Marc Ihm
6 | ;; URL: https://github.com/marcIhm/org-working-set
7 | ;; Version: 2.6.5
8 | ;; Package-Requires: ((org "9.3") (dash "2.12") (s "1.12") (emacs "26.3"))
9 |
10 | ;; This file is not part of GNU Emacs.
11 |
12 | ;;; License:
13 |
14 | ;; This program is free software; you can redistribute it and/or modify
15 | ;; it under the terms of the GNU General Public License as published by
16 | ;; the Free Software Foundation; either version 3, or (at your option)
17 | ;; any later version.
18 | ;;
19 | ;; This program is distributed in the hope that it will be useful,
20 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 | ;; GNU General Public License for more details.
23 | ;;
24 | ;; You should have received a copy of the GNU General Public License
25 | ;; along with GNU Emacs. If not, see .
26 | ;;
27 |
28 | ;;; Commentary:
29 |
30 | ;; Purpose:
31 | ;;
32 | ;; Manage a small subset of org-nodes to visit them with ease.
33 | ;;
34 | ;; On a busy day org-working-set allows to jump quickly between the nodes
35 | ;; associated with different tasks. It provides an answer to the question:
36 | ;; What have I been doing before beeing interrupted in the middle of an
37 | ;; interruption ?
38 | ;;
39 | ;; The working-set is a small set of nodes; you may add nodes (which
40 | ;; means: their ids) to your working-set, if you want to visit them
41 | ;; frequently; the node visited last is called the current node. The
42 | ;; working-set is volatile and expected to change each day or even hour.
43 | ;;
44 | ;; Once you have added nodes to your working set, there are two ways to
45 | ;; traverse them (both accessible through the central function
46 | ;; `org-working-set'): circling through your working set is the quickest
47 | ;; way to return to the current node or visit others; alternatively, the
48 | ;; working-set menu produces a editable list of all working-set nodes,
49 | ;; allowing visits too.
50 | ;;
51 | ;; Please note, that org-working-set adds an id-property to all nodes in
52 | ;; the working-set; but it does not move or change the nodes in any other
53 | ;; way.
54 | ;;
55 | ;; The list of ids from the nodes of your working-set is stored within the
56 | ;; property-drawer of a distinguished node specified via
57 | ;; `org-working-set-id'; this node will also collect an ever-growing
58 | ;; journal of nodes added to the working-set, which may serve as a
59 | ;; reference later.
60 | ;;
61 | ;;
62 | ;; Similar Packages:
63 | ;;
64 | ;; Depending on your needs you might find these packages interesting too
65 | ;; as they provide similar functionality: org-now and org-mru-clock.
66 | ;;
67 | ;;
68 | ;; User-Story:
69 | ;;
70 | ;; Assume, you come into the office in the morning and start your Emacs
71 | ;; with org-mode, because you keep all your notes in org. Yesterday
72 | ;; evening you only worked within the org-node 'Feature Request';
73 | ;; therefore your working-set only contains this node (which means: its
74 | ;; id).
75 | ;;
76 | ;; So, you invoke the working-set menu (or even quicker, the circle) and
77 | ;; jump to the node 'Feature Request' where you continue to work. Short
78 | ;; after that, your Boss asks for an urgent status-report. You immediately
79 | ;; stop work on 'Feature Request' and find your way to the neglected node
80 | ;; 'Status Report', The working set cannot help you to find this node
81 | ;; initially, but then you add it for quicker access from now on. Your
82 | ;; working set now contains two nodes.
83 | ;;
84 | ;; Next you attend your scrum-meeting, which means you open the node
85 | ;; 'Daily Scrum'. You add it to your working set, because you expect to
86 | ;; make short excursions to other nodes and want to come back quickly.
87 | ;; After the meeting you remove its node from your working set and
88 | ;; continue to work on 'Status Report', which you find through your
89 | ;; working-set quickly.
90 | ;;
91 | ;; When done with the report you have a look at your agenda, and realize
92 | ;; that 'Organize Team-Event' is scheduled for today. So you decide to add
93 | ;; it to your working-set (in case you get interrupted by a phone call)
94 | ;; and start to work on this for an hour or so. The rest of the day passes
95 | ;; like this with work, interruptions and task-switches.
96 | ;;
97 | ;; If this sounds like your typical work-day, you might indeed benefit
98 | ;; from org-working-set.
99 | ;;
100 | ;;
101 | ;; Setup:
102 | ;;
103 | ;; - org-working-set can be installed with package.el
104 | ;; - Invoke `org-working-set', it will explain and assist in setting the
105 | ;; customizable variable `org-working-set-id'
106 | ;; - Optional: Bind `org-working-set' to a key, e.g. C-c w
107 | ;;
108 |
109 | ;;; Change Log:
110 |
111 | ;; Version 2.6
112 | ;;
113 | ;; - Allow to add missing files to org-id-files, if an id cannot be found
114 | ;; - In circle add commands to terminate on-head / at-end
115 | ;; - In Menu allow to go to node without starring it
116 | ;;
117 | ;; Version 2.5
118 | ;;
119 | ;; - Allow inline tasks in working set
120 | ;; - `kill' as a synonym for `delete'
121 | ;; - Use org-mark-ring
122 | ;;
123 | ;; Version 2.4
124 | ;;
125 | ;; - todo-state can be changed from working set menu
126 | ;; - working set is kept in least-recently-used order
127 | ;; - Wrapping org-id-find and org-id-goto more often
128 | ;;
129 | ;; Version 2.3
130 | ;;
131 | ;; - Renamed 'log of working-set nodes' into 'journal'
132 | ;; - Create org-working-set-dispatch-keymap for easier customization
133 | ;; - Reorganized keys (but you may change it if you like)
134 | ;; - In-prompt display of settings for clock-in and land-at
135 | ;; - Added a 'Fictional User-Story' to the documentation
136 | ;; - Running tests under unix
137 | ;;
138 | ;; Version 2.2
139 | ;;
140 | ;; - Moved org-id-cleanup to its own package
141 | ;; - Improved handling of missing ids in working set
142 | ;; - Refactoring
143 | ;; - Fixes
144 | ;;
145 | ;; Version 2.1
146 | ;;
147 | ;; - Added org-id-cleanup to clean up unreferenced IDs without attachments
148 | ;;
149 | ;; Version 2.0
150 | ;;
151 | ;; - Added a log of working set nodes
152 | ;; - The node designated by org-working-set-id will be used to store this log
153 | ;; - Simplified handling of clocking
154 | ;; - Retired property working-set-nodes-do-not-clock
155 | ;; - Renamed custom-variable org-working-set-clock-into-working-set into
156 | ;; org-working-set-clock-in
157 | ;; - Renamed org-working-set-show-working-set-overlay into
158 | ;; org-working-set-show-overlay
159 | ;; - Renamed org-working-set-goto-bottom-in-working-set into
160 | ;; org-working-set-goto-bottom
161 | ;;
162 | ;; Version 1.1
163 | ;;
164 | ;; - Moved functions for working set into its own file
165 | ;; - Show breadcrumbs in working-set-menu
166 | ;; - Prepare for melpa
167 | ;;
168 |
169 | ;;; Code:
170 |
171 | (require 'org)
172 | (require 'org-inlinetask)
173 | (require 'dash)
174 | (require 's)
175 |
176 |
177 | ;;; customizable options
178 |
179 | (defgroup org-working-set nil
180 | "Options concerning the working-set of org-nodes; see `org-working-set' for details."
181 | :tag "Org Working-set"
182 | :group 'org)
183 |
184 | (defcustom org-working-set-id nil
185 | "Id of the org-node for the working-set; should be empty initially. The property drawer will be used to store the ids of the working-set nodes, the body will be populated with an ever-growing list of nodes, that have been added."
186 | :group 'org-working-set
187 | :type 'string)
188 |
189 | (defcustom org-working-set-clock-in nil
190 | "Clock into nodes of working-set ?"
191 | :group 'org-working-set
192 | :type 'boolean)
193 |
194 | (defcustom org-working-set-land-at-end nil
195 | "When visiting a node, land at end ?"
196 | :group 'org-working-set
197 | :type 'boolean)
198 |
199 |
200 | ;;; Variables
201 |
202 | (defvar org-working-set--ids nil "Ids of working-set nodes (if any).")
203 | (defvar org-working-set--ids-saved nil "Backup for ‘org-working-set--ids’.")
204 | (defvar org-working-set--id-last-goto nil "Id of last node from working-set, that has been visited.")
205 | (defvar org-working-set--circle-before-marker nil "Marker for position before entry into circle.")
206 | (defvar org-working-set--circle-win-config nil "Window configuration before entry into circle.")
207 | (defvar org-working-set--circle-cancel-transient-function nil "Function to end circle.")
208 | (defvar org-working-set--cancel-timer nil "Timer to cancel waiting for key.")
209 | (defvar org-working-set--overlay nil "Overlay to display name of current working-set node.")
210 | (defvar org-working-set--short-help-wanted nil "Non-nil, if short help should be displayed in working-set menu.")
211 | (defvar org-working-set--id-not-found nil "Id of last node not found.")
212 | (defvar org-working-set--disp-on-error nil "Buffer to display on error.")
213 | (defvar org-working-set--clock-in-curr nil "Current and effecive value of `org-working-set-clock-in'.")
214 | (defvar org-working-set--land-at-end-curr nil "Current and effecive value of `org-working-set-land-at-end'.")
215 |
216 | (defun org-working-set--define-keymap (keymap keylist)
217 | "Define Keys given by KEYLIST in KEYMAP."
218 | (dolist (keyentry keylist)
219 | (dolist (key (car keyentry))
220 | (define-key keymap (kbd key) (cdr keyentry))))
221 | keymap)
222 |
223 | (defvar org-working-set-dispatch-keymap
224 | (let ((keymap (make-sparse-keymap)))
225 | (org-working-set--define-keymap
226 | keymap
227 | '((("s") . org-working-set--set)
228 | (("a") . org-working-set--add)
229 | (("A") . org-working-set--add-without-remove)
230 | (("d") . org-working-set--delete-from)
231 | (("k") . org-working-set--delete-from)
232 | (("SPC") . org-working-set--menu)
233 | (("TAB" "") . org-working-set--circle-start)
234 | (("?") . org-working-set--dispatch-toggle-help)
235 | (("j") . org-working-set--journal-enter)
236 | (("c") . org-working-set--dispatch-toggle-clock-in)
237 | (("l") . org-working-set--dispatch-toggle-land-at-end)
238 | (("u") . org-working-set--nodes-restore)
239 | (("C-g" "q") . keyboard-quit))))
240 | "Keymap used for initial dispatch after calling `org-working-set'.")
241 |
242 | (defvar org-working-set-circle-keymap
243 | (let ((keymap (make-sparse-keymap)))
244 | (set-keymap-parent keymap org-mode-map)
245 | (org-working-set--define-keymap
246 | keymap
247 | '((("TAB" "") . org-working-set--circle-forward)
248 | (("c") . org-working-set--circle-toggle-clock-in)
249 | (("l") . org-working-set--circle-toggle-land-at-end)
250 | (("RET" "q") . org-working-set--circle-done)
251 | (("SPC") . org-working-set--circle-switch-to-menu)
252 | (("DEL") . org-working-set--circle-backward)
253 | (("h") . org-working-set--circle-done-at-heading)
254 | (("e") . org-working-set--circle-done-at-end)
255 | (("?") . org-working-set--circle-toggle-help)
256 | (("d") . org-working-set--circle-delete-current)
257 | (("k") . org-working-set--circle-delete-current)
258 | (("C-g" "q") . org-working-set--circle-quit))))
259 | "Keymap used in working set circle.")
260 |
261 | (defvar org-working-set-menu-keymap
262 | (let ((keymap (make-sparse-keymap)))
263 | (set-keymap-parent keymap org-mode-map)
264 | (org-working-set--define-keymap
265 | keymap
266 | '((("RET") . org-working-set-menu-go--this-win)
267 | (("SPC") . org-working-set-menu-go--this-win-dont-set)
268 | (("TAB" "") . org-working-set-menu-go--other-win)
269 | (("p") . org-working-set--menu-peek)
270 | (("d") . org-working-set--menu-delete-entry)
271 | (("k") . org-working-set--menu-delete-entry)
272 | (("t") . org-working-set--menu-todo)
273 | (("u") . org-working-set--menu-undo)
274 | (("q") . org-working-set--menu-quit)
275 | (("c") . org-working-set--menu-toggle-clock-in)
276 | (("l") . org-working-set--menu-toggle-land-at-end)
277 | (("?") . org-working-set--menu-toggle-help)
278 | (("r") . org-working-set--menu-rebuild))))
279 | "Keymap used in working set menu.")
280 |
281 | (defvar org-working-set--dispatch-help-strings nil "Short and long help for initial dispatch in `org-working-set'; will be initialized from keymap on first call.")
282 |
283 | (defvar org-working-set--circle-help-strings nil "Short and long help for working set circle; will be initialized from keymap on first call.")
284 |
285 | (defvar org-working-set--menu-help-strings nil "Short and long help to be presented in working set menu; will be initialized from keymap on first call.")
286 |
287 | (defconst org-working-set--menu-buffer-name "*working-set of org-nodes*" "Name of buffer with list of working-set nodes.")
288 |
289 | ;; Version of this package
290 | (defvar org-working-set-version "2.5.0" "Version of `org-ẃorking-set', format is major.minor.bugfix, where \"major\" are incompatible changes and \"minor\" are new features.")
291 |
292 |
293 | ;;; The central dispatch function
294 |
295 | (defun org-working-set ()
296 | ;; Do NOT edit the part of this help-text before version number. It will
297 | ;; be overwritten with Commentary-section from beginning of this file.
298 | ;; Editing after version number is fine.
299 | ;;
300 | ;; For Rake: Insert here
301 | "Manage a small subset of org-nodes to visit them with ease.
302 |
303 | On a busy day org-working-set allows to jump quickly between the nodes
304 | associated with different tasks. It provides an answer to the question:
305 | What have I been doing before beeing interrupted in the middle of an
306 | interruption ?
307 |
308 | The working-set is a small set of nodes; you may add nodes (which
309 | means: their ids) to your working-set, if you want to visit them
310 | frequently; the node visited last is called the current node. The
311 | working-set is volatile and expected to change each day or even hour.
312 |
313 | Once you have added nodes to your working set, there are two ways to
314 | traverse them (both accessible through the central function
315 | `org-working-set'): circling through your working set is the quickest
316 | way to return to the current node or visit others; alternatively, the
317 | working-set menu produces a editable list of all working-set nodes,
318 | allowing visits too.
319 |
320 | Please note, that org-working-set adds an id-property to all nodes in
321 | the working-set; but it does not move or change the nodes in any other
322 | way.
323 |
324 | The list of ids from the nodes of your working-set is stored within the
325 | property-drawer of a distinguished node specified via
326 | `org-working-set-id'; this node will also collect an ever-growing
327 | journal of nodes added to the working-set, which may serve as a
328 | reference later.
329 |
330 | Similar Packages:
331 |
332 | Depending on your needs you might find these packages interesting too
333 | as they provide similar functionality: org-now and org-mru-clock.
334 |
335 | User-Story:
336 |
337 | Assume, you come into the office in the morning and start your Emacs
338 | with org-mode, because you keep all your notes in org. Yesterday
339 | evening you only worked within the org-node 'Feature Request';
340 | therefore your working-set only contains this node (which means: its
341 | id).
342 |
343 | So, you invoke the working-set menu (or even quicker, the circle) and
344 | jump to the node 'Feature Request' where you continue to work. Short
345 | after that, your Boss asks for an urgent status-report. You immediately
346 | stop work on 'Feature Request' and find your way to the neglected node
347 | 'Status Report', The working set cannot help you to find this node
348 | initially, but then you add it for quicker access from now on. Your
349 | working set now contains two nodes.
350 |
351 | Next you attend your scrum-meeting, which means you open the node
352 | 'Daily Scrum'. You add it to your working set, because you expect to
353 | make short excursions to other nodes and want to come back quickly.
354 | After the meeting you remove its node from your working set and
355 | continue to work on 'Status Report', which you find through your
356 | working-set quickly.
357 |
358 | When done with the report you have a look at your agenda, and realize
359 | that 'Organize Team-Event' is scheduled for today. So you decide to add
360 | it to your working-set (in case you get interrupted by a phone call)
361 | and start to work on this for an hour or so. The rest of the day passes
362 | like this with work, interruptions and task-switches.
363 |
364 | If this sounds like your typical work-day, you might indeed benefit
365 | from org-working-set.
366 |
367 | This is version 2.5.0 of org-working-set.el.
368 |
369 | `org-working-set' is the single entry-point; its subcommands allow to:
370 |
371 | - Modify the list of nodes (e.g. add nodes or remove others)
372 | - Circle quickly through the nodes
373 | - Show a menu buffer with all nodes currently in the working set"
374 | (interactive)
375 |
376 | (unwind-protect
377 | (let (key def text more-text)
378 |
379 | (unless org-working-set--dispatch-help-strings
380 | (setq org-working-set--dispatch-help-strings (org-working-set--make-help-strings org-working-set-dispatch-keymap)))
381 |
382 | (setq org-working-set--clock-in-curr org-working-set-clock-in)
383 | (setq org-working-set--land-at-end-curr org-working-set-land-at-end)
384 |
385 | (if (or (not org-working-set-id)
386 | (string= org-working-set-id ""))
387 | (org-working-set--id-assistant))
388 |
389 | (org-working-set--nodes-from-property-if-unset-or-stale)
390 |
391 | (while (not text)
392 | (setq def nil)
393 | (while (not def)
394 | (setq key (read-key-sequence
395 | (apply 'format
396 | (org-working-set--format-prompt "org-working-set; " org-working-set--dispatch-help-strings "%s - "))))
397 | (setq def (lookup-key org-working-set-dispatch-keymap key))
398 | (when (or (not def)
399 | (numberp def))
400 | (message "Invalid key: %s" key)
401 | (setq def nil)
402 | (sit-for 1)))
403 |
404 | (setq text (funcall def)))
405 |
406 | (when (consp text)
407 | (setq more-text (cdr text))
408 | (setq text (car text)))
409 |
410 | (org-working-set--nodes-persist)
411 |
412 | (setq text (format text (or more-text "") (length org-working-set--ids) (if (cdr org-working-set--ids) "s" "")))
413 | (message (concat (upcase (substring text 0 1)) (substring text 1))))
414 |
415 | ;; display buffer on error
416 | (when org-working-set--disp-on-error
417 | (pop-to-buffer org-working-set--disp-on-error '((display-buffer-at-bottom)))
418 | (setq org-working-set--disp-on-error nil))))
419 |
420 |
421 | ;;; Smaller functions directly available from dispatch; circle and menu see further down
422 |
423 | (defun org-working-set--set ()
424 | "Set working-set to current node."
425 | (unless (string-equal major-mode "org-mode")
426 | (error "This is not an org-buffer"))
427 | (let ((id (org-id-get-create)))
428 | (setq org-working-set--ids-saved org-working-set--ids)
429 | (setq org-working-set--ids (list id))
430 | (setq org-working-set--id-last-goto id)
431 | (org-working-set--clock-in-maybe)
432 | "working-set has been set to current node (1 node)"))
433 |
434 | (defun org-working-set--add-without-remove ()
435 | "As normal add but without removing parent or children already in working-set."
436 | (org-working-set--add t))
437 |
438 | (defun org-working-set--add (&optional without-remove)
439 | "Add current node to working-set."
440 | (let ((more-text "")
441 | title id ids-up-to-top was-already head)
442 |
443 | (unless (string-equal major-mode "org-mode")
444 | (error "This is not an org-buffer"))
445 |
446 | (if (org-inlinetask-in-task-p)
447 | (setq id (org-id-get-create) head (org-get-heading t t t t))
448 | (org-with-limited-levels
449 | (setq id (org-id-get-create) head (org-get-heading t t t t))))
450 | (setq title (org-format-outline-path
451 | (cons head (reverse (org-get-outline-path)))
452 | most-positive-fixnum nil " / "))
453 |
454 | (if (member id org-working-set--ids)
455 | (setq was-already t)
456 | (setq org-working-set--ids-saved org-working-set--ids)
457 |
458 | ;; before adding, remove any children of new node, that are already in working-set
459 | ;; i.e. remove all nodes from working set that have the new node as any of their parents
460 | (unless without-remove
461 | (setq org-working-set--ids
462 | (delete nil (mapcar (lambda (wid)
463 | (if (member id
464 | ;; compute all parents of working set node id wid
465 | (org-with-point-at (org-working-set--id-find wid t)
466 | (org-working-set--ids-up-to-top)))
467 | ;; if new node is parent of a node already in working set
468 | (progn
469 | (setq more-text ", removing its children")
470 | nil) ; do not keep this node from working set
471 | wid)) ; keep it
472 | org-working-set--ids)))
473 |
474 | ;; remove any parents of new node, that are already in working-set
475 | (setq ids-up-to-top (org-working-set--ids-up-to-top))
476 | (when (-intersection ids-up-to-top org-working-set--ids)
477 | (setq org-working-set--ids (-difference org-working-set--ids ids-up-to-top))
478 | (setq more-text (concat more-text ", replacing its parent"))))
479 |
480 | ;; finally add new node to working-set
481 | (setq org-working-set--ids (cons id org-working-set--ids))
482 | (org-working-set--journal-add id title))
483 |
484 | (setq org-working-set--id-last-goto id)
485 | (org-working-set--clock-in-maybe)
486 | (cons
487 | (concat
488 | (if was-already
489 | "current node is already part of working-set%s (%d node%s)"
490 | "current node has been appended to working-set%s (%d node%s)")
491 | (propertize (concat ": " head) 'face 'org-agenda-dimmed-todo-face))
492 | more-text)))
493 |
494 |
495 | (defun org-working-set--delete-from (&optional id)
496 | "Delete current node from working-set.
497 | Optional argument ID gives the node to delete."
498 | (setq id (or id (org-id-get)))
499 | (format
500 | (if (and id (member id org-working-set--ids))
501 | (progn
502 | (if (string= id org-working-set--id-last-goto) (setq org-working-set--id-last-goto nil))
503 | (setq org-working-set--ids-saved org-working-set--ids)
504 | (setq org-working-set--ids (delete id org-working-set--ids))
505 | "Current node has been removed from working-set (%d node%s)")
506 | "Current node has not been in working-set (%d node%s)")
507 | (length org-working-set--ids) (if org-working-set--ids "s" "")))
508 |
509 |
510 | (defun org-working-set--journal-enter ()
511 | "Enter journal of working set nodes and position cursor on first link."
512 | (org-id-goto org-working-set-id)
513 | (recenter 1)
514 | (org-end-of-meta-data t)
515 | (org-working-set--unfold-buffer t)
516 | (search-forward "[" (line-end-position) t 2)
517 | "log of additions to working set")
518 |
519 |
520 | (defun org-working-set--dispatch-toggle-help ()
521 | "Show help."
522 | (interactive)
523 | (setq org-working-set--short-help-wanted
524 | (not org-working-set--short-help-wanted))
525 | nil)
526 |
527 |
528 | (defun org-working-set--nodes-restore (&optional upcase)
529 | "Restore previously saved working-set.
530 | Optional argument UPCASE modifies the returned message."
531 | (let (txt)
532 | (if org-working-set--ids-saved
533 | (progn
534 | (setq txt (format "Discarded current working set of and restored previous set; now %d node%s in working-set" (length org-working-set--ids-saved) (if (cdr org-working-set--ids-saved) "s" "")))
535 | (setq org-working-set--ids org-working-set--ids-saved))
536 | (setq txt "No saved working-set nodes to restore, nothing to do"))
537 | (if upcase (concat (upcase (substring txt 0 1))
538 | (substring txt 1)
539 | ".")
540 | txt)))
541 |
542 |
543 | (defun org-working-set--dispatch-toggle-clock-in ()
544 | "Toggle between clocking in and not."
545 | (interactive)
546 | (setq org-working-set--clock-in-curr (not org-working-set--clock-in-curr))
547 | nil)
548 |
549 |
550 | (defun org-working-set--dispatch-toggle-land-at-end ()
551 | "Toggle between landing at head or end."
552 | (interactive)
553 | (setq org-working-set--land-at-end-curr (not org-working-set--land-at-end-curr))
554 | nil)
555 |
556 |
557 | ;;; Functions for the working set circle
558 |
559 | (defun org-working-set--circle-start ()
560 | "Go through working-set, one node after the other."
561 | (unless org-working-set--ids (error "No nodes in working-set; please add some first"))
562 |
563 | (unless org-working-set--circle-help-strings
564 | (setq org-working-set--circle-help-strings (org-working-set--make-help-strings org-working-set-circle-keymap)))
565 |
566 | (setq org-working-set--short-help-wanted nil)
567 | (setq org-working-set--circle-before-marker (point-marker))
568 | (setq org-working-set--circle-win-config (current-window-configuration))
569 |
570 | (setq org-working-set--circle-cancel-transient-function
571 | (set-transient-map
572 | org-working-set-circle-keymap t
573 | ;; this is run (in any case) on leaving the map
574 | (lambda ()
575 | (if org-working-set--cancel-timer
576 | (cancel-timer org-working-set--cancel-timer))
577 | (message nil)
578 | (org-working-set--remove-tooltip-overlay)
579 | (let (keys)
580 | ;; save and repeat terminating key, because org-clock-in might read interactively
581 | (if (input-pending-p) (setq keys (read-key-sequence nil)))
582 | (ignore-errors (org-working-set--clock-in-maybe))
583 | (if keys (setq unread-command-events (listify-key-sequence keys))))
584 | (when org-working-set--circle-before-marker
585 | (move-marker org-working-set--circle-before-marker nil)
586 | (setq org-working-set--circle-before-marker nil)))))
587 |
588 | ;; first move
589 | (message (concat (org-working-set--circle-continue t) " - ")))
590 |
591 |
592 | (defun org-working-set--circle-forward ()
593 | "Move forward."
594 | (interactive)
595 | (setq this-command last-command)
596 | (message (concat (org-working-set--circle-continue) " - ")))
597 |
598 |
599 | (defun org-working-set--circle-backward ()
600 | "Move backward."
601 | (interactive)
602 | (setq this-command last-command)
603 | (message (concat (org-working-set--circle-continue nil t) " - ")))
604 |
605 |
606 | (defun org-working-set--circle-toggle-clock-in ()
607 | "Toggle clocking."
608 | (interactive)
609 | (setq org-working-set--clock-in-curr (not org-working-set--clock-in-curr))
610 | (message (concat (org-working-set--circle-continue t) " - ")))
611 |
612 |
613 | (defun org-working-set--circle-toggle-land-at-end ()
614 | "Toggle between landing at head or end."
615 | (interactive)
616 | (setq org-working-set--land-at-end-curr (not org-working-set--land-at-end-curr))
617 | (if org-working-set--land-at-end-curr
618 | (org-working-set--put-tooltip-overlay)
619 | (org-working-set--remove-tooltip-overlay))
620 | (message (concat (org-working-set--circle-continue t) " - ")))
621 |
622 |
623 | (defun org-working-set--circle-switch-to-menu ()
624 | "Leave working set circle and enter menu."
625 | (interactive)
626 | (message "Switching to menu")
627 | (org-working-set--remove-tooltip-overlay)
628 | (run-with-timer 0 nil 'org-working-set--menu))
629 |
630 |
631 | (defun org-working-set--circle-done ()
632 | "Finish regularly."
633 | (interactive)
634 | (message "Circle done.")
635 | (org-working-set--remove-tooltip-overlay))
636 |
637 |
638 | (defun org-working-set--circle-done-at-heading ()
639 | "Finish regularly and go back to heading."
640 | (interactive)
641 | (message "Circle done; at heading.")
642 | (org-working-set--remove-tooltip-overlay)
643 | (org-with-limited-levels
644 | (org-back-to-heading)))
645 |
646 |
647 | (defun org-working-set--circle-done-at-end ()
648 | "Finish regularly and go back to end."
649 | (interactive)
650 | (message "Circle done; at end.")
651 | (org-working-set--remove-tooltip-overlay)
652 | (org-working-set--end-of-node))
653 |
654 |
655 | (defun org-working-set--circle-toggle-help ()
656 | "Show help."
657 | (interactive)
658 | (setq org-working-set--short-help-wanted
659 | (not org-working-set--short-help-wanted))
660 | (message (org-working-set--circle-continue t)))
661 |
662 |
663 | (defun org-working-set--circle-delete-current ()
664 | "Delete current entry."
665 | (interactive)
666 | (setq this-command last-command)
667 | (org-working-set--nodes-persist)
668 | (message (concat (org-working-set--delete-from) " "
669 | (org-working-set--circle-continue)
670 | " - ")))
671 |
672 |
673 | (defun org-working-set--circle-quit ()
674 | "Leave circle and return to prior node."
675 | (interactive)
676 | (if org-working-set--circle-before-marker ; proper cleanup of marker will happen in cancel-transient function
677 | (org-goto-marker-or-bmk org-working-set--circle-before-marker))
678 | (when org-working-set--circle-win-config
679 | (set-window-configuration org-working-set--circle-win-config)
680 | (setq org-working-set--circle-win-config nil))
681 | (org-working-set--remove-tooltip-overlay)
682 | (message "Quit")
683 | (if org-working-set--circle-cancel-transient-function
684 | (funcall org-working-set--circle-cancel-transient-function)))
685 |
686 |
687 | (defun org-working-set--circle-continue (&optional stay back)
688 | "Continue with working set circle after start.
689 | Optional argument STAY prevents changing location.
690 | Optional argument BACK"
691 | (let (last-id following-id previous-id target-id parent-ids)
692 |
693 | ;; compute target
694 | (setq last-id (or org-working-set--id-last-goto
695 | (car (last org-working-set--ids))))
696 | (setq following-id (car (or (cdr-safe (member last-id
697 | (append org-working-set--ids org-working-set--ids)))
698 | org-working-set--ids)))
699 | (if back
700 | (setq previous-id (car (or (cdr-safe (member last-id
701 | (reverse (append org-working-set--ids org-working-set--ids))))
702 | org-working-set--ids))))
703 | (setq target-id (if stay last-id (if back previous-id following-id)))
704 | (setq parent-ids (org-working-set--ids-up-to-top)) ; remember this before changing location
705 |
706 | ;; bail out on inactivity
707 | (if org-working-set--cancel-timer
708 | (cancel-timer org-working-set--cancel-timer))
709 | (setq org-working-set--cancel-timer
710 | (run-at-time 30 nil
711 | (lambda () (if org-working-set--circle-cancel-transient-function
712 | (funcall org-working-set--circle-cancel-transient-function)))))
713 |
714 | (org-working-set--goto-id target-id)
715 | (setq org-working-set--id-last-goto target-id)
716 |
717 | (if org-working-set--land-at-end-curr
718 | (org-working-set--put-tooltip-overlay))
719 |
720 | ;; Compose return message:
721 | (apply 'format
722 | (org-working-set--format-prompt
723 | (concat
724 | "In circle, "
725 | ;; explanation
726 | (format (cond (stay
727 | "returning to %slast")
728 | ((member target-id parent-ids)
729 | "staying below %scurrent")
730 | (t
731 | (concat "at %s" (if back "previous" "next"))))
732 | (if org-working-set--land-at-end-curr "end of " ""))
733 | ;; count of nodes
734 | (if (cdr org-working-set--ids)
735 | (format " node (%s); " (org-working-set--out-of-clause target-id))
736 | (format " single node; ")))
737 | org-working-set--circle-help-strings))))
738 |
739 |
740 | ;;; Functions for the working set menu
741 |
742 | (defun org-working-set--menu ()
743 | "Show menu to let user choose among and manipulate list of working-set nodes."
744 |
745 | (unless org-working-set--ids (error "No nodes in working-set; please add some first"))
746 |
747 | (unless org-working-set--menu-help-strings
748 | (setq org-working-set--menu-help-strings (org-working-set--make-help-strings org-working-set-menu-keymap)))
749 |
750 | (setq org-working-set--short-help-wanted nil)
751 | (pop-to-buffer org-working-set--menu-buffer-name '((display-buffer-at-bottom)))
752 | (org-working-set--menu-rebuild t t)
753 |
754 | (use-local-map org-working-set-menu-keymap)
755 | "Buffer with nodes of working-set")
756 |
757 |
758 | (defun org-working-set-menu-go--this-win ()
759 | "Go to node specified by line under cursor in this window."
760 | (interactive)
761 | (org-working-set-menu-go nil t))
762 |
763 |
764 | (defun org-working-set-menu-go--this-win-dont-set ()
765 | "Go to node specified by line under cursor in this window, but do not star."
766 | (interactive)
767 | (org-working-set-menu-go nil nil))
768 |
769 |
770 | (defun org-working-set-menu-go--other-win ()
771 | "Go to node specified by line under cursor in other window."
772 | (interactive)
773 | (org-working-set-menu-go t t))
774 |
775 |
776 | (defun org-working-set-menu-go (other-win set-last-id)
777 | "Go to node specified by line under cursor.
778 | The Boolean arguments OTHER-WIN goes to node in other window."
779 | (let ((id (org-working-set--menu-get-id)))
780 |
781 | (if other-win
782 | (progn
783 | (other-window 1)
784 | (org-working-set--goto-id id))
785 | (if (> (count-windows) 1) (delete-window))
786 | (org-working-set--goto-id id))
787 |
788 | (when set-last-id
789 | (setq org-working-set--id-last-goto id)
790 | ;; put id in front of list
791 | (setq org-working-set--ids (cons id (delete id org-working-set--ids))))
792 |
793 | (org-working-set--clock-in-maybe)
794 | (org-working-set--nodes-persist)))
795 |
796 |
797 | (defun org-working-set--menu-peek ()
798 | "Peek into node specified by line under cursor."
799 | (interactive)
800 | (save-window-excursion
801 | (save-excursion
802 | (org-working-set--goto-id (org-working-set--menu-get-id))
803 | (delete-other-windows)
804 | (read-char "Peeking into node, any key to return." nil 10))))
805 |
806 |
807 | (defun org-working-set--menu-delete-entry ()
808 | "Delete node under cursor from working set."
809 | (interactive)
810 | (message (org-working-set--delete-from (org-working-set--menu-get-id)))
811 | (org-working-set--nodes-persist)
812 | (org-working-set--menu-rebuild))
813 |
814 |
815 | (defun org-working-set--menu-todo ()
816 | "Set todo state for node under cursor."
817 | (interactive)
818 | (save-window-excursion
819 | (org-id-goto (org-working-set--menu-get-id))
820 | (recenter 1)
821 | (org-todo))
822 | (org-working-set--menu-rebuild))
823 |
824 |
825 | (defun org-working-set--menu-undo ()
826 | "Undo last modification to working set."
827 | (interactive)
828 | (message (org-working-set--nodes-restore))
829 | (org-working-set--nodes-persist)
830 | (org-working-set--menu-rebuild t))
831 |
832 |
833 | (defun org-working-set--menu-quit ()
834 | "Quit menu."
835 | (interactive)
836 | (delete-windows-on org-working-set--menu-buffer-name)
837 | (kill-buffer org-working-set--menu-buffer-name))
838 |
839 |
840 | (defun org-working-set--menu-toggle-help ()
841 | "Show help."
842 | (interactive)
843 | (setq org-working-set--short-help-wanted
844 | (not org-working-set--short-help-wanted))
845 | (org-working-set--menu-rebuild t))
846 |
847 |
848 | (defun org-working-set--menu-toggle-clock-in ()
849 | "Toggle between clocking in and not in working set menu."
850 | (interactive)
851 | (setq org-working-set--clock-in-curr (not org-working-set--clock-in-curr))
852 | (org-working-set--menu-rebuild t))
853 |
854 |
855 | (defun org-working-set--menu-toggle-land-at-end ()
856 | "Toggle between landing at head or end."
857 | (interactive)
858 | (setq org-working-set--land-at-end-curr (not org-working-set--land-at-end-curr))
859 | (org-working-set--menu-rebuild t))
860 |
861 |
862 | (defun org-working-set--advice-for-org-id-update-id-locations (_orig-func &rest _args)
863 | "Advice that moderates use of `org-id-update-id-location' for `org-working-set--menu-rebuild'."
864 | (org-working-set--ask-and-handle-stale-id))
865 |
866 |
867 | (defun org-working-set--menu-rebuild (&optional resize go-top)
868 | "Rebuild content of menu-buffer.
869 | Optional argument RESIZE adjusts window size.
870 | Optional argument GO-TOP goes to top of new window, rather than keeping current position."
871 | (interactive)
872 | (let (cursor-here prev-help-len this-help-len lb pparts)
873 | (org-working-set--nodes-from-property-if-unset-or-stale)
874 | (with-current-buffer (get-buffer-create org-working-set--menu-buffer-name)
875 | (set (make-local-variable 'line-move-visual) nil)
876 | (setq buffer-read-only nil)
877 | (setq cursor-here (point))
878 | (setq prev-help-len (next-property-change (point-min)))
879 | (cursor-intangible-mode)
880 | (erase-buffer)
881 | (setq pparts (org-working-set--format-prompt "" org-working-set--menu-help-strings ", * marks last visited%s"))
882 | (insert
883 | (apply 'format
884 | (flatten-list
885 | (list (propertize
886 | (car pparts)
887 | 'face 'org-agenda-dimmed-todo-face
888 | 'cursor-intangible t
889 | 'front-sticky t)
890 | (mapcar (lambda (x) (propertize x 'face 'default)) (cdr pparts))))))
891 | (setq this-help-len (next-property-change (point-min)))
892 | (insert "\n\n")
893 | (if go-top (setq cursor-here (point)))
894 | (if org-working-set--ids
895 | (mapc (lambda (id)
896 | (let (heads olpath)
897 | (save-window-excursion
898 | (org-working-set--id-goto id)
899 | (setq olpath (org-format-outline-path
900 | (reverse (org-get-outline-path)) most-positive-fixnum nil " / "))
901 | (setq heads (concat (substring-no-properties (or (org-get-heading) "?"))
902 | (if (> (length olpath) 0)
903 | (propertize (concat " / " olpath)
904 | 'face 'org-agenda-dimmed-todo-face)
905 | ""))))
906 | (insert (format "%s %s" (if (eq id org-working-set--id-last-goto) "*" " ") heads))
907 | (setq lb (line-beginning-position))
908 | (insert "\n")
909 | (put-text-property lb (point) 'org-working-set-id id)))
910 | org-working-set--ids)
911 | (insert " No nodes in working-set.\n"))
912 | (if (or go-top (not prev-help-len))
913 | (goto-char cursor-here)
914 | (goto-char (+ cursor-here (- this-help-len prev-help-len))))
915 | (when resize
916 | (ignore-errors
917 | (fit-window-to-buffer (get-buffer-window))
918 | (enlarge-window 1)))
919 | (setq buffer-read-only t))))
920 |
921 |
922 | (defun org-working-set--menu-get-id ()
923 | "Extract id from current line in working-set menu."
924 | (or (get-text-property (point) 'org-working-set-id)
925 | (error "This line does not point to a node from working-set")))
926 |
927 |
928 | ;;; General helper functions
929 |
930 | (defun org-working-set--insert-files (files)
931 | "Insert given list of FILES into current buffer using full window width."
932 | (let ((tab-stop-list '(2 42 82)))
933 | (dolist (name files)
934 | (if (> (+ (indent-next-tab-stop (current-column))
935 | (length name))
936 | (- (window-width) 10))
937 | (insert "\n"))
938 | (tab-to-tab-stop)
939 | (insert name))))
940 |
941 |
942 | (defun org-working-set--id-find (id &optional markerp)
943 | "Wrapper for org-id-find, that does not go stale during rebuild of org-id-locations"
944 | (let (retval)
945 | (setq org-working-set--id-not-found id)
946 | (unwind-protect
947 | (progn
948 | (advice-add 'org-id-update-id-locations :around #'org-working-set--advice-for-org-id-update-id-locations)
949 | (setq retval (org-id-find id markerp)))
950 | (advice-remove 'org-id-update-id-locations #'org-working-set--advice-for-org-id-update-id-locations))
951 | (setq org-working-set--id-not-found nil)
952 | retval))
953 |
954 |
955 | (defun org-working-set--id-goto (id)
956 | "Wrapper for org-id-goto, that does not go stale during rebuild of org-id-locations"
957 | (setq org-working-set--id-not-found id)
958 | (unwind-protect
959 | (progn
960 | (advice-add 'org-id-update-id-locations :around #'org-working-set--advice-for-org-id-update-id-locations)
961 | (org-id-goto id))
962 | (advice-remove 'org-id-update-id-locations #'org-working-set--advice-for-org-id-update-id-locations))
963 | (org-working-set--check-id id)
964 | (setq org-working-set--id-not-found nil))
965 |
966 |
967 | (defun org-working-set--goto-id (id)
968 | "Goto node with given ID and unfold"
969 | (let (marker)
970 | (setq marker (org-working-set--id-find id 'marker))
971 | (unless marker
972 | (setq org-working-set--id-last-goto nil)
973 | (error "Could not find working-set node with id %s" id))
974 | (pop-to-buffer-same-window (marker-buffer marker))
975 | (goto-char (marker-position marker))
976 | (org-working-set--unfold-buffer)
977 | (org-mark-ring-push)
978 | (move-marker marker nil)
979 | (org-working-set--check-id id)
980 | (if (and org-working-set--land-at-end-curr
981 | (not (org-inlinetask-in-task-p)))
982 | (progn
983 | (org-working-set--end-of-node)
984 | (recenter -1))
985 | (recenter 1))))
986 |
987 |
988 | (defun org-working-set--check-id (id)
989 | "Check, if we really arrived there"
990 | (let ((maybe (if (buffer-narrowed-p) (format " (maybe because buffer %s is narrowed)" (buffer-name)) "")))
991 | (unless (org-id-get)
992 | (error "Did not arrive at node with id '%s'%s" id maybe))
993 | (unless (string= id (org-id-get))
994 | (error "Node with id '%s' was found, but 'goto' did not succeed%s" id maybe))))
995 |
996 |
997 | (defun org-working-set--end-of-node ()
998 | "Goto end of current node, ignore inline-tasks but stop at first child."
999 | (let (level (pos (point)))
1000 | (when (ignore-errors (org-with-limited-levels (org-back-to-heading)))
1001 | (setq level (outline-level))
1002 | (forward-char 1)
1003 | (if (and (org-with-limited-levels (re-search-forward org-outline-regexp-bol nil t))
1004 | (> (outline-level) level))
1005 | (progn ; landed on child node
1006 | (goto-char (match-beginning 0))
1007 | (forward-line -1))
1008 | (goto-char pos) ; landed on next sibling or end of buffer
1009 | (org-with-limited-levels
1010 | (org-end-of-subtree nil t)
1011 | (when (org-at-heading-p)
1012 | (forward-line -1))))
1013 | (beginning-of-line)
1014 | (org-reveal))
1015 | (recenter -2)))
1016 |
1017 |
1018 | (defun org-working-set--nodes-persist ()
1019 | "Write working-set to property."
1020 | (setq org-working-set--ids (cl-remove-duplicates org-working-set--ids :test (lambda (x y) (string= x y))))
1021 | (let ((ws-bp (org-working-set--id-bp)))
1022 | (with-current-buffer (car ws-bp)
1023 | (org-entry-put (cdr ws-bp) "working-set-nodes" (mapconcat #'identity org-working-set--ids " ")))))
1024 |
1025 |
1026 | (defun org-working-set--nodes-from-property-if-unset-or-stale ()
1027 | "Read working-set to property if conditions apply."
1028 | (if (or (not org-working-set--ids)
1029 | org-working-set--id-not-found)
1030 | (let ((bp (org-working-set--id-bp)))
1031 | (with-current-buffer (car bp)
1032 | (save-excursion
1033 | (goto-char (cdr bp))
1034 | (setq org-working-set--ids (split-string (or (org-entry-get nil "working-set-nodes") "")))
1035 | (when (member org-working-set--id-not-found org-working-set--ids)
1036 | (org-working-set--ask-and-handle-stale-id)))))
1037 | (setq org-working-set--id-not-found nil)))
1038 |
1039 |
1040 | (defun org-working-set--ask-and-handle-stale-id ()
1041 | "Ask user about stale ID from working set and handle answer."
1042 | (let ((char-choices (list ?d ?u ?o ?q ?f))
1043 | (window-config (current-window-configuration))
1044 | (idnf org-working-set--id-not-found)
1045 | char)
1046 |
1047 | (org-working-set--show-explanation
1048 | "*ID not found*"
1049 | (format "ERROR: ID %s from working set cannot be found. Please specify how to proceed:\n" org-working-set--id-not-found)
1050 | " - d :: delete this ID from the working set"
1051 | " - u :: save all org buffers, then run `org-id-update-id-locations' to rescan your org-files"
1052 | " - o :: multi-occur over all org files for this id"
1053 | " - f :: view current list in org-id-files and maybe add another one"
1054 | " - q :: quit and do nothing"
1055 | "\nIf unsure, try 'u' first and then 'd'."
1056 | "In any case the current function will be aborted and you will need to start over.")
1057 | (unwind-protect
1058 | (while (not (memq char char-choices))
1059 | (setq char (read-char-choice "Your choice: " char-choices)))
1060 | (kill-buffer-and-window)
1061 | (set-window-configuration window-config))
1062 |
1063 | (cond
1064 | ((eq char ?q)
1065 | (message "The missing id is %s" org-working-set--id-not-found)
1066 | (keyboard-quit))
1067 | ((eq char ?d)
1068 | (setq org-working-set--ids-saved org-working-set--ids)
1069 | (setq org-working-set--ids (delete org-working-set--id-not-found org-working-set--ids))
1070 | (org-working-set--nodes-persist)
1071 | (error "Removed ID %s from working-set; please start over" idnf))
1072 | ((eq char ?o)
1073 | (multi-occur-in-matching-buffers "\\.org$" org-working-set--id-not-found)
1074 | (setq org-working-set--disp-on-error "*Occur*")
1075 | (let ((owsinf org-working-set--id-not-found))
1076 | (setq org-working-set--id-not-found nil)
1077 | (error "Multi-occur for ID %s; if it has been found twice, `u' might help; otherwise the referred node or its properties might have been deleted (consider `d')" owsinf)))
1078 | ((eq char ?f)
1079 | (let ((buna "*content of org-id-files*")
1080 | file)
1081 | (with-current-buffer-window buna '((display-buffer-at-bottom)) nil
1082 | (insert (format "Current content of variable `org-id-files':\n\n"))
1083 | (org-working-set--insert-files org-id-files)
1084 | (insert "\n")
1085 | (ignore-errors
1086 | (fit-window-to-buffer (get-buffer-window buna))
1087 | (enlarge-window 1)))
1088 | (setq file (read-file-name "Choose a single files to add or hit C-g to cancel operation: " org-directory))
1089 | (if (and (file-readable-p file)
1090 | (file-regular-p file))
1091 | (progn (push file org-id-files)
1092 | (message "Added %s to `org-id-locations'" file))
1093 | (message "Specified name %s is not readable or not a file" file))))
1094 | ((eq char ?u)
1095 | (message "Updating ID locations")
1096 | (sit-for 1)
1097 | (org-save-all-org-buffers)
1098 | (advice-remove 'org-id-update-id-locations #'org-working-set--advice-for-org-id-update-id-locations)
1099 | (org-id-update-id-locations)
1100 | (setq org-working-set--ids nil)
1101 | (error "Searched all files for ID %s; please start over" org-working-set--id-not-found)))))
1102 |
1103 |
1104 | (defun org-working-set--clock-in-maybe ()
1105 | "Clock into current node if appropriate."
1106 | (if org-working-set--clock-in-curr
1107 | (org-with-limited-levels (org-clock-in))))
1108 |
1109 |
1110 | (defun org-working-set--format-prompt (before short-and-long &optional after)
1111 | "Format prompt and help string.
1112 | Argument SHORT-AND-LONG has two help strings, BEFORE and AFTER are added."
1113 | (let (text)
1114 | (setq text (concat
1115 | before
1116 | "Type "
1117 | (if org-working-set--short-help-wanted
1118 | (cdr short-and-long)
1119 | (car short-and-long))
1120 | (format (if after after "%s")
1121 | (format " [%%s.lock-in: %s, %%s.and-at: %s]"
1122 | (if org-working-set--clock-in-curr "yes" "no ")
1123 | (if org-working-set--land-at-end-curr "end " "head")))))
1124 | (if org-working-set--short-help-wanted
1125 | (setq text (with-temp-buffer
1126 | (insert text)
1127 | (fill-region (point-min) (point-max) nil t)
1128 | (buffer-string))))
1129 | (list text "c" "l")))
1130 |
1131 |
1132 | (defun org-working-set--unfold-buffer (&optional skip-recenter)
1133 | "Helper function to unfold buffer.
1134 | Optional argument SKIP-RECENTER avoids recentering of buffer in window."
1135 | (org-show-context 'tree)
1136 | (org-reveal '(16))
1137 | (unless skip-recenter (recenter 1)))
1138 |
1139 |
1140 | (defun org-working-set--id-bp ()
1141 | "Return buffer and point of working-set node."
1142 | (let ((fp (org-working-set--id-find org-working-set-id)))
1143 | (unless fp (error "Could not find node %s with working set" org-working-set-id))
1144 | (cons (get-file-buffer (car fp))
1145 | (cdr fp))))
1146 |
1147 |
1148 | (defun org-working-set--show-explanation (buffer-name &rest strings)
1149 | "Show buffer BUFFER-NAME with explanations STRINGS."
1150 | (pop-to-buffer buffer-name '((display-buffer-at-bottom)) nil)
1151 | (with-current-buffer buffer-name
1152 | (erase-buffer)
1153 | (org-mode)
1154 | (mapc
1155 | (lambda (x) (insert x) (org-fill-paragraph) (insert "\n"))
1156 | strings)
1157 | (setq mode-line-format nil)
1158 | (setq buffer-read-only t)
1159 | (setq cursor-type nil)
1160 | (fit-window-to-buffer)
1161 | (enlarge-window 1)
1162 | (goto-char (point-min))
1163 | (recenter 0)
1164 | (setq window-size-fixed 'height)))
1165 |
1166 |
1167 | (defun org-working-set--id-assistant ()
1168 | "Assist the user in choosing a node, where the list of working-set nodes can be stored."
1169 | (let ((window-config (current-window-configuration))
1170 | (current-heading (ignore-errors (org-get-heading)))
1171 | use-current-node)
1172 |
1173 | (org-working-set--show-explanation
1174 | "*org working-set assistant*"
1175 | "\nThe required variable `org-working-set-id' has not been set. It should contain the id of an empty node, where org-working-set will store its runtime information. The property drawer will be used to store the ids of the working-set nodes, the body will be populated with an ever-growing list of nodes, that have been added."
1176 | "\nThere are three ways to set `org-working-set-id':"
1177 | "- Choose a node and get and copy the value of its ID-property (via `org-id-get-create'); use the customize-interface to set `org-working-set-id' to the chosen id."
1178 | "- As above, but edit your .emacs and insert a setq-clause: (setq org-working-set-id \"XXX\"), where XXX is the id of your node. You might want to add a keybinding too, e.g. (global-set-key (kbd \"C-c w\") 'org-working-set)"
1179 | (format "- Use the ID of the node the, where the cursor is currently positioned in (which is '%s')." current-heading)
1180 | "\nIf you choose the first or second way, you should answer 'no' to the question below and go ahead yourself."
1181 | "\nIf you choose the third way, you should answer 'yes'."
1182 | (format "\nHowever, if you are not already within the right node, you may answer 'no' to the question, navigate to the right node and invoke `%s' again." this-command))
1183 | (unwind-protect
1184 | (setq use-current-node (yes-or-no-p "Do you want to use the id of the current node ? "))
1185 | (kill-buffer-and-window)
1186 | (set-window-configuration window-config))
1187 |
1188 |
1189 | (if use-current-node
1190 | (let ((id (org-id-get-create)))
1191 | (customize-save-variable 'org-working-set-id id)
1192 | (message "Using id of current node to store `org-working-set-id'")
1193 | (sit-for 1))
1194 | (error "`org-working-set-id' not set"))))
1195 |
1196 |
1197 | (defun org-working-set--make-help-strings (keymap)
1198 | "Construct short and long help strings for given keymap."
1199 | (let (direct-keys grouped short long)
1200 | (setq direct-keys ; ((function1 . key1) (function1 . key2) (function2 . key3) ...)
1201 | (reverse
1202 | (mapcar (lambda (cell) (cons (cdr cell) (car cell))) ; swap car and cdr
1203 | (-take-while (lambda (x) (consp x)) ; ignore keys from parent keymaps, after next symbol 'keymap
1204 | (cdr (car (list keymap))))))) ; direct key-definitionss come after an initial symbol 'keymap
1205 | (setq short (concat
1206 | (s-join ","
1207 | (-remove (lambda (x) (member x '("?" "C-g" "q" "")))
1208 | (mapcar
1209 | (lambda (def-key) (single-key-description (cdr def-key)))
1210 | direct-keys)))
1211 | " or ? for short help"))
1212 | (setq grouped (-group-by 'car direct-keys)) ; ((function1 key1 key2) (function2 key3 key4) ...)
1213 | (setq long
1214 | (mapconcat (lambda (group)
1215 | (concat
1216 | (s-join ","
1217 | (-remove (lambda (x) (member x '("")))
1218 | (mapcar
1219 | (lambda (kcell) (single-key-description (cdr kcell)))
1220 | (cdr group))))
1221 | ") "
1222 | (s-chop-suffix "." (cl-first (s-lines (documentation (car group)))))))
1223 | grouped
1224 | ", "))
1225 | (cons short long)))
1226 |
1227 |
1228 | (defun org-working-set--ids-up-to-top ()
1229 | "Get list of all ids from current node up to top level."
1230 | (when (string= major-mode "org-mode")
1231 | (let (ids id pt)
1232 | (save-excursion
1233 | (ignore-errors
1234 | (while (progn (and (setq id (org-id-get))
1235 | (setq ids (cons id ids)))
1236 | (setq pt (point))
1237 | (outline-up-heading 1)
1238 | (/= pt (point))))))
1239 | ids)))
1240 |
1241 |
1242 | (defun org-working-set--journal-add (id title)
1243 | "Add entry into log of working-set nodes.
1244 | ID and TITLE specify heading to log"
1245 | (let ((bp (org-working-set--id-bp)))
1246 | (with-current-buffer (car bp)
1247 | (save-excursion
1248 | (goto-char (cdr bp))
1249 | (org-end-of-meta-data t) ; skips over empty lines too
1250 | (when (org-at-heading-p) ; no log-line yet
1251 | (backward-char) ; needed for tests to work around an edge-case in save-excursion
1252 | (insert "\n\n\n")
1253 | (forward-line -1))
1254 | (insert (make-string (1+ (org-current-level)) ? )
1255 | "- ")
1256 | (org-insert-time-stamp nil t t)
1257 | (insert (format " [[id:%s][%s]]\n" id title))))))
1258 |
1259 |
1260 | (defun org-working-set--put-tooltip-overlay ()
1261 | "Create and show overlay for tooltip."
1262 | (let (head)
1263 | (setq head (org-with-limited-levels (org-get-heading t t t t)))
1264 | (when org-working-set--land-at-end-curr
1265 | (if org-working-set--overlay (delete-overlay org-working-set--overlay))
1266 | (setq org-working-set--overlay (make-overlay (point-at-bol) (point-at-bol)))
1267 | (overlay-put org-working-set--overlay
1268 | 'after-string
1269 | (propertize
1270 | (format " %s (%s) " head (org-working-set--out-of-clause (org-id-get)))
1271 | 'face 'match))
1272 | (overlay-put org-working-set--overlay 'priority most-positive-fixnum))))
1273 |
1274 |
1275 | (defun org-working-set--out-of-clause (id)
1276 | "Create string describing position in working set."
1277 | (format "%d of %d"
1278 | (1+ (- (length org-working-set--ids)
1279 | (length (member id org-working-set--ids))))
1280 | (length org-working-set--ids)))
1281 |
1282 |
1283 | (defun org-working-set--remove-tooltip-overlay ()
1284 | "Remove overlay for tooltip"
1285 | (if org-working-set--overlay
1286 | (delete-overlay org-working-set--overlay))
1287 | (setq org-working-set--overlay nil))
1288 |
1289 |
1290 | (provide 'org-working-set)
1291 |
1292 | ;; Local Variables:
1293 | ;; fill-column: 75
1294 | ;; comment-column: 50
1295 | ;; End:
1296 |
1297 | ;;; org-working-set.el ends here
1298 |
--------------------------------------------------------------------------------
/rake_config.yml:
--------------------------------------------------------------------------------
1 | source: org-working-set.el
2 | package: org-working-set
3 | required_pieces_commentary:
4 | - Purpose
5 | - Similar Packages
6 | - Setup
7 | - User-Story
8 | pieces_for_docstring:
9 | - Purpose
10 | - Similar Packages
11 | - User-Story
12 | testfile: owst.el
13 |
--------------------------------------------------------------------------------
/test/.nosearch:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/marcIhm/org-working-set/c83a63f34829dca137941bc06e29c34bf056a43b/test/.nosearch
--------------------------------------------------------------------------------
/test/owst.el:
--------------------------------------------------------------------------------
1 | ;;; owst.el --- Regression Tests for org-working-set.el
2 |
3 | ;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
4 |
5 | ;; Author: Marc Ihm <1@2484.de>
6 | ;; Keywords: outlines, regression-tests, elisp
7 | ;; Requires: org, org-working-set
8 | ;; Version: 0.0.2
9 |
10 | ;; This file is not part of GNU Emacs.
11 |
12 | ;;; License:
13 |
14 | ;; This program is free software; you can redistribute it and/or modify
15 | ;; it under the terms of the GNU General Public License as published by
16 | ;; the Free Software Foundation; either version 3, or (at your option)
17 | ;; any later version.
18 | ;;
19 | ;; This program is distributed in the hope that it will be useful,
20 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 | ;; GNU General Public License for more details.
23 | ;;
24 | ;; You should have received a copy of the GNU General Public License
25 | ;; along with GNU Emacs. If not, see .
26 |
27 | ;;; Commentary:
28 |
29 | ;; Purpose:
30 | ;;
31 | ;; Regression tests for package org-working-set.el.
32 | ;;
33 | ;; Setup:
34 | ;;
35 | ;; None required
36 | ;;
37 | ;;
38 | ;;
39 | ;; Further reading:
40 | ;;
41 | ;; See org-working-set.el, which is tested by this package
42 | ;;
43 |
44 | ;;; Code:
45 |
46 | (require 'org-working-set)
47 | (require 'org-id)
48 | (require 'cl-lib)
49 | (require 'ert)
50 |
51 | (defvar owst-ert-work-file (concat temporary-file-directory "owst-ert-work.org"))
52 | (defvar owst-work-buffer nil)
53 |
54 | ;;
55 | ;; All tests
56 | ;;
57 |
58 | (ert-deftest owst-test-aaa-test-test-setup ()
59 | (owst-with-test-setup
60 | (message "Testing test setup")))
61 |
62 |
63 | (ert-deftest owst-test-clock-into-working-set ()
64 | (owst-with-test-setup
65 | (unwind-protect
66 | (progn
67 | (let ((org-working-set-clock-in nil))
68 | (should (not (org-clock-is-active)))
69 | (owst-goto "eins")
70 | (owst-do "s ")
71 | (sleep-for 1)
72 | (should (not (org-clock-is-active)))
73 |
74 | (setq org-working-set-clock-in t)
75 | (owst-goto "zwei")
76 | (owst-do "s ")
77 | (sleep-for 1)
78 | (should (org-clock-is-active))))
79 | (org-clock-out))))
80 |
81 |
82 | (ert-deftest owst-test-assistant ()
83 | (owst-with-test-setup
84 | (setq org-working-set-id nil)
85 | (owst-do "y e s a")
86 | (should org-working-set-id)
87 | (should (string= org-working-set-id (car org-working-set--ids)))))
88 |
89 |
90 | (ert-deftest owst-test-working-set-restore ()
91 | (owst-with-test-setup
92 | (owst-goto "zwei")
93 | (owst-do "s")
94 | (should (= (length org-working-set--ids) 1))
95 | (owst-do "d")
96 | (should (= (length org-working-set--ids) 0))
97 | (owst-do "u")
98 | (should (= (length org-working-set--ids) 1))))
99 |
100 |
101 | (ert-deftest owst-test-working-set-goto-end ()
102 | (owst-with-test-setup
103 | (owst-goto "drei")
104 | (owst-do "s")
105 | (beginning-of-buffer)
106 | (owst-do "TAB l")
107 | (forward-line)
108 | (should (looking-at ".* vier"))))
109 |
110 |
111 | (ert-deftest owst-test-working-set-return-after-quit ()
112 | (owst-with-test-setup
113 | (owst-goto "zwei")
114 | (owst-do "s")
115 | (owst-goto "drei")
116 | (owst-do "TAB q")
117 | (should (looking-at ".* drei"))))
118 |
119 |
120 | (ert-deftest owst-test-working-set-add-and-find-inline ()
121 | (owst-with-test-setup
122 | (goto-char 0)
123 | (search-forward "Inline")
124 | (owst-do "a")
125 | (goto-char 0)
126 | (owst-do "SPC ")
127 | (should (looking-at "\*+ Inline"))))
128 |
129 |
130 | (ert-deftest owst-test-working-set-menu-goto ()
131 | (owst-with-test-setup
132 | (owst-goto "zwei")
133 | (owst-do "s")
134 | (owst-goto "eins")
135 | (owst-do "a")
136 | (owst-do "SPC ")
137 | (should (looking-at ".* zwei"))))
138 |
139 |
140 | (ert-deftest owst-test-working-set-menu-delete ()
141 | (owst-with-test-setup
142 | (owst-goto "zwei")
143 | (owst-do "s")
144 | (owst-goto "eins")
145 | (owst-do "a")
146 | (should (= (length org-working-set--ids) 2))
147 | (owst-do "SPC d q")
148 | (should (= (length org-working-set--ids) 1))))
149 |
150 |
151 | (ert-deftest owst-test-double-working-set ()
152 | (owst-with-test-setup
153 | (owst-goto "zwei")
154 | (owst-do "s")
155 | (owst-goto "eins")
156 | (owst-do "a")
157 | (owst-do "TAB TAB")
158 | (should (looking-at ".* zwei"))
159 | (owst-do "TAB")
160 | (should (looking-at ".* zwei"))
161 | (owst-do "TAB TAB")
162 | (should (looking-at ".* eins"))))
163 |
164 |
165 | (ert-deftest owst-test-nested-working-set ()
166 | (owst-with-test-setup
167 | (owst-goto "drei")
168 | (owst-do "s")
169 | (owst-goto "vier")
170 | (owst-do "a")
171 | (should (= (length org-working-set--ids) 1))))
172 |
173 |
174 | (ert-deftest owst-test-log-of-working-set ()
175 | (owst-with-test-setup
176 | (owst-goto "zwei")
177 | (owst-do "a")
178 | (owst-goto "eins")
179 | (org-end-of-meta-data t)
180 | (should (looking-at "[[:blank:]]+-"))))
181 |
182 |
183 | (ert-deftest owst-test-when-node-has-gone ()
184 | (owst-with-test-setup
185 | (owst-goto "zwei")
186 | (owst-do "a")
187 | (org-delete-property "ID")
188 | (ignore-errors
189 | (owst-do "SPC d"))
190 | (should (= (length org-working-set--ids) 0))))
191 |
192 |
193 | (ert-deftest owst-test-advice-for-problems ()
194 | (owst-with-test-setup
195 | (owst-goto "vier")
196 | (owst-do "a")
197 | (org-delete-property "ID")
198 | (ignore-errors
199 | (owst-do "SPC o"))
200 | (with-current-buffer "*Occur*"
201 | (should (looking-at "2 matches")))))
202 |
203 |
204 | ;;
205 | ;; Helper functions
206 | ;;
207 |
208 | (defmacro owst-with-test-setup (&rest body)
209 | "Execute body within test setup"
210 | (declare (indent 0) (debug t))
211 | `(progn
212 | (owst-setup-test)
213 | (unwind-protect
214 | (progn ,@body)
215 | (owst-teardown-test))))
216 |
217 |
218 | (defun owst-do (keys &optional prefix)
219 | (execute-kbd-macro (kbd (concat prefix (if prefix " " "") "M-x o r g - w o r k i n g - s e t " keys))))
220 |
221 |
222 | (defun owst-setup-test ()
223 | (interactive)
224 | (message (format "Executing test %S" (ert-test-name (ert--stats-current-test ert--current-run-stats))))
225 | ;; remove any left over buffers
226 | (owst-remove-work-buffers)
227 | ;; create them new
228 | (owst-create-work-buffer)
229 | (switch-to-buffer owst-work-buffer)
230 | (basic-save-buffer)
231 | (org-agenda-file-to-front owst-ert-work-file)
232 | (org-cycle '(64))
233 | (delete-other-windows)
234 | (end-of-buffer)
235 | (org-id-update-id-locations (list owst-ert-work-file))
236 | (ignore-errors
237 | (kill-buffer org-working-set--menu-buffer-name))
238 | (setq org-working-set--ids nil)
239 | (setq org-working-set--ids-do-not-clock nil)
240 | (setq org-working-set--id-not-found nil))
241 |
242 |
243 | (defun owst-teardown-test ()
244 | (interactive)
245 | (with-current-buffer owst-work-buffer
246 | (set-buffer-modified-p nil)
247 | (basic-save-buffer))
248 | (org-remove-file owst-ert-work-file))
249 |
250 |
251 | (defun owst-remove-work-buffers ()
252 | "Remove any left over work buffers"
253 | (let ((b (get-buffer "owst-ert-work.org")))
254 | (when b
255 | (with-current-buffer b
256 | (set-buffer-modified-p nil))
257 | (kill-buffer b)))
258 | (setq owst-work-buffer nil))
259 |
260 |
261 | (defun owst-goto (name)
262 | (org-id-goto (cdr (assoc name owst-names-ids))))
263 |
264 | ;;
265 | ;; Test data
266 | ;;
267 |
268 |
269 | (defvar owst-names-ids
270 | (list (cons "eins" "53e15dce-6f28-4674-bd65-e63b516d97ac")
271 | (cons "zwei" "87512329-a204-47e5-b38c-1b22838b6f7d")
272 | (cons "drei" "b77473f3-dba0-4b4f-9db7-3ba095d12de4")
273 | (cons "vier" "2a3d87d0-9ad0-416b-aa22-dea96fede8b7"))
274 | "Associating names of nodes with ids")
275 |
276 |
277 | (defun owst-create-work-buffer ()
278 | (unless owst-work-buffer
279 | (setq owst-work-buffer (find-file-noselect owst-ert-work-file)))
280 | (with-current-buffer owst-work-buffer
281 | (setq buffer-save-without-query t)
282 | (auto-save-mode t)
283 | (if (file-exists-p buffer-auto-save-file-name)
284 | (delete-file buffer-auto-save-file-name))
285 | (erase-buffer)
286 | (insert "
287 | * eins
288 | :PROPERTIES:
289 | :ID: 53e15dce-6f28-4674-bd65-e63b516d97ac
290 | :working-set-nodes:
291 | :END:
292 | * zwei
293 | :PROPERTIES:
294 | :ID: 87512329-a204-47e5-b38c-1b22838b6f7d
295 | :END:
296 | *************** Inline
297 | :PROPERTIES:
298 | :ID: 4939f218-d086-49c6-94f6-0f4046111b0f
299 | :END:
300 | *************** END
301 | * drei
302 | :PROPERTIES:
303 | :ID: b77473f3-dba0-4b4f-9db7-3ba095d12de4
304 | :END:
305 | ** vier
306 | :PROPERTIES:
307 | :ID: 2a3d87d0-9ad0-416b-aa22-dea96fede8b7
308 | :END:
309 | ")
310 | (org-mode)
311 | (setq org-working-set-id "53e15dce-6f28-4674-bd65-e63b516d97ac")
312 | owst-work-buffer))
313 |
314 |
315 | (provide 'owst)
316 |
317 | ;; Local Variables:
318 | ;; fill-column: 75
319 | ;; comment-column: 50
320 | ;; End:
321 |
322 | ;;; owst.el ends here
323 |
--------------------------------------------------------------------------------