Browse Source

Partial solution to the fontification problem. Having some trouble with the MATCH-STRING calls, but mostly ok.

Robert P. Goldman 15 years ago
parent
commit
daa6f98cab
1 changed files with 101 additions and 4 deletions
  1. 101 4
      contrib/lisp/org-export-generic.el

+ 101 - 4
contrib/lisp/org-export-generic.el

@@ -1,4 +1,4 @@
-;;; org-export-generic.el --- Export frameworg with custom backends
+;; org-export-generic.el --- Export frameworg with custom backends
 
 
 ;; Copyright (C) 2009  Free Software Foundation, Inc.
 ;; Copyright (C) 2009  Free Software Foundation, Inc.
 
 
@@ -466,6 +466,15 @@ preformatted text\).  A common non-nil value for this keyword
 is \"\\n\".  Should typically be combined with a value for 
 is \"\\n\".  Should typically be combined with a value for 
 :body-line-format that does NOT end with a newline."
 :body-line-format that does NOT end with a newline."
     :type string)
     :type string)
+
+;;; fontification keywords
+(def-org-export-generic-keyword :bold-format)
+(def-org-export-generic-keyword :italic-format)
+(def-org-export-generic-keyword :underline-format)
+(def-org-export-generic-keyword :strikethrough-format)
+(def-org-export-generic-keyword :code-format)
+(def-org-export-generic-keyword :verbatim-format)
+
     
     
   
   
 
 
@@ -623,6 +632,7 @@ underlined headlines.  The default is 3."
 		  :verbatim-multiline t
 		  :verbatim-multiline t
 		  :select-tags (plist-get export-plist :select-tags-export)
 		  :select-tags (plist-get export-plist :select-tags-export)
 		  :exclude-tags (plist-get export-plist :exclude-tags-export)
 		  :exclude-tags (plist-get export-plist :exclude-tags-export)
+                  :emph-multiline t
 		  :archived-trees
 		  :archived-trees
 		  (plist-get export-plist :archived-trees-export)
 		  (plist-get export-plist :archived-trees-export)
 		  :add-text (plist-get opt-plist :text))
 		  :add-text (plist-get opt-plist :text))
@@ -671,6 +681,16 @@ underlined headlines.  The default is 3."
 	 (bodylineform  (or (plist-get export-plist :body-line-format) "%s"))
 	 (bodylineform  (or (plist-get export-plist :body-line-format) "%s"))
          (blockquotestart (or (plist-get export-plist :blockquote-start) "\n\n\t"))
          (blockquotestart (or (plist-get export-plist :blockquote-start) "\n\n\t"))
          (blockquoteend (or (plist-get export-plist :blockquote-end) "\n\n"))
          (blockquoteend (or (plist-get export-plist :blockquote-end) "\n\n"))
+
+         ;; dynamic variables used heinously in fontification
+         ;; not referenced locally...
+         (format-boldify (plist-get export-plist :bold-format))
+         (format-italicize (plist-get export-plist :italic-format))
+         (format-underline (plist-get export-plist :underline-format))
+         (format-strikethrough (plist-get export-plist :strikethrough-format))
+         (format-code (plist-get export-plist :code-format))
+         (format-verbatim (plist-get export-plist :verbatim-format))
+
          
          
 
 
 	 thetoc toctags have-headings first-heading-pos
 	 thetoc toctags have-headings first-heading-pos
@@ -854,7 +874,7 @@ underlined headlines.  The default is 3."
 	    (if org-export-generic-links-to-notes
 	    (if org-export-generic-links-to-notes
 		(push (cons desc0 link) link-buffer)
 		(push (cons desc0 link) link-buffer)
 	      (setq rpl (concat rpl " (" link ")")
 	      (setq rpl (concat rpl " (" link ")")
-		    wrap (+ (length line) (- (length (match-string 0) line))
+		    wrap (+ (length line) (- (length (match-string 0 line)))
 			    (length desc)))))
 			    (length desc)))))
 	  (setq line (replace-match rpl t t line))))
 	  (setq line (replace-match rpl t t line))))
       (when custom-times
       (when custom-times
@@ -936,7 +956,7 @@ underlined headlines.  The default is 3."
 			     listcheckhalfend)))
 			     listcheckhalfend)))
 	 )
 	 )
 
 
-	(insert (format listformat line)))
+	(insert (format listformat (org-export-generic-fontify line))))
        ((string-match "^\\([ \t]+\\)\\([0-9]+\\.[ \t]*\\)" line)
        ((string-match "^\\([ \t]+\\)\\([0-9]+\\.[ \t]*\\)" line)
 	;;
 	;;
 	;; numbered list item
 	;; numbered list item
@@ -962,7 +982,7 @@ underlined headlines.  The default is 3."
 			     listcheckhalfend)))
 			     listcheckhalfend)))
 	 )
 	 )
 
 
