-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathorg-working-set.el
1297 lines (1086 loc) · 51.6 KB
/
org-working-set.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; org-working-set.el --- Manage and visit a small and changing set of org-nodes that you work on -*- lexical-binding: t; -*-
;; Copyright (C) 2019-2022 Free Software Foundation, Inc.
;; Author: Marc Ihm <marc@ihm.name>
;; URL: https://github.com/marcIhm/org-working-set
;; Version: 2.6.5
;; Package-Requires: ((org "9.3") (dash "2.12") (s "1.12") (emacs "26.3"))
;; This file is not part of GNU Emacs.
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;
;;; Commentary:
;; Purpose:
;;
;; Manage a small subset of org-nodes to visit them with ease.
;;
;; On a busy day org-working-set allows to jump quickly between the nodes
;; associated with different tasks. It provides an answer to the question:
;; What have I been doing before beeing interrupted in the middle of an
;; interruption ?
;;
;; The working-set is a small set of nodes; you may add nodes (which
;; means: their ids) to your working-set, if you want to visit them
;; frequently; the node visited last is called the current node. The
;; working-set is volatile and expected to change each day or even hour.
;;
;; Once you have added nodes to your working set, there are two ways to
;; traverse them (both accessible through the central function
;; `org-working-set'): circling through your working set is the quickest
;; way to return to the current node or visit others; alternatively, the
;; working-set menu produces a editable list of all working-set nodes,
;; allowing visits too.
;;
;; Please note, that org-working-set adds an id-property to all nodes in
;; the working-set; but it does not move or change the nodes in any other
;; way.
;;
;; The list of ids from the nodes of your working-set is stored within the
;; property-drawer of a distinguished node specified via
;; `org-working-set-id'; this node will also collect an ever-growing
;; journal of nodes added to the working-set, which may serve as a
;; reference later.
;;
;;
;; Similar Packages:
;;
;; Depending on your needs you might find these packages interesting too
;; as they provide similar functionality: org-now and org-mru-clock.
;;
;;
;; User-Story:
;;
;; Assume, you come into the office in the morning and start your Emacs
;; with org-mode, because you keep all your notes in org. Yesterday
;; evening you only worked within the org-node 'Feature Request';
;; therefore your working-set only contains this node (which means: its
;; id).
;;
;; So, you invoke the working-set menu (or even quicker, the circle) and
;; jump to the node 'Feature Request' where you continue to work. Short
;; after that, your Boss asks for an urgent status-report. You immediately
;; stop work on 'Feature Request' and find your way to the neglected node
;; 'Status Report', The working set cannot help you to find this node
;; initially, but then you add it for quicker access from now on. Your
;; working set now contains two nodes.
;;
;; Next you attend your scrum-meeting, which means you open the node
;; 'Daily Scrum'. You add it to your working set, because you expect to
;; make short excursions to other nodes and want to come back quickly.
;; After the meeting you remove its node from your working set and
;; continue to work on 'Status Report', which you find through your
;; working-set quickly.
;;
;; When done with the report you have a look at your agenda, and realize
;; that 'Organize Team-Event' is scheduled for today. So you decide to add
;; it to your working-set (in case you get interrupted by a phone call)
;; and start to work on this for an hour or so. The rest of the day passes
;; like this with work, interruptions and task-switches.
;;
;; If this sounds like your typical work-day, you might indeed benefit
;; from org-working-set.
;;
;;
;; Setup:
;;
;; - org-working-set can be installed with package.el
;; - Invoke `org-working-set', it will explain and assist in setting the
;; customizable variable `org-working-set-id'
;; - Optional: Bind `org-working-set' to a key, e.g. C-c w
;;
;;; Change Log:
;; Version 2.6
;;
;; - Allow to add missing files to org-id-files, if an id cannot be found
;; - In circle add commands to terminate on-head / at-end
;; - In Menu allow to go to node without starring it
;;
;; Version 2.5
;;
;; - Allow inline tasks in working set
;; - `kill' as a synonym for `delete'
;; - Use org-mark-ring
;;
;; Version 2.4
;;
;; - todo-state can be changed from working set menu
;; - working set is kept in least-recently-used order
;; - Wrapping org-id-find and org-id-goto more often
;;
;; Version 2.3
;;
;; - Renamed 'log of working-set nodes' into 'journal'
;; - Create org-working-set-dispatch-keymap for easier customization
;; - Reorganized keys (but you may change it if you like)
;; - In-prompt display of settings for clock-in and land-at
;; - Added a 'Fictional User-Story' to the documentation
;; - Running tests under unix
;;
;; Version 2.2
;;
;; - Moved org-id-cleanup to its own package
;; - Improved handling of missing ids in working set
;; - Refactoring
;; - Fixes
;;
;; Version 2.1
;;
;; - Added org-id-cleanup to clean up unreferenced IDs without attachments
;;
;; Version 2.0
;;
;; - Added a log of working set nodes
;; - The node designated by org-working-set-id will be used to store this log
;; - Simplified handling of clocking
;; - Retired property working-set-nodes-do-not-clock
;; - Renamed custom-variable org-working-set-clock-into-working-set into
;; org-working-set-clock-in
;; - Renamed org-working-set-show-working-set-overlay into
;; org-working-set-show-overlay
;; - Renamed org-working-set-goto-bottom-in-working-set into
;; org-working-set-goto-bottom
;;
;; Version 1.1
;;
;; - Moved functions for working set into its own file
;; - Show breadcrumbs in working-set-menu
;; - Prepare for melpa
;;
;;; Code:
(require 'org)
(require 'org-inlinetask)
(require 'dash)
(require 's)
;;; customizable options
(defgroup org-working-set nil
"Options concerning the working-set of org-nodes; see `org-working-set' for details."
:tag "Org Working-set"
:group 'org)
(defcustom org-working-set-id nil
"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."
:group 'org-working-set
:type 'string)
(defcustom org-working-set-clock-in nil
"Clock into nodes of working-set ?"
:group 'org-working-set
:type 'boolean)
(defcustom org-working-set-land-at-end nil
"When visiting a node, land at end ?"
:group 'org-working-set
:type 'boolean)
;;; Variables
(defvar org-working-set--ids nil "Ids of working-set nodes (if any).")
(defvar org-working-set--ids-saved nil "Backup for ‘org-working-set--ids’.")
(defvar org-working-set--id-last-goto nil "Id of last node from working-set, that has been visited.")
(defvar org-working-set--circle-before-marker nil "Marker for position before entry into circle.")
(defvar org-working-set--circle-win-config nil "Window configuration before entry into circle.")
(defvar org-working-set--circle-cancel-transient-function nil "Function to end circle.")
(defvar org-working-set--cancel-timer nil "Timer to cancel waiting for key.")
(defvar org-working-set--overlay nil "Overlay to display name of current working-set node.")
(defvar org-working-set--short-help-wanted nil "Non-nil, if short help should be displayed in working-set menu.")
(defvar org-working-set--id-not-found nil "Id of last node not found.")
(defvar org-working-set--disp-on-error nil "Buffer to display on error.")
(defvar org-working-set--clock-in-curr nil "Current and effecive value of `org-working-set-clock-in'.")
(defvar org-working-set--land-at-end-curr nil "Current and effecive value of `org-working-set-land-at-end'.")
(defun org-working-set--define-keymap (keymap keylist)
"Define Keys given by KEYLIST in KEYMAP."
(dolist (keyentry keylist)
(dolist (key (car keyentry))
(define-key keymap (kbd key) (cdr keyentry))))
keymap)
(defvar org-working-set-dispatch-keymap
(let ((keymap (make-sparse-keymap)))
(org-working-set--define-keymap
keymap
'((("s") . org-working-set--set)
(("a") . org-working-set--add)
(("A") . org-working-set--add-without-remove)
(("d") . org-working-set--delete-from)
(("k") . org-working-set--delete-from)
(("SPC") . org-working-set--menu)
(("TAB" "<tab>") . org-working-set--circle-start)
(("?") . org-working-set--dispatch-toggle-help)
(("j") . org-working-set--journal-enter)
(("c") . org-working-set--dispatch-toggle-clock-in)
(("l") . org-working-set--dispatch-toggle-land-at-end)
(("u") . org-working-set--nodes-restore)
(("C-g" "q") . keyboard-quit))))
"Keymap used for initial dispatch after calling `org-working-set'.")
(defvar org-working-set-circle-keymap
(let ((keymap (make-sparse-keymap)))
(set-keymap-parent keymap org-mode-map)
(org-working-set--define-keymap
keymap
'((("TAB" "<tab>") . org-working-set--circle-forward)
(("c") . org-working-set--circle-toggle-clock-in)
(("l") . org-working-set--circle-toggle-land-at-end)
(("RET" "q") . org-working-set--circle-done)
(("SPC") . org-working-set--circle-switch-to-menu)
(("DEL") . org-working-set--circle-backward)
(("h") . org-working-set--circle-done-at-heading)
(("e") . org-working-set--circle-done-at-end)
(("?") . org-working-set--circle-toggle-help)
(("d") . org-working-set--circle-delete-current)
(("k") . org-working-set--circle-delete-current)
(("C-g" "q") . org-working-set--circle-quit))))
"Keymap used in working set circle.")
(defvar org-working-set-menu-keymap
(let ((keymap (make-sparse-keymap)))
(set-keymap-parent keymap org-mode-map)
(org-working-set--define-keymap
keymap
'((("RET") . org-working-set-menu-go--this-win)
(("SPC") . org-working-set-menu-go--this-win-dont-set)
(("TAB" "<tab>") . org-working-set-menu-go--other-win)
(("p") . org-working-set--menu-peek)
(("d") . org-working-set--menu-delete-entry)
(("k") . org-working-set--menu-delete-entry)
(("t") . org-working-set--menu-todo)
(("u") . org-working-set--menu-undo)
(("q") . org-working-set--menu-quit)
(("c") . org-working-set--menu-toggle-clock-in)
(("l") . org-working-set--menu-toggle-land-at-end)
(("?") . org-working-set--menu-toggle-help)
(("r") . org-working-set--menu-rebuild))))
"Keymap used in working set menu.")
(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.")
(defvar org-working-set--circle-help-strings nil "Short and long help for working set circle; will be initialized from keymap on first call.")
(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.")
(defconst org-working-set--menu-buffer-name "*working-set of org-nodes*" "Name of buffer with list of working-set nodes.")
;; Version of this package
(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.")
;;; The central dispatch function
(defun org-working-set ()
;; Do NOT edit the part of this help-text before version number. It will
;; be overwritten with Commentary-section from beginning of this file.
;; Editing after version number is fine.
;;
;; For Rake: Insert here
"Manage a small subset of org-nodes to visit them with ease.
On a busy day org-working-set allows to jump quickly between the nodes
associated with different tasks. It provides an answer to the question:
What have I been doing before beeing interrupted in the middle of an
interruption ?
The working-set is a small set of nodes; you may add nodes (which
means: their ids) to your working-set, if you want to visit them
frequently; the node visited last is called the current node. The
working-set is volatile and expected to change each day or even hour.
Once you have added nodes to your working set, there are two ways to
traverse them (both accessible through the central function
`org-working-set'): circling through your working set is the quickest
way to return to the current node or visit others; alternatively, the
working-set menu produces a editable list of all working-set nodes,
allowing visits too.
Please note, that org-working-set adds an id-property to all nodes in
the working-set; but it does not move or change the nodes in any other
way.
The list of ids from the nodes of your working-set is stored within the
property-drawer of a distinguished node specified via
`org-working-set-id'; this node will also collect an ever-growing
journal of nodes added to the working-set, which may serve as a
reference later.
Similar Packages:
Depending on your needs you might find these packages interesting too
as they provide similar functionality: org-now and org-mru-clock.
User-Story:
Assume, you come into the office in the morning and start your Emacs
with org-mode, because you keep all your notes in org. Yesterday
evening you only worked within the org-node 'Feature Request';
therefore your working-set only contains this node (which means: its
id).
So, you invoke the working-set menu (or even quicker, the circle) and
jump to the node 'Feature Request' where you continue to work. Short
after that, your Boss asks for an urgent status-report. You immediately
stop work on 'Feature Request' and find your way to the neglected node
'Status Report', The working set cannot help you to find this node
initially, but then you add it for quicker access from now on. Your
working set now contains two nodes.
Next you attend your scrum-meeting, which means you open the node
'Daily Scrum'. You add it to your working set, because you expect to
make short excursions to other nodes and want to come back quickly.
After the meeting you remove its node from your working set and
continue to work on 'Status Report', which you find through your
working-set quickly.
When done with the report you have a look at your agenda, and realize
that 'Organize Team-Event' is scheduled for today. So you decide to add
it to your working-set (in case you get interrupted by a phone call)
and start to work on this for an hour or so. The rest of the day passes
like this with work, interruptions and task-switches.
If this sounds like your typical work-day, you might indeed benefit
from org-working-set.
This is version 2.5.0 of org-working-set.el.
`org-working-set' is the single entry-point; its subcommands allow to:
- Modify the list of nodes (e.g. add nodes or remove others)
- Circle quickly through the nodes
- Show a menu buffer with all nodes currently in the working set"
(interactive)
(unwind-protect
(let (key def text more-text)
(unless org-working-set--dispatch-help-strings
(setq org-working-set--dispatch-help-strings (org-working-set--make-help-strings org-working-set-dispatch-keymap)))
(setq org-working-set--clock-in-curr org-working-set-clock-in)
(setq org-working-set--land-at-end-curr org-working-set-land-at-end)
(if (or (not org-working-set-id)
(string= org-working-set-id ""))
(org-working-set--id-assistant))
(org-working-set--nodes-from-property-if-unset-or-stale)
(while (not text)
(setq def nil)
(while (not def)
(setq key (read-key-sequence
(apply 'format
(org-working-set--format-prompt "org-working-set; " org-working-set--dispatch-help-strings "%s - "))))
(setq def (lookup-key org-working-set-dispatch-keymap key))
(when (or (not def)
(numberp def))
(message "Invalid key: %s" key)
(setq def nil)
(sit-for 1)))
(setq text (funcall def)))
(when (consp text)
(setq more-text (cdr text))
(setq text (car text)))
(org-working-set--nodes-persist)
(setq text (format text (or more-text "") (length org-working-set--ids) (if (cdr org-working-set--ids) "s" "")))
(message (concat (upcase (substring text 0 1)) (substring text 1))))
;; display buffer on error
(when org-working-set--disp-on-error
(pop-to-buffer org-working-set--disp-on-error '((display-buffer-at-bottom)))
(setq org-working-set--disp-on-error nil))))
;;; Smaller functions directly available from dispatch; circle and menu see further down
(defun org-working-set--set ()
"Set working-set to current node."
(unless (string-equal major-mode "org-mode")
(error "This is not an org-buffer"))
(let ((id (org-id-get-create)))
(setq org-working-set--ids-saved org-working-set--ids)
(setq org-working-set--ids (list id))
(setq org-working-set--id-last-goto id)
(org-working-set--clock-in-maybe)
"working-set has been set to current node (1 node)"))
(defun org-working-set--add-without-remove ()
"As normal add but without removing parent or children already in working-set."
(org-working-set--add t))
(defun org-working-set--add (&optional without-remove)
"Add current node to working-set."
(let ((more-text "")
title id ids-up-to-top was-already head)
(unless (string-equal major-mode "org-mode")
(error "This is not an org-buffer"))
(if (org-inlinetask-in-task-p)
(setq id (org-id-get-create) head (org-get-heading t t t t))
(org-with-limited-levels
(setq id (org-id-get-create) head (org-get-heading t t t t))))
(setq title (org-format-outline-path
(cons head (reverse (org-get-outline-path)))
most-positive-fixnum nil " / "))
(if (member id org-working-set--ids)
(setq was-already t)
(setq org-working-set--ids-saved org-working-set--ids)
;; before adding, remove any children of new node, that are already in working-set
;; i.e. remove all nodes from working set that have the new node as any of their parents
(unless without-remove
(setq org-working-set--ids
(delete nil (mapcar (lambda (wid)
(if (member id
;; compute all parents of working set node id wid
(org-with-point-at (org-working-set--id-find wid t)
(org-working-set--ids-up-to-top)))
;; if new node is parent of a node already in working set
(progn
(setq more-text ", removing its children")
nil) ; do not keep this node from working set
wid)) ; keep it
org-working-set--ids)))
;; remove any parents of new node, that are already in working-set
(setq ids-up-to-top (org-working-set--ids-up-to-top))
(when (-intersection ids-up-to-top org-working-set--ids)
(setq org-working-set--ids (-difference org-working-set--ids ids-up-to-top))
(setq more-text (concat more-text ", replacing its parent"))))
;; finally add new node to working-set
(setq org-working-set--ids (cons id org-working-set--ids))
(org-working-set--journal-add id title))
(setq org-working-set--id-last-goto id)
(org-working-set--clock-in-maybe)
(cons
(concat
(if was-already
"current node is already part of working-set%s (%d node%s)"
"current node has been appended to working-set%s (%d node%s)")
(propertize (concat ": " head) 'face 'org-agenda-dimmed-todo-face))
more-text)))
(defun org-working-set--delete-from (&optional id)
"Delete current node from working-set.
Optional argument ID gives the node to delete."
(setq id (or id (org-id-get)))
(format
(if (and id (member id org-working-set--ids))
(progn
(if (string= id org-working-set--id-last-goto) (setq org-working-set--id-last-goto nil))
(setq org-working-set--ids-saved org-working-set--ids)
(setq org-working-set--ids (delete id org-working-set--ids))
"Current node has been removed from working-set (%d node%s)")
"Current node has not been in working-set (%d node%s)")
(length org-working-set--ids) (if org-working-set--ids "s" "")))
(defun org-working-set--journal-enter ()
"Enter journal of working set nodes and position cursor on first link."
(org-id-goto org-working-set-id)
(recenter 1)
(org-end-of-meta-data t)
(org-working-set--unfold-buffer t)
(search-forward "[" (line-end-position) t 2)
"log of additions to working set")
(defun org-working-set--dispatch-toggle-help ()
"Show help."
(interactive)
(setq org-working-set--short-help-wanted
(not org-working-set--short-help-wanted))
nil)
(defun org-working-set--nodes-restore (&optional upcase)
"Restore previously saved working-set.
Optional argument UPCASE modifies the returned message."
(let (txt)
(if org-working-set--ids-saved
(progn
(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" "")))
(setq org-working-set--ids org-working-set--ids-saved))
(setq txt "No saved working-set nodes to restore, nothing to do"))
(if upcase (concat (upcase (substring txt 0 1))
(substring txt 1)
".")
txt)))
(defun org-working-set--dispatch-toggle-clock-in ()
"Toggle between clocking in and not."
(interactive)
(setq org-working-set--clock-in-curr (not org-working-set--clock-in-curr))
nil)
(defun org-working-set--dispatch-toggle-land-at-end ()
"Toggle between landing at head or end."
(interactive)
(setq org-working-set--land-at-end-curr (not org-working-set--land-at-end-curr))
nil)
;;; Functions for the working set circle
(defun org-working-set--circle-start ()
"Go through working-set, one node after the other."
(unless org-working-set--ids (error "No nodes in working-set; please add some first"))
(unless org-working-set--circle-help-strings
(setq org-working-set--circle-help-strings (org-working-set--make-help-strings org-working-set-circle-keymap)))
(setq org-working-set--short-help-wanted nil)
(setq org-working-set--circle-before-marker (point-marker))
(setq org-working-set--circle-win-config (current-window-configuration))
(setq org-working-set--circle-cancel-transient-function
(set-transient-map
org-working-set-circle-keymap t
;; this is run (in any case) on leaving the map
(lambda ()
(if org-working-set--cancel-timer
(cancel-timer org-working-set--cancel-timer))
(message nil)
(org-working-set--remove-tooltip-overlay)
(let (keys)
;; save and repeat terminating key, because org-clock-in might read interactively
(if (input-pending-p) (setq keys (read-key-sequence nil)))
(ignore-errors (org-working-set--clock-in-maybe))
(if keys (setq unread-command-events (listify-key-sequence keys))))
(when org-working-set--circle-before-marker
(move-marker org-working-set--circle-before-marker nil)
(setq org-working-set--circle-before-marker nil)))))
;; first move
(message (concat (org-working-set--circle-continue t) " - ")))
(defun org-working-set--circle-forward ()
"Move forward."
(interactive)
(setq this-command last-command)
(message (concat (org-working-set--circle-continue) " - ")))
(defun org-working-set--circle-backward ()
"Move backward."
(interactive)
(setq this-command last-command)
(message (concat (org-working-set--circle-continue nil t) " - ")))
(defun org-working-set--circle-toggle-clock-in ()
"Toggle clocking."
(interactive)
(setq org-working-set--clock-in-curr (not org-working-set--clock-in-curr))
(message (concat (org-working-set--circle-continue t) " - ")))
(defun org-working-set--circle-toggle-land-at-end ()
"Toggle between landing at head or end."
(interactive)
(setq org-working-set--land-at-end-curr (not org-working-set--land-at-end-curr))
(if org-working-set--land-at-end-curr
(org-working-set--put-tooltip-overlay)
(org-working-set--remove-tooltip-overlay))
(message (concat (org-working-set--circle-continue t) " - ")))
(defun org-working-set--circle-switch-to-menu ()
"Leave working set circle and enter menu."
(interactive)
(message "Switching to menu")
(org-working-set--remove-tooltip-overlay)
(run-with-timer 0 nil 'org-working-set--menu))
(defun org-working-set--circle-done ()
"Finish regularly."
(interactive)
(message "Circle done.")
(org-working-set--remove-tooltip-overlay))
(defun org-working-set--circle-done-at-heading ()
"Finish regularly and go back to heading."
(interactive)
(message "Circle done; at heading.")
(org-working-set--remove-tooltip-overlay)
(org-with-limited-levels
(org-back-to-heading)))
(defun org-working-set--circle-done-at-end ()
"Finish regularly and go back to end."
(interactive)
(message "Circle done; at end.")
(org-working-set--remove-tooltip-overlay)
(org-working-set--end-of-node))
(defun org-working-set--circle-toggle-help ()
"Show help."
(interactive)
(setq org-working-set--short-help-wanted
(not org-working-set--short-help-wanted))
(message (org-working-set--circle-continue t)))
(defun org-working-set--circle-delete-current ()
"Delete current entry."
(interactive)
(setq this-command last-command)
(org-working-set--nodes-persist)
(message (concat (org-working-set--delete-from) " "
(org-working-set--circle-continue)
" - ")))
(defun org-working-set--circle-quit ()
"Leave circle and return to prior node."
(interactive)
(if org-working-set--circle-before-marker ; proper cleanup of marker will happen in cancel-transient function
(org-goto-marker-or-bmk org-working-set--circle-before-marker))
(when org-working-set--circle-win-config
(set-window-configuration org-working-set--circle-win-config)
(setq org-working-set--circle-win-config nil))
(org-working-set--remove-tooltip-overlay)
(message "Quit")
(if org-working-set--circle-cancel-transient-function
(funcall org-working-set--circle-cancel-transient-function)))
(defun org-working-set--circle-continue (&optional stay back)
"Continue with working set circle after start.
Optional argument STAY prevents changing location.
Optional argument BACK"
(let (last-id following-id previous-id target-id parent-ids)
;; compute target
(setq last-id (or org-working-set--id-last-goto
(car (last org-working-set--ids))))
(setq following-id (car (or (cdr-safe (member last-id
(append org-working-set--ids org-working-set--ids)))
org-working-set--ids)))
(if back
(setq previous-id (car (or (cdr-safe (member last-id
(reverse (append org-working-set--ids org-working-set--ids))))
org-working-set--ids))))
(setq target-id (if stay last-id (if back previous-id following-id)))
(setq parent-ids (org-working-set--ids-up-to-top)) ; remember this before changing location
;; bail out on inactivity
(if org-working-set--cancel-timer
(cancel-timer org-working-set--cancel-timer))
(setq org-working-set--cancel-timer
(run-at-time 30 nil
(lambda () (if org-working-set--circle-cancel-transient-function
(funcall org-working-set--circle-cancel-transient-function)))))
(org-working-set--goto-id target-id)
(setq org-working-set--id-last-goto target-id)
(if org-working-set--land-at-end-curr
(org-working-set--put-tooltip-overlay))
;; Compose return message:
(apply 'format
(org-working-set--format-prompt
(concat
"In circle, "
;; explanation
(format (cond (stay
"returning to %slast")
((member target-id parent-ids)
"staying below %scurrent")
(t
(concat "at %s" (if back "previous" "next"))))
(if org-working-set--land-at-end-curr "end of " ""))
;; count of nodes
(if (cdr org-working-set--ids)
(format " node (%s); " (org-working-set--out-of-clause target-id))
(format " single node; ")))
org-working-set--circle-help-strings))))
;;; Functions for the working set menu
(defun org-working-set--menu ()
"Show menu to let user choose among and manipulate list of working-set nodes."
(unless org-working-set--ids (error "No nodes in working-set; please add some first"))
(unless org-working-set--menu-help-strings
(setq org-working-set--menu-help-strings (org-working-set--make-help-strings org-working-set-menu-keymap)))
(setq org-working-set--short-help-wanted nil)
(pop-to-buffer org-working-set--menu-buffer-name '((display-buffer-at-bottom)))
(org-working-set--menu-rebuild t t)
(use-local-map org-working-set-menu-keymap)
"Buffer with nodes of working-set")
(defun org-working-set-menu-go--this-win ()
"Go to node specified by line under cursor in this window."
(interactive)
(org-working-set-menu-go nil t))
(defun org-working-set-menu-go--this-win-dont-set ()
"Go to node specified by line under cursor in this window, but do not star."
(interactive)
(org-working-set-menu-go nil nil))
(defun org-working-set-menu-go--other-win ()
"Go to node specified by line under cursor in other window."
(interactive)
(org-working-set-menu-go t t))
(defun org-working-set-menu-go (other-win set-last-id)
"Go to node specified by line under cursor.
The Boolean arguments OTHER-WIN goes to node in other window."
(let ((id (org-working-set--menu-get-id)))
(if other-win
(progn
(other-window 1)
(org-working-set--goto-id id))
(if (> (count-windows) 1) (delete-window))
(org-working-set--goto-id id))
(when set-last-id
(setq org-working-set--id-last-goto id)
;; put id in front of list
(setq org-working-set--ids (cons id (delete id org-working-set--ids))))
(org-working-set--clock-in-maybe)
(org-working-set--nodes-persist)))
(defun org-working-set--menu-peek ()
"Peek into node specified by line under cursor."
(interactive)
(save-window-excursion
(save-excursion
(org-working-set--goto-id (org-working-set--menu-get-id))
(delete-other-windows)
(read-char "Peeking into node, any key to return." nil 10))))
(defun org-working-set--menu-delete-entry ()
"Delete node under cursor from working set."
(interactive)
(message (org-working-set--delete-from (org-working-set--menu-get-id)))
(org-working-set--nodes-persist)
(org-working-set--menu-rebuild))
(defun org-working-set--menu-todo ()
"Set todo state for node under cursor."
(interactive)
(save-window-excursion
(org-id-goto (org-working-set--menu-get-id))
(recenter 1)
(org-todo))
(org-working-set--menu-rebuild))
(defun org-working-set--menu-undo ()
"Undo last modification to working set."
(interactive)
(message (org-working-set--nodes-restore))
(org-working-set--nodes-persist)
(org-working-set--menu-rebuild t))
(defun org-working-set--menu-quit ()
"Quit menu."
(interactive)
(delete-windows-on org-working-set--menu-buffer-name)
(kill-buffer org-working-set--menu-buffer-name))
(defun org-working-set--menu-toggle-help ()
"Show help."
(interactive)
(setq org-working-set--short-help-wanted
(not org-working-set--short-help-wanted))
(org-working-set--menu-rebuild t))
(defun org-working-set--menu-toggle-clock-in ()
"Toggle between clocking in and not in working set menu."
(interactive)
(setq org-working-set--clock-in-curr (not org-working-set--clock-in-curr))
(org-working-set--menu-rebuild t))
(defun org-working-set--menu-toggle-land-at-end ()
"Toggle between landing at head or end."
(interactive)
(setq org-working-set--land-at-end-curr (not org-working-set--land-at-end-curr))
(org-working-set--menu-rebuild t))
(defun org-working-set--advice-for-org-id-update-id-locations (_orig-func &rest _args)
"Advice that moderates use of `org-id-update-id-location' for `org-working-set--menu-rebuild'."
(org-working-set--ask-and-handle-stale-id))
(defun org-working-set--menu-rebuild (&optional resize go-top)
"Rebuild content of menu-buffer.
Optional argument RESIZE adjusts window size.
Optional argument GO-TOP goes to top of new window, rather than keeping current position."
(interactive)
(let (cursor-here prev-help-len this-help-len lb pparts)
(org-working-set--nodes-from-property-if-unset-or-stale)
(with-current-buffer (get-buffer-create org-working-set--menu-buffer-name)
(set (make-local-variable 'line-move-visual) nil)
(setq buffer-read-only nil)
(setq cursor-here (point))
(setq prev-help-len (next-property-change (point-min)))
(cursor-intangible-mode)
(erase-buffer)
(setq pparts (org-working-set--format-prompt "" org-working-set--menu-help-strings ", * marks last visited%s"))
(insert
(apply 'format
(flatten-list
(list (propertize
(car pparts)
'face 'org-agenda-dimmed-todo-face
'cursor-intangible t
'front-sticky t)
(mapcar (lambda (x) (propertize x 'face 'default)) (cdr pparts))))))
(setq this-help-len (next-property-change (point-min)))
(insert "\n\n")
(if go-top (setq cursor-here (point)))
(if org-working-set--ids
(mapc (lambda (id)
(let (heads olpath)
(save-window-excursion
(org-working-set--id-goto id)
(setq olpath (org-format-outline-path
(reverse (org-get-outline-path)) most-positive-fixnum nil " / "))
(setq heads (concat (substring-no-properties (or (org-get-heading) "?"))
(if (> (length olpath) 0)
(propertize (concat " / " olpath)
'face 'org-agenda-dimmed-todo-face)
""))))
(insert (format "%s %s" (if (eq id org-working-set--id-last-goto) "*" " ") heads))
(setq lb (line-beginning-position))
(insert "\n")
(put-text-property lb (point) 'org-working-set-id id)))
org-working-set--ids)
(insert " No nodes in working-set.\n"))
(if (or go-top (not prev-help-len))
(goto-char cursor-here)
(goto-char (+ cursor-here (- this-help-len prev-help-len))))
(when resize
(ignore-errors
(fit-window-to-buffer (get-buffer-window))
(enlarge-window 1)))
(setq buffer-read-only t))))
(defun org-working-set--menu-get-id ()
"Extract id from current line in working-set menu."
(or (get-text-property (point) 'org-working-set-id)
(error "This line does not point to a node from working-set")))
;;; General helper functions
(defun org-working-set--insert-files (files)
"Insert given list of FILES into current buffer using full window width."
(let ((tab-stop-list '(2 42 82)))
(dolist (name files)
(if (> (+ (indent-next-tab-stop (current-column))
(length name))
(- (window-width) 10))
(insert "\n"))
(tab-to-tab-stop)
(insert name))))
(defun org-working-set--id-find (id &optional markerp)
"Wrapper for org-id-find, that does not go stale during rebuild of org-id-locations"
(let (retval)
(setq org-working-set--id-not-found id)
(unwind-protect
(progn
(advice-add 'org-id-update-id-locations :around #'org-working-set--advice-for-org-id-update-id-locations)
(setq retval (org-id-find id markerp)))
(advice-remove 'org-id-update-id-locations #'org-working-set--advice-for-org-id-update-id-locations))
(setq org-working-set--id-not-found nil)
retval))
(defun org-working-set--id-goto (id)
"Wrapper for org-id-goto, that does not go stale during rebuild of org-id-locations"
(setq org-working-set--id-not-found id)
(unwind-protect
(progn
(advice-add 'org-id-update-id-locations :around #'org-working-set--advice-for-org-id-update-id-locations)
(org-id-goto id))
(advice-remove 'org-id-update-id-locations #'org-working-set--advice-for-org-id-update-id-locations))
(org-working-set--check-id id)
(setq org-working-set--id-not-found nil))
(defun org-working-set--goto-id (id)
"Goto node with given ID and unfold"
(let (marker)
(setq marker (org-working-set--id-find id 'marker))
(unless marker
(setq org-working-set--id-last-goto nil)
(error "Could not find working-set node with id %s" id))
(pop-to-buffer-same-window (marker-buffer marker))
(goto-char (marker-position marker))
(org-working-set--unfold-buffer)
(org-mark-ring-push)
(move-marker marker nil)
(org-working-set--check-id id)
(if (and org-working-set--land-at-end-curr
(not (org-inlinetask-in-task-p)))
(progn
(org-working-set--end-of-node)
(recenter -1))
(recenter 1))))
(defun org-working-set--check-id (id)
"Check, if we really arrived there"
(let ((maybe (if (buffer-narrowed-p) (format " (maybe because buffer %s is narrowed)" (buffer-name)) "")))
(unless (org-id-get)
(error "Did not arrive at node with id '%s'%s" id maybe))
(unless (string= id (org-id-get))
(error "Node with id '%s' was found, but 'goto' did not succeed%s" id maybe))))
(defun org-working-set--end-of-node ()
"Goto end of current node, ignore inline-tasks but stop at first child."
(let (level (pos (point)))
(when (ignore-errors (org-with-limited-levels (org-back-to-heading)))