forked from alphapapa/outorg
-
Notifications
You must be signed in to change notification settings - Fork 0
/
outorg.el
1927 lines (1686 loc) · 70.3 KB
/
outorg.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
;;; outorg.el --- Org-style comment editing
;; Maintainer: Adam Porter <[email protected]>
;; Version: 2.1-pre
;; URL: https://github.com/alphapapa/outorg
;; Package-Requires: ((emacs "24.4"))
;;;; MetaData
;; :PROPERTIES:
;; :copyright: Thorsten Jolitz
;; :copyright-years: 2013+
;; :version: 2.0
;; :licence: GPL 2 or later (free software)
;; :licence-url: http://www.gnu.org/licenses/
;; :part-of-emacs: no
;; :maintainer: Adam Porter
;; :inspiration: org-src
;; :keywords: emacs org-mode comment-editing
;; :git-repo: https://github.com/alphapapa/outorg
;; :git-clone: git://github.com/alphapapa/outorg.git
;; :END:
;;;; Commentary
;;;;; About outorg
;; Outorg is for editing comment-sections of source-code files in
;; temporary Org-mode buffers. It turns conventional
;; literate-programming upside-down in that the default mode is the
;; programming-mode, and special action has to be taken to switch to the
;; text-mode (i.e. Org-mode).
;; Outorg depends on Outshine, i.e. outline-minor-mode with outshine
;; extensions activated. An outshine buffer is structured like an
;; org-mode buffer, only with outcommented headlines. While in
;; Org-mode text is text and source-code is 'hidden' inside of special
;; src-blocks, in an outshine buffer source-code is source-code and
;; text is 'hidden' as comments.
;; Thus org-mode and programming-mode are just two different views on
;; the outshine-style structured source-file, and outorg is the tool
;; to switch between these two views. When switching from a
;; programming-mode to org-mode, the comments are converted to text
;; and the source-code is put into src-blocks. When switching back
;; from org-mode to the programming-mode, the process is reversed -
;; the text is outcommented again and the src-blocks that enclose the
;; source-code are removed.
;; When the code is more important than the text, i.e. when the task
;; is rather 'literate PROGRAMMING' than 'LITERATE programming', it is
;; often more convenient to work in a programming-mode and switch to
;; org-mode once in a while than vice-versa. Outorg is really fast,
;; even big files with 10k lines are converted in a second or so, and
;; the user decides if he wants to convert just the current subtree
;; (done instantly) or the whole buffer. Since text needs no session
;; handling or variable passing or other special treatment, the outorg
;; approach is much simpler than the Org-Babel approach. However, the
;; full power of Org-Babel is available once the *outorg-edit-buffer*
;; has popped up.
;;;;; Usage
;; Outorg (like outshine) assumes that you set
;; `outline-minor-mode-prefix' in your init-file to 'M-#':
;; #+BEGIN_EXAMPLE
;; ;; must be set before outline is loaded
;; (defvar outline-minor-mode-prefix "\M-#")
;; #+END_EXAMPLE
;; Outorg's main command is
;; #+begin_example
;; M-# # (or M-x outorg-edit-as-org)
;; #+end_example
;; to be used in source-code buffers where `outline-minor-mode' is
;; activated with `outshine' extensions. The Org-mode edit-buffer popped
;; up by this command is called *outorg-edit-buffer* and has
;; `outorg-edit-minor-mode' activated, a minor-mode with only 2 commands:
;; #+begin_example
;; M-# (outorg-copy-edits-and-exit)
;; C-x C-s (outorg-save-edits-to-tmp-file)
;; #+end_example
;; If you want to insert Org-mode source-code or example blocks in
;; comment-sections, i.e. you don't want outorg to remove the
;; enclosing blocks, simply outcomment them in the outorg-edit buffer
;; before calling `outorg-copy-edits-and-exit'.
;; Note that outorg only treats 'active' src-blocks in a special way -
;; the blocks whose Babel language is equal to the major-mode of the
;; associated programming-mode buffer. All other (src-) blocks are
;; treated like normal text.
;; Note further that outorg uses example-blocks as 'fallback' when it
;; cannot find the major-mode of the programming-mode buffer in the
;; `org-babel-load-languages'. In this case you should not use
;; example-blocks for other tasks, since they will be removed when
;; exiting the *outorg-edit-buffer*, use e.g. quote-blocks or
;; verse-blocks instead.
;;;;; Installation
;; You can get outorg.el either from Github (see section MetaData) or
;; via MELPA. It depends on outshine.el, so you have to install and
;; configure outshine first to make outorg work.
;; Installation is easy, simply insert
;; #+begin_example
;; (require 'outorg)
;; #+end_example
;; in your init file. When you use navi-mode.el too, the third Outshine
;; library, it suffices to (require 'navi), since it requires the other
;; two libraries.
;;;;; Bugs and Shortcomings
;; Outorg started out purely line-based, it only worked with
;; 'one-line' comments, i.e. with comment-sections like those produced
;; by `comment-region' (a command that comments or uncomments each
;; line in the region). It was enhanced later on to recognize comment
;; regions too, i.e. those special multi-line comments found in many
;; programming languages. But using outorg on such multi-line comments
;; will probably change their syntax back to 'single-line', whenever
;; `comment-region' uses this style.
;;;;; Tests
;; A special kind of test has been developed for outorg using the
;; `ert-buffer' library, the so called 'conversion test'. It has the
;; following steps:
;; 1. programming-mode -> org-mode
;; 2. edit in org-mode, store undo-information
;; 3. org-mode -> programming-mode
;; 4. programming-mode -> org-mode (again)
;; 5. undo edits
;; 6. org-mode -> programming-mode (again)
;; After these 4 conversions, the original programming-mode buffer
;; must be unchanged when the conversion process is perfect, i.e. does
;; not introduce any changes itself. See `outorg-test.el' for details.
;;;;; Emacs Version
;; Outorg works with GNU Emacs 24.2.1 or later. No attempts of testing
;; with older versions or other types of Emacs have been made (yet).
;;;; ChangeLog
;; | date | author(s) | version |
;; |-----------------+-----------------+---------|
;; | <2014-09-20 Sa> | Thorsten Jolitz | 2.0 |
;; | <2013-05-03 Fr> | Thorsten Jolitz | 1.0 |
;; | <2013-02-11 Mo> | Thorsten Jolitz | 0.9 |
;;; Requires
(require 'outline)
(require 'org)
(require 'org-watchdoc nil t)
;; (unless (require 'outorg-export nil t)
;; (message
;; "Try library `outorg-export' for automated export to all Org
;; backends:\n%s"
;; "https://github.com/jleechpe/outorg-export"))
(declare-function R-mode "ess-r-d")
(declare-function org-watchdoc-propagate-changes "org-watchdoc")
(declare-function org-watchdoc-set-md5 "org-watchdoc")
;;; Mode and Exporter Definitions
;;;; Outorg Edit minor-mode
(define-minor-mode outorg-edit-minor-mode
"Minor mode for Org-mode buffers generated by outorg.
There is a mode hook, and two commands:
\\[outorg-copy-edits-and-exit] outorg-copy-edits-and-exit
\\[outorg-save-edits-to-tmp-file] outorg-save-edits-to-tmp-file"
:lighter " Outorg")
;;; Variables
;;;; Consts
(defconst outorg-version "2.0"
"outorg version number.")
(defconst outorg-edit-buffer-name "*outorg-edit-buffer*"
"Name of the temporary outorg edit buffer.")
;; FIXME org-babel names should be correct, but major-mode names need
;; to be cross-checked!
(defconst outorg-language-name-assocs
'((abc-mode . abc)
(asymptote-mode . asymptote)
(awk-mode . awk)
(c-mode . C) ;
(c++-mode . cpp) ;
(calc-mode . calc) ;
(clojure-mode . clojure)
(css-mode . css)
(d-mode . D) ;
(ditaa-mode . ditaa)
(dot-mode . dot)
(emacs-lisp-mode . emacs-lisp) ;
(eukleides-mode . eukleides)
(fomus-mode . fomus)
(fortran-mode . F90)
(gnuplot-mode . gnuplot)
(groovy-mode . groovy)
(haskell-mode . haskell)
(j-mode . J)
(java-mode . java)
(javascript-mode . js)
(julia-mode . julia)
(latex-mode . latex) ;
(ledger-mode . ledger)
(lilypond-mode . ly)
(lisp-mode . lisp)
(make-mode . makefile)
(mathomatic-mode . mathomatic)
(matlab-mode . matlab)
(maxima-mode . max)
(mscgen-mode . mscgen)
(tuareg-mode . ocaml) ;
(octave-mode . octave)
(org-mode . org) ;
(oz-mode . oz)
(perl-mode . perl)
(picolisp-mode . picolisp) ;
(plantuml-mode . plantuml)
(python-mode . python)
(ess-mode . R) ;
(ruby-mode . ruby)
(sass-mode . sass)
(scala-mode . scala)
(scheme-mode . scheme)
(shen-mode . shen)
(sh-mode . sh) ;
(sql-mode . sql)
(sqlite-mode . sqlite)
(tcl-mode . tcl))
"Associations between major-mode-name and org-babel language
names.")
(defconst outorg-tracked-markers '(point-marker
beg-of-subtree-marker mark-marker)
"Outorg markers to be tracked. The actual marker names are constructed by adding a prefix, either 'outorg-code-buffer-' or 'outorg-edit-buffer-'.")
(defconst outorg-tracked-org-markers '(org-clock-marker
org-clock-hd-marker org-clock-default-task
org-clock-interrupted-task selected-task org-open-link-marker
org-log-note-marker org-log-note-return-to
org-entry-property-inherited-from)
"Org markers to be tracked by outorg.")
;;;; Vars
(defvar outline-minor-mode-prefix "\C-c"
"New outline-minor-mode prefix.")
(defvar outorg-edit-whole-buffer-p nil
"Non-nil if the whole code-buffer is edited.")
(defvar outorg-initial-window-config nil
"Initial window-configuration when editing as Org.")
(defvar outorg-code-buffer-read-only-p nil
"Remember if code-buffer was read only before editing")
;; copied and adapted from ob-core.el
(defvar outorg-temporary-directory) ; FIXME why this duplication?
(unless (or noninteractive (boundp 'outorg-temporary-directory))
(defvar outorg-temporary-directory
(or (and (boundp 'outorg-temporary-directory)
(file-exists-p outorg-temporary-directory)
outorg-temporary-directory)
(make-temp-file "outorg-" t))
"Directory to hold outorg's temporary files.
This directory will be removed on Emacs shutdown."))
(defvar outorg-last-temp-file nil
"Storage for absolute file name of last saved temp-file.")
(defvar outorg-called-via-outshine-use-outorg-p nil
"Non-nil if outorg was called via `outshine-use-outorg' command")
(defvar outorg-oldschool-elisp-headers-p nil
"Non-nil if an Emacs Lisp file uses oldschool headers ';;;+'")
(defvar outorg-insert-default-export-template-p nil
"Non-nil means either the file specified in
`outorg-export-template-for-org-mode' or a file given by the user
will be inserted at the top of the *outorg-edit-buffer* when it
is opened, and will be removed when it is closed, thus enabling
the user to e.g. define default export options in a file and use
them on-demand in the *outorg-edit-buffer*. The value of this variable is
toggled with command `outorg-toggle-export-template-insertion'.")
;; (make-variable-buffer-local 'outorg-insert-default-export-template-p)
(defvar outorg-ask-user-for-export-template-file-p nil
"Non-nil means user is prompted for export-template-file.")
;; (make-variable-buffer-local 'outorg-ask-user-for-export-template-file-p)
(defvar outorg-keep-export-template-p nil
"Non-nil means inserted export template is permanent.")
;; (make-variable-buffer-local 'outorg-keep-export-template-p)
(defvar outorg-export-template-regexp
(concat
"[[:space:]\n]*"
"# <<<\\*\\*\\* BEGIN EXPORT TEMPLATE [[:ascii:]]+"
"# <<<\\*\\*\\* END EXPORT TEMPLATE \\*\\*\\*>>>[^*]*")
"Regexp used to identify (and delete) export templates.")
(defvar outorg-propagate-changes-p nil
"Non-nil means propagate changes to associated doc files.")
;; (make-variable-buffer-local 'outorg-propagate-changes-p)
(defvar outorg-code-buffer-point-marker (make-marker)
"Marker to store position in code-buffer.")
(defvar outorg-edit-buffer-point-marker (make-marker)
"Marker to store position in edit-buffer.")
(defvar outorg-code-buffer-beg-of-subtree-marker (make-marker)
"Marker to store begin of current subtree in
code-buffer.")
(defvar outorg-edit-buffer-beg-of-subtree-marker (make-marker)
"Marker to store begin of current subtree in
edit-buffer.")
(defvar outorg-markers-to-move nil
"Markers that should be moved with a cut-and-paste operation.
Those markers are stored together with their positions relative to
the start of the region.")
(defvar outorg-org-finish-function-called-p nil
"Non-nil if `org-finish-function' was called, nil otherwise.")
(defvar outorg-beginning-of-comment (make-marker)
"Marker for tracking beginning of comment.
If pt-A < pt-B, the region between A and B is out- or
uncommented.")
(defvar outorg-beginning-of-code (make-marker)
"Marker for tracking beginning of source code.
If pt-B < pt-C, the region between B and C is wrapped/unwrapped
as source-block.")
(defvar outorg-end-of-code (make-marker)
"Marker for tracking end of source code.
If pt-B < pt-C, the region between B and C is wrapped/unwrapped
as source-block.")
;; ;; pt-A
;; (defvar outorg-beg-comment-marker (make-marker)
;; "Outorg marker for tracking begin of comment.")
;; ;; pt-B
;; (defvar outorg-beg-src-marker (make-marker)
;; "Outorg marker for tracking beginning of source-code.")
;; ;; pt-C
;; (defvar outorg-end-src-marker (make-marker)
;; "Outorg marker for tracking end of source-code.")
;;;; Hooks
(defvar outorg-hook nil
"Functions to run after `outorg' is loaded.")
(defvar outorg-edit-minor-mode-hook nil
"Hook run after `outorg' switched a source code file or subtree to
Org-mode.")
;;;; Customs
;;;;; Custom Groups
(defgroup outorg nil
"Library for outline navigation and Org-mode editing in Lisp buffers."
:prefix "outorg-"
:group 'lisp
:link '(url-link
"http://orgmode.org/worg/org-tutorials/org-outside-org.html"))
;;;;; Custom Vars
;; inspired by 'org-src.el'
(defcustom outorg-edit-buffer-persistent-message t
"Non-nil means show persistent exit help message while in edit-buffer.
The message is shown in the header-line, which will be created in the
first line of the window showing the editing buffer."
:group 'outorg
:type 'boolean)
(defcustom outorg-unindent-active-source-blocks-p t
"Non-nil means common indentation (e.g. 2 spaces) in the active
source-blocks of the *outorg-edit-buffer* (i.e. those in the
language of the associated source-code buffer, and only in those)
is removed before converting back from Org to source-code."
:group 'outorg
:type 'boolean)
(defcustom outorg-ensure-blank-line nil
"Non-nil means insert an overlay between text and blocks.
This overlay displays a blank line. It is inserted in the editing buffer and
persists after the editing buffer is closed.")
;;; Functions
;;;; Non-interactive Functions
;;;;; Get Buffer Mode and Language Name
(defun outorg-comment-on-line ()
"Look forward from point for a comment at the start of this
line. If found, move point to the beginning of the text after
`comment-start' syntax, and return the location of the
beginning of the line. If the line does not start with
`comment-start', returns `nil'."
(and (search-forward-regexp (concat "\\("
(regexp-quote comment-start)
"[[:space:]]*\\)")
(line-end-position)
1)
(eq (match-beginning 0) (point-at-bol))
(point-at-bol)))
(defun outorg-comment-on-line-p ()
"Determine if point is on a line that begins with a comment."
(save-excursion
(beginning-of-line)
(outorg-comment-on-line)))
(defun outorg-comment-search-forward ()
"Like `comment-search-forward', but looks only for comments
beginning with `comment-start' syntax at the start of a
line. Point is left at the beginning of the text after the line
comment syntax, while the returned point is at the beginning of
the line."
(while (not (or (eobp) (outorg-comment-on-line))) (forward-line))
(point-at-bol))
;; copied from http://www.emacswiki.org/emacs/basic-edit-toolkit.el
(defun outorg-region-or-buffer-limits ()
"Return the start and end of the region as a list, smallest first.
If the region is not active or empty, then bob and eob are used."
(if (or
(not mark-active)
(null (mark))
(= (point) (mark)))
(list (point-min) (point-max))
(if (< (point) (mark))
(list (point) (mark))
(list (mark) (point)))))
(defun outorg-get-buffer-mode (&optional buf-or-strg as-strg-p)
"Return major-mode of BUF-OR-STRG or current-buffer.
If AS-STRG-P is non-nil, a string is returned instead instead
of a symbol."
(let ((buf (if buf-or-strg
(get-buffer buf-or-strg)
(current-buffer))))
(with-current-buffer buf
(if as-strg-p (symbol-name major-mode) major-mode))))
(defun outorg-get-babel-name (&optional mode-name as-string)
"Return the symbol associated in Org-Babel with MODE-NAME.
Uses `outorg-language-name-assocs' as association list between
the string returned by `major-mode' in the associated source-code
buffer and the symbol used for that language in
`org-babel-load-languages'. If AS-STRING is non-nil, a string is
returned."
(let* ((mmode (if mode-name
(cond
((stringp mode-name) (intern mode-name))
((symbolp mode-name) mode-name)
(t (error "Mode-Name neither String nor Symbol")))
major-mode))
(bname (or (cdr (assoc mmode outorg-language-name-assocs))
;; Not found in alist; just use major-mode name without "-mode" suffix
(intern (replace-regexp-in-string "-mode$" "" (symbol-name mmode))))))
(if as-string
(symbol-name bname)
bname)))
(defun outorg-get-mode-name (babel-name &optional as-strg-p)
"Return the major-mode name associated with BABEL-NAME.
Uses `outorg-language-name-assocs' as association list between
the symbol returned by `major-mode' in the associated source-code
buffer and the symbol used for that language in
`org-babel-load-languages'. If AS-STRG-P is non-nil, a string
is returned."
(let* ((bname
(cond
((stringp babel-name) (intern babel-name))
((symbolp babel-name) babel-name)
(t (error "Babel-Name neither String nor Symbol"))))
(mmode
(car
(rassoc bname outorg-language-name-assocs))))
(if as-strg-p (symbol-name mmode) mmode)))
(defun outorg-get-language-name (&optional mode-name as-sym-p)
"Extract car of splitted and normalized MODE-NAME.
If AS-SYM-P is non-nil, a symbol instead of a string is
returned."
(let* ((mmode (or
(and mode-name
(cond
((stringp mode-name) mode-name)
((symbolp mode-name) (symbol-name mode-name))
(t (error
"Mode-Name neither String nor Symbol"))))
(symbol-name major-mode)))
(splitted-mmode
(split-string mmode "-mode"))
(language-name
(if (> (length splitted-mmode) 1)
(car splitted-mmode)
(car (split-string mmode "\\.")))))
(if as-sym-p (intern language-name) language-name)))
(defun outorg-in-babel-load-languages-p (&optional mode-name)
"Non-nil if MODE-NAME is in Org-Babel load languages.
If MODE-NAME is nil, check if Org-Babel identifier of major-mode of current buffer is in Org-Babel load languages."
(let* ((mmode (or
(and mode-name
(cond
((stringp mode-name) (intern mode-name))
((symbolp mode-name) mode-name)
(t (error
"Mode-Name neither String nor Symbol"))))
major-mode)))
(assoc
;; Note that babel's cpp (for C++) is packaged in ob-C with the C
;; language
(let ((bname (outorg-get-babel-name mmode)))
(if (eq bname (intern "cpp")) (intern "C") bname))
org-babel-load-languages)))
;;;;; Configure Edit Buffer
;; copied and adapted from org-src.el
(defun outorg-edit-configure-buffer ()
"Configure edit buffer"
(let ((msg
(concat "[ "
(buffer-name
(marker-buffer outorg-code-buffer-point-marker))
" ] "
(substitute-command-keys "Exit with \\[outorg-copy-edits-and-exit]"))))
;; Only run the kill-buffer-hooks when the outorg edit buffer is
;; being killed. This is because temporary buffers may be created
;; by various org commands, and when those buffers are killed, we
;; do not want the outorg kill hooks to run.
(org-add-hook 'kill-buffer-hook
(lambda ()
(when (string= (buffer-name) outorg-edit-buffer-name)
(outorg-save-edits-to-tmp-file)))
nil 'local)
(org-add-hook 'kill-buffer-hook
(lambda ()
(when (string= (buffer-name) outorg-edit-buffer-name)
(outorg-reset-global-vars)) nil 'local))
;; (setq buffer-offer-save t)
(and outorg-edit-buffer-persistent-message
(setq-local header-line-format msg))
;; (setq buffer-file-name
;; (concat (buffer-file-name
;; (marker-buffer outorg-code-buffer-point-marker))
;; "[" (buffer-name) "]"))
(if (featurep 'xemacs)
(progn
(make-variable-buffer-local
'write-contents-hooks) ; needed only for 21.4
(setq write-contents-hooks
'(outorg-save-edits-to-tmp-file)))
(setq write-contents-functions
'(outorg-save-edits-to-tmp-file)))
;; (setq buffer-read-only t) ; why?
))
;; (org-add-hook 'outorg-edit-minor-mode-hook 'outorg-edit-minor-mode)
(org-add-hook 'outorg-edit-minor-mode-hook
'outorg-edit-configure-buffer)
;;;;; Backup Edit Buffer
;; copied and adapted from ob-core.el
(defun outorg-temp-file (prefix &optional suffix)
"Create a temporary file in the `outorg-temporary-directory'.
Passes PREFIX and SUFFIX directly to `make-temp-file' with the
value of `temporary-file-directory' temporarily set to the value
of `outorg-temporary-directory'."
(let ((temporary-file-directory
(if (file-remote-p default-directory)
(concat (file-remote-p default-directory) "/tmp")
(or (and (boundp 'outorg-temporary-directory)
(file-exists-p outorg-temporary-directory)
outorg-temporary-directory)
temporary-file-directory))))
(make-temp-file prefix nil suffix)))
(defun outorg-save-edits-to-tmp-file ()
"Save edit-buffer in temporary file"
(interactive)
(let* ((code-file (file-name-sans-extension
(file-name-nondirectory
(buffer-name
(marker-buffer
outorg-code-buffer-point-marker)))))
(tmp-file (outorg-temp-file code-file))
(tmp-dir (file-name-directory tmp-file)))
(setq outorg-last-temp-file tmp-file)
(setq buffer-file-name (concat tmp-dir "outorg-edit-" code-file))
(write-region nil nil tmp-file nil 'VISIT)))
;; copied and adapted from ob-core.el
(defun outorg-remove-temporary-directory ()
"Remove `outorg-temporary-directory' on Emacs shutdown."
(when (and (boundp 'outorg-temporary-directory)
(file-exists-p outorg-temporary-directory))
;; taken from `delete-directory' in files.el
(condition-case nil
(progn
(mapc (lambda (file)
;; This test is equivalent to
;; (and (file-directory-p fn) (not (file-symlink-p fn)))
;; but more efficient
(if (eq t (car (file-attributes file)))
(delete-directory file)
(delete-file file)))
;; We do not want to delete "." and "..".
(directory-files outorg-temporary-directory 'full
"^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
(delete-directory outorg-temporary-directory))
(error
(message "Failed to remove temporary outorg directory %s"
(if (boundp 'outorg-temporary-directory)
outorg-temporary-directory
"[directory not defined]"))))))
(add-hook 'kill-emacs-hook 'outorg-remove-temporary-directory)
;;;;; Reset Global Vars
;; TODO better use buffer-local variables instead?
(defun outorg-reset-global-vars ()
"Reset some global vars defined by outorg to initial values."
(ignore-errors
(set-marker outorg-code-buffer-point-marker nil)
(set-marker outorg-code-buffer-beg-of-subtree-marker nil)
(set-marker outorg-edit-buffer-point-marker nil)
(set-marker outorg-edit-buffer-beg-of-subtree-marker nil)
(setq outorg-edit-whole-buffer-p nil)
(setq outorg-initial-window-config nil)
(setq outorg-code-buffer-read-only-p nil)
(setq outorg-oldschool-elisp-headers-p nil)
(setq outorg-insert-default-export-template-p nil)
(setq outorg-ask-user-for-export-template-file-p nil)
(setq outorg-keep-export-template-p nil)
(setq outorg-propagate-changes-p nil)
(setq outorg-called-via-outshine-use-outorg-p nil)
(when outorg-markers-to-move
(mapc (lambda (m)
(when (markerp m)
(move-marker m nil)))
outorg-markers-to-move)
(setq outorg-markers-to-move nil))
(setq outorg-org-finish-function-called-p nil)))
;;;;; Remove Trailing Blank Lines
;; inspired by `article-remove-trailing-blank-lines' in `gnus-art.el'
(defun outorg-remove-trailing-blank-lines ()
"Remove all trailing blank lines from buffer.
Finally add one newline."
(save-excursion
(let ((inhibit-read-only t))
(goto-char (point-max))
(delete-region
(point)
(progn
(while (and (not (bobp))
(looking-at "^[ \t]*$"))
(forward-line -1))
(forward-line 1)
(point))))))
;;;;; Save and Restore Markers
;; 1. Deal with position markers in code and edit buffer, to get the
;; least possible surprise about point position after switching
;; buffers
;; 2. Deal with org markers set in the edit buffer and needed in
;; after command hooks when edit buffer is already closed
(defun outorg-save-markers (markers)
"Save MARKERS in `outorg-markers-to-move'."
(save-restriction
(widen)
(let* ((beg (if (or outorg-edit-whole-buffer-p
(equal (buffer-name) outorg-edit-buffer-name))
(point-min)
(if (outline-on-heading-p)
(point)
(save-excursion
(outline-previous-heading)
(point)))))
(end (if (or outorg-edit-whole-buffer-p
(equal (buffer-name) outorg-edit-buffer-name))
(point-max)
(save-excursion
(outline-end-of-subtree)
(point))))
(prefix (cond ((eq (current-buffer) (marker-buffer outorg-code-buffer-point-marker))
"outorg-code-buffer-")
((eq (current-buffer) (marker-buffer outorg-edit-buffer-point-marker))
"outorg-edit-buffer-")
(t (error "This should not happen"))))
(markers (mapcar (lambda (marker)
(intern (format "%s%s"
(if (string-match "\\(org\\|mark\\)"
(car (split-string (symbol-name marker) "-" t)))
""
prefix)
marker)))
markers)))
(mapc (lambda (marker)
(outorg-check-and-save-marker marker beg end))
markers))))
;; adapted from org.el
(defun outorg-check-and-save-marker (marker-or-var beg end)
"Check if MARKER-OR-VAR is between BEG and END.
If yes, remember the marker and the distance to BEG."
(let ((marker (cond
((markerp marker-or-var) marker-or-var)
((boundp marker-or-var) (eval marker-or-var))
(t nil))))
(when (and (markerp marker)
(marker-buffer marker)
(equal (marker-buffer marker) (current-buffer)))
(when (and (>= marker beg) (< marker end))
(let* ((splitted-marker-name
(split-string
(symbol-name marker-or-var)
"\\(outorg-\\|-buffer-\\)" t))
(split-gt-1-p (> (length splitted-marker-name) 1))
(marker-buf
(ignore-errors
(when split-gt-1-p
(intern (car splitted-marker-name)))))
(marker-typ
(ignore-errors
(if split-gt-1-p
(intern (cadr splitted-marker-name))
(intern (car splitted-marker-name))))))
(push (list marker-buf marker-typ (- marker beg))
outorg-markers-to-move))))))
(defun outorg-reinstall-markers-in-region (beg)
"Move all remembered markers to their position relative to BEG."
(mapc (lambda (--marker-lst)
(move-marker
(eval
(intern
(format "%s%s"
(cond
((eq (car --marker-lst) 'code)
"outorg-edit-buffer-")
((eq (car --marker-lst) 'edit)
"outorg-code-buffer-")
((and (booleanp (car --marker-lst))
(null (car --marker-lst)))
"")
(t (error "This should not happen.")))
(cadr --marker-lst))))
(+ beg (caddr --marker-lst))))
outorg-markers-to-move)
(setq outorg-markers-to-move nil))
;;;;; Copy and Convert
(defun outorg-convert-org-to-outshine
(&optional mode infile outfile BATCH)
"Convert an existing Org-mode file into an Outshine buffer.
If MODE is non-nil, the Outshine buffer will be put in this
major-mode, otherwise the major-mode of the language of the first
source-code block in the Org-mode buffer will be used.
If INFILE is non-nil, the specified Org-mode file will be
visited, otherwise the current buffer will be used (i.e. the
buffer content will be copied to a temporary *outorg-edit-buffer*
for further processing).
If OUTFILE is non-nil, the converted Outshine buffer will be
saved in this file. Its the user's responsability to make sure
that OUTFILE's file-extension is suited for the major-mode of the
Outshine buffer to be saved. When in doubt, consult variable
`auto-mode-alist' for associations between file-extensions and
major-modes.
If BATCH is non-nil (and OUTFILE is non-nil, otherwise it makes
no sense), the new Outshine file is saved and its buffer
deleted."
(let* ((org-buffer (if infile
(if (and (file-exists-p infile)
(string-equal
(file-name-extension infile) "org"))
(find-file (expand-file-name infile))
(error
"Infile doesn't exist or is not an Org file"))
(current-buffer)))
(maj-mode (or mode
(with-current-buffer org-buffer
(save-excursion
(goto-char (point-min))
(or
;; major-mode of first src-block
(ignore-errors
(org-next-block
nil nil org-babel-src-block-regexp)
(format
"%s-mode"
(car (org-babel-get-src-block-info 'LIGHT))))
;; default case emacs-lisp-mode
"emacs-lisp-mode"))))))
(with-current-buffer (get-buffer-create
(generate-new-buffer-name "tmp"))
(setq outorg-code-buffer-point-marker (point-marker))
(funcall (intern maj-mode))
(and outfile
;; ;; FIXME does not really avoid confirmation prompts
;; (add-to-list 'revert-without-query (expand-file-name outfile))
(if BATCH
(write-file (expand-file-name outfile))
(write-file (expand-file-name outfile) 'CONFIRM))))
(setq outorg-edit-whole-buffer-p t)
(setq outorg-initial-window-config
(current-window-configuration))
(with-current-buffer (get-buffer-create outorg-edit-buffer-name)
(erase-buffer)
(insert-buffer-substring org-buffer)
(org-mode)
(outorg-transform-active-source-block-headers)
(outorg-copy-edits-and-exit))
;; ;; FIXME ugly hack
;; (funcall major-mode)
;; (funcall major-mode)
;; (fontify-keywords)
(when outfile
(save-buffer)
;; (revert-buffer t t)
;; (remove
;; (expand-file-name outfile)
;; revert-without-query)
(and BATCH (kill-buffer)))))
(defun outorg-transform-active-source-block-headers ()
"Move switches and arguments on top of block.
This functions transforms all active source-blocks, i.e. those
with the associated source-code buffer's major-mode as
language. If there are switches and header arguments after the
language specification on the #+BEGIN_SRC line, they are moved on
top of the block.
The idea behind this function is that it should be possible to
specify permanent switches and arguments even for source-code
blocks that are transformed back to code after
`outorg-copy-and-switch' is called. They will remain as comment
lines directly over their code section in the source-code buffer,
and thus be transformed to text - and thereby activated -
everytime `outorg-edit-as-org' is called."
(save-excursion
(let* ((mode (outorg-get-buffer-mode
(marker-buffer outorg-code-buffer-point-marker)))
(active-lang
(outorg-get-babel-name mode 'as-strg-p)))
(org-babel-map-src-blocks nil
(when (string-equal active-lang lang)
(let ((sw switches)
(args header-args))
(goto-char end-lang)
(delete-region (point) (line-end-position))
(goto-char beg-block)
(forward-line -1)
(when (org-string-nw-p sw)
(newline)
(insert (format "#+header: %s" sw)))
(when (org-string-nw-p args)
(let ((params
(ignore-errors
(org-split-string args)))
headers)
(while params
(setq headers
(cons
(format "#+header: %s %s"
(org-no-properties (pop params))
(org-no-properties (pop params)))
headers)))
(newline)
(insert (mapconcat 'identity headers "\n"))))))))))
;; (insert (format "#+header: %s" args)))))))))
;; Thx to Eric Abrahamsen for the tip about `mail-header-separator'
(defun outorg-prepare-message-mode-buffer-for-editing ()
"Prepare an unsent-mail in a message-mode buffer for outorg.
This function assumes that '--text follows this line--' (or
whatever is found inside variable `mail-header-separator') is the
first line below the message header, is always present, and never
modified by the user. It turns this line into an `outshine'
headline and out-comments all text below this line - if any."
(goto-char (point-min))
;; (re-search-forward "--text follows this line--" nil 'NOERROR)
(re-search-forward mail-header-separator nil 'NOERROR)
(let ((inhibit-read-only t))
(replace-match "* \\&"))
;; (replace-match "* \\&")
(beginning-of-line)
(let ((start-body (point)))
(comment-region start-body (point-max))
(narrow-to-region start-body (point-max))
(forward-line)))
(defun outorg-prepare-message-mode-buffer-for-sending ()
"Prepare an unsent-mail edited via `outorg-edit' for sending.
This function assumes that '* --text follows this line--' is the
first line below the message header and is, like all lines below
it, out-commented with `comment-region'. It deletes the leading
star and uncomments the line and all text below it - if any."
(save-excursion
(goto-char (point-min))
(re-search-forward
(concat
"\\(" (regexp-quote "* ") "\\)"
"--text follows this line--")
nil 'NOERROR)
(replace-match "" nil nil nil 1)
(beginning-of-line)
(let ((start-body (point)))
(uncomment-region start-body (point-max))
(widen))))
(defun outorg-prepare-iorg-edit-buffer-for-editing ()
"Prepare a buffer opened with `edit' from iorg-scrape for outorg.
This function assumes that a PicoLisp symbol that contains the
text of an Org-mode file (fetched from an iOrg application) has
been loaded into a PicoLisp `edit' buffer. It transforms the
buffer content to a `outshine' compatible format, such that
`outorg-edit-as-org' can be applied on it.
In particular, this function assumes that the original `edit'
buffer has the following format
;; #+begin_quote
txt \"<content-org-file>\"
\(********\)
;; #+end_quote
and that the text must be transformed to a format that looks
somehow like this
;; #+begin_quote
## #+DESCRIPTION txt
\[## #+<OPTIONAL-EXPORT-HEADERS>\]
## * Org-file
## Content