ox-skos.el 16 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494
  1. ;;; ox-skos.el --- SKOS Back-End for Org Export Engine
  2. ;; Copyright (C) 2017 Bastien Guerry
  3. ;; Author: Bastien Guerry <bzg@gnu.org>
  4. ;; Keywords: skos
  5. ;; This file is not part of GNU Emacs.
  6. ;; This program is free software: you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation, either version 3 of the License, or
  9. ;; (at your option) any later version.
  10. ;; This program is distributed in the hope that it will be useful,
  11. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. ;; GNU General Public License for more details.
  14. ;; You should have received a copy of the GNU General Public License
  15. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  16. ;;; Commentary:
  17. ;; This library implements a SKOS back-end (as TTL or XML/RDF) for Org
  18. ;; exporter, based on the `html' back-end.
  19. ;;
  20. ;; This backend understands these new option keywords:
  21. ;;
  22. ;; #+SKOS_EXTENSION: rdf (the default)
  23. ;; #+CONCEPTSCHEMEID: set the ID of the concept scheme
  24. ;; #+CONCEPTSCHEMEBASEURI: set the concept scheme base URI
  25. ;; #+CONCEPTSCHEMEID: set the concept scheme ID
  26. ;;
  27. ;;; Todo:
  28. ;;
  29. ;; - use :skos:note:fr: to specify the language?
  30. ;; - use :skos:note:1 or :skos:note:note_label for multiple notes?
  31. ;; - implement related (add var with list of properties?)
  32. ;; - use SKOS_EXTENSION for ttl output?
  33. ;; - write ox-skos-html to export to html
  34. ;; - write ox-skos-latex to export to latex (and scribble?!)
  35. ;;; Code:
  36. (require 'ox-html)
  37. (require 'ob-core)
  38. (require 'url-util)
  39. (declare-function url-encode-url "url-util" (url))
  40. (declare-function org-babel-parse-header-arguments "ob-core" (arg-string))
  41. ;;; Variables and options
  42. (defgroup org-export-skos nil
  43. "Options specific to SKOS export back-end."
  44. :tag "Org SKOS"
  45. :group 'org-export)
  46. (defcustom org-skos-extension "rdf"
  47. "File extension for the SKOS output file."
  48. :group 'org-export-skos
  49. :type 'string)
  50. (defcustom org-skos-uri-separator "/"
  51. "Separate the concept scheme URI and the concept scheme ID."
  52. :group 'org-export-skos
  53. :type 'string)
  54. (defcustom org-skos-id-separator "-"
  55. "Separate the concept scheme ID and the concept ID."
  56. :group 'org-export-skos
  57. :type 'string)
  58. ;; (setq org-skos-uri-separator "/")
  59. ;; (setq org-skos-id-separator "-")
  60. (defcustom org-skos-ISO-25964 nil
  61. "When non-nil, include ISO-THES data."
  62. :group 'org-export-skos
  63. :type 'boolean)
  64. ;; (setq org-skos-ISO-25964 nil)
  65. (defvar org-skos-terms nil
  66. "A list of terms to generate iso-thes data.")
  67. ;;; Define backend
  68. (org-export-define-derived-backend 'skos 'html
  69. :menu-entry
  70. '(?s "Export to SKOS"
  71. ((?s "As SKOS buffer"
  72. (lambda (a s v b) (org-skos-export-as-skos a s v)))
  73. (?S "As SKOS file" (lambda (a s v b) (org-skos-export-to-skos a s v)))))
  74. :options-alist
  75. '((:description "DESCRIPTION" nil nil newline)
  76. (:coverage "COVERAGE" nil nil newline)
  77. (:type "TYPE" nil nil newline)
  78. (:source "SOURCE" nil nil newline)
  79. (:contributor "CONTRIBUTOR" nil nil newline)
  80. (:homepage "HOMEPAGE" nil nil newline)
  81. (:rights "RIGHTS" nil nil newline)
  82. (:publisher "PUBLISHER" nil nil newline)
  83. (:subject "SUBJECT" nil nil newline)
  84. (:keywords "KEYWORDS" nil nil space)
  85. (:conceptschemebaseuri "CONCEPTSCHEMEBASEURI" nil nil t)
  86. (:conceptschemeid "CONCEPTSCHEMEID" nil nil t)
  87. (:with-toc nil nil nil)
  88. (:skos-extension "SKOS_EXTENSION" nil org-skos-extension))
  89. :filters-alist '((:filter-final-output . org-skos-final-function))
  90. :translate-alist '((headline . org-skos-headline)
  91. (comment . (lambda (&rest args) ""))
  92. (comment-block . (lambda (&rest args) ""))
  93. (section . org-skos-section)
  94. (paragraph . (lambda (&rest args) ""))
  95. (template . org-skos-template)))
  96. ;;; Export functions
  97. ;;;###autoload
  98. (defun org-skos-export-as-skos (&optional async subtreep visible-only)
  99. "Export current buffer to a SKOS buffer.
  100. If narrowing is active in the current buffer, only export its
  101. narrowed part.
  102. If a region is active, export that region.
  103. A non-nil optional argument ASYNC means the process should happen
  104. asynchronously. The resulting buffer should be accessible
  105. through the `org-export-stack' interface.
  106. When optional argument SUBTREEP is non-nil, export the sub-tree
  107. at point, extracting information from the headline properties
  108. first.
  109. When optional argument VISIBLE-ONLY is non-nil, don't export
  110. contents of hidden elements.
  111. Export is done in a buffer named \"*Org SKOS Export*\", which will
  112. be displayed when `org-export-show-temporary-export-buffer' is
  113. non-nil."
  114. (interactive)
  115. (setq org-skos-terms nil)
  116. (org-export-to-buffer 'skos "*Org SKOS Export*"
  117. async subtreep visible-only nil nil (lambda () (text-mode))))
  118. ;;;###autoload
  119. (defun org-skos-export-to-skos (&optional async subtreep visible-only)
  120. "Export current buffer to a SKOS file.
  121. If narrowing is active in the current buffer, only export its
  122. narrowed part.
  123. If a region is active, export that region.
  124. A non-nil optional argument ASYNC means the process should happen
  125. asynchronously. The resulting file should be accessible through
  126. the `org-export-stack' interface.
  127. When optional argument SUBTREEP is non-nil, export the sub-tree
  128. at point, extracting information from the headline properties
  129. first.
  130. When optional argument VISIBLE-ONLY is non-nil, don't export
  131. contents of hidden elements.
  132. Return output file's name."
  133. (interactive)
  134. (setq org-skos-terms nil)
  135. (let ((outfile (org-export-output-file-name
  136. (concat "." org-skos-extension) subtreep)))
  137. (org-export-to-file 'skos outfile async subtreep visible-only)))
  138. ;;;###autoload
  139. (defun org-skos-publish-to-skos (plist filename pub-dir)
  140. "Publish an org file to SKOS.
  141. FILENAME is the filename of the Org file to be published. PLIST
  142. is the property list for the given project. PUB-DIR is the
  143. publishing directory.
  144. Return output file name."
  145. (setq org-skos-terms nil)
  146. (org-publish-org-to
  147. 'skos filename (concat "." org-skos-extension) plist pub-dir))
  148. ;;; Main transcoding functions
  149. (defun org-skos-i18n (value lang attr conceptschemeuri conceptschemebaseuri)
  150. "Convert VALUE with LANG into xml attribute ATTR.
  151. VALUE can be a string or an alist."
  152. (if (null value) ""
  153. (let ((values (org-babel-parse-header-arguments value))
  154. (id (org-id-new))
  155. (attr0 (when (string-match "[^:]+:\\(.+\\)" attr)
  156. (match-string 1 attr))))
  157. (concat
  158. (when (and org-skos-ISO-25964
  159. (or (string= attr0 "prefLabel")
  160. (string= attr0 "altLabel")))
  161. ;; Update the global list of terms
  162. (push (list id attr0 values) org-skos-terms)
  163. (format (concat
  164. "<xl:" attr0 ">\n<iso-thes:"
  165. (cond ((string= attr0 "prefLabel") "PreferredTerm")
  166. ((string= attr0 "altLabel") "SimpleNonPreferredTerm")
  167. (t ""))
  168. " rdf:about=\"%s" org-skos-uri-separator
  169. "%s\" />\n</xl:" attr0 ">\n")
  170. conceptschemebaseuri id))
  171. (mapconcat
  172. (lambda (lv)
  173. (let ((l (if (cdr lv) (substring (symbol-name (car lv)) 1) lang))
  174. (v (if (cdr lv) (cdr lv) (symbol-name (car lv)))))
  175. (format "<%s xml:lang=\"%s\">%s</%s>" attr l v attr)))
  176. values
  177. "\n")))))
  178. (defun org-skos-headline (headline contents info)
  179. "Transcode HEADLINE element into SKOS format.
  180. CONTENTS is the headline contents. INFO is a plist used as a
  181. communication channel."
  182. (let* ((id (or (org-element-property :ID headline)
  183. (url-encode-url
  184. (org-element-property :URI headline))))
  185. (lang (org-export-data (plist-get info :language) info))
  186. (timestr (format-time-string-ISO-8601))
  187. ;; FIXME: check skos:scopeNote
  188. (conceptschemebaseuri
  189. (url-encode-url (plist-get info :conceptschemebaseuri)))
  190. (conceptschemeuri
  191. (concat
  192. conceptschemebaseuri
  193. org-skos-uri-separator
  194. (url-encode-url (plist-get info :conceptschemeid))))
  195. (notation
  196. (org-skos-i18n
  197. (org-element-property :SKOS:NOTATION headline)
  198. lang "skos:notation" conceptschemeuri conceptschemebaseuri))
  199. (example
  200. (org-skos-i18n
  201. (org-element-property :SKOS:EXAMPLE headline)
  202. lang "skos:example" conceptschemeuri conceptschemebaseuri))
  203. (note
  204. (org-skos-i18n
  205. (org-element-property :SKOS:NOTE headline)
  206. lang "skos:note" conceptschemeuri conceptschemebaseuri))
  207. (altlabel
  208. (org-skos-i18n
  209. (org-element-property :SKOS:ALTLABEL headline)
  210. lang "skos:altLabel" conceptschemeuri conceptschemebaseuri))
  211. (preflabel
  212. (org-skos-i18n
  213. (or (org-element-property :SKOS:PREFLABEL headline)
  214. (org-element-property :raw-value headline))
  215. lang "skos:prefLabel" conceptschemeuri conceptschemebaseuri))
  216. (broader
  217. (or
  218. (org-element-property :ID (org-export-get-parent-headline headline))
  219. (org-element-property :URI (org-export-get-parent-headline headline))))
  220. (narrower ;; a list of narrower URIs
  221. (org-element-map (plist-get info :parse-tree) 'headline
  222. (lambda (h)
  223. (if (equal
  224. (org-element-property
  225. :raw-value (org-export-get-parent-headline h))
  226. (org-element-property :raw-value headline))
  227. (or
  228. (org-element-property :ID h)
  229. (org-element-property :URI h))))))
  230. (parent (org-element-property :parent headline))
  231. ;; FIXME use org-export-get-previous-element?
  232. (first-para
  233. (car (delete
  234. nil
  235. (org-element-map parent 'paragraph
  236. (lambda (p)
  237. (if (eq (org-element-property
  238. :parent (org-element-property :parent p))
  239. headline)
  240. p))))))
  241. (definition
  242. (or (org-skos-i18n
  243. (org-element-property :SKOS:DEFINITION headline)
  244. lang "skos:definition" conceptschemeuri conceptschemebaseuri)
  245. (and first-para
  246. (format "<skos:definition xml:lang=\"%s\">%s</skos:definition>"
  247. lang
  248. (org-trim
  249. (buffer-substring-no-properties
  250. (org-element-property :contents-begin first-para)
  251. (org-element-property :contents-end first-para)))))
  252. "NO DEFINITION")))
  253. (concat
  254. ;; Add basic SKOS info
  255. (format
  256. "<skos:Concept rdf:about=\"%s%s%s\">
  257. <rdf:type rdf:resource=\"http://www.w3.org/2004/02/skos/core#Concept\"/>
  258. <skos:inScheme>
  259. <skos:ConceptScheme rdf:about=\"%s\"/>
  260. </skos:inScheme>
  261. <dct:modified>%s</dct:modified>
  262. <dct:created>%s</dct:created>
  263. "
  264. conceptschemeuri org-skos-id-separator id
  265. conceptschemeuri
  266. timestr timestr)
  267. definition "\n" notation "\n" preflabel "\n"
  268. altlabel "\n" example "\n" note "\n"
  269. (when org-skos-ISO-25964 "<iso-thes:status>1</iso-thes:status>\n")
  270. ;; Possibly add "broader"
  271. (when broader
  272. (format "<skos:broader rdf:resource=\"%s%s\"/>\n" conceptschemeuri broader))
  273. ;; Possibly add "narrower"
  274. (when narrower
  275. (mapconcat
  276. (lambda (n)
  277. (format "<skos:narrower rdf:resource=\"%s%s\"/>" conceptschemeuri n))
  278. narrower "\n"))
  279. ;; Possibly add topConceptOf
  280. (when (= (org-element-property :level headline) 1)
  281. (format "<skos:topConceptOf rdf:resource=\"%s\"/>" conceptschemeuri))
  282. ;; Possibly add iso-thes:status
  283. "\n</skos:Concept>\n"
  284. contents)))
  285. ;; FIXME: id should be uuid, without the conceptscheme base URI
  286. (defun org-skos-build-iso-thes-term (term conceptschemebaseuri)
  287. "Use `term' to build iso-thes bloc.
  288. `term' is a list with an id, an iso-thes attribute and a list of
  289. cons formed from a language specified and a litteral."
  290. (let ((timestr (format-time-string-ISO-8601))
  291. (id (car term))
  292. (attr (nth 1 term))
  293. (values (nth 2 term)))
  294. (format
  295. "<iso-thes:%s rdf:about=\"%s%s%s\">
  296. <iso-thes:status>1</iso-thes:status>
  297. %s
  298. <dct:modified>%s</dct:modified>
  299. <dct:created>%s</dct:created>
  300. </iso-thes:%s>"
  301. attr
  302. conceptschemebaseuri org-skos-uri-separator id
  303. (mapconcat
  304. (lambda(v)
  305. (format "<xl:literalForm xml:lang=\"%s\">%s</xl:literalForm>"
  306. ;; (car v)
  307. (substring (symbol-name (car v)) 1)
  308. (cdr v)))
  309. values "\n")
  310. timestr timestr
  311. attr)))
  312. (defun org-skos-build-iso-thes-terms (contents info)
  313. "Build the list of iso-thes terms using `org-skos-terms'."
  314. (let ((conceptschemebaseuri (plist-get info :conceptschemebaseuri)))
  315. (mapconcat
  316. (lambda (term)
  317. (org-skos-build-iso-thes-term term conceptschemebaseuri))
  318. org-skos-terms
  319. "\n")))
  320. (defun format-time-string-ISO-8601 ()
  321. (concat
  322. (format-time-string "%Y-%m-%dT%T")
  323. ((lambda (x) (concat (substring x 0 3) ":" (substring x 3 5)))
  324. (format-time-string "%z"))))
  325. (defun org-skos-build-top-level-description (contents info)
  326. (let ((conceptschemebaseuri (plist-get info :conceptschemebaseuri))
  327. (conceptschemeid (plist-get info :conceptschemeid))
  328. (description (plist-get info :description))
  329. (lang (org-export-data (plist-get info :language) info))
  330. (title (org-export-data (plist-get info :title) info))
  331. (publisher (org-export-data (plist-get info :publisher) info))
  332. (homepage (org-export-data (plist-get info :homepage) info))
  333. (rights (org-export-data (plist-get info :rights) info))
  334. (email (org-export-data (plist-get info :email) info))
  335. (type (org-export-data (plist-get info :type) info))
  336. (source (org-export-data (plist-get info :source) info))
  337. (author (org-export-data (plist-get info :author) info))
  338. (contributor (org-export-data (plist-get info :contributor) info))
  339. (subject (org-export-data (plist-get info :subject) info))
  340. (coverage (org-export-data (plist-get info :coverage) info))
  341. (timestr (format-time-string-ISO-8601)))
  342. (concat
  343. (format "<skos:ConceptScheme rdf:about=\"%s%s%s\">
  344. <rdf:type rdf:resource=\"http://www.w3.org/2004/02/skos/core#ConceptScheme\"/>
  345. <dc:rights>%s</dc:rights>
  346. <dct:created>%s</dct:created>
  347. <dc:relation></dc:relation>
  348. <dct:issued>Publication</dct:issued>
  349. <dct:modified>%s</dct:modified>
  350. <dc:type>%s</dc:type>
  351. <dc:source>%s</dc:source>
  352. <dc:subject>%s</dc:subject>
  353. <dc:coverage>%s</dc:coverage>
  354. <dc:language>%s-%s</dc:language>
  355. <dc:publisher>%s</dc:publisher>
  356. <dc:contributor>%s</dc:contributor>
  357. <dc:creator>
  358. <foaf:Organization>
  359. <foaf:mbox>%s</foaf:mbox>
  360. <foaf:homepage>%s</foaf:homepage>
  361. <foaf:name>%s</foaf:name>
  362. </foaf:Organization>
  363. </dc:creator>
  364. <dct:description xml:lang=\"%s\">%s</dct:description>
  365. <dct:title xml:lang=\"%s\">%s</dct:title>\n"
  366. conceptschemebaseuri org-skos-uri-separator conceptschemeid
  367. rights
  368. timestr
  369. timestr
  370. type
  371. source
  372. subject
  373. coverage
  374. lang (upcase lang)
  375. publisher
  376. contributor
  377. email homepage author
  378. lang description lang title)
  379. (mapconcat
  380. (lambda (uri)
  381. (format "<skos:hasTopConcept rdf:resource=\"%s%s%s%s%s\"/>"
  382. conceptschemebaseuri org-skos-uri-separator
  383. conceptschemeid org-skos-id-separator
  384. uri))
  385. (org-element-map (plist-get info :parse-tree)
  386. 'headline (lambda (h)
  387. ;; Only consider top-level concepts
  388. (if (= (org-element-property :level h) 1)
  389. (or (org-element-property :ID h)
  390. (url-encode-url
  391. (org-element-property :URI h))))))
  392. "\n")
  393. "\n</skos:ConceptScheme>")))
  394. (defun org-skos-template (contents info)
  395. "Return complete document string after SKOS conversion.
  396. CONTENTS is the transcoded contents string. INFO is a plist used
  397. as a communication channel."
  398. (concat
  399. (format "<?xml version=\"1.0\" encoding=\"%s\"?>\n"
  400. (symbol-name org-html-coding-system))
  401. "<rdf:RDF
  402. xmlns:schema=\"http://schema.org/\"
  403. xmlns:org=\"http://www.w3.org/ns/org#\"
  404. xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"
  405. xmlns:rdfs=\"http://www.w3.org/2000/01/rdf-schema#\"
  406. xmlns:dc=\"http://purl.org/dc/elements/1.1/\"
  407. xmlns:dct=\"http://purl.org/dc/terms/\"
  408. xmlns:foaf=\"http://xmlns.com/foaf/0.1/\"
  409. xmlns:mcc=\"http://www.culture.fr/thesaurus/elements/1.0/\"
  410. xmlns:skos=\"http://www.w3.org/2004/02/skos/core#\""
  411. (if org-skos-ISO-25964
  412. "
  413. xmlns:xsd=\"http://www.w3.org/2001/XMLSchema#\"
  414. xmlns:euvoc=\"http://publications.europa.eu/ontology/euvoc#\"
  415. xmlns:prov=\"http://www.w3.org/ns/prov#\"
  416. xmlns:skosxl=\"http://www.w3.org/2008/05/skos-xl#\">"
  417. ">")
  418. "\n"
  419. "\n"
  420. ;; Add description of top-level concepts
  421. (org-skos-build-top-level-description contents info)
  422. "\n"
  423. contents
  424. (when org-skos-ISO-25964
  425. (org-skos-build-iso-thes-terms contents info))
  426. "\n</rdf:RDF>"))
  427. (defun org-skos-section (section contents info)
  428. "Transcode SECTION element into SKOS format.
  429. CONTENTS is the section contents. INFO is a plist used as
  430. a communication channel."
  431. contents)
  432. ;;; Filters
  433. (defun org-skos-final-function (contents backend info)
  434. "Prettify the SKOS output."
  435. (with-temp-buffer
  436. (xml-mode)
  437. (insert contents)
  438. (indent-region (point-min) (point-max))
  439. (buffer-substring-no-properties (point-min) (point-max))))
  440. (provide 'ox-skos)
  441. ;;; ox-skos.el ends here