/
ox-linuxmag-fr.el
645 lines (540 loc) · 26.1 KB
/
ox-linuxmag-fr.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
;;; ox-linuxmag-fr.el --- Org-mode exporter for the French GNU/Linux Magazine -*- lexical-binding: t; -*-
;; Copyright (C) 2022-2023 Damien Cassou
;; Authors: Damien Cassou <damien@cassou.me>
;; Version: 0.3.0
;; URL: https://github.com/DamienCassou/ox-linuxmag-fr
;; Package-Requires: ((emacs "28.1"))
;; Created: 15 Oct 2022
;; This file is not part of GNU Emacs.
;; 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 of the License, 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 this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This Org exporter is based on the OpenDocument exporter and changes
;; only what needs to be changed so the output is compatible with
;; GNU/Linux Magazine (http://www.gnulinuxmag.com/).
;;
;; The ./resources/styles.xml and ./resources/template.xml files are
;; extracted from the OpenOffice Writer template file at
;; https://github.com/GLMF/outils_auteurs.
;;; Code:
(require 'cl-lib)
(require 'org-compat)
(require 'org-macs)
(require 'ox)
(require 'ox-odt)
(require 'dired-aux) ;; to create the archive file
(defconst ox-linuxmag-fr--resources-dir
(expand-file-name "resources" (file-name-directory (or load-file-name (buffer-file-name))))
"Directory containing the style and template XML files.")
(defvar ox-linuxmag-fr--inline-code-style "code_5f_par")
;;; Create the 'linuxmag-fr Org export backend
(org-export-define-derived-backend
'linuxmag-fr
'odt
:translate-alist
`((template . ox-linuxmag-fr--template)
(bold . ox-linuxmag-fr--bold)
(code . ox-linuxmag-fr--code)
(verbatim . ox-linuxmag-fr--code)
(headline . ox-linuxmag-fr--headline)
(italic . ox-linuxmag-fr--italic)
(item . ox-linuxmag-fr--format-contents)
(link . ox-linuxmag-fr--link)
(paragraph . ox-linuxmag-fr--paragraph)
(plain-list . ox-linuxmag-fr--format-contents)
(special-block . ox-linuxmag-fr--special-block)
(src-block . ox-linuxmag-fr--src-block)
(table . ox-linuxmag-fr--table)
(table-cell . ox-linuxmag-fr--table-cell)
(target . ox-linuxmag-fr--target)
(underline . ox-linuxmag-fr--underline))
:menu-entry '(?g "Export to ODT for GNU/Linux Magazine"
((?g "As ODT file" ox-linuxmag-fr-export-to-odt)))
:options-alist
`((:author-description "AUTHOR_DESCRIPTION" nil nil newline)
(:logos "LOGOS" nil nil newline))
:filters-alist '((:filter-options . ox-linuxmag-fr--generate-secondary-files-contents)))
;; Main exporter functions
(defun ox-linuxmag-fr--template (contents info)
"Create the contents of the template.xml file.
CONTENTS is the exported text. INFO is a plist holding
contextual information."
(let* (;; `org-display-custom-times' should be accessed right
;; within the context of the Org buffer. So obtain its
;; value before moving on to temp-buffer context down below.
(custom-time-fmts
(if org-display-custom-times
(cons (substring (car org-time-stamp-custom-formats) 1 -1)
(substring (cdr org-time-stamp-custom-formats) 1 -1))
'("%Y-%M-%d %a" . "%Y-%M-%d %a %H:%M"))))
(with-temp-buffer
(insert-file-contents
(expand-file-name "template.xml" ox-linuxmag-fr--resources-dir))
;; Write automatic styles.
;; - Position the cursor.
(goto-char (point-min))
(re-search-forward " </office:automatic-styles>" nil t)
(goto-char (match-beginning 0))
;; - Dump automatic table styles.
(cl-loop for (style-name props) in
(plist-get org-odt-automatic-styles 'Table) do
(when (setq props (or (plist-get props :rel-width) "96"))
(insert (format org-odt-table-style-format style-name props))))
;; - Dump date-styles.
(when (plist-get info :odt-use-date-fields)
(insert (org-odt--build-date-styles (car custom-time-fmts)
"OrgDate1")
(org-odt--build-date-styles (cdr custom-time-fmts)
"OrgDate2")))
;; Position the cursor to document body.
(goto-char (point-min))
(re-search-forward "</office:text>" nil nil)
(goto-char (match-beginning 0))
(ox-linuxmag-fr--write-preamble info)
(insert contents)
(buffer-substring-no-properties (point-min) (point-max)))))
(defun ox-linuxmag-fr--write-preamble (info)
"Insert the first body lines of a template.xml file into the current buffer.
INFO is a plist holding contextual information."
(cl-labels ((get-property (keyword) (plist-get info keyword))
(export-property (keyword) (org-export-data (get-property keyword) info)))
(insert (ox-linuxmag-fr--format-texth (export-property :title) "Heading"))
(insert (ox-linuxmag-fr--format-textp (export-property :author) "Signature"))
(insert (ox-linuxmag-fr--format-textp
(format "[%s]" (export-property :author-description))
"Signature"))
(insert (ox-linuxmag-fr--format-textp (export-property :description) "chapeau"))
(insert (ox-linuxmag-fr--format-pragma "Mots-clés"))
(insert (ox-linuxmag-fr--format-textp (export-property :keywords)))
(insert (ox-linuxmag-fr--format-pragma (format "Fin %s" "Mots-clés")))
(when-let* ((logos (get-property :logos)))
(dolist (logo (split-string logos ","))
(insert (ox-linuxmag-fr--format-pragma (format "Logo : %s" (string-trim logo))))))))
(defvar nxml-auto-insert-xml-declaration-flag)
;;; End-user function
(defun ox-linuxmag-fr-export-to-odt (&optional async subtreep visible-only ext-plist)
"Export current buffer to a ODT file.
If narrowing is active in the current buffer, only export its
narrowed part.
If a region is active, export that region.
A non-nil optional argument ASYNC means the process should happen
asynchronously. The resulting file should be accessible through
the `org-export-stack' interface.
When optional argument SUBTREEP is non-nil, export the sub-tree
at point, extracting information from the headline properties
first.
When optional argument VISIBLE-ONLY is non-nil, don't export
contents of hidden elements.
EXT-PLIST, when provided, is a property list with external
parameters overriding Org default settings, but still inferior to
file-local settings.
Return output file's name."
(interactive)
(let ((outfile (org-export-output-file-name ".odt" subtreep)))
(if async
(org-export-async-start (lambda (f) (org-export-add-to-stack f 'linuxmag-fr))
`(expand-file-name
(ox-linuxmag-fr--export-to-odt-sync ,outfile ,subtreep ,visible-only ,ext-plist)))
(ox-linuxmag-fr--export-to-odt-sync outfile subtreep visible-only ext-plist))))
(defun ox-linuxmag-fr--export-to-odt-sync (outfile subtreep visible-only ext-plist)
"Synchronously export current org buffer to a OUTFILE ODT file.
If narrowing is active in the current buffer, only export its
narrowed part.
If a region is active, export that region.
When optional argument SUBTREEP is non-nil, export the sub-tree
at point, extracting information from the headline properties
first.
When optional argument VISIBLE-ONLY is non-nil, don't export
contents of hidden elements.
EXT-PLIST, when provided, is a property list with external
parameters overriding Org default settings, but still inferior to
file-local settings.
Return output file's name."
(let* ((basename (file-name-nondirectory (file-name-sans-extension outfile)))
(figure-files (make-hash-table)))
(org-odt--export-wrap
outfile
(let* ((other-files (make-hash-table))
(ext-plist `(,@ext-plist
:ox-linuxmag-fr-basename ,basename
:ox-linuxmag-fr-figure-files ,figure-files
:ox-linuxmag-fr-other-files ,other-files)))
(ox-linuxmag-fr--write-content-file subtreep visible-only ext-plist)
(ox-linuxmag-fr--write-secondary-files other-files)))
(ox-linuxmag-fr--archive-odt-and-figures basename outfile figure-files)))
(defun ox-linuxmag-fr--write-content-file (subtreep visible-only ext-plist)
"Write the content.xml file to disk.
If narrowing is active in the current buffer, only export its
narrowed part.
If a region is active, export that region.
When optional argument SUBTREEP is non-nil, export the sub-tree
at point, extracting information from the headline properties
first.
When optional argument VISIBLE-ONLY is non-nil, don't export
contents of hidden elements.
EXT-PLIST, when provided, is a property list with external
parameters overriding Org default settings, but still inferior to
file-local settings.
Return output file's name."
(let ((content (org-export-as 'linuxmag-fr subtreep visible-only nil ext-plist)))
(with-current-buffer (ox-linuxmag-fr--content-xml-buffer) (erase-buffer) (insert content))))
(defun ox-linuxmag-fr--content-xml-buffer ()
"Return the buffer containing content.xml."
(require 'nxml-mode)
(let ((nxml-auto-insert-xml-declaration-flag nil))
(find-file-noselect
(concat org-odt-zip-dir "content.xml") t)))
;;; Transcoders
(defun ox-linuxmag-fr--bold (_bold contents _info)
"Transcode BOLD from Org to ODT.
CONTENTS is the text with bold markup. INFO is a plist holding
contextual information."
(ox-linuxmag-fr--format-textspan contents "gras"))
(defun ox-linuxmag-fr--code (code _contents _info)
"Transcode a CODE object from Org to ODT.
CONTENTS is nil. INFO is a plist used as a communication
channel."
(format "<text:span text:style-name=\"%s\">%s</text:span>"
ox-linuxmag-fr--inline-code-style
(org-odt--encode-plain-text (org-element-property :value code))))
(defun ox-linuxmag-fr--headline (headline contents info)
"Transcode a HEADLINE element from Org to ODT.
CONTENTS holds the contents of the headline. INFO is a plist
holding contextual information."
(let* ((numbered (org-export-numbered-headline-p headline info))
(format-headline-function
(cl-function
(lambda (_todo _todo-type _priority text _tags &key section-number &allow-other-keys)
(cond
((not numbered) text)
((seq-contains-p section-number ?.) (format "%s %s" section-number text))
(t (format "%s. %s" section-number text))))))
(full-text (org-odt-format-headline--wrap headline nil info format-headline-function))
(level (org-export-get-relative-level headline info)))
(concat
(ox-linuxmag-fr--format-texth full-text (format "Heading_20_%s" level))
contents)))
(defun ox-linuxmag-fr--italic (_italic contents _info)
"Transcode ITALIC from Org to ODT.
CONTENTS is the text with italic markup. INFO is a plist holding
contextual information."
(ox-linuxmag-fr--format-textspan contents "italic"))
(defun ox-linuxmag-fr--link (link desc info)
"Transcode a LINK object from Org to ODT.
DESC is the description part of the link, or the empty string.
INFO is a plist holding contextual information. See
`org-export-data'."
(let ((raw-link (org-element-property :raw-link link)))
(cl-case (intern (org-element-property :type link))
(fuzzy (ox-linuxmag-fr--format-fuzzy-link link desc info))
;; file links are taken care of by the containing paragraph:
(file nil)
(t (ox-linuxmag-fr--format-textspan raw-link "url")))))
(defun ox-linuxmag-fr--is-paragraph-a-figure-p (paragraph info)
"Return non-nil if PARAGRAPH is the definition of an external figure.
INFO is a plist holding contextual information."
(org-odt--standalone-link-p paragraph info))
(defun ox-linuxmag-fr--figure-number (element info)
"Return the one-based position of the figure ELEMENT in the document.
Return nil if ELEMENT is not the definition of an external figure.
INFO is a plist holding contextual information."
(when (and (eq (org-element-type element) 'paragraph)
(ox-linuxmag-fr--is-paragraph-a-figure-p element info))
(org-export-get-ordinal element info nil #'ox-linuxmag-fr--is-paragraph-a-figure-p)))
(defun ox-linuxmag-fr--format-fuzzy-link (link desc info)
"Return a string representing LINK.
If LINK targets a figure, the returned string is the one-based
position of the figure within the document.
DESC is the description part of the link, or the empty string.
INFO is a plist holding contextual information."
(let* ((target (org-export-resolve-fuzzy-link link info)))
(if (and (eq (org-element-type target) 'paragraph)
(ox-linuxmag-fr--is-paragraph-a-figure-p target info))
(format (number-to-string (ox-linuxmag-fr--figure-number target info)))
(let* ((ref-string (ox-linuxmag-fr--format-textspan
(format "[%s]" (org-element-property :raw-link link)) "gras")))
(if (length= desc 0)
ref-string
(concat desc " " ref-string))))))
(defun ox-linuxmag-fr--paragraph (paragraph contents info)
"Transcode a PARAGRAPH element from Org to ODT.
CONTENTS is the contents of the paragraph, as a string. INFO is
the plist used as a communication channel."
(cond
((ox-linuxmag-fr--is-paragraph-a-figure-p paragraph info)
(ox-linuxmag-fr--format-figure paragraph contents info))
(t
(let* ((parent (org-export-get-parent paragraph))
(parent-type (org-element-type parent))
(prefix (when (eq parent-type 'item) "- "))
(style (if (and
(eq parent-type 'special-block)
(equal (org-element-property :type parent) "note_pao"))
"pragma"
"Normal")))
(org-odt--format-paragraph
paragraph
(concat prefix contents)
info
style
"" "")))))
(defun ox-linuxmag-fr--format-note (contents note-type)
"Return a string containing CONTENTS with a box markup.
NOTE-TYPE is a symbol representing the kind of box."
(cl-case note-type
(PAO (concat
(ox-linuxmag-fr--format-pragma "Début note PAO")
contents
(ox-linuxmag-fr--format-pragma "Fin note PAO")))
((attention avertissement)
(concat
(ox-linuxmag-fr--format-pragma (format "Début note : %s" (capitalize (symbol-name note-type))))
contents
(ox-linuxmag-fr--format-pragma "Fin note")))
(t
(concat
(ox-linuxmag-fr--format-pragma (format "Début note"))
contents
(ox-linuxmag-fr--format-pragma "Fin note")))))
(defun ox-linuxmag-fr--format-figure (paragraph _contents info)
"Return a string representing the figure in PARAGRAPH.
INFO is a plist holding contextual information."
(when-let* ((link (org-element-map paragraph 'link #'identity info t))
(path (org-element-property :path link))
(figure-number (ox-linuxmag-fr--figure-number paragraph info))
(filename (format "%s_%s_%02d.%s"
(plist-get info :ox-linuxmag-fr-basename)
(file-name-sans-extension (file-name-nondirectory path))
figure-number
(file-name-extension path)))
(pragma (format "Image : %s" filename))
(legend (org-export-data (org-export-get-caption paragraph) info)))
(puthash figure-number
(list
:source-filename path
:target-filename filename)
(plist-get info :ox-linuxmag-fr-figure-files))
(concat
(ox-linuxmag-fr--format-pragma pragma)
(ox-linuxmag-fr--format-textp (format "Fig. %s : %s" figure-number legend) "legende"))))
(defun ox-linuxmag-fr--special-block (special-block contents _info)
"Transcode a SPECIAL-BLOCK element from Org to ODT.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
(let ((type (intern (org-element-property :type special-block))))
(cl-case type
(encadre (ox-linuxmag-fr--format-encadre special-block contents))
(note (ox-linuxmag-fr--format-note contents 'default))
(note_pao (ox-linuxmag-fr--format-note contents 'PAO))
(note_avertissement (ox-linuxmag-fr--format-note contents 'avertissement))
(note_attention (ox-linuxmag-fr--format-note contents 'attention))
(t contents))))
(defun ox-linuxmag-fr--format-encadre (special-block contents)
"Return a string containing CONTENTS surrounded with markup for a box.
SPECIAL-BLOCK is the element containing the whole block."
(let ((title (org-export-read-attribute :attr_linuxmag-fr special-block :titre)))
(concat
(ox-linuxmag-fr--format-pragma "Début encadré")
(format "<text:h text:style-name=\"Heading_20_1\" text:outline-level=\"1\">%s</text:h>" title)
contents
(ox-linuxmag-fr--format-pragma "Fin encadré"))))
(defun ox-linuxmag-fr--src-block (src-block _contents info)
"Transcode a SRC-BLOCK element from Org to ODT.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
(let ((block-type (or (org-export-read-attribute :attr_linuxmag-fr src-block :type)
"code"))
(info (ox-linuxmag-fr--src-block-rewrite-info info)))
(mapconcat
(lambda (line) (ox-linuxmag-fr--src-block-convert-line line src-block block-type info))
(org-split-string (org-element-property :value src-block) "\n")
"\n")))
(defun ox-linuxmag-fr--src-block-rewrite-info (info)
"Rewrite INFO so spaces in plain-text strings are preserved.
INFO is a plist holding contextual information."
(let* ((identity-transcoder (lambda (data _info) (org-odt--encode-plain-text data)))
(initial-translate-alist (plist-get info :translate-alist))
(translate-alist `((plain-text . ,identity-transcoder)
,@initial-translate-alist)))
`(:translate-alist ,translate-alist ,@info)))
(defun ox-linuxmag-fr--src-block-convert-line (line src-block block-type info)
"Convert string LINE into ODT.
SRC-BLOCK is the Org parsed element containing this
line. BLOCK-TYPE is either \"console\" or \"code\". INFO is a
plist holding contextual information."
(ox-linuxmag-fr--format-textp
(let* ((ox-linuxmag-fr--inline-code-style "code_5f_em"))
(org-export-data
(org-element-parse-secondary-string line '(code) src-block)
info))
block-type))
(defun ox-linuxmag-fr--table (table contents info)
"Transcode a TABLE element from Org to ODT.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
(concat
(format "<table:table table:style-name=\"Tableau\">")
(format "<table:table-column table:style-name=\"Tableau.A\" table:number-columns-repeated=\"%s\"/>"
(length (org-odt-table-first-row-data-cells table info)))
contents
(format "</table:table>")))
(defun ox-linuxmag-fr--table-cell (_table-cell contents _info)
"Transcode a TABLE-CELL element from Org to ODT.
CONTENTS is nil. INFO is a plist used as a communication
channel."
(concat
(format "<table:table-cell table:style-name=\"Tableau.A1\" office:value-type=\"string\">")
(when contents (ox-linuxmag-fr--format-textp contents))
(format "</table:table-cell>")))
(defun ox-linuxmag-fr--target (target _contents _info)
"Transcode a TARGET object from Org to ODT.
CONTENTS is nil. INFO is a plist holding contextual
information."
(ox-linuxmag-fr--format-textspan
(format "[%s]" (org-element-property :value target))
"gras"))
(defun ox-linuxmag-fr--underline (_underline contents _info)
"Transcode UNDERLINE from Org to ODT.
CONTENTS is the text with underline markup. INFO is a plist
holding contextual information."
(ox-linuxmag-fr--format-textspan contents "menu"))
;;; Utility functions
(defun ox-linuxmag-fr--format-contents (_element contents _info)
"Return CONTENTS."
contents)
(defun ox-linuxmag-fr--format-pragma (pragma)
"Return a string containing a paragraph with PRAGMA."
(ox-linuxmag-fr--format-textp (format "/// %s ///" pragma) "pragma"))
(defun ox-linuxmag-fr--format-textp (content &optional style)
"Return a string containing a paragraph with CONTENT.
Use STYLE as the paragraph's style or \"Normal\" if nil."
(format "<text:p text:style-name=\"%s\">%s</text:p>" (or style "Normal") content))
(defun ox-linuxmag-fr--format-texth (content style)
"Return a string containing a header with CONTENT.
Use STYLE as the header's style."
(format "<text:h text:style-name=\"%s\">%s</text:h>" style content))
(defun ox-linuxmag-fr--format-textspan (content style)
"Return a string containing a span with CONTENT.
Use STYLE as the span's style."
(format "<text:span text:style-name=\"%s\">%s</text:span>" style content))
;;; Write secondary files
(defun ox-linuxmag-fr--generate-secondary-files-contents (info _backend)
"Add to INFO the contents of meta.xml.
INFO is a plist holding contextual information."
(puthash :meta (ox-linuxmag-fr--make-meta-content info) (plist-get info :ox-linuxmag-fr-other-files))
info)
(defun ox-linuxmag-fr--make-meta-content (info)
"Return the contents of the meta.xml file.
INFO is a plist holding contextual information."
(let ((title (org-export-data (plist-get info :title) info))
(subtitle (org-export-data (plist-get info :subtitle) info))
(author (let ((author (plist-get info :author)))
(if (not author) "" (org-export-data author info))))
(keywords (or (plist-get info :keywords) ""))
(description (or (plist-get info :description) "")))
(with-temp-buffer
(insert "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
<office:document-meta
xmlns:office=\"urn:oasis:names:tc:opendocument:xmlns:office:1.0\"
xmlns:xlink=\"http://www.w3.org/1999/xlink\"
xmlns:dc=\"http://purl.org/dc/elements/1.1/\"
xmlns:meta=\"urn:oasis:names:tc:opendocument:xmlns:meta:1.0\"
xmlns:ooo=\"http://openoffice.org/2004/office\"
office:version=\"1.2\">
<office:meta>\n")
(insert (format "<dc:creator>%s</dc:creator>\n" author))
(insert (format "<meta:initial-creator>%s</meta:initial-creator>\n" author))
;; Date, if required.
(when (plist-get info :with-date)
;; Check if DATE is specified as an Org-timestamp. If yes,
;; include it as meta information. Otherwise, just use
;; today's date.
(let* ((date (let ((date (plist-get info :date)))
(and (not (cdr date))
(eq (org-element-type (car date)) 'timestamp)
(car date)))))
(let ((iso-date (org-odt--format-timestamp date nil 'iso-date)))
(insert (format "<dc:date>%s</dc:date>\n" iso-date))
(insert (format "<meta:creation-date>%s</meta:creation-date>\n" iso-date)))))
(insert (format "<meta:generator>%s</meta:generator>\n" (plist-get info :creator)))
(insert (format "<meta:keyword>%s</meta:keyword>\n" keywords))
(insert (format "<dc:subject>%s</dc:subject>\n" description))
(insert (format "<dc:title>%s</dc:title>\n" title))
(when (org-string-nw-p subtitle)
(insert (format
"<meta:user-defined meta:name=\"subtitle\">%s</meta:user-defined>\n"
subtitle)))
(insert "\n")
(insert " </office:meta>\n")
(insert "</office:document-meta>")
(buffer-substring-no-properties (point-min) (point-max)))))
(defun ox-linuxmag-fr--write-secondary-files (other-files)
"Write meta.xml and styles.xml to the disk.
OTHER-FILES is a hashtable with a :meta key and the content of
meta.xml as value."
(ox-linuxmag-fr--write-meta-file (gethash :meta other-files))
(ox-linuxmag-fr--write-styles-file))
(defun ox-linuxmag-fr--write-meta-file (content)
"Write CONTENT in the meta.xml file."
(write-region content nil (concat org-odt-zip-dir "meta.xml"))
(org-odt-create-manifest-file-entry "text/xml" "meta.xml"))
(defun ox-linuxmag-fr--write-styles-file ()
"Create the contents of the styles.xml file."
(let* ((styles-file (expand-file-name "styles.xml" ox-linuxmag-fr--resources-dir)))
(copy-file styles-file (concat org-odt-zip-dir "styles.xml") t)
;; create a manifest entry for styles.xml
(org-odt-create-manifest-file-entry "text/xml" "styles.xml")
;; Ensure we have write permissions to this file.
(set-file-modes (concat org-odt-zip-dir "styles.xml") #o600)))
;;; Create archive file with ODT file and referenced figures
(defun ox-linuxmag-fr--archive-odt-and-figures (basename odt-file figure-files)
"Create an archive file in `default-directory'.
The archive file will be named after BASENAME with the archive
extension appended. The ODT-FILE and the FIGURE-FILES will be
added to the archive."
(when-let* ((archive-directory (make-temp-file (format "%s-" basename) t)))
(ox-linuxmag-fr--add-files-to-archive-directory
(file-name-as-directory archive-directory)
odt-file
figure-files)
(ox-linuxmag-fr--make-archive archive-directory basename)))
(defun ox-linuxmag-fr--add-files-to-archive-directory (archive-directory odt-file figure-files)
"Add ODT-FILE and FIGURE-FILES to ARCHIVE-DIRECTORY."
(copy-file odt-file archive-directory)
(ox-linuxmag-fr--copy-figure-files-to-archive-directory figure-files archive-directory))
(defun ox-linuxmag-fr--copy-figure-files-to-archive-directory (figure-files archive-directory)
"Copy each of FIGURE-FILES to ARCHIVE-DIRECTORY.
FIGURE-FILES is a map whose keys are ignored and whose values
are (:source-filename SOURCE :target-filename TARGET)."
(pcase-dolist (`(:source-filename ,source :target-filename ,target)
(map-values figure-files))
(copy-file
source
(expand-file-name target archive-directory))))
(defun ox-linuxmag-fr--make-archive (archive-directory basename)
"Create an archive file named after BASENAME.
The content of the archive is the ARCHIVE-DIRECTORY."
(let ((compressed-file (dired-compress-file archive-directory)))
(rename-file
compressed-file
(expand-file-name
(format "%s.%s"
basename
;; Same as calling `file-name-extension' but handles
;; files with multiple extensions, e.g., .tar.gz:
(substring compressed-file (1+ (seq-position compressed-file ?.))))
default-directory)
t)))
(provide 'ox-linuxmag-fr)
;;; ox-linuxmag-fr.el ends here
;; LocalWords: Transcode xml OpenDocument https github outils
;; LocalWords: plist auteurs
;; LocalWords: transcoded