-	(insert (format numlistformat line)))
+	(insert (format numlistformat (org-export-generic-fontify line))))
 
 
        ((equal line "ORG-BLOCKQUOTE-START")
        ((equal line "ORG-BLOCKQUOTE-START")
         (setq line blockquotestart))
         (setq line blockquotestart))
@@ -978,6 +998,9 @@ underlined headlines.  The default is 3."
 	;;
 	;;
 	(org-export-generic-check-section "body" bodytextpre bodytextsuf)
 	(org-export-generic-check-section "body" bodytextpre bodytextsuf)
 
 
+        (setq line 
+              (org-export-generic-fontify line))
+
 	;; XXX: properties?  list?
 	;; XXX: properties?  list?
 	(if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)" line)
 	(if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)" line)
 	    (setq line (replace-match "\\1\\3:" t nil line)))
 	    (setq line (replace-match "\\1\\3:" t nil line)))
@@ -1284,6 +1307,80 @@ REVERSE means to reverse the list if the plist match is a list
     (and vl (setcar vl nil))
     (and vl (setcar vl nil))
     vl))
     vl))
 
 
+
+;;; FIXME: this should probably turn into a defconstant later [2010/05/20:rpg]
+(defvar org-export-generic-emphasis-alist
+  '(("*" format-boldify nil)
+    ("/" format-italicize nil)
+    ("_" format-underline nil)
+    ("+" format-strikethrough nil)
+    ("=" format-code t)
+    ("~" format-verbatim t))
+  "Alist of org format -> formatting variables for fontification.
+Each element of the list is a list of three elements.
+The first element is the character used as a marker for fontification.
+The second element is a variable name, set in org-export-generic.  That
+variable will be dereferenced to obtain a formatting string to wrap 
+fontified text with.
+The third element decides whether to protect converted text from other
+conversions.")
+
+;;; Cargo-culted from the latex translation.  I couldn't figure out how
+;;; to keep the structure since the generic export operates on lines, rather
+;;; than on a buffer as in the latex export, meaning that none of the
+;;; search forward code could be kept.  This led me to rewrite the
+;;; whole thing recursively.  A huge lose for efficiency (potentially),
+;;; but I couldn't figure out how to make the looping work.
+;;; Worse, it's /doubly/ recursive, because this function calls
+;;; org-export-generic-emph-format, which can call it recursively...
+;;; [2010/05/20:rpg]
+(defun org-export-generic-fontify (string)
+  "Convert fontification according to generic rules."
+  (if (string-match org-emph-re string)
+        ;; The match goes one char after the *string*, except at the end of a line
+
+        ;; as far as I can tell from cargo-culting the code from
+        ;; the latex translation, we have the following:
+        ;; (match-string 1) is the material BEFORE the match
+        ;;          -- should be unchanged
+        ;; (match-string 3) is the actual markup character
+        ;; (match-string 4) is the material that is to be
+        ;;          marked up
+        ;; (match-string 5) is the remainder
+        (let ((emph (assoc (match-string 3 string)
+                           org-export-generic-emphasis-alist))
+              (beg (match-beginning 0)))
+          (unless emph
+            (message "`org-export-generic-emphasis-alist' has no entry for formatting triggered by \"%s\""
+                     (match-string 3 string)))
+          ;; now we need to determine whether we have strikethrough or
+          ;; a list, which is a bit nasty
+          (if (and (equal (match-string 3 str) "+")
+                   (save-match-data
+                     (string-match "\\`-+\\'" (match-string 4 str))))
+              ;; a list --- skip this match and recurse
+              (concat (substring str 0 (match-beginning 3))
+                      (org-export-generic-fontify (substring str (match-beginning 3))))
+              (concat (substring str 0 beg)
+                      (match-string 1 string)
+                      (org-export-generic-emph-format (second emph)
+                                                      (match-string 4 string)
+                                                      (third emph))
+                      (org-export-generic-fontify (match-string 5 string)))))
+        string))
+
+(defun org-export-generic-emph-format (format-varname string protect)
+  "Return a string that results from applying the markup indicated by
+FORMAT-VARNAME to STRING."
+  (let ((format (symbol-value format-varname)))
+    (let ((string-to-emphasize
+           (if protect
+               string
+               (org-export-generic-fontify string))))
+      (if format
+          (format format string-to-emphasize)
+          string-to-emphasize))))
+
 (provide 'org-generic)
 (provide 'org-generic)
 (provide 'org-export-generic)
 (provide 'org-export-generic)