[patch][ox-koma-letter] Support for to and from headings

[Rasmus <rasmus@gmx.us>]

[-- Attachment #1: Type: text/plain, Size: 380 bytes --]


Hi,

Some more patches that should work against the master branch.

Patch 1: bug fixes.  Most notably use symbols some places rather than
strings.

Patch 2 adds support for TO and FROM headings.  If you've got time for
testing I would appreciate feedback.  It's explained in the top of the
patch.

–Rasmus

-- 
This is the kind of tedious nonsense up with which I will not put

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Bug-fixes-for-ox-koma-letter.el.patch --]
[-- Type: text/x-patch, Size: 3764 bytes --]

From 8cc0953849b7b3e7d791c7ad4fd4a9a71581ada5 Mon Sep 17 00:00:00 2001
From: "rasmus.pank" <rasmus.pank@gmail.com>
Date: Mon, 27 May 2013 17:29:14 +0200
Subject: [PATCH 1/2] Bug fixes for ox-koma-letter.el

* ox-koma-letter.el: If tag wasn't given a headline could cause
  trouble.
* ox-koma-letter.el: bug in subject-format defcustom.
* ox-koma-letter.el: some newline changes
* ox-koma-letter.el: changed varioues quoted things to symbols.
---
 contrib/lisp/ox-koma-letter.el | 51 +++++++++++++++++++++++-------------------
 1 file changed, 28 insertions(+), 23 deletions(-)

diff --git a/contrib/lisp/ox-koma-letter.el b/contrib/lisp/ox-koma-letter.el
index 4af0ba7..82bdf33 100644
--- a/contrib/lisp/ox-koma-letter.el
+++ b/contrib/lisp/ox-koma-letter.el
@@ -93,7 +93,7 @@ string."
   :type '(radio (function-item user-full-name)
 		(string)
 		(function)
