summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2018-06-23 23:33:37 +0200
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2018-06-23 23:33:37 +0200
commitf5d5a95018f0d3b99116c9df44022f0f8d4a26a7 (patch)
tree62d1424ccbf26b73b05f23886471ae8a5c65b736
parenta8677adb49f15491ab29efc894330958c9321c68 (diff)
downloadorg-mode-f5d5a95018f0d3b99116c9df44022f0f8d4a26a7.tar.gz
ox-koma-letter: Tiny refactoring and cosmetics
-rw-r--r--contrib/lisp/ox-koma-letter.el315
1 files changed, 157 insertions, 158 deletions
diff --git a/contrib/lisp/ox-koma-letter.el b/contrib/lisp/ox-koma-letter.el
index 47f5cf8..37ea4d0 100644
--- a/contrib/lisp/ox-koma-letter.el
+++ b/contrib/lisp/ox-koma-letter.el
@@ -125,12 +125,13 @@
;;; Code:
+(require 'cl-lib)
(require 'ox-latex)
;; Install a default letter class.
(unless (assoc "default-koma-letter" org-latex-classes)
(add-to-list 'org-latex-classes
- '("default-koma-letter" "\\documentclass[11pt]{scrlttr2}")))
+ '("default-koma-letter" "\\documentclass[11pt]{scrlttr2}")))
;;; User-Configurable Variables
@@ -157,9 +158,9 @@ Functions must return a string.
This option can also be set with the AUTHOR keyword."
:group 'org-export-koma-letter
:type '(radio (function-item user-full-name)
- (string)
- (function)
- (const :tag "Do not export author" nil)))
+ (string)
+ (function)
+ (const :tag "Do not export author" nil)))
(defcustom org-koma-letter-email 'org-koma-letter-email
"Sender's email address.
@@ -171,9 +172,9 @@ a function may be given. Functions must return a string.
This option can also be set with the EMAIL keyword."
:group 'org-export-koma-letter
:type '(radio (function-item org-koma-letter-email)
- (string)
- (function)
- (const :tag "Do not export email" nil)))
+ (string)
+ (function)
+ (const :tag "Do not export email" nil)))
(defcustom org-koma-letter-from-address ""
"Sender's address, as a string.
@@ -305,14 +306,14 @@ This option can also be set with the OPTIONS keyword, e.g.:
(const :tag "No export" nil)
(const :tag "Default options" t)
(set :tag "Configure options"
- (const :tag "Subject after opening" afteropening)
- (const :tag "Subject before opening" beforeopening)
- (const :tag "Subject centered" centered)
- (const :tag "Subject left-justified" left)
- (const :tag "Subject right-justified" right)
- (const :tag "Add title or description to subject" underlined)
- (const :tag "Set subject underlined" titled)
- (const :tag "Do not add title or description to subject" untitled)))
+ (const :tag "Subject after opening" afteropening)
+ (const :tag "Subject before opening" beforeopening)
+ (const :tag "Subject centered" centered)
+ (const :tag "Subject left-justified" left)
+ (const :tag "Subject right-justified" right)
+ (const :tag "Add title or description to subject" underlined)
+ (const :tag "Set subject underlined" titled)
+ (const :tag "Do not add title or description to subject" untitled)))
:group 'org-export-koma-letter)
(defcustom org-koma-letter-use-backaddress nil
@@ -354,24 +355,24 @@ This option can also be set with the OPTIONS keyword, e.g.:
\"foldmarks:(b l m t)\"."
:group 'org-export-koma-letter
:type '(choice
- (const :tag "Activate default folding marks" t)
- (const :tag "Deactivate folding marks" nil)
- (set
- :tag "Configure folding marks"
- (const :tag "Activate upper horizontal mark on left paper edge" B)
- (const :tag "Deactivate upper horizontal mark on left paper edge" b)
- (const :tag "Activate all horizontal marks on left paper edge" H)
- (const :tag "Deactivate all horizontal marks on left paper edge" h)
- (const :tag "Activate left vertical mark on upper paper edge" L)
- (const :tag "Deactivate left vertical mark on upper paper edge" l)
- (const :tag "Activate middle horizontal mark on left paper edge" M)
- (const :tag "Deactivate middle horizontal mark on left paper edge" m)
- (const :tag "Activate punch or center mark on left paper edge" P)
- (const :tag "Deactivate punch or center mark on left paper edge" p)
- (const :tag "Activate lower horizontal mark on left paper edge" T)
- (const :tag "Deactivate lower horizontal mark on left paper edge" t)
- (const :tag "Activate all vertical marks on upper paper edge" V)
- (const :tag "Deactivate all vertical marks on upper paper edge" v))))
+ (const :tag "Activate default folding marks" t)
+ (const :tag "Deactivate folding marks" nil)
+ (set
+ :tag "Configure folding marks"
+ (const :tag "Activate upper horizontal mark on left paper edge" B)
+ (const :tag "Deactivate upper horizontal mark on left paper edge" b)
+ (const :tag "Activate all horizontal marks on left paper edge" H)
+ (const :tag "Deactivate all horizontal marks on left paper edge" h)
+ (const :tag "Activate left vertical mark on upper paper edge" L)
+ (const :tag "Deactivate left vertical mark on upper paper edge" l)
+ (const :tag "Activate middle horizontal mark on left paper edge" M)
+ (const :tag "Deactivate middle horizontal mark on left paper edge" m)
+ (const :tag "Activate punch or center mark on left paper edge" P)
+ (const :tag "Deactivate punch or center mark on left paper edge" p)
+ (const :tag "Activate lower horizontal mark on left paper edge" T)
+ (const :tag "Deactivate lower horizontal mark on left paper edge" t)
+ (const :tag "Activate all vertical marks on upper paper edge" V)
+ (const :tag "Deactivate all vertical marks on upper paper edge" v))))
(defcustom org-koma-letter-use-phone nil
"Non-nil prints sender's phone number.
@@ -427,8 +428,8 @@ See also `org-koma-letter-opening' and
"Non-nil means title should be interpreted as subject if subject is missing.
This option can also be set with the OPTIONS keyword,
e.g. \"title-subject:t\"."
- :group 'org-export-koma-letter
- :type 'boolean)
+ :group 'org-export-koma-letter
+ :type 'boolean)
(defconst org-koma-letter-special-tags-in-letter '(to from closing location)
"Header tags related to the letter itself.")
@@ -446,8 +447,8 @@ e.g. \"title-subject:t\"."
"Holds special content temporarily.")
(make-obsolete-variable 'org-koma-letter-use-title
- 'org-export-with-title
- "25.1" 'set)
+ 'org-export-with-title
+ "25.1" 'set)
;;; Define Back-End
@@ -474,9 +475,9 @@ e.g. \"title-subject:t\"."
(:special-tags-as-macro nil nil org-koma-letter-special-tags-as-macro)
(:special-tags-in-letter nil nil org-koma-letter-special-tags-in-letter)
(:special-tags-after-closing nil "after-closing-order"
- org-koma-letter-special-tags-after-closing)
+ org-koma-letter-special-tags-after-closing)
(:special-tags-after-letter nil "after-letter-order"
- org-koma-letter-special-tags-after-letter)
+ org-koma-letter-special-tags-after-letter)
(:with-backaddress nil "backaddress" org-koma-letter-use-backaddress)
(:with-email nil "email" org-koma-letter-use-email)
(:with-foldmarks nil "foldmarks" org-koma-letter-use-foldmarks)
@@ -507,19 +508,19 @@ e.g. \"title-subject:t\"."
(:inbuffer-with-from-logo nil "from-logo" 'koma-letter:empty)
(:inbuffer-with-place nil "place" 'koma-letter:empty))
:translate-alist '((export-block . org-koma-letter-export-block)
- (export-snippet . org-koma-letter-export-snippet)
- (headline . org-koma-letter-headline)
- (keyword . org-koma-letter-keyword)
- (template . org-koma-letter-template))
+ (export-snippet . org-koma-letter-export-snippet)
+ (headline . org-koma-letter-headline)
+ (keyword . org-koma-letter-keyword)
+ (template . org-koma-letter-template))
:menu-entry
'(?k "Export with KOMA Scrlttr2"
((?L "As LaTeX buffer" org-koma-letter-export-as-latex)
- (?l "As LaTeX file" org-koma-letter-export-to-latex)
- (?p "As PDF file" org-koma-letter-export-to-pdf)
- (?o "As PDF file and open"
- (lambda (a s v b)
- (if a (org-koma-letter-export-to-pdf t s v b)
- (org-open-file (org-koma-letter-export-to-pdf nil s v b))))))))
+ (?l "As LaTeX file" org-koma-letter-export-to-latex)
+ (?p "As PDF file" org-koma-letter-export-to-pdf)
+ (?o "As PDF file and open"
+ (lambda (a s v b)
+ (if a (org-koma-letter-export-to-pdf t s v b)
+ (org-open-file (org-koma-letter-export-to-pdf nil s v b))))))))
@@ -536,7 +537,7 @@ e.g. \"title-subject:t\"."
"Get contents from a headline tagged with KEY.
The contents is stored in `org-koma-letter-special-contents'."
(let ((value (cdr (assoc-string (org-koma-letter--get-value key)
- org-koma-letter-special-contents))))
+ org-koma-letter-special-contents))))
(when value (org-string-nw-p (org-trim value)))))
(defun org-koma-letter--get-value (value)
@@ -545,26 +546,26 @@ Determines if VALUE is nil, a string, a function or a symbol and
return a string or nil."
(when value
(cond ((stringp value) value)
- ((functionp value) (funcall value))
- ((symbolp value) (symbol-name value))
- (t value))))
+ ((functionp value) (funcall value))
+ ((symbolp value) (symbol-name value))
+ (t value))))
(defun org-koma-letter--special-contents-inline (keywords info)
"Process KEYWORDS members of `org-koma-letter-special-contents'.
+
KEYWORDS is a list of symbols. Return them as a string to be
formatted.
The function is used for inserting content of special headings
-such as the one tagged with PS.
-"
+such as the one tagged with PS."
(mapconcat
(lambda (keyword)
(let* ((name (org-koma-letter--get-value keyword))
- (value (org-koma-letter--get-tagged-contents name))
- (macrop (memq keyword (plist-get info :special-tags-as-macro))))
+ (value (org-koma-letter--get-tagged-contents name))
+ (macrop (memq keyword (plist-get info :special-tags-as-macro))))
(cond ((not value) nil)
- (macrop (format "\\%s{%s}\n" name value))
- (t value))))
+ (macrop (format "\\%s{%s}\n" name value))
+ (t value))))
keywords
"\n"))
@@ -585,7 +586,8 @@ such as the one tagged with PS.
"Transcode an EXPORT-BLOCK element into KOMA Scrlttr2 code.
CONTENTS is nil. INFO is a plist used as a communication
channel."
- (when (member (org-element-property :type export-block) '("KOMA-LETTER" "LATEX"))
+ (when (member (org-element-property :type export-block)
+ '("KOMA-LETTER" "LATEX"))
(org-remove-indentation (org-element-property :value export-block))))
;;;; Export Snippet
@@ -604,7 +606,7 @@ channel."
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 KOMA-LETTER keywords. Otherwise, fallback
;; to `latex' back-end.
(if (equal key "KOMA-LETTER") value
@@ -623,7 +625,7 @@ stored in `org-koma-letter-special-contents' and included at the
appropriate place."
(let ((special-tag (org-koma-letter--special-tag headline info)))
(if (not special-tag)
- contents
+ contents
(push (cons special-tag contents) org-koma-letter-special-contents)
"")))
@@ -632,13 +634,11 @@ appropriate place."
INFO is a plist holding contextual information. Return first
special tag headline."
(let ((special-tags (append
- (plist-get info :special-tags-in-letter)
- (plist-get info :special-tags-after-closing)
- (plist-get info :special-tags-after-letter))))
- (catch 'exit
- (dolist (tag (org-export-get-tags headline info))
- (let ((tag (assoc-string tag special-tags)))
- (when tag (throw 'exit tag)))))))
+ (plist-get info :special-tags-in-letter)
+ (plist-get info :special-tags-after-closing)
+ (plist-get info :special-tags-after-letter))))
+ (cl-some (lambda (tag) (and (assoc-string tag special-tags) tag))
+ (org-export-get-tags headline info))))
(defun org-koma-letter--keyword-or-headline (plist-key pred info)
"Return the correct version of opening or closing.
@@ -649,15 +649,15 @@ and an info plist. INFO is a plist holding contextual
information. Return the preferred candidate for the exported of
PLIST-KEY."
(let* ((keyword-candidate (plist-get info plist-key))
- (headline-candidate (when (and (plist-get info :with-headline-opening)
- (or (plist-get info :special-headings)
- (not keyword-candidate)))
- (org-element-map (plist-get info :parse-tree)
- 'headline
- (lambda (head)
- (when (funcall pred head info)
- (org-element-property :title head)))
- info t))))
+ (headline-candidate (when (and (plist-get info :with-headline-opening)
+ (or (plist-get info :special-headings)
+ (not keyword-candidate)))
+ (org-element-map (plist-get info :parse-tree)
+ 'headline
+ (lambda (h)
+ (and (funcall pred h info)
+ (org-element-property :title head)))
+ info t))))
(org-export-data (or headline-candidate keyword-candidate "") info)))
;;;; Template
@@ -681,35 +681,35 @@ holding export options."
;; settings coming from buffer keywords.
(org-koma-letter--build-settings 'global info)
(mapconcat (lambda (file) (format "\\LoadLetterOption{%s}\n" file))
- (split-string (or (plist-get info :lco) ""))
- "")
+ (split-string (or (plist-get info :lco) ""))
+ "")
(org-koma-letter--build-settings 'buffer info)
;; Date.
(format "\\date{%s}\n" (org-export-data (org-export-get-date info) info))
;; Hyperref, document start, and subject and title.
(let* ((with-subject (plist-get info :with-subject))
- (with-title (plist-get info :with-title))
- (title-as-subject (and with-subject
- (plist-get info :with-title-as-subject)))
- (subject* (org-string-nw-p
- (org-export-data (plist-get info :subject) info)))
- (title* (and with-title
- (org-string-nw-p
- (org-export-data (plist-get info :title) info))))
- (subject (cond ((not with-subject) nil)
- (title-as-subject (or subject* title*))
- (t subject*)))
- (title (cond ((not with-title) nil)
- (title-as-subject (and subject* title*))
- (t title*)))
- (hyperref-template (plist-get info :latex-hyperref-template))
- (spec (append (list (cons ?t (or title subject "")))
- (org-latex--format-spec info))))
+ (with-title (plist-get info :with-title))
+ (title-as-subject (and with-subject
+ (plist-get info :with-title-as-subject)))
+ (subject* (org-string-nw-p
+ (org-export-data (plist-get info :subject) info)))
+ (title* (and with-title
+ (org-string-nw-p
+ (org-export-data (plist-get info :title) info))))
+ (subject (cond ((not with-subject) nil)
+ (title-as-subject (or subject* title*))
+ (t subject*)))
+ (title (cond ((not with-title) nil)
+ (title-as-subject (and subject* title*))
+ (t title*)))
+ (hyperref-template (plist-get info :latex-hyperref-template))
+ (spec (append (list (cons ?t (or title subject "")))
+ (org-latex--format-spec info))))
(concat
(when (and with-subject (not (eq with-subject t)))
- (format "\\KOMAoption{subject}{%s}\n"
- (if (symbolp with-subject) with-subject
- (mapconcat #'symbol-name with-subject ","))))
+ (format "\\KOMAoption{subject}{%s}\n"
+ (if (symbolp with-subject) with-subject
+ (mapconcat #'symbol-name with-subject ","))))
;; Hyperref.
(format-spec hyperref-template spec)
;; Document start.
@@ -720,26 +720,27 @@ holding export options."
(when (or (org-string-nw-p title) (org-string-nw-p subject)) "\n")))
;; Letter start.
(let ((keyword-val (plist-get info :to-address))
- (heading-val (org-koma-letter--get-tagged-contents 'to)))
+ (heading-val (org-koma-letter--get-tagged-contents 'to)))
(format "\\begin{letter}{%%\n%s}\n\n"
- (org-koma-letter--add-latex-newlines
- (or (if (plist-get info :special-headings)
- (or heading-val keyword-val)
- (or keyword-val heading-val))
- "\\mbox{}"))))
+ (org-koma-letter--add-latex-newlines
+ (or (if (plist-get info :special-headings)
+ (or heading-val keyword-val)
+ (or keyword-val heading-val))
+ "\\mbox{}"))))
;; Opening.
(format "\\opening{%s}\n\n"
- (org-koma-letter--keyword-or-headline
- :opening (lambda (h i) (not (org-koma-letter--special-tag h i)))
- info))
+ (org-koma-letter--keyword-or-headline
+ :opening (lambda (h i) (not (org-koma-letter--special-tag h i)))
+ info))
;; Letter body.
contents
;; Closing.
(format "\\closing{%s}\n"
- (org-koma-letter--keyword-or-headline
- :closing (lambda (h i) (eq (org-koma-letter--special-tag h i)
- 'closing))
- info))
+ (org-koma-letter--keyword-or-headline
+ :closing
+ (lambda (h i)
+ (eq (org-koma-letter--special-tag h i) 'closing))
+ info))
(org-koma-letter--special-contents-inline
(plist-get info :special-tags-after-closing) info)
;; Letter end.
@@ -754,23 +755,21 @@ holding export options."
SCOPE is either `global' or `buffer'. INFO is a plist used as
a communication channel."
(let* ((check-scope
- (function
- ;; Non-nil value when SETTING was defined in SCOPE.
- (lambda (setting)
- (let ((property (intern (format ":inbuffer-%s" setting))))
- (if (eq scope 'global)
- (eq (plist-get info property) 'koma-letter:empty)
- (not (eq (plist-get info property) 'koma-letter:empty)))))))
- (heading-or-key-value
- (function
- (lambda (heading key &optional scoped)
- (let* ((heading-val
- (org-koma-letter--get-tagged-contents heading))
- (key-val (org-string-nw-p (plist-get info key)))
- (scopedp (funcall check-scope (or scoped heading))))
- (and (or (and key-val scopedp) heading-val)
- (not (and (eq scope 'global) heading-val))
- (if scopedp key-val heading-val)))))))
+ ;; Non-nil value when SETTING was defined in SCOPE.
+ (lambda (setting)
+ (let ((property (intern (format ":inbuffer-%s" setting))))
+ (if (eq scope 'global)
+ (eq (plist-get info property) 'koma-letter:empty)
+ (not (eq (plist-get info property) 'koma-letter:empty))))))
+ (heading-or-key-value
+ (lambda (heading key &optional scoped)
+ (let* ((heading-val
+ (org-koma-letter--get-tagged-contents heading))
+ (key-val (org-string-nw-p (plist-get info key)))
+ (scopedp (funcall check-scope (or scoped heading))))
+ (and (or (and key-val scopedp) heading-val)
+ (not (and (eq scope 'global) heading-val))
+ (if scopedp key-val heading-val))))))
(concat
;; Name.
(let ((author (plist-get info :author)))
@@ -781,8 +780,8 @@ a communication channel."
;; From.
(let ((from (funcall heading-or-key-value 'from :from-address)))
(and from
- (format "\\setkomavar{fromaddress}{%s}\n"
- (org-koma-letter--add-latex-newlines from))))
+ (format "\\setkomavar{fromaddress}{%s}\n"
+ (org-koma-letter--add-latex-newlines from))))
;; Email.
(let ((email (plist-get info :email)))
(and email
@@ -817,41 +816,41 @@ a communication channel."
(if (plist-get info :with-from-logo) "true" "false")))
;; Signature.
(let* ((heading-val
- (and (plist-get info :with-headline-opening)
- (pcase (org-koma-letter--get-tagged-contents 'closing)
- ((and (pred org-string-nw-p) closing) (org-trim closing))
- (_ nil))))
- (signature (org-string-nw-p (plist-get info :signature)))
- (signature-scope (funcall check-scope 'signature)))
+ (and (plist-get info :with-headline-opening)
+ (pcase (org-koma-letter--get-tagged-contents 'closing)
+ ((and (pred org-string-nw-p) closing) (org-trim closing))
+ (_ nil))))
+ (signature (org-string-nw-p (plist-get info :signature)))
+ (signature-scope (funcall check-scope 'signature)))
(and (or (and signature signature-scope)
- heading-val)
- (not (and (eq scope 'global) heading-val))
- (format "\\setkomavar{signature}{%s}\n"
- (if signature-scope signature heading-val))))
+ heading-val)
+ (not (and (eq scope 'global) heading-val))
+ (format "\\setkomavar{signature}{%s}\n"
+ (if signature-scope signature heading-val))))
;; Back address.
(and (funcall check-scope 'with-backaddress)
(format "\\KOMAoption{backaddress}{%s}\n"
(if (plist-get info :with-backaddress) "true" "false")))
;; Place.
(let ((with-place-set (funcall check-scope 'with-place))
- (place-set (funcall check-scope 'place)))
+ (place-set (funcall check-scope 'place)))
(and (or (and with-place-set place-set)
- (and (eq scope 'buffer) (or with-place-set place-set)))
- (format "\\setkomavar{place}{%s}\n"
- (if (plist-get info :with-place) (plist-get info :place)
- ""))))
+ (and (eq scope 'buffer) (or with-place-set place-set)))
+ (format "\\setkomavar{place}{%s}\n"
+ (if (plist-get info :with-place) (plist-get info :place)
+ ""))))
;; Location.
(let ((location (funcall heading-or-key-value 'location :location)))
(and location
- (format "\\setkomavar{location}{%s}\n" location)))
+ (format "\\setkomavar{location}{%s}\n" location)))
;; Folding marks.
(and (funcall check-scope 'with-foldmarks)
(let ((foldmarks (plist-get info :with-foldmarks)))
- (cond ((consp foldmarks)
- (format "\\KOMAoptions{foldmarks=true,foldmarks=%s}\n"
- (mapconcat #'symbol-name foldmarks "")))
- (foldmarks "\\KOMAoptions{foldmarks=true}\n")
- (t "\\KOMAoptions{foldmarks=false}\n")))))))
+ (cond ((consp foldmarks)
+ (format "\\KOMAoptions{foldmarks=true,foldmarks=%s}\n"
+ (mapconcat #'symbol-name foldmarks "")))
+ (foldmarks "\\KOMAoptions{foldmarks=true}\n")
+ (t "\\KOMAoptions{foldmarks=false}\n")))))))
@@ -859,7 +858,7 @@ a communication channel."
;;;###autoload
(defun org-koma-letter-export-as-latex
- (&optional async subtreep visible-only body-only ext-plist)
+ (&optional async subtreep visible-only body-only ext-plist)
"Export current buffer as a KOMA Scrlttr2 letter.
If narrowing is active in the current buffer, only export its
@@ -896,7 +895,7 @@ non-nil."
;;;###autoload
(defun org-koma-letter-export-to-latex
- (&optional async subtreep visible-only body-only ext-plist)
+ (&optional async subtreep visible-only body-only ext-plist)
"Export current buffer as a KOMA Scrlttr2 letter (tex).
If narrowing is active in the current buffer, only export its
@@ -928,13 +927,13 @@ directory.
Return output file's name."
(interactive)
(let ((outfile (org-export-output-file-name ".tex" subtreep))
- (org-koma-letter-special-contents))
+ (org-koma-letter-special-contents))
(org-export-to-file 'koma-letter outfile
async subtreep visible-only body-only ext-plist)))
;;;###autoload
(defun org-koma-letter-export-to-pdf
- (&optional async subtreep visible-only body-only ext-plist)
+ (&optional async subtreep visible-only body-only ext-plist)
"Export current buffer as a KOMA Scrlttr2 letter (pdf).
If narrowing is active in the current buffer, only export its
@@ -963,7 +962,7 @@ file-local settings.
Return PDF file's name."
(interactive)
(let ((file (org-export-output-file-name ".tex" subtreep))
- (org-koma-letter-special-contents))
+ (org-koma-letter-special-contents))
(org-export-to-file 'koma-letter file
async subtreep visible-only body-only ext-plist
(lambda (file) (org-latex-compile file)))))