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