org-mtags.el 9.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257
  1. ;;; org-mtags.el --- Muse-like tags in Org-mode
  2. ;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
  3. ;;
  4. ;; Author: Carsten Dominik <carsten at orgmode dot org>
  5. ;; Keywords: outlines, hypermedia, calendar, wp
  6. ;; Homepage: http://orgmode.org
  7. ;; Version: 0.01
  8. ;;
  9. ;; This file is not yet part of GNU Emacs.
  10. ;;
  11. ;; GNU Emacs is free software; you can redistribute it and/or modify
  12. ;; it under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 3, or (at your option)
  14. ;; any later version.
  15. ;; GNU Emacs is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  18. ;; GNU General Public License for more details.
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with GNU Emacs; see the file COPYING. If not, write to the
  21. ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  22. ;; Boston, MA 02110-1301, USA.
  23. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  24. ;;
  25. ;;; Commentary:
  26. ;;
  27. ;; This modules implements some of the formatting tags available in
  28. ;; Emacs Muse. This is not a way if adding new functionality, but just
  29. ;; a different way to write some formatting directives. The advantage is
  30. ;; that files written in this way can be read by Muse reasonably well,
  31. ;; and that this provides an alternative way of writing formatting
  32. ;; directives in Org, a way that some might find more pleasant to type
  33. ;; and look at that the Org's #+BEGIN..#+END notation.
  34. ;; The goal of this development is to make it easier for people to
  35. ;; move between both worlds as they see fit for different tasks.
  36. ;; The following muse tags will be translated during export into their
  37. ;; native Org equivalents:
  38. ;;
  39. ;; <br>
  40. ;; Needs to be at the end of a line. Will be translated to "\\".
  41. ;;
  42. ;; <example switches="-n -r">
  43. ;; Needs to be on a line by itself, similarly the </example> tag.
  44. ;; Will be translated into Org's #+BEGIN_EXAMPLE construct.
  45. ;;
  46. ;; <quote>
  47. ;; Needs to be on a line by itself, similarly the </quote> tag.
  48. ;; Will be translated into Org's #+BEGIN_QUOTE construct.
  49. ;;
  50. ;; <comment>
  51. ;; Needs to be on a line by itself, similarly the </comment> tag.
  52. ;; Will be translated into Org's #+BEGIN_COMMENT construct.
  53. ;;
  54. ;; <verse>
  55. ;; Needs to be on a line by itself, similarly the </verse> tag.
  56. ;; Will be translated into Org's #+BEGIN_VERSE construct.
  57. ;;
  58. ;; <contents>
  59. ;; This gets translated into "[TABLE-OF-CONTENTS]". It will not
  60. ;; trigger the production of a table of contents - that is done
  61. ;; in Org with the "#+OPTIONS: toc:t" setting. But it will define
  62. ;; the location where the TOC will be placed.
  63. ;;
  64. ;; <literal style="STYLE"> ;; only latex, html, and docbook supported
  65. ;; in Org.
  66. ;; Needs to be on a line by itself, similarly the </literal> tag.
  67. ;;
  68. ;; <src lang="LANG" switches="-n -r">
  69. ;; Needs to be on a line by itself, similarly the </src> tag.
  70. ;; Will be translated into Org's BEGIN_SRC construct.
  71. ;;
  72. ;; <include file="FILE" markup="MARKUP" lang="LANG"
  73. ;; prefix="str" prefix1="str" switches="-n -r">
  74. ;; Needs to be on a line by itself.
  75. ;; Will be translated into Org's #+INCLUDE construct.
  76. ;;
  77. ;; The lisp/perl/ruby/python tags can be implemented using the
  78. ;; `org-eval.el' module, which see.
  79. (require 'org)
  80. ;;; Customization
  81. (defgroup org-mtags nil
  82. "Options concerning Muse tags in Org mode."
  83. :tag "Org Muse Tags"
  84. :group 'org)
  85. (defface org-mtags ; similar to shadow
  86. (org-compatible-face 'shadow
  87. '((((class color grayscale) (min-colors 88) (background light))
  88. (:foreground "grey50"))
  89. (((class color grayscale) (min-colors 88) (background dark))
  90. (:foreground "grey70"))
  91. (((class color) (min-colors 8) (background light))
  92. (:foreground "green"))
  93. (((class color) (min-colors 8) (background dark))
  94. (:foreground "yellow"))))
  95. "Face for Muse-like tags in Org."
  96. :group 'org-mtags
  97. :group 'org-faces)
  98. (defcustom org-mtags-prefer-muse-templates t
  99. "Non-nil means prefere Muse tags for structure elements.
  100. This is relevane when expanding the templates defined in the variable
  101. `org-structure-templates'."
  102. :group 'org-mtags
  103. :type 'boolean)
  104. (defconst org-mtags-supported-tags
  105. '("example" "quote" "comment" "verse" "contents" "literal" "src" "include")
  106. "The tags that are supported by org-mtags.el for conversion.
  107. In addition to this list, the <br> tag is supported as well.")
  108. (defconst org-mtags-fontification-re
  109. (concat
  110. "^[ \t]*</?\\("
  111. (mapconcat 'identity org-mtags-supported-tags "\\|")
  112. "\\)\\>[^>]*>\\|<br>[ \t]*$")
  113. "Regular expression used for fontifying muse tags.")
  114. (defun org-mtags-replace ()
  115. "Replace Muse-like tags with the appropriate Org constructs.
  116. The is done in the entire buffer."
  117. (interactive) ;; FIXME
  118. (let ((re (concat "^[ \t]*\\(</?\\("
  119. (mapconcat 'identity org-mtags-supported-tags "\\|")
  120. "\\)\\>\\)"))
  121. info tag rpl style markup lang file prefix prefix1 switches)
  122. ;; First, do the <br> tag
  123. (goto-char (point-min))
  124. (while (re-search-forward "<br>[ \t]*$" nil t)
  125. (replace-match "\\\\" t t))
  126. ;; Now, all the other tags
  127. (goto-char (point-min))
  128. (while (re-search-forward re nil t)
  129. (goto-char (match-beginning 1))
  130. (setq info (org-mtags-get-tag-and-attributes))
  131. (if (not info)
  132. (end-of-line 1)
  133. (setq tag (plist-get info :tag))
  134. (cond
  135. ((equal tag "contents")
  136. (setq rpl "[TABLE-OF-CONTENTS]")
  137. ;; FIXME: also trigger TOC in options-plist?????
  138. )
  139. ((member tag '("quote" "comment" "verse"))
  140. (if (plist-get info :closing)
  141. (setq rpl (format "#+END_%s" (upcase tag)))
  142. (setq rpl (format "#+BEGIN_%s" (upcase tag)))))
  143. ((equal tag "literal")
  144. (setq style (plist-get info :style))
  145. (and style (setq style (downcase style)))
  146. (if (plist-get info :closing)
  147. (setq rpl (cond
  148. ((member style '("latex"))
  149. "#+END_LaTeX")
  150. ((member style '("html"))
  151. "#+END_HTML")
  152. ((member style '("docbook"))
  153. "#+END_DOCBOOK")
  154. ((member style '("ascii"))
  155. "#+END_ASCII")))
  156. (setq rpl (cond
  157. ((member style '("latex"))
  158. "#+BEGIN_LaTeX")
  159. ((member style '("html"))
  160. "#+BEGIN_HTML")
  161. ((member style '("ascii"))
  162. "#+BEGIN_ASCII")))))
  163. ((equal tag "example")
  164. (if (plist-get info :closing)
  165. (setq rpl "#+END_EXAMPLE")
  166. (setq rpl "#+BEGIN_EXAMPLE")
  167. (when (setq switches (plist-get info :switches))
  168. (setq rpl (concat rpl " " switches)))))
  169. ((equal tag "src")
  170. (if (plist-get info :closing)
  171. (setq rpl "#+END_SRC")
  172. (setq rpl "#+BEGIN_SRC")
  173. (when (setq lang (plist-get info :lang))
  174. (setq rpl (concat rpl " " lang))
  175. (when (setq switches (plist-get info :switches))
  176. (setq rpl (concat rpl " " switches))))))
  177. ((equal tag "include")
  178. (setq file (plist-get info :file)
  179. markup (downcase (plist-get info :markup))
  180. lang (plist-get info :lang)
  181. prefix (plist-get info :prefix)
  182. prefix1 (plist-get info :prefix1)
  183. switches (plist-get info :switches))
  184. (setq rpl "#+INCLUDE")
  185. (setq rpl (concat rpl " " (prin1-to-string file)))
  186. (when markup
  187. (setq rpl (concat rpl " " markup))
  188. (when (and (equal markup "src") lang)
  189. (setq rpl (concat rpl " " lang))))
  190. (when prefix
  191. (setq rpl (concat rpl " :prefix " (prin1-to-string prefix))))
  192. (when prefix1
  193. (setq rpl (concat rpl " :prefix1 " (prin1-to-string prefix1))))
  194. (when switches
  195. (setq rpl (concat rpl " " switches)))))
  196. (when rpl
  197. (goto-char (plist-get info :match-beginning))
  198. (delete-region (point-at-bol) (plist-get info :match-end))
  199. (insert rpl))))))
  200. (defun org-mtags-get-tag-and-attributes ()
  201. "Parse a Muse-like tag at point ant rturn the information about it.
  202. The return value is a property list which contains all the attributes
  203. with string values. In addition, it reutnrs the following properties:
  204. :tag The tag as a string.
  205. :match-beginning The beginning of the match, just before \"<\".
  206. :match-end The end of the match, just after \">\".
  207. :closing t when the tag starts with \"</\"."
  208. (when (looking-at "<\\(/\\)?\\([a-zA-Z]+\\>\\)\\([^>]*\\)>")
  209. (let ((start 0)
  210. tag rest prop attributes endp val)
  211. (setq tag (org-match-string-no-properties 2)
  212. endp (match-end 1)
  213. rest (and (match-end 3)
  214. (org-match-string-no-properties 3))
  215. attributes (list :tag tag
  216. :match-beginning (match-beginning 0)
  217. :match-end (match-end 0)
  218. :closing endp))
  219. (when rest
  220. (while (string-match "\\([a-zA-Z]+\\)=\\([^ \t\n>]+\\|\"[^>]+\"\\)"
  221. rest start)
  222. (setq start (match-end 0)
  223. prop (org-match-string-no-properties 1 rest)
  224. val (org-remove-double-quotes
  225. (org-match-string-no-properties 2 rest)))
  226. (setq attributes (plist-put attributes
  227. (intern (concat ":" prop)) val))))
  228. attributes)))
  229. (defun org-mtags-fontify-tags (limit)
  230. "Fontify the muse-like tags."
  231. (while (re-search-forward org-mtags-fontification-re limit t)
  232. (add-text-properties (match-beginning 0) (match-end 0)
  233. '(face org-mtags font-lock-multiline t
  234. font-lock-fontified t))))
  235. (add-hook 'org-export-preprocess-hook 'org-mtags-replace)
  236. (add-hook 'org-font-lock-hook 'org-mtags-fontify-tags)
  237. (provide 'org-mtags)
  238. ;;; org-mtags.el ends here