diff --git a/contrib/lisp/ox-koma-letter.el b/contrib/lisp/ox-koma-letter.el index 47f5cf85f..37ea4d04c 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)))))