-
Notifications
You must be signed in to change notification settings - Fork 5
/
org-dp.el
1402 lines (1260 loc) · 43.5 KB
/
org-dp.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-dp.el --- Declarative Local Programming with Org Elements
;; Author: Thorsten Jolitz <tjolitz AT gmail DOT com>
;; Version: 1.0
;; URL: https://github.com/tj64/org-dp
;; Package-Requires: ((cl-lib "0.5"))
;;;; MetaData
;; :PROPERTIES:
;; :copyright: Thorsten Jolitz
;; :copyright-years: 2014+
;; :version: 1.0
;; :licence: GPL 3 or later (free software)
;; :licence-url: http://www.gnu.org/licenses/
;; :part-of-emacs: no
;; :author: Thorsten Jolitz
;; :author_email: tjolitz AT gmail DOT com
;; :keywords: emacs org-mode org-elements declarative-programming
;; :git-repo: https://github.com/tj64/org-dp
;; :git-clone: git://github.com/tj64/org-dp.git
;; :END:
;;;; Commentary
;; Functions for declarative local programming with Org elements. They
;; allow to declare what should be done and leave the low-level work,
;; the "how-to", to the Org parser/interpreter framework.
;; With other words, org-dp acts on the internal representation of Org
;; elements rather than on their textual representation, and leaves
;; the transformation between both representations to the
;; parser/interpreter framework. To create or modify an element, you
;; call the parser to open it up, rewire its internals, and then call
;; the interpreter to build the element again based on its modified
;; internals.
;; Since all Org elements are uniformely represented as nested lists
;; internally, with their properties stored as key-val pairs in
;; plists, they can be treated in a much more uniform way when dealing
;; with the internal representation instead of the highly variable
;; textual representations. A big advantage of plists is that only
;; those properties that are actually accessed matter, so when
;; transforming one Org element into another on the internal level one
;; does not have to worry about not matching properties as long as
;; these are not used by the interpreter when building the textual
;; representation of the transformed element.
;; Library org-dp is meant for programming at the local level,
;; i.e. without any (contextual) information except those about the
;; parsed element at point. It is designed to make using the Org-mode
;; parser/interpreter framework at local level as convenient as using
;; it at the global level (with a complete parse-tree produced by
;; `org-element-parse-buffer` available). It takes care of the
;; org-element caching mechanism in that it only acts on copies of the
;; locally parsed elements at point, never on the original parsed (and
;; cached) object itself.
;;;; Usage
;; This library introduces a few 'public' functions
;; - `org-dp-create' :: create a new Org element by building its
;; internal representation
;; - `org-dp-rewire' :: modify (and maybe transform) an existing Org
;; element by changing its internal representation
;; - `org-dp-map' :: map elements in a buffer and 'rewire' them
;; and 1 command as generic UI
;; - `org-dp-prompt' :: universal function for getting user info
;; The following more 'private' functions and commands are used by the
;; core/UI functions, but might be useful by themselves
;; - `org-dp-contents' :: get content of (local) element
;; - `org-dp-in' :: return position-info if inside element, nil
;; otherwise (not yet implemented)
;; - `org-dp-prompt-all' :: workhorse function for prompting the user
;; - `org-dp-prompt-for-src-block-props' :: prompt user for src-block
;; properties (adapted from ob-core.el)
;; Note that the src-block parameters are appended to the src-block's
;; headline. If you rather want them as separate #+header: lines on
;; top of the src-block you can use `org-dp-toggle-headers' from
;; org-dp-lib.el for swapping headers and parameters.
;;;; Examples
;;;;; Create Src-Block
;; : #+BEGIN_SRC emacs-lisp
;; : (org-dp-create 'src-block nil nil
;; : '(:name "ex1" :header (":cache no" ":noweb yes"))
;; : :language "picolisp"
;; : :preserve-indent 1
;; : :parameters ":results value"
;; : :value "(+ 2 2)")
;; : #+END_SRC
;; #+results:
;; : #+NAME: ex1
;; : #+HEADER: :noweb yes
;; : #+HEADER: :cache no
;; : #+BEGIN_SRC picolisp :results value
;; : (+ 2 2)
;; : #+END_SRC
;;;;; Transform Src-Block into Example Block
;; : #+NAME: ex2
;; : #+HEADER: :results raw
;; : #+BEGIN_SRC emacs-lisp :exports both
;; : (org-dp-rewire 'example-block)
;; : #+END_SRC
;; : #+results: ex2
;; : #+BEGIN_EXAMPLE
;; : (org-dp-rewire 'example-block)
;; : #+END_EXAMPLE
;;;;; Transform Src-Block into Headline
;; : #+NAME: ex2
;; : #+HEADER: :results raw
;; : #+BEGIN_SRC emacs-lisp :cache no :noweb yes
;; : (org-dp-rewire 'headline
;; : (lambda (_cont_ elem)
;; : (concat
;; : "This was an\n\n"
;; : (org-element-property :language elem)
;; : "\n\nsrc-block with header args\n\n"
;; : (org-element-property :parameters elem)
;; : "\n\nbefore."))
;; : 'append '(:name "transformed Src-Block")
;; : :level 1
;; : :title (lambda (_old_ elem)
;; : (mapconcat
;; : 'upcase
;; : (split-string
;; : (car
;; : (org-element-property :header elem))
;; : ":")
;; : " "))
;; : :tags (lambda (_old_ elem)
;; : (list (org-element-property :name elem)))
;; : :header nil)
;; : #+END_SRC
;; : #+NAME: transformed Src-Block
;; : * RESULTS RAW :ex2:
;; : This was an
;; :
;; : emacs-lisp
;; :
;; : src-block with header args
;; :
;; : :cache no :noweb yes
;; :
;; : before.
;;; Requires
;; (eval-when-compile
;; (require 'cl))
(require 'cl-lib)
(require 'ox)
(require 'tempo)
;;; Variables
;;;; Consts
(defconst org-dp-elem-props
(list
'(center-block . (contents))
'(drawer . (:drawer-name contents))
'(dynamic-block . (:block-name :arguments contents))
'(footnote-definition . (:label contents))
'(headline . (:level :todo-keyword :priority :title :archivedp
:tags :commentedp :pre-blank
:footnote-section-p contents))
'(inline-task . (:level :todo-keyword :priority :title :tags
contents))
'(item . (:bullet :checkbox :counter :tag contents))
'(plain-list . (contents))
'(property-drawer . (contents))
'(quote-block . (contents))
'(section . (contents))
'(special-block . (:type contents))
'(babel-call . (:value))
'(clock . (:value :duration))
'(comment . (:value))
'(comment-block . (:value))
'(diary-sexp . (:value))
'(example-block . (:switches :preserve-indent :value))
'(fixed-width . (:value))
'(horizontal-rule . nil)
'(keyword . (:key :value))
'(latex-environment . (:value))
'(node-property . (:key :value))
'(paragraph . (contents))
'(planning . (:deadline :scheduled :closed))
'(src-block . (:language :switches :parameters :value
:preserve-indent))
'(table . (:type :value :tblfm contents)) ; :value when table.el
'(table-row . (:type contents))
'(verse-block . (contents)))
"AList of elements and their interpreted properties.")
(defconst org-dp-inline-elems
(list 'babel-call 'footnote-definition 'inline-task 'table-cell)
"List of Org elements and objects that not necessarily start with a newline.")
(defconst org-dp-no-content-elems
(list 'babel-call 'clock 'comment 'comment-block 'diary-sexp
'example-block 'fixed-width 'horizontal-rule 'keyword
'latex-environment 'node-property 'planning 'src-block)
"List of Org elements without interpreted .")
(defconst org-dp-value-blocks
(list 'comment-block 'example-block 'src-block)
"List of Org block that have a :value instead of contents.")
(defconst org-dp-affiliated-keys
(list :caption :data :header :headers :label :name :plot :resname
:result :results :source :srcname :tblname)
"List of all `org-element-affiliated-keywords' as downcased
keywords, including deprecated old keywords that are mapped
to new keywords in `org-element-keyword-translation-alist'.")
(defconst org-dp-single-keys
(list :name :plot :results)
"Selection of downcased keywords from
`org-element-affiliated-keywords', namely those new keywords
not member of `org-dp-multiple-keys', `org-dp-parsed-keys' or
`org-dp-dual-keys'.")
(defconst org-dp-multiple-keys
(list :header :caption)
"Downcased keywords from `org-element-multiple-keywords'.")
(defconst org-dp-parsed-keys
(list :caption)
"Downcased keywords from `org-element-parsed-keywords'.")
(defconst org-dp-dual-keys
(list :caption :results)
"Downcased keywords from `org-element-dual-keywords'.")
(defconst org-dp-apply-funs '(create rewire)
"Functions that can be applied in `org-dp-apply'.")
;;;; Customs
;;;;; Custom Groups
(defgroup org-dp nil
"Declarative Programming with Org Elements."
:prefix "org-dp"
:group 'lisp
:link '(url-link "https://github.com/tj64/org-dp"))
;;;;; Custom Vars
;; (defcustom org-dp-default-babel-lang "emacs-lisp"
;; "Default Babel language used for new src-blocks."
;; :group 'org-dp
;; :type 'string)
;;;; Vars
(defvar org-dp-tempo-elem-type ""
"Variable used to store user input in tempo templates.
Input is the Org Element type, e.g. 'src-block.")
(defvar org-dp-tempo-create-with-comments-elem-props
'(case (intern org-dp-tempo-elem-type)
(drawer
'(l ":drawer-name " "\"" p "\"" n> ))
(dynamic-block
'(l ":block-name " "\"" p "\"" n>
":arguments " "\"" p "\"" n>))
(footnote-definition
'(l ":label " "\"" p "\"" n> ))
(headline
'(l ":level " p "1 ;1..8" n>
":priority " p "nil ;65|66|67" n>
":todo-keyword " p "TODO" n>
":title " "\"" p "\"" n>
":tags " "'(" p " ) ;(\"tag1\" \"tag2\")" n>
":commentedp " p "nil ;t" n>
":pre-blank " p "0" n>
":footnote-section-p " p "nil ;t" n>))
(inline-task
'(l ":level " p "1 ;1..8" n>
":priority " p "nil ;65|66|67" n>
":todo-keyword " p "TODO" n>
":title " "\"" p "\"" n>
":tags " "'(" p " ) ;(\"tag1\" \"tag2\")" n>))
(item
'(l ":bullet " "\"" p "\"" n>
":checkbox " "\"" p "\"" n>
":counter " "\"" p "\"" n>
":tag " "\"" p "\"" n> ))
(special-block
'(l ":type " "\"" p "\"" n> ))
(babel-call
'(l ":value " "\"" p "\"" n> ))
(clock
'(l ":value " "\"" p "\"" n>
":duration " "\"" p "\"" n>))
(comment
'(l ":value " "\"" p "\"" n> ))
(comment-block
'(l ":value " "\"" p "\"" n> ))
(diary-sexp
'(l ":value " "\"" p "\"" n> ))
(example-block
'(l ":switches " "\"" p "\"" n>
":preserve-indent " "\"" p "\"" n>
":value " "\"" p "\"" n> ))
(fixed-width
'(l ":value " "\"" p "\"" n> ))
(keyword
'(l ":key " "\"" p "\"" n>
":value " "\"" p "\"" n>))
(latex-environment
'(l ":value " "\"" p "\"" n> ))
(node-property
'(l ":key " "\"" p "\"" n>
":value " "\"" p "\"" n>))
(planning
'(l ":deadline " "\"" p "\"" n>
":scheduled " "\"" p "\"" n>
":closed " "\"" p "\"" n>))
(src-block
'(l ":language " "\"" p "\"" n>
":switches " "\"" p "\"" n>
":parameters " "\"" p "\"" n>
":value " "\"" p "\"" n>
":preserve-indent " "\"" p "\"" n>))
(table
'(l ":type " "\"" p "\"" n>
":value " "\"" p "\"" n>
":tblfm " "\"" p "\"" n>))
(table-row
'(l ":type " "\"" p "\"" n> ))
;; plain-list, property-drawer, quote-block, section,
;; horizontal rule, paragraph
(t nil))
"Variable holding element properties for org-dp-create tempo
template.")
(defvar org-dp-tempo-create-elem-props
'(case (intern org-dp-tempo-elem-type)
(drawer
'(l ":drawer-name " "\"" p "\"" n> ))
(dynamic-block
'(l ":block-name " "\"" p "\"" n>
":arguments " "\"" p "\"" n>))
(footnote-definition
'(l ":label " "\"" p "\"" n> ))
(headline
'(l ":level " p "1 ;1..8" n>
":priority " p "nil ;65|66|67" n>
":todo-keyword " p "TODO" n>
":title " "\"" p "\"" n>
":tags " "'(" p " )" n>
":commentedp " p "nil" n>
":pre-blank " p "0" n>
":footnote-section-p " p "nil" n>))
(inline-task
'(l ":level " p "1 ;1..8" n>
":priority " p "nil ;65|66|67" n>
":todo-keyword " p "TODO" n>
":title " "\"" p "\"" n>
":tags " "'(" p " )" n>))
(item
'(l ":bullet " "\"" p "\"" n>
":checkbox " "\"" p "\"" n>
":counter " "\"" p "\"" n>
":tag " "\"" p "\"" n> ))
(special-block
'(l ":type " "\"" p "\"" n> ))
(babel-call
'(l ":value " "\"" p "\"" n> ))
(clock
'(l ":value " "\"" p "\"" n>
":duration " "\"" p "\"" n>))
(comment
'(l ":value " "\"" p "\"" n> ))
(comment-block
'(l ":value " "\"" p "\"" n> ))
(diary-sexp
'(l ":value " "\"" p "\"" n> ))
(example-block
'(l ":switches " "\"" p "\"" n>
":preserve-indent " "\"" p "\"" n>
":value " "\"" p "\"" n> ))
(fixed-width
'(l ":value " "\"" p "\"" n> ))
(keyword
'(l ":key " "\"" p "\"" n>
":value " "\"" p "\"" n>))
(latex-environment
'(l ":value " "\"" p "\"" n> ))
(node-property
'(l ":key " "\"" p "\"" n>
":value " "\"" p "\"" n>))
(planning
'(l ":deadline " "\"" p "\"" n>
":scheduled " "\"" p "\"" n>
":closed " "\"" p "\"" n>))
(src-block
'(l ":language " "\"" p "\"" n>
":switches " "\"" p "\"" n>
":parameters " "\"" p "\"" n>
":value " "\"" p "\"" n>
":preserve-indent " "\"" p "\"" n>))
(table
'(l ":type " "\"" p "\"" n>
":value " "\"" p "\"" n>
":tblfm " "\"" p "\"" n>))
(table-row
'(l ":type " "\"" p "\"" n> ))
;; plain-list, property-drawer, quote-block, section,
;; horizontal rule, paragraph
(t nil))
"Variable holding element properties for org-dp-create tempo
template.")
(defvar org-dp-tempo-rewire-elem-props
'(case (intern org-dp-tempo-elem-type)
(drawer
'(l ":drawer-name '(lambda (old elem) (" p " ))" n> ))
(dynamic-block
'(l ":block-name '(lambda (old elem) " p " )" n>
":arguments '(lambda (old elem) " p " )" n>))
(footnote-definition
'(l ":label '(lambda (old elem) " p " )" n> ))
(headline
'(l ":level '(lambda (old elem) " p " )" n>
":priority '(lambda (old elem) " p " )" n>
":todo-keyword '(lambda (old elem) " p " )" n>
":title '(lambda (old elem) " p " )" n>
":tags '(lambda (old elem) " p " )" n>
":commentedp '(lambda (old elem) " p " )" n>
":pre-blank '(lambda (old elem) " p " )" n>
":footnote-section-p '(lambda (old elem) " p " )" n>))
(inline-task
'(l ":level '(lambda (old elem) " p " )" n>
":priority '(lambda (old elem) " p " )" n>
":todo-keyword '(lambda (old elem) " p " )" n>
":title '(lambda (old elem) " p " )" n>
":tags '(lambda (old elem) " p " )" n> ))
(item
'(l ":bullet '(lambda (old elem) " p " )" n>
":checkbox '(lambda (old elem) " p " )" n>
":counter '(lambda (old elem) " p " )" n>
":tag '(lambda (old elem) " p " )" n> ))
(special-block
'(l ":type '(lambda (old elem) " p " )" n> ))
(babel-call
'(l ":value '(lambda (old elem) " p " )" n> ))
(clock
'(l ":value '(lambda (old elem) " p " )" n>
":duration '(lambda (old elem) " p " )" n>))
(comment
'(l ":value '(lambda (old elem) " p " )" n> ))
(comment-block
'(l ":value '(lambda (old elem) " p " )" n> ))
(diary-sexp
'(l ":value '(lambda (old elem) " p " )" n> ))
(example-block
'(l ":switches '(lambda (old elem) " p " )" n>
":preserve-indent '(lambda (old elem) " p " )" n>
":value '(lambda (old elem) " p " )" n> ))
(fixed-width
'(l ":value '(lambda (old elem) " p " )" n> ))
(keyword
'(l ":key '(lambda (old elem) " p " )" n>
":value '(lambda (old elem) " p " )" n>))
(latex-environment
'(l ":value '(lambda (old elem) " p " )" n> ))
(node-property
'(l ":key '(lambda (old elem) " p " )" n>
":value '(lambda (old elem) " p " )" n>))
(planning
'(l ":deadline '(lambda (old elem) " p " )" n>
":scheduled '(lambda (old elem) " p " )" n>
":closed '(lambda (old elem) " p " )" n>))
(src-block
'(l ":language '(lambda (old elem) " p " )" n>
":switches '(lambda (old elem) " p " )" n>
":parameters '(lambda (old elem) " p " )" n>
":value '(lambda (old elem) " p " )" n>
":preserve-indent '(lambda (old elem) " p " )" n>))
(table
'(l ":type '(lambda (old elem) " p " )" n>
":value '(lambda (old elem) " p " )" n>
":tblfm '(lambda (old elem) " p " )" n>))
(table-row
'(l ":type '(lambda (old elem) " p " )" n> ))
;; plain-list, property-drawer, quote-block, section,
;; horizontal rule, paragraph
(t nil))
"Variable holding element properties for org-dp-rewire tempo
template.")
(defvar org-dp-tempo-cont ""
"Variable holding element content for tempo templates.")
;;; Functions
;;;; Core Functions
(cl-defun org-dp-create (elem-type &optional contents insert-p affiliated &rest args)
"Create Org element of type ELEM-TYPE (headline by default).
Depending on its type, CONTENTS is used as the element's content
or value.
If INSERT-P is nil, return interpreted string. If its value is
the symbol 'data', return the raw data, otherwise, for any other
non-nil value, insert interpreted element at point.
AFFILIATED should be a plist of affiliated keys and values if
given.
If ARGS are given, they should be key-value pairs
of (interpreted) properties for ELEM-TYPE (see
`org-dp-elem-props' for a complete overview)."
(let* ((type (or elem-type 'headline))
(val (when (and (memq type org-dp-value-blocks)
(not (org-string-nw-p
(plist-get args :value))))
(list :value (or (org-string-nw-p contents) "\n"))))
;; FIXME kind of a hack (pre-processing really necessary?)
(preproc-args (cond
((and (consp (car args))
(consp (caar args)))
(caar args))
((consp (car args)) (car args))
(t args)))
(data (list type
(cond
((consp affiliated) (org-combine-plists
preproc-args affiliated
val))
((not affiliated)
(mapc
(lambda (--aff-kw)
(setq preproc-args
(plist-put preproc-args
--aff-kw nil)))
(cl-intersection preproc-args
org-dp-affiliated-keys))
(org-combine-plists preproc-args val))
(t (org-combine-plists preproc-args val)))
(unless val
;; (cond
;; ((and (stringp contents)
;; (eq type 'headline))
;; (cons 'section `(nil ,contents)))
;; ((and (stringp contents)
;; (not (memq
;; type
;; org-element-all-objects)))
;; (cons 'paragraph `(nil ,contents)))
;; (t contents))
(if (and (stringp contents)
(memq type
'(item footnote-definition)))
(cons 'paragraph `(nil ,contents))
contents)))))
(cond
((eq insert-p 'data) data)
(insert-p
(progn
(unless (and (bolp)
(not (memq type org-dp-inline-elems)))
(newline))
(insert (org-element-interpret-data data))))
(t (org-element-interpret-data data)))))
;; (defun* org-dp-create (elem-type &optional contents insert-p affiliated &rest args)
;; "Create Org element of type ELEM-TYPE (headline by default).
;; Depending on its type, CONTENTS is used as the element's content
;; or5 value. If INSERT-P is non-nil, insert interpreted element at
;; point. AFFILIATED should be a plist of affiliated keys and values
;; if given. ARGS are key-value pairs of (interpreted) properties for
;; ELEM-TYPE (see `org-dp-elem-props' for a complete overview)."
;; (let* ((type (or elem-type 'headline))
;; (val (when (and (memq type org-dp-value-blocks)
;; (not (org-string-nw-p
;; (plist-get args :value))))
;; (list :value (or (org-string-nw-p contents) "\n"))))
;; ;; FIXME kind of a hack (pre-processing really necessary?)
;; (preproc-args (cond
;; ((and (consp (car args))
;; (consp (caar args)))
;; (caar args))
;; ((consp (car args)) (car args))
;; (t args)))
;; (strg (org-element-interpret-data
;; (list type
;; (cond
;; ((consp affiliated) (org-combine-plists
;; preproc-args affiliated
;; val))
;; ((not affiliated)
;; (mapcar
;; (lambda (--aff-kw)
;; (setq preproc-args
;; (plist-put preproc-args
;; --aff-kw nil)))
;; (intersection preproc-args
;; org-dp-affiliated-keys))
;; (org-combine-plists preproc-args val))
;; (t (org-combine-plists preproc-args val)))
;; (unless val
;; (if (and (stringp contents)
;; (not (memq
;; type
;; org-element-all-objects)))
;; (cons 'section `(nil ,contents))
;; contents))))))
;; (if insert-p
;; (progn
;; (unless (and (bolp)
;; (not (memq type org-dp-inline-elems)))
;; (newline))
;; (insert strg))
;; strg)))
(cl-defun org-dp-rewire (elem-type &optional contents replace affiliated element &rest args)
"Rewire element-at-point or ELEMENT (if given).
If CONTENTS is non-nil, act conditional on its value:
- string or internal representation (parse-tree) :: use
raw/interpreted value as rewired element's contents.
- function with two arguments :: call function with original
argument's contents (in parse-tree format) as first argument
and original element (in parse-tree format) as second
argument. Use the returned string/list (in parse-tree format)
as rewired element's raw/interpreted contents.
- t :: (boolean) get interpreted contents of original element.
If REPLACE is non-nil, act conditional on its value:
- append :: (symbol) append rewired element after original element
- prepend :: (symbol) prepend rewired element before original element
- non-nil :: (any) replace original element with rewired element
- nil :: just return rewired element
If AFFILIATED is non-nil, act conditional on its value:
- property list :: (consp) combine element's property list with
this plist of affiliated keywords
- non-nil :: (any) all affiliated keywords are retained in
rewired element.
- nil :: (boolean) no affiliated keywords are retained in
rewired element.
ELEM-TYPE is one of the types in `org-element-all-elements'. If
it is nil, the element type of the original element is used. ARGS
is a plist consisting of key-val pairs of all other keyword
arguments given, defining the (rewired) element's properties.
The former value of an element property can be reused in the
creation of a new value by giving a `lambda' expession or
function taking two arguments (instead of just a value) to a
key. The first argument will then be replaced by the property's
former value when applying the function. The second argument
should be the parsed element itself, enabling access to its type
and all its properties inside of the lambda expression."
(let* ((orig-elem (cond
((and (not (booleanp element))
(symbolp element))
(eval element))
((stringp element)
(let ((el (car (read-from-string element))))
(when (consp el) el)))
((consp element) element)
(t (org-element-at-point))))
(type (or elem-type (org-element-type orig-elem)))
(elem (cl-copy-list orig-elem))
(plist (cl-copy-list (cadr elem)))
(beg (set-marker
(make-marker) (org-element-property :begin elem)))
(paff (set-marker
(make-marker)
(org-element-property :post-affiliated elem)))
(end (set-marker
(make-marker) (org-element-property :end elem)))
(cont (let ((orig-elem-cont (org-dp-contents elem)))
(cond
;; ((and (consp contents) (functionp contents))
((and contents (functionp contents))
(apply contents (list orig-elem-cont elem)))
((and contents (booleanp contents))
orig-elem-cont)
(t contents))))
strg)
(while args
(let* ((key (pop args))
(val-or-fun (pop args))
(old-val (org-element-property key elem))
(new-val
(if (functionp val-or-fun)
(apply val-or-fun old-val (list elem))
val-or-fun)))
(setq plist (plist-put plist key new-val))))
(setq strg (org-element-interpret-data
(list (or type (org-element-type elem))
(cond
((consp affiliated)
(org-combine-plists plist affiliated))
((not affiliated)
(mapc
(lambda (--aff-kw)
(setq plist (plist-put
plist --aff-kw nil)))
(cl-intersection plist
org-dp-affiliated-keys))
plist)
(t plist))
(if (and (stringp cont)
(memq type
'(item footnote-definition)))
(cons 'paragraph `(nil ,cont))
cont)
;; (if (stringp cont)
;; (cons 'section `(nil ,cont))
;; cont)
)))
(if (and (marker-position beg)
(marker-position end))
(cl-case replace
(append (save-excursion (goto-char end) (insert strg)))
(prepend (goto-char beg) (insert strg))
(t (if (not replace)
strg
(delete-region beg end)
(goto-char end)
(set-marker beg nil)
(set-marker paff nil)
(set-marker end nil)
(save-excursion (insert strg)))))
(if replace (insert strg) strg))))
(defun org-dp-map (fun-with-args rgxp &optional match-pos backward-search-p beg end silent-p)
"Apply quoted FUN-WITH-ARGS at every RGXP match.
If MATCH-POS is given, act conditional on its value:
- non-nil :: (any) move point to either match-beginning
(match-beginning 0), when forward-search is used, or
match-end (match-end 0), when backward-search is used.
- (sym . n) :: (cons pair) move point to sym (beg or end) of nth
subexpression: -> (match-beginning n)
or (match-end n)
Otherwise match position is not changed, so search function
`re-search-forward' will \"Set point to the end of the occurrence
found, and return point\", which is equivalent to moving point
to (match-end 0). If BACKWARD-SEARCH-P is non-nil,
`re-search-backward' is used instead, that will \"Set point to
the beginning of the match, and return point.\".
Integers BEG and/or END limit the search, if given. If SILENT-P
is non-nil, a final message reporting the total number of
mappings will be suppressed.
Given the following example Org-mode buffer
#+BEGIN_ORG
* ORG SCRATCH
** Foo
** Bar
** Loo
#+END_ORG
an example call of `org-dp-map' yields significantly different
results when called with forward-search or with
backward-search. Assume FUN-WITH-ARGS is:
#+BEGIN_SRC emacs-lisp
(org-dp-rewire nil (lambda (old elem) old) t nil nil
:tags '(\"mytag\")
:title (lambda (old elem) old)
:level 3)
#+END_SRC
and RGXP is \"^\\*+ \", then calling
#+BEGIN_SRC emacs-lisp
(org-dp-map FUN-WITH-ARGS RGXP t)
#+END_SRC
i.e. mapping with forward-search, yields
#+BEGIN_ORG
*** ORG SCRATCH :mytag:
** Foo
** Bar
** Loo
#+END_ORG
while calling
#+BEGIN_SRC emacs-lisp
(org-dp-map FUN-WITH-ARGS RGXP nil t)
#+END_SRC
i.e. mapping with backward-search, yields
#+BEGIN_ORG
*** ORG SCRATCH :mytag:
*** Foo :mytag:
*** Bar :mytag:
*** Loo :mytag:
#+END_ORG
In contrast to other mapping functions in Org-mode, this mapping
function does not collect any information about mapped elements,
it simply moves point quickly to all positions in a buffer(range)
that are matched by a (forward) regexp-search and applies one of
`org-dp''s or `org-dp-lib''s functions locally at that
point (i.e. without any context information other than that about
the parsed element-at-point).
When calling FUN `org-dp-create', or `org-dp-rewire' with
argument ELEMENT given, no parsing at all takes places, but newly
created of modified elements can be inserted at point.
This mapping function wraps its body in `save-excursion' and
`save-match-data' calls, so point position and global match-data
are preserved. It does not widen the buffer before executing its
body, so buffer restrictions are respected. "
(and (consp fun-with-args)
(functionp (car fun-with-args))
(org-string-nw-p rgxp)
(let ((pt-min (or beg (point-min)))
(pt-max (make-marker))
(match-point-marker (make-marker))
(loop-counter 0)
eval-positions)
(unless backward-search-p
(set-marker-insertion-type match-point-marker t))
(set-marker-insertion-type pt-max t)
(move-marker pt-max (or end (point-max)))
(save-excursion
(save-match-data
(if backward-search-p
(goto-char pt-max)
(goto-char pt-min))
(while (if backward-search-p
(re-search-backward rgxp pt-min 'NOERROR)
(re-search-forward rgxp pt-max 'NOERROR))
(move-marker match-point-marker (point))
(setq loop-counter (1+ loop-counter))
(cond
((and match-pos (not (consp match-pos)))
(goto-char (if backward-search-p
(match-end 0)
(match-beginning 0))))
((and (consp match-pos)
(memq (car match-pos) '(beg end))
(integer-or-marker-p (cdr match-pos))
(not (eq (cdr match-pos) 0)))
(if (eq (car match-pos) 'beg)
(goto-char (match-beginning (cdr match-pos)))
(goto-char (match-end (cdr match-pos)))))
(t nil))
(setq eval-positions (cons (point) eval-positions))
(eval fun-with-args)
(goto-char match-point-marker))))
(move-marker match-point-marker nil)
(move-marker pt-max nil)
(unless silent-p
(message
(concat
"%s\nwas called %d times at buffer positions %s "
"of original buffer.")
fun-with-args loop-counter (reverse eval-positions))))))
;;;; Utility Functions
(defun org-dp-contents (&optional element interpret-p no-properties-p)
"Get contents of element-at-point or ELEMENT.
If INTERPRET-P is non-nil, call `org-element-interpret-data' on
return value. Call `org-no-properties' on result if
NO-PROPERTIES-P is non-nil too."
(let* ((elem (cond
((and (not (booleanp element))
(symbolp element))
(eval element))
((stringp element)
(let ((el (car (read-from-string element))))
(when (consp el) el)))
((consp element) element)
(t (org-element-at-point))))
(beg (org-element-property :begin elem))
(end (org-element-property :end elem))
(type (org-element-type elem)))
(if (and beg end)
(save-restriction
(narrow-to-region beg end)
(let ((cont (org-element-map
(org-element-parse-buffer 'object)
type 'org-element-contents nil t)))
(cond
((and interpret-p no-properties-p)
(org-no-properties (org-element-interpret-data cont)))
(interpret-p
(org-element-interpret-data cont))
(t cont))))
(org-element-contents elem))))
(defun org-dp-in (type)
"")
;;; Commands
;;;; Prompt User
;; This function reuses parts of`org-babel-insert-header-arg' and
;; `org-babel-demarcate-block'
(defun org-dp-prompt-for-src-block-props (lang)
"Prompt for src-block header argument.
Select from lists of common args and values. Argument LANG
specifies the Org Babel language."
(interactive
(list (completing-read
"Lang: "
(mapcar #'symbol-name
(delete-dups
(append (mapcar #'car
org-babel-load-languages)
(mapcar
(lambda (el) (intern (car el)))
org-src-lang-modes)))))))
(let* ((lang-headers (intern
(concat "org-babel-header-args:" lang)))
(headers (org-babel-combine-header-arg-lists
org-babel-common-header-args-w-values
(when (boundp lang-headers)
(eval lang-headers))))
(header-args ""))
(while (y-or-n-p "Add arg ")
(let* ((key (completing-read
"Header Arg: "
(mapcar
(lambda (header-spec)
(symbol-name (car header-spec)))
headers)))
(vals (cdr (assoc (intern key) headers))))
(setq header-args
(concat
(format
":%s %s"
key
(cond
((eq vals :any)
(read-from-minibuffer "value: "))
((listp vals)
(mapconcat
(lambda (group)
(let ((arg (completing-read
"Value: "
(cons "default"
(mapcar #'symbol-name
group)))))
(if (and arg
(not (string= "default" arg)))
arg "")))
;; arg nil)))
vals " "))))
(if (org-string-nw-p header-args) " " "")
header-args))))
(message "src-block params: %s"
(list :language lang :parameters header-args))