Files
emacs/lisp/my/my-org-letter.el

447 lines
16 KiB
EmacsLisp
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
;;; my-org-letter.el --- Summary -*- lexical-binding: t -*-
;;; Commentary:
;; # -*- ispell-local-dictionary: "german" -*-
;; :FORM:
;; #+LANGUAGE: de
;; #+FROM_ASSOCIATION: XYZ AG
;; #+FROM_NAME: Max Mustermann
;; #+FROM_STREET: Regenbogenstrasse 7
;; #+FROM_PLACE: 12345 Hamburg
;; #+FROM_PHONE: 0123456789
;; #+FROM_URL: www.beispiel.de
;; #+FROM_EMAIL: mail@example.de
;; #+TO_ASSOCIATION: Firma AG
;; #+TO_NAME: Herr Karl Marx
;; #+TO_STREET: Firmstrasse 13
;; #+TO_PLACE: Berlin
;; #+PLACE: Hamburg
;; #+DATE: \today
;; # #+DATE: 3. Januar 2020
;; :END:
;; #+SUBJECT: Abrechnung
;; #+SUBJECT: 2020
;; #+SUBJECT_EXTRA: Kontonummer
;; #+SUBJECT_EXTRA: März
;; hiermit sende ich Ihnen die angeforderten Unterlagen zu und ...
;; #+ATTACHMENT: analage 1
;; #+ATTACHMENT: anlage 2
;; #+ATTACHMENT: analage 3
;; #+ATTACHMENT: analage 6
;;; Code:
(require 'ox-latex)
;;; Function Declarations
(defvar my-org-letter-export-with-toc)
(defvar my-org-letter-latex-default-packages-alist)
(defvar my-org-letter-latex-packages-alist)
(defvar my-org-letter-latex-compiler)
(defvar my-org-letter-latex-default-class)
(defvar my-org-letter-latex-default-class-options)
(defvar my-org-letter-latex-default-header)
(defvar my-org-letter-latex-default-header-extra)
(defvar my-org-letter-latex-opening-format)
(defvar my-org-letter-latex-opening)
(defvar my-org-letter-latex-closing-format)
(defvar my-org-letter-latex-closing)
(defvar my-org-letter-latex-subject)
(defvar my-org-letter-latex-subject-extra)
(defvar my-org-letter-latex-from-association)
(defvar my-org-letter-latex-from-name)
(defvar my-org-letter-latex-from-street)
(defvar my-org-letter-latex-from-place)
(defvar my-org-letter-latex-from-phone)
(defvar my-org-letter-latex-from-url)
(defvar my-org-letter-latex-from-email)
(defvar my-org-letter-latex-to-association)
(defvar my-org-letter-latex-to-name)
(defvar my-org-letter-latex-to-street)
(defvar my-org-letter-latex-to-place)
(defvar my-org-letter-latex-place)
(defvar my-org-letter-latex-attachment)
(defcustom my-org-letter-export-with-toc nil "")
(defcustom my-org-letter-latex-subject "" "")
(defcustom my-org-letter-latex-subject-extra "" "")
(defcustom my-org-letter-latex-from-association "" "")
(defcustom my-org-letter-latex-from-name "" "")
(defcustom my-org-letter-latex-from-street "" "")
(defcustom my-org-letter-latex-from-place "" "")
(defcustom my-org-letter-latex-from-phone "" "")
(defcustom my-org-letter-latex-from-url "" "")
(defcustom my-org-letter-latex-from-email "" "")
(defcustom my-org-letter-latex-to-association "" "")
(defcustom my-org-letter-latex-to-name "" "")
(defcustom my-org-letter-latex-to-street "" "")
(defcustom my-org-letter-latex-to-place "" "")
(defcustom my-org-letter-latex-place "" "")
(defcustom my-org-letter-latex-attachment "" "")
(org-export-define-derived-backend 'letter-latex 'latex
:menu-entry
'(?l ?l
(
;;(?T "As LaTeX buffer" my-org-letter-latex-export-as-latex)
;;(?t "As LaTeX file" my-org-letter-latex-export-to-latex)
(?t "As PDF-letter file" my-org-letter-latex-export-to-pdf)
(?T "As PDF-letter file and open"
(lambda (a s v b)
(if a (my-org-letter-latex-export-to-pdf t s v b)
(org-open-file (my-org-letter-latex-export-to-pdf nil s v b)))))))
:options-alist
'((:with-toc nil "toc" my-org-letter-export-with-toc)
(:latex-class "LATEX_CLASS" nil my-org-letter-latex-default-class t)
(:latex-class-options "LATEX_CLASS_OPTIONS" nil my-org-letter-latex-default-class-options t)
(:latex-header "LATEX_HEADER" nil my-org-letter-latex-default-header newline)
(:latex-header-extra "LATEX_HEADER_EXTRA" nil my-org-letter-latex-default-header-extra newline)
(:latex-compiler "LATEX_COMPILER" nil my-org-letter-latex-compiler)
(:letter-closing-format "CLOSING_FORMAT" nil my-org-letter-latex-closing-format newline)
(:letter-closing "CLOSING" nil my-org-letter-latex-closing newline)
(:letter-opening-format "OPENING_FORMAT" nil my-org-letter-latex-opening-format newline)
(:letter-opening "OPENING" nil my-org-letter-latex-opening newline)
(:letter-subject "SUBJECT" nil my-org-letter-latex-subject newline)
(:letter-subject-extra "SUBJECT_EXTRA" nil my-org-letter-latex-subject-extra newline)
(:letter-from-association "FROM_ASSOCIATION" nil my-org-letter-latex-from-association t)
(:letter-from-name "FROM_NAME" nil my-org-letter-latex-from-name t)
(:letter-from-street "FROM_STREET" nil my-org-letter-latex-from-street t)
(:letter-from-place "FROM_PLACE" nil my-org-letter-latex-from-place t)
(:letter-from-phone "FROM_PHONE" nil my-org-letter-latex-from-phone t)
(:letter-from-url "FROM_URL" nil my-org-letter-latex-from-url t)
(:letter-from-email "FROM_EMAIL" nil my-org-letter-latex-from-email t)
(:letter-to-association "TO_ASSOCIATION" nil my-org-letter-latex-to-association t)
(:letter-to-name "TO_NAME" nil my-org-letter-latex-to-name t)
(:letter-to-street "TO_STREET" nil my-org-letter-latex-to-street t)
(:letter-to-place "TO_PLACE" nil my-org-letter-latex-to-place t)
(:letter-place "PLACE" nil my-org-letter-latex-place t)
(:letter-attachment "ATTACHMENT" nil my-org-letter-latex-attachment newline))
:translate-alist
'((template . my-org-letter-latex-template))
)
;;;; Compilation
(defcustom my-org-letter-latex-compiler "lualatex"
"See `org-latex-compiler'"
:group 'org-export-latex
:type '(choice
(const :tag "pdfLaTeX" "pdflatex")
(const :tag "XeLaTeX" "xelatex")
(const :tag "LuaLaTeX" "lualatex")
(const :tag "Unset" ""))
:version "26.1"
:package-version '(Org . "9.0"))
;;;; Preamble
(defcustom my-org-letter-latex-default-class "koma-letter"
"The default LaTeX class."
:group 'org-export-latex
:type '(string :tag "LaTeX class"))
(defcustom my-org-letter-latex-default-class-options "[enlargefirstpage]"
"The default LaTeX class options."
:group 'org-export-latex
:type '(string :tag "LaTeX class"))
(add-to-list 'org-latex-classes
'("koma-letter" "\\documentclass{scrlttr2}"
("\\section{%s}" . "\\section*{%s}")
("\\subsection{%s}" . "\\subsection*{%s}")
("\\subsubsection{%s}" . "\\subsubsection*{%s}")
("\\paragraph{%s}" . "\\paragraph*{%s}")
("\\subparagraph{%s}" . "\\subparagraph*{%s}")))
(defcustom my-org-letter-latex-default-header
"\\setlength{\\parskip}{6pt}
\\setlength{\\parindent}{0pt}
\\setlength{\\textheight}{22.5cm}
\\newcommand{\\fromassociation}{<<fromassociation>>}
\\newcommand{\\fromname}{<<fromname>>}
\\setkomavar{fromname}{\\fromname}
\\newcommand{\\fromstreet}{<<fromstreet>>}
\\newcommand{\\fromplace}{<<fromplace>>}
\\setkomavar{fromaddress}{\\fromstreet, \\fromplace}
\\setkomavar{fromphone}{<<fromphone>>}
\\setkomavar{fromurl}{<<fromurl>>}
\\setkomavar{fromemail}{<<fromemail>>}
\\setkomavar{place}{<<place>>}
\\newcommand\\toassociation{<<toassociation>>}
\\newcommand\\toname{<<toname>>}
\\newcommand\\tostreet{<<tostreet>>}
\\newcommand\\toplace{<<toplace>>}
\\newcommand\\subject{<<subject>>}
\\newcommand\\subjectextra{<<subjectextra>>}
% adjust some spacings
\\makeatletter
\\@setplength{toaddrwidth}{10cm}
\\makeatother
"
"Preamble options"
:group 'my-org-letter-latex)
(defcustom my-org-letter-latex-default-header-extra ""
"Preamble extra options"
:group 'my-org-letter-latex
)
(defcustom my-org-letter-latex-default-packages-alist
'(("AUTO" "inputenc" t ("pdflatex"))
("T1" "fontenc" t ("pdflatex"))
("" "graphicx" t)
("" "grffile" t)
("" "longtable" nil)
("" "wrapfig" nil)
("" "rotating" nil)
("normalem" "ulem" t)
("" "amsmath" t)
("" "textcomp" t)
("" "amssymb" t)
("" "capt-of" nil)
("" "hyperref" nil)
;;
("ngerman" "babel" nil)
("utf8" "inputenc" nil)
("" "scrlayer-scrpage" nil)
)
"See `org-latex-default-packages-alist'"
:group 'my-org-letter-latex
;;:set 'org-set-packages-alist
;;:get 'org-get-packages-alist
:version "26.1"
:package-version '(Org . "8.3")
:type '(repeat
(choice
(list :tag "options/package pair"
(string :tag "options")
(string :tag "package")
(boolean :tag "Snippet")
(choice
(const :tag "For all compilers" nil)
(repeat :tag "Allowed compiler" string)))
(string :tag "A line of LaTeX"))))
(defcustom my-org-letter-latex-packages-alist nil
"See `org-latex-packages-alist'"
:group 'my-org-letter-latex
;;:set 'org-set-packages-alist
;;:get 'org-get-packages-alist
:type '(repeat
(choice
(list :tag "options/package pair"
(string :tag "options")
(string :tag "package")
(boolean :tag "Snippet"))
(string :tag "A line of LaTeX"))))
;;;; Document
(defcustom my-org-letter-latex-opening-format
"\\firsthead{
\\begin{flushright}\\textsf{\\begin{tabular}{l}
\\fromassociation \\\\ \\usekomavar{fromname} \\\\ \\fromstreet \\\\
\\fromplace\\\\[3mm] \\usekomavar{fromphone} \\\\ \\usekomavar{fromemail}
\\end{tabular}}\\end{flushright}
}
% Kopf und Fußzeile der Folgeseiten
\\defpagestyle{nextpage}{{} {} {\\textsf{\\parbox{\\hsize}{\\usekomavar{fromname}\\today\\ \\hrulefill\\ \\pagename~\\thepage}}}}
{{} {} {}}
\\pagestyle{nextpage}
\\begin{letter}{Empfänger} % den Wert Empfänger nicht verändern
\\setkomavar{toname}{\\toassociation \\\\ \\toname}
\\setkomavar{toaddress}{\\tostreet \\\\ \\toplace}
\\setkomavar{subject}{\\subject \\\\ {\\normalfont \\subjectextra}}
\\opening{<<opening>>}"
"Letter opening structure, will replace <<opening>> with `my-org-letter-latex-opening'."
:group 'my-org-letter-latex)
(defcustom my-org-letter-latex-opening
"Sehr geehrter \\toname,"
"Letter opening, see also `my-org-letter-latex-opening-format'."
:group 'my-org-letter-latex)
(defcustom my-org-letter-latex-closing-format
"\\closing{<<closing>>}"
"Letter closing structure, will replace <<closing>> with `my-org-letter-latex-closing'."
:group 'my-org-letter-latex)
(defcustom my-org-letter-latex-closing
"Freundliche Grüße,"
"Letter closing, see also `my-org-letter-latex-closing-format'."
:group 'my-org-letter-latex)
;;; Template
;;;###autoload
(defun my-org-letter-latex-make-preamble (info &optional template snippet?)
"See `org-latex-make-preamble'"
(let* ((class (plist-get info :latex-class))
(class-template
(or template
(let* ((class-options (plist-get info :latex-class-options))
(header (nth 1 (assoc class (plist-get info :latex-classes)))))
(and (stringp header)
(if (not class-options) header
(replace-regexp-in-string
"^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)"
class-options header t nil 1))))
(user-error "Unknown LaTeX class `%s'" class))))
(org-latex-guess-polyglossia-language
(org-latex-guess-babel-language
(org-latex-guess-inputenc
(org-element-normalize-string
(org-splice-latex-header
class-template
(org-latex--remove-packages my-org-letter-latex-default-packages-alist info)
(org-latex--remove-packages my-org-letter-latex-packages-alist info)
snippet?
(mapconcat #'org-element-normalize-string
(list (s-replace-all
(list (cons "<<fromassociation>>" (plist-get info :letter-from-association))
(cons "<<fromname>>" (plist-get info :letter-from-name))
(cons "<<fromstreet>>" (plist-get info :letter-from-street))
(cons "<<fromplace>>" (plist-get info :letter-from-place))
(cons "<<fromphone>>" (plist-get info :letter-from-phone))
(cons "<<fromurl>>" (plist-get info :letter-from-url))
(cons "<<fromemail>>" (plist-get info :letter-from-email))
(cons "<<toassociation>>" (plist-get info :letter-to-association))
(cons "<<toname>>" (plist-get info :letter-to-name))
(cons "<<tostreet>>" (plist-get info :letter-to-street))
(cons "<<toplace>>" (plist-get info :letter-to-place))
(cons "<<place>>" (plist-get info :letter-place))
(cons "<<date>>" (plist-get info :date))
(cons "<<subject>>" (string-replace "\n" "\\\\" (plist-get info :letter-subject)))
(cons "<<subjectextra>>" (string-replace "\n" "\\\\" (plist-get info :letter-subject-extra))))
(plist-get info :latex-header))
(and (not snippet?)
(plist-get info :latex-header-extra)))
""))))
info)
info)))
(defun my-org-letter-latex-template (contents info)
"See `org-latex-template'"
(let ((title (org-export-data (plist-get info :title) info))
(spec (org-latex--format-spec info)))
(concat
;; Time-stamp.
(and (plist-get info :time-stamp-file)
(format-time-string "%% Created %Y-%m-%d %a %H:%M\n"))
;; LaTeX compiler.
(org-latex--insert-compiler info)
;; Document class and packages.
(my-org-letter-latex-make-preamble info)
;; Possibly limit depth for headline numbering.
(let ((sec-num (plist-get info :section-numbers)))
(when (integerp sec-num)
(format "\\setcounter{secnumdepth}{%d}\n" sec-num)))
;; Author.
(let ((author (and (plist-get info :with-author)
(let ((auth (plist-get info :author)))
(and auth (org-export-data auth info)))))
(email (and (plist-get info :with-email)
(org-export-data (plist-get info :email) info))))
(cond ((and author email (not (string= "" email)))
(format "\\author{%s\\thanks{%s}}\n" author email))
((or author email) (format "\\author{%s}\n" (or author email)))))
;; Date.
(let ((date (and (plist-get info :with-date) (org-export-get-date info))))
(format "\\date{%s}\n" (org-export-data date info)))
;; Title and subtitle.
(let* ((subtitle (plist-get info :subtitle))
(formatted-subtitle
(when subtitle
(format (plist-get info :latex-subtitle-format)
(org-export-data subtitle info))))
(separate (plist-get info :latex-subtitle-separate)))
(concat
(format "\\title{%s%s}\n" title
(if separate "" (or formatted-subtitle "")))
(when (and separate subtitle)
(concat formatted-subtitle "\n"))))
;; Hyperref options.
(let ((template (plist-get info :latex-hyperref-template)))
(and (stringp template)
(format-spec template spec)))
;; Document start.
"\\begin{document}\n\n"
;; Title command.
(let* ((title-command (plist-get info :latex-title-command))
(command (and (stringp title-command)
(format-spec title-command spec))))
(org-element-normalize-string
(cond ((not (plist-get info :with-title)) nil)
((string= "" title) nil)
((not (stringp command)) nil)
((string-match "\\(?:[^%]\\|^\\)%s" command)
(format command title))
(t command))))
;; Table of contents.
(let ((depth (plist-get info :with-toc)))
(when depth
(concat (when (integerp depth)
(format "\\setcounter{tocdepth}{%d}\n" depth))
(plist-get info :latex-toc-command))))
;; Document's body.
(concat (string-replace
"<<opening>>"
(plist-get info :letter-opening)
(plist-get info :letter-opening-format))
"\n")
contents
(concat (string-replace
"<<closing>>"
(plist-get info :letter-closing)
(plist-get info :letter-closing-format))
"\n")
;; attachments
(let ((attachments (plist-get info :letter-attachment)))
(unless (string-equal attachments "")
(concat "\\vspace*{\\fill}\n"
"\\encl{" (string-replace "\n" "\\\\" attachments) "}\n")))
"\\end{letter}\n"
;; Creator.
(and (plist-get info :with-creator)
(concat (plist-get info :creator) "\n"))
;; Document end.
"\\end{document}")))
;;;###autoload
(defun my-org-letter-latex-export-to-latex
(&optional async subtreep visible-only body-only ext-plist)
"See `org-latex-export-to-latex'"
(interactive)
(let ((outfile (org-export-output-file-name ".tex" subtreep)))
(org-export-to-file 'letter-latex outfile
async subtreep visible-only body-only ext-plist)))
;;;###autoload
(defun my-org-letter-latex-export-to-pdf
(&optional async subtreep visible-only body-only ext-plist)
"See `org-latex-export-to-pdf'"
(interactive)
(let ((outfile (org-export-output-file-name ".tex" subtreep)))
(org-export-to-file 'letter-latex outfile
async subtreep visible-only body-only ext-plist
(lambda (file) (org-latex-compile file)))))
(provide 'my-org-letter)
;;; my-org-letter.el ends here