-		(const nil)))
+		(const :tag "Do not export author" nil)))
 
 (defcustom org-koma-letter-email 'org-koma-letter-email
   "The sender's email address.
@@ -105,7 +105,7 @@ function may be given.  Functions must return a string."
   :type '(radio (function-item org-koma-letter-email)
 		(string)
 		(function)
-		(const nil)))
+		(const :tag "Do not export email" nil)))
 
 (defcustom org-koma-letter-from-address nil
   "Sender's address, as a string."
@@ -153,17 +153,19 @@ writing the following values are allowed:
 
 Please refer to the KOMA-script manual (Table 4.16. in the
 English manual of 2012-07-22)"
-  :type '(set   (const  "afteropening")
-		(const  "beforeopening")
-		(const  "centered")
-		(const  "left")
-		(const  "right")
-		(const  "underlined")
-		(const  "titled")
-		(const  "untitled")
-		(const :tag "No export" nil)
-		(const :tag "Default options" t)
-		(string))
+  :type '(radio
+	  (const :tag "No export" nil)
+	  (const :tag "Default options" t)
+	  (set :tag "selection"
+	   (const  'afteropening)
+	   (const  'beforeopening)
+	   (const  'centered)
+	   (const  'left)
+	   (const  'right)
+	   (const  'underlined)
+	   (const  'titled)
+	   (const  'untitled))
+	  (string))
   :group 'org-export-koma-letter)
 
 
@@ -198,15 +200,16 @@ Use `foldmarks:true' to activate default fold marks or
   :group 'org-export-koma-letter
   :type 'boolean)
 
-(defconst org-koma-letter-special-tags-after-closing
-  '("ps" "encl" "cc")
+
+
+(defconst org-koma-letter-special-tags-after-closing '(ps encl cc)
   "Header tags to be inserted after closing")
 
-(defconst org-koma-letter-special-tags-after-letter '("after_letter")
+(defconst org-koma-letter-special-tags-after-letter '(after_letter)
   "Header tags to be inserted after closing")
 
-(defvar org-koma-letter-special-contents nil "holds special
-content temporarily.")
+(defvar org-koma-letter-special-contents nil
+  "holds special content temporarily.")
 
 
 \f
@@ -286,9 +289,10 @@ is t the content in `org-koma-letter-special-contents' will not
 be wrapped in a macro named whatever the members of a-list are called.
 "
   (let (output)
-    (dolist (ac a-list output)
-      (let
-	  ((x (org-koma-letter--get-tagged-contents ac))
+    (dolist (ac* a-list output)
+      (let*
+	  ((ac (cond ((symbolp ac*) (symbol-name ac*)) (t ac*)))
+	   (x (org-koma-letter--get-tagged-contents ac))
 	   (regexp (if keep-newlines "" "\\`\n+\\|\n*\\'")))
 	(when x
 	  (setq output
@@ -354,8 +358,9 @@ appropriate place."
   (let*
       ((tags (and (plist-get info :with-tags)
 		 (org-export-get-tags headline info)))
-       (tag (downcase (car tags))))
-    (if (member tag (plist-get info :special-tags))
+       (tag (if tags  (downcase (car tags)))))
+    (if (member tag
+		(mapcar 'symbol-name (plist-get info :special-tags)))
 	(progn
 	  (push (cons tag contents)
 		org-koma-letter-special-contents)
-- 
1.8.3


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Added-support-for-to-and-from-heading.patch --]
[-- Type: text/x-patch, Size: 9254 bytes --]

From 7fbc3b4b9ef742b895b1af67ba1a05c93d511eea Mon Sep 17 00:00:00 2001
From: rasmus <rasmus@gmx.us>
Date: Sat, 1 Jun 2013 19:52:36 +0200
Subject: [PATCH 2/2] Added support for to and from heading.

* ox-koma-letter.el (org-koma-letter-special-tags-in-letter): list of
tags that are typeset as part of the letter.  *
ox-koma-letter.el (org-koma-letter--determine-special-value):
determine which value to use (for to and from currentlly) if more than
candidate is available.  Which value is selected depends on
`org-koma-letter-prefer-special-headings'.  *
ox-koma-letter.el (org-koma-letter-prefer-special-headings): a boolean
stating whether to prefer headings with to/from or the #+X_ADDRESS.

The following letter now exports "as expected".  In particular when
special-headings is t heading values have presedence so the
from address would be ="Rasmus\nEmacs\nOrg-mode"= where the
=\n=s would be escaped.  If specia-headings is nil (default)
the from would be my-adr.  The same is true for TO address.

#+BEGIN_SRC org
#+FROM_ADDRESS: my-adr
#+TO_ADDRESS: your-adr
#+LATEX_CLASS: koma-letter
#+OPTIONS: special-headings:t

Here's the contents

* from :from:

   Rasmus
   Emacs
   Org-mode
#+END_SRC

On a technical note, note that the default value will be used if
neither #+X_ADDRESS or a heading is given.
---
 contrib/lisp/ox-koma-letter.el | 77 ++++++++++++++++++++++++++++++++----------
 1 file changed, 60 insertions(+), 17 deletions(-)

diff --git a/contrib/lisp/ox-koma-letter.el b/contrib/lisp/ox-koma-letter.el
index 82bdf33..c8999e3 100644
--- a/contrib/lisp/ox-koma-letter.el
+++ b/contrib/lisp/ox-koma-letter.el
@@ -132,6 +132,13 @@ function may be given.  Functions must return a string."
   :group 'org-export-koma-letter
   :type 'string)
 
+
+(defcustom org-koma-letter-prefer-special-headings nil
+  "If both a TO or FROM is specified two places should the
+  heading version be preferred?"
+  :group 'org-export-koma-letter
+  :type 'boolean)
+
 (defcustom org-koma-letter-signature nil
   "String used as the signature."
   :group 'org-export-koma-letter
@@ -200,7 +207,8 @@ Use `foldmarks:true' to activate default fold marks or
   :group 'org-export-koma-letter
   :type 'boolean)
 
-
+(defconst org-koma-letter-special-tags-in-letter '(to from)
+  "header tags related to the letter itself")
 
 (defconst org-koma-letter-special-tags-after-closing '(ps encl cc)
   "Header tags to be inserted after closing")
@@ -219,7 +227,7 @@ Use `foldmarks:true' to activate default fold marks or
   :options-alist
   '((:lco "LCO" nil org-koma-letter-class-option-file)
     (:author "AUTHOR" nil (org-koma-letter--get-custom org-koma-letter-author) t)
-    (:from-address "FROM_ADDRESS" nil org-koma-letter-from-address newline)
+    (:from-address "FROM_ADDRESS" nil nil newline)
     (:phone-number "PHONE_NUMBER" nil org-koma-letter-phone-number)
     (:email "EMAIL" nil (org-koma-letter--get-custom org-koma-letter-email) t)
     (:to-address "TO_ADDRESS" nil nil newline)
@@ -227,9 +235,12 @@ Use `foldmarks:true' to activate default fold marks or
     (:opening "OPENING" nil org-koma-letter-opening)
     (:closing "CLOSING" nil org-koma-letter-closing)
     (:signature "SIGNATURE" nil org-koma-letter-signature newline)
-    (:special-tags nil nil
-		   (append org-koma-letter-special-tags-after-closing
-			   org-koma-letter-special-tags-after-letter))
+    (:special-tags nil nil (append
+			    org-koma-letter-special-tags-in-letter
+			    org-koma-letter-special-tags-after-closing
+			    org-koma-letter-special-tags-after-letter))
+    (:special-headings nil "special-headings"
+		       org-koma-letter-prefer-special-headings)
     (:with-after-closing nil "after-closing-order"
 			 org-koma-letter-special-tags-after-closing)
     (:with-after-letter nil "after-letter-order"
@@ -265,9 +276,9 @@ Use `foldmarks:true' to activate default fold marks or
 ;; The following is taken from/inspired by ox-grof.el
 ;; Thanks, Luis!
 
-(defun org-koma-letter--get-tagged-contents (tag)
+(defun org-koma-letter--get-tagged-contents (key)
   "Get tagged content from `org-koma-letter-special-contents'"
-  (cdr (assoc tag org-koma-letter-special-contents)))
+  (cdr (assoc (org-koma-letter--get-custom key) org-koma-letter-special-contents)))
 
 (defun org-koma-letter--get-custom (value)
   "Determines whether a value is nil, a string or a
@@ -275,8 +286,8 @@ function (a symobl).  If it is a function it it evaluates it."
   (when value
     (cond ((stringp value) value)
 	  ((functionp value) (funcall value))
-	  ((symbolp value) (symbol-name value)))))
-
+	  ((symbolp value) (symbol-name value))
+	  (t value))))
 
 (defun org-koma-letter--prepare-special-contents-as-macro (a-list &optional keep-newlines no-tag)
   "Finds all the components of `org-koma-letter-special-contents'
@@ -291,9 +302,8 @@ be wrapped in a macro named whatever the members of a-list are called.
   (let (output)
     (dolist (ac* a-list output)
       (let*
-	  ((ac (cond ((symbolp ac*) (symbol-name ac*)) (t ac*)))
-	   (x (org-koma-letter--get-tagged-contents ac))
-	   (regexp (if keep-newlines "" "\\`\n+\\|\n*\\'")))
+	  ((ac (org-koma-letter--get-custom ac*))
+	   (x (org-koma-letter--get-tagged-contents ac)))
 	(when x
 	  (setq output
 		(concat
@@ -301,7 +311,7 @@ be wrapped in a macro named whatever the members of a-list are called.
 		 ;; sometimes LaTeX complains about newlines
 		 ;; at the end or beginning of macros.  Remove them.
 		 (org-koma-letter--format-string-as-macro
-		  (format "%s" (replace-regexp-in-string regexp "" x))
+		  (if keep-newlines x (org-koma-letter--remove-offending-new-lines x))
 		  (unless no-tag  ac)))))))))
 
 (defun org-koma-letter--format-string-as-macro (string &optional macro)
@@ -310,10 +320,39 @@ be wrapped in a macro named whatever the members of a-list are called.
       (format "\\%s{%s}" macro string)
     (format "%s" string)))
 
+(defun org-koma-letter--remove-offending-new-lines (string)
+  "Remove new lines in the begging and end of `string'"
+  (replace-regexp-in-string "\\`\n+\\|\n*\\'" "" string))
+
+
+(defun org-koma-letter--determine-special-value (info key)
+  "Determine who the letter is to and whom it is from.
+  oxkoma-letter allows two ways to specify these things.  If both
+  are present return the preferred one as determined by
+ `org-koma-letter-prefer-special-headings'.  When `from' is t "
+  (let* ((plit-alist '((from . :from-address)
+			       (to . ::to-address)))
+	 (default-alist  `((from  ,org-koma-letter-from-address)
+			   (to  "\\mbox{}")))
+	 (option-value (plist-get info (cdr-safe (assoc key plit-alist))))
+	 (head-value (org-koma-letter--get-tagged-contents key))
+	 (order (append
+		 (funcall
+		  (if (plist-get info :special-headings)
+		      'reverse 'identity)
+		  `(,option-value ,head-value))
+		 (cdr-safe (assoc key default-alist))))
+	 (adr (cond ((car order)) ((cadr order)) ((caddr order)) (t nil))))
+    (when adr
+      (replace-regexp-in-string
+       "\n" "\\\\\\\\\n"
+       (org-koma-letter--remove-offending-new-lines adr)))))
+
 ;;; Transcode Functions
 
 ;;;; Export Block
 
+
 (defun org-koma-letter-export-block (export-block contents info)
   "Transcode an EXPORT-BLOCK element into KOMA Scrlttr2 code.
 CONTENTS is nil.  INFO is a plist used as a communication
@@ -323,6 +362,7 @@ channel."
 
 ;;;; Export Snippet
 
+
 (defun org-koma-letter-export-snippet (export-snippet contents info)
   "Transcode an EXPORT-SNIPPET object into KOMA Scrlttr2 code.
 CONTENTS is nil.  INFO is a plist used as a communication
@@ -332,12 +372,14 @@ channel."
 
 ;;;; Keyword
 
+
+
 (defun org-koma-letter-keyword (keyword contents info)
   "Transcode a KEYWORD element into KOMA Scrlttr2 code.
 CONTENTS is nil.  INFO is a plist used as a communication
 channel."
   (let ((key (org-element-property :key keyword))
-        (value (org-element-property :value keyword)))
+	(value (org-element-property :value keyword)))
     ;; Handle specifically BEAMER and TOC (headlines only) keywords.
     ;; Otherwise, fallback to `latex' back-end.
     (if (equal key "KOMA-LETTER") value
@@ -405,7 +447,7 @@ holding export options."
            info)))))
    (let ((lco (plist-get info :lco))
 	 (author (plist-get info :author))
-	 (from-address (plist-get info :from-address))
+	 (from-address (org-koma-letter--determine-special-value info 'from))
 	 (phone-number (plist-get info :phone-number))
 	 (email (plist-get info :email))
 	 (signature (plist-get info :signature)))
@@ -465,7 +507,7 @@ holding export options."
        (format "\\setkomavar{subject}{%s}\n\n" subject))))
    ;; Letter start
    (format "\\begin{letter}{%%\n%s}\n\n"
-	   (or (plist-get info :to-address) "no address given"))
+	   (org-koma-letter--determine-special-value info 'to))
    ;; Opening.
    (format "\\opening{%s}\n\n" (plist-get info :opening))
    ;; Letter body.
@@ -569,7 +611,8 @@ directory.
 
 Return output file's name."
   (interactive)
-  (let ((outfile (org-export-output-file-name ".tex" subtreep)))
+  (let ((outfile (org-export-output-file-name ".tex" subtreep))
+	(org-koma-letter-special-contents))
     (if async
 	(org-export-async-start
 	    (lambda (f) (org-export-add-to-stack f 'koma-letter))
-- 
1.8.3