ox-groff.el (70992B)
1 ;;; ox-groff.el --- Groff Back-End for Org Export Engine 2 3 ;; Copyright (C) 2011-2021 Free Software Foundation, Inc. 4 5 ;; Author: Nicolas Goaziou <n.goaziou at gmail dot com> 6 ;; Author: Luis R Anaya <papoanaya aroba hot mail punto com> 7 ;; Keywords: outlines, hypermedia, calendar, wp 8 9 ;; This file is not part of GNU Emacs. 10 11 ;; This program is free software; you can redistribute it and/or modify 12 ;; it under the terms of the GNU General Public License as published by 13 ;; the Free Software Foundation, either version 3 of the License, or 14 ;; (at your option) any later version. 15 16 ;; This program is distributed in the hope that it will be useful, 17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 ;; GNU General Public License for more details. 20 21 ;; You should have received a copy of the GNU General Public License 22 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 23 ;;; Commentary: 24 ;; 25 ;; This library implements a Groff Memorandum Macro back-end for Org 26 ;; generic exporter. 27 ;; 28 ;; To test it, run 29 ;; 30 ;; M-: (org-export-to-buffer 'groff "*Test Groff*") RET 31 ;; 32 ;; in an org-mode buffer then switch to the buffer to see the Groff 33 ;; export. See ox.el for more details on how this exporter works. 34 ;; 35 ;; It introduces two new buffer keywords: "GROFF_CLASS" and 36 ;; "GROFF_CLASS_OPTIONS". 37 38 ;;; Code: 39 40 (eval-when-compile (require 'cl)) 41 (require 'ox) 42 43 (defvar orgtbl-exp-regexp) 44 45 46 ;;; Define Back-End 47 48 (org-export-define-backend 'groff 49 '((bold . org-groff-bold) 50 (center-block . org-groff-center-block) 51 (clock . org-groff-clock) 52 (code . org-groff-code) 53 (drawer . org-groff-drawer) 54 (dynamic-block . org-groff-dynamic-block) 55 (entity . org-groff-entity) 56 (example-block . org-groff-example-block) 57 (export-block . org-groff-export-block) 58 (export-snippet . org-groff-export-snippet) 59 (fixed-width . org-groff-fixed-width) 60 (footnote-definition . org-groff-footnote-definition) 61 (footnote-reference . org-groff-footnote-reference) 62 (headline . org-groff-headline) 63 (horizontal-rule . org-groff-horizontal-rule) 64 (inline-src-block . org-groff-inline-src-block) 65 (inlinetask . org-groff-inlinetask) 66 (italic . org-groff-italic) 67 (item . org-groff-item) 68 (keyword . org-groff-keyword) 69 (line-break . org-groff-line-break) 70 (link . org-groff-link) 71 (node-property . org-groff-node-property) 72 (paragraph . org-groff-paragraph) 73 (plain-list . org-groff-plain-list) 74 (plain-text . org-groff-plain-text) 75 (planning . org-groff-planning) 76 (property-drawer . org-groff-property-drawer) 77 (quote-block . org-groff-quote-block) 78 (radio-target . org-groff-radio-target) 79 (section . org-groff-section) 80 (special-block . org-groff-special-block) 81 (src-block . org-groff-src-block) 82 (statistics-cookie . org-groff-statistics-cookie) 83 (strike-through . org-groff-strike-through) 84 (subscript . org-groff-subscript) 85 (superscript . org-groff-superscript) 86 (table . org-groff-table) 87 (table-cell . org-groff-table-cell) 88 (table-row . org-groff-table-row) 89 (target . org-groff-target) 90 (template . org-groff-template) 91 (timestamp . org-groff-timestamp) 92 (underline . org-groff-underline) 93 (verbatim . org-groff-verbatim) 94 (verse-block . org-groff-verse-block)) 95 :menu-entry 96 '(?g "Export to GROFF" 97 ((?g "As GROFF file" org-groff-export-to-groff) 98 (?p "As PDF file" org-groff-export-to-pdf) 99 (?o "As PDF file and open" 100 (lambda (a s v b) 101 (if a (org-groff-export-to-pdf t s v b) 102 (org-open-file (org-groff-export-to-pdf nil s v b))))))) 103 :options-alist 104 '((:groff-class "GROFF_CLASS" nil org-groff-default-class t) 105 (:groff-class-options "GROFF_CLASS_OPTIONS" nil nil t) 106 (:groff-header-extra "GROFF_HEADER" nil nil newline))) 107 108 109 110 ;;; User Configurable Variables 111 112 (defgroup org-export-groff nil 113 "Options for exporting Org mode files to Groff." 114 :tag "Org Export Groff" 115 :group 'org-export) 116 117 ;;; Preamble 118 119 (defcustom org-groff-default-class "internal" 120 "The default Groff class." 121 :group 'org-export-groff 122 :type '(string :tag "Groff class")) 123 124 (defcustom org-groff-classes 125 '(("file" ".MT 1" 126 (:heading 'default :type "memo" :last-section "toc")) 127 ("internal" ".MT 0" 128 (:heading 'default :type "memo" :last-section "toc")) 129 ("programmer" ".MT 2" 130 (:heading 'default :type "memo" :last-section "toc")) 131 ("engineer" ".MT 3" 132 (:heading 'default :type "memo" :last-section "toc")) 133 ("external" ".MT 4" 134 (:heading 'default :type "memo" :last-section "toc")) 135 ("letter" ".MT 5" 136 (:heading 'default :type "memo" :last-section "sign")) 137 ("custom" ".so file" 138 (:heading custom-function :type "custom" :last-section "toc")) 139 ("dummy" "" 140 (:heading 'default :type "memo")) 141 ("ms" "ms" 142 (:heading 'default :type "cover" :last-section "toc")) 143 ("se_ms" "se_ms" 144 (:heading 'default :type "cover" :last-section "toc")) 145 ("block" "BL" 146 (:heading 'default :type "letter" :last-section "sign")) 147 ("semiblock" "SB" 148 (:heading 'default :type "letter" :last-section "sign")) 149 ("fullblock" "FB" 150 (:heading 'default :type "letter" :last-section "sign")) 151 ("simplified" "SP" 152 (:heading 'default :type "letter" :last-section "sign")) 153 ("none" "" (:heading 'default :type "custom"))) 154 155 ;; none means, no Cover or Memorandum Type and no calls to AU, AT, ND and TL 156 ;; This is to facilitate the creation of custom pages. 157 158 ;; dummy means, no Cover or Memorandum Type but calls to AU, AT, ND and TL 159 ;; are made. This is to facilitate Abstract Insertion. 160 161 "This list describes the attributes for the documents being created. 162 It allows for the creation of new " 163 :group 'org-export-groff 164 :type '(repeat 165 (list (string :tag "Document Type") 166 (string :tag "Header") 167 (repeat :tag "Options" :inline t 168 (choice 169 (list :tag "Heading") 170 (function :tag "Hook computing sectioning")))))) 171 172 ;;; Headline 173 174 (defconst org-groff-special-tags 175 '("FROM" "TO" "ABSTRACT" "APPENDIX" "BODY" "NS")) 176 177 (defcustom org-groff-format-headline-function nil 178 "Function to format headline text. 179 180 This function will be called with 5 arguments: 181 TODO the todo keyword (string or nil). 182 TODO-TYPE the type of todo (symbol: `todo', `done', nil) 183 PRIORITY the priority of the headline (integer or nil) 184 TEXT the main headline text (string). 185 TAGS the tags as a list of strings (list of strings or nil). 186 187 The function result will be used in the section format string. 188 189 As an example, one could set the variable to the following, in 190 order to reproduce the default set-up: 191 192 \(defun org-groff-format-headline (todo todo-type priority text tags) 193 \"Default format function for a headline.\" 194 \(concat (when todo 195 \(format \"\\fB%s\\fP \" todo)) 196 \(when priority 197 \(format \"[\\#%c] \" priority)) 198 text 199 \(when tags 200 \(format \" %s \" 201 \(mapconcat 'identity tags \":\"))))" 202 :group 'org-export-groff 203 :type 'function) 204 205 ;;; Timestamps 206 207 (defcustom org-groff-active-timestamp-format "\\fI%s\\fP" 208 "A printf format string to be applied to active timestamps." 209 :group 'org-export-groff 210 :type 'string) 211 212 (defcustom org-groff-inactive-timestamp-format "\\fI%s\\fP" 213 "A printf format string to be applied to inactive timestamps." 214 :group 'org-export-groff 215 :type 'string) 216 217 (defcustom org-groff-diary-timestamp-format "\\fI%s\\fP" 218 "A printf format string to be applied to diary timestamps." 219 :group 'org-export-groff 220 :type 'string) 221 222 ;;; Links 223 224 (defcustom org-groff-inline-image-rules 225 '(("file" . "\\.\\(jpg\\|png\\|pdf\\|ps\\|eps\\|pic\\)\\'") 226 ("fuzzy" . "\\.\\(jpg\\|png\\|pdf\\|ps\\|eps\\|pic\\)\\'")) 227 "Rules characterizing image files that can be inlined into Groff. 228 229 A rule consists in an association whose key is the type of link 230 to consider, and value is a regexp that will be matched against 231 link's path. 232 233 Note that, by default, the image extensions actually allowed 234 depend on the way the Groff file is processed. When used with 235 pdfgroff, pdf, jpg and png images are OK. When processing 236 through dvi to Postscript, only ps and eps are allowed. The 237 default we use here encompasses both." 238 :group 'org-export-groff 239 :type '(alist :key-type (string :tag "Type") 240 :value-type (regexp :tag "Path"))) 241 242 (defcustom org-groff-link-with-unknown-path-format "\\fI%s\\fP" 243 "Format string for links with unknown path type." 244 :group 'org-export-groff 245 :type 'string) 246 247 ;;; Tables 248 249 (defcustom org-groff-tables-centered t 250 "When non-nil, tables are exported in a center environment." 251 :group 'org-export-groff 252 :type 'boolean) 253 254 (defcustom org-groff-tables-verbatim nil 255 "When non-nil, tables are exported verbatim." 256 :group 'org-export-groff 257 :type 'boolean) 258 259 (defcustom org-groff-table-scientific-notation "%sE%s" 260 "Format string to display numbers in scientific notation. 261 The format should have \"%s\" twice, for mantissa and exponent 262 \(i.e. \"%s\\\\times10^{%s}\"). 263 264 When nil, no transformation is made." 265 :group 'org-export-groff 266 :type '(choice 267 (string :tag "Format string") 268 (const :tag "No formatting"))) 269 270 ;;; Text markup 271 272 (defcustom org-groff-text-markup-alist 273 '((bold . "\\fB%s\\fP") 274 (code . "\\fC%s\\fP") 275 (italic . "\\fI%s\\fP") 276 (strike-through . "\\fC%s\\fP") ; Strike through and underline 277 (underline . "\\fI%s\\fP") ; need to be revised. 278 (verbatim . "protectedtexttt")) 279 "Alist of Groff expressions to convert text markup. 280 281 The key must be a symbol among `bold', `code', `italic', 282 `strike-through', `underline' and `verbatim'. The value is 283 a formatting string to wrap fontified text with it. 284 285 If no association can be found for a given markup, text will be 286 returned as-is." 287 :group 'org-export-groff 288 :type 'alist 289 :options '(bold code italic strike-through underline verbatim)) 290 291 ;;; Drawers 292 293 (defcustom org-groff-format-drawer-function nil 294 "Function called to format a drawer in Groff code. 295 296 The function must accept two parameters: 297 NAME the drawer name, like \"LOGBOOK\" 298 CONTENTS the contents of the drawer. 299 300 The function should return the string to be exported. 301 302 For example, the variable could be set to the following function 303 in order to mimic default behaviour: 304 305 \(defun org-groff-format-drawer-default \(name contents\) 306 \"Format a drawer element for Groff export.\" 307 contents\)" 308 :group 'org-export-groff 309 :type 'function) 310 311 ;;; Inlinetasks 312 313 (defcustom org-groff-format-inlinetask-function nil 314 "Function called to format an inlinetask in Groff code. 315 316 The function must accept six parameters: 317 TODO the todo keyword, as a string 318 TODO-TYPE the todo type, a symbol among `todo', `done' and nil. 319 PRIORITY the inlinetask priority, as a string 320 NAME the inlinetask name, as a string. 321 TAGS the inlinetask tags, as a list of strings. 322 CONTENTS the contents of the inlinetask, as a string. 323 324 The function should return the string to be exported. 325 326 For example, the variable could be set to the following function 327 in order to mimic default behaviour: 328 329 \(defun org-groff-format-inlinetask \(todo type priority name tags contents\) 330 \"Format an inline task element for Groff export.\" 331 \(let ((full-title 332 \(concat 333 \(when todo 334 \(format \"\\fB%s\\fP \" todo)) 335 \(when priority (format \"[\\#%c] \" priority)) 336 title 337 \(when tags 338 \(format \":%s:\" 339 \(mapconcat 'identity tags \":\"))))) 340 \(format (concat \".DS L\\n\" 341 \"%s\\n\\n\" 342 \"%s\" 343 \".DE\") 344 full-title contents))" 345 :group 'org-export-groff 346 :type 'function) 347 348 ;; Src blocks 349 350 (defcustom org-groff-source-highlight nil 351 "Use GNU source highlight to embellish source blocks " 352 :group 'org-export-groff 353 :type 'boolean) 354 355 (defcustom org-groff-source-highlight-langs 356 '((emacs-lisp "lisp") (lisp "lisp") (clojure "lisp") 357 (scheme "scheme") 358 (c "c") (cc "cpp") (csharp "csharp") (d "d") 359 (fortran "fortran") (cobol "cobol") (pascal "pascal") 360 (ada "ada") (asm "asm") 361 (perl "perl") (cperl "perl") 362 (python "python") (ruby "ruby") (tcl "tcl") (lua "lua") 363 (java "java") (javascript "javascript") 364 (tex "latex") 365 (shell-script "sh") (awk "awk") (diff "diff") (m4 "m4") 366 (ocaml "caml") (caml "caml") 367 (sql "sql") (sqlite "sql") 368 (html "html") (css "css") (xml "xml") 369 (bat "bat") (bison "bison") (clipper "clipper") 370 (ldap "ldap") (opa "opa") 371 (php "php") (postscript "postscript") (prolog "prolog") 372 (properties "properties") (makefile "makefile") 373 (tml "tml") (vala "vala") (vbscript "vbscript") (xorg "xorg")) 374 "Alist mapping languages to their listing language counterpart. 375 The key is a symbol, the major mode symbol without the \"-mode\". 376 The value is the string that should be inserted as the language 377 parameter for the listings package. If the mode name and the 378 listings name are the same, the language does not need an entry 379 in this list - but it does not hurt if it is present." 380 :group 'org-export-groff 381 :type '(repeat 382 (list 383 (symbol :tag "Major mode ") 384 (string :tag "Listings language")))) 385 386 (defcustom org-groff-source-highlight-options nil 387 "Association list of options for the groff listings package. 388 389 These options are supplied as a comma-separated list to the 390 \\lstset command. Each element of the association list should be 391 a list containing two strings: the name of the option, and the 392 value. For example, 393 394 (setq org-groff-source-highlight-options 395 '((\"basicstyle\" \"\\small\") 396 (\"keywordstyle\" \"\\color{black}\\bfseries\\underbar\"))) 397 398 will typeset the code in a small size font with underlined, bold 399 black keywords. 400 401 Note that the same options will be applied to blocks of all 402 languages." 403 :group 'org-export-groff 404 :type '(repeat 405 (list 406 (string :tag "Listings option name ") 407 (string :tag "Listings option value")))) 408 409 (defvar org-groff-custom-lang-environments nil 410 "Alist mapping languages to language-specific Groff environments. 411 412 It is used during export of src blocks by the listings and 413 groff packages. For example, 414 415 \(setq org-groff-custom-lang-environments 416 '\(\(python \"pythoncode\"\)\)\) 417 418 would have the effect that if org encounters begin_src python 419 during groff export it will use pythoncode as the source-highlight 420 language.") 421 422 ;;; Plain text 423 424 (defcustom org-groff-special-char 425 '(("(c)" . "\\\\(co") 426 ("(tm)" . "\\\\(tm") 427 ("(rg)" . "\\\\(rg")) 428 "CONS list in which the value of the car 429 is replace on the value of the CDR. " 430 :group 'org-export-groff 431 :type '(list 432 (cons :tag "Character Substitute" 433 (string :tag "Original Character Group") 434 (string :tag "Replacement Character")))) 435 436 ;;; Compilation 437 438 (defcustom org-groff-pdf-process 439 '("pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf" 440 "pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf" 441 "pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf") 442 443 "Commands to process a Groff file to a PDF file. 444 This is a list of strings, each of them will be given to the 445 shell as a command. %f in the command will be replaced by the 446 full file name, %b by the file base name \(i.e. without 447 extension) and %o by the base directory of the file." 448 :group 'org-export-pdf 449 :type '(choice 450 (repeat :tag "Shell command sequence" 451 (string :tag "Shell command")) 452 (const :tag "2 runs of pdfgroff" 453 ("pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf" 454 "pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf")) 455 (const :tag "3 runs of pdfgroff" 456 ("pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf" 457 "pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf" 458 "pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf")) 459 (function))) 460 461 (defcustom org-groff-logfiles-extensions 462 '("aux" "idx" "log" "out" "toc" "nav" "snm" "vrb") 463 "The list of file extensions to consider as Groff logfiles." 464 :group 'org-export-groff 465 :type '(repeat (string :tag "Extension"))) 466 467 (defcustom org-groff-remove-logfiles t 468 "Non-nil means remove the logfiles produced by PDF production. 469 These are the .aux, .log, .out, and .toc files." 470 :group 'org-export-groff 471 :type 'boolean) 472 473 (defcustom org-groff-organization "Org User" 474 "Name of the organization used to populate the .AF command." 475 :group 'org-export-groff 476 :type 'string) 477 478 (defcustom org-groff-raster-to-ps nil 479 "Command used to convert raster to EPS. Nil for no conversion. Make sure that 480 `org-groff-inline-image-rules' is adjusted accordingly if not conversion is being 481 done. In this case, remove the entries for jpg and png in the file and fuzzy lists." 482 :group 'org-export-groff 483 :type '(choice 484 (repeat :tag "Shell Command Sequence" (string :tag "Shell Command")) 485 (const :tag "sam2p" "a=%s;b=%s;sam2p ${a} ${b} ;grep -v BeginData ${b} > b_${b};mv b_${b} ${b}" ) 486 (const :tag "NetPNM" "a=%s;b=%s;pngtopnm ${a} | pnmtops -noturn > ${b}" ) 487 (const :tag "None" nil))) 488 489 (defvar org-groff-registered-references nil) 490 (defvar org-groff-special-content nil) 491 492 493 494 ;;; Internal Functions 495 496 (defun org-groff--caption/label-string (element info) 497 "Return caption and label Groff string for ELEMENT. 498 499 INFO is a plist holding contextual information. If there's no 500 caption nor label, return the empty string. 501 502 For non-floats, see `org-groff--wrap-label'." 503 (let ((main (org-export-get-caption element)) 504 (short (org-export-get-caption element t)) 505 (label (org-element-property :name element))) 506 (cond ((and (not main) (not label)) "") 507 ((not main) (format "\\fI%s\\fP" label)) 508 ;; Option caption format with short name. 509 (short (format "%s\n.br\n - %s\n" 510 (org-export-data short info) 511 (org-export-data main info))) 512 ;; Standard caption format. 513 (t (format "\\fR%s\\fP" (org-export-data main info)))))) 514 515 (defun org-groff--wrap-label (element output) 516 "Wrap label associated to ELEMENT around OUTPUT, if appropriate. 517 This function shouldn't be used for floats. See 518 `org-groff--caption/label-string'." 519 (let ((label (org-element-property :name element))) 520 (if (or (not output) (not label) (string= output "") (string= label "")) 521 output 522 (concat (format "%s\n.br\n" label) output)))) 523 524 (defun org-groff--text-markup (text markup) 525 "Format TEXT depending on MARKUP text markup. 526 See `org-groff-text-markup-alist' for details." 527 (let ((fmt (cdr (assq markup org-groff-text-markup-alist)))) 528 (cond 529 ;; No format string: Return raw text. 530 ((not fmt) text) 531 ((string= "protectedtexttt" fmt) 532 (let ((start 0) 533 (trans '(("\\" . "\\"))) 534 (rtn "") 535 char) 536 (while (string-match "[\\{}$%&_#~^]" text) 537 (setq char (match-string 0 text)) 538 (if (> (match-beginning 0) 0) 539 (setq rtn (concat rtn (substring text 0 (match-beginning 0))))) 540 (setq text (substring text (1+ (match-beginning 0)))) 541 (setq char (or (cdr (assoc char trans)) (concat "\\" char)) 542 rtn (concat rtn char))) 543 (setq text (concat rtn text)) 544 (format "\\fC%s\\fP" text))) 545 ;; Else use format string. 546 (t (format fmt text))))) 547 548 549 (defun org-groff--get-tagged-content (tag info) 550 (cdr (assoc tag org-groff-special-content))) 551 552 (defun org-groff--mt-head (title contents attr info) 553 (concat 554 555 ;; 1. Insert Organization 556 (let ((firm-option (plist-get attr :firm))) 557 (cond 558 ((stringp firm-option) 559 (format ".AF \"%s\" \n" firm-option)) 560 (t (format ".AF \"%s\" \n" (or org-groff-organization ""))))) 561 562 ;; 2. Title 563 (let ((title (if (plist-get info :with-title) title "")) 564 (subtitle1 (plist-get attr :subtitle1)) 565 (subtitle2 (plist-get attr :subtitle2))) 566 567 (cond 568 ((string= "" title) 569 (format ".TL \"%s\" \"%s\" \n%s\n" 570 (or subtitle1 "") 571 (or subtitle2 "") " ")) 572 573 ((not (or subtitle1 subtitle2)) 574 (format ".TL\n%s\n" 575 (or title ""))) 576 (t 577 (format ".TL \"%s\" \"%s \" \n%s\n" 578 (or subtitle1 "") 579 (or subtitle2 "") title)))) 580 581 ;; 3. Author. 582 ;; In Groff, .AU *MUST* be placed after .TL 583 ;; If From, populate with data from From else 584 ;; 585 (let ((author (and (plist-get info :with-author) 586 (let ((auth (plist-get info :author))) 587 (and auth (org-export-data auth info))))) 588 (email (and (plist-get info :with-email) 589 (org-export-data (plist-get info :email) info))) 590 (from-data (org-groff--get-tagged-content "FROM" info)) 591 592 (to-data (org-groff--get-tagged-content "TO" info))) 593 594 (cond 595 ((and author from-data) 596 (let ((au-line 597 (mapconcat 598 (lambda (from-line) 599 (format " \"%s\" " from-line)) 600 (split-string 601 (setq from-data 602 (replace-regexp-in-string "\\.P\n" "" from-data)) "\n") ""))) 603 604 (concat 605 (format ".AU \"%s\" " author) au-line "\n"))) 606 607 ((and author email (not (string= "" email))) 608 (format ".AU \"%s\" \"%s\"\n" author email)) 609 610 (author (format ".AU \"%s\"\n" author)) 611 612 (t ".AU \"\" \n"))) 613 614 615 ;; 4. Author Title, if present 616 (let ((at-item (plist-get attr :author-title))) 617 (if (and at-item (stringp at-item)) 618 (format ".AT \"%s\" \n" at-item) 619 "")) 620 621 ;; 5. Date. 622 (when (plist-get info :with-date) 623 (let ((date (org-export-data (org-export-get-date info) info))) 624 (and (org-string-nw-p date) (format ".ND \"%s\"\n" date)))) 625 626 ;; 627 ;; If Abstract, then Populate Abstract 628 ;; 629 630 (let ((abstract-data (org-groff--get-tagged-content "ABSTRACT" info)) 631 (to-data (org-groff--get-tagged-content "TO" info))) 632 (cond 633 (abstract-data 634 (format ".AS\n%s\n.AE\n" abstract-data)) 635 (to-data 636 (format ".AS\n%s\n.AE\n" to-data)))))) 637 638 (defun org-groff--letter-head (title contents attr info) 639 (let ((author (and (plist-get info :with-author) 640 (let ((auth (plist-get info :author))) 641 (and auth (org-export-data auth info))))) 642 (email (and (plist-get info :with-email) 643 (org-export-data (plist-get info :email) info))) 644 (from-data (org-groff--get-tagged-content "FROM" info)) 645 (at-item (plist-get attr :author-title)) 646 (to-data (org-groff--get-tagged-content "TO" info))) 647 648 649 ;; If FROM then get data from FROM 650 (if from-data 651 (setq from-data 652 (replace-regexp-in-string "\\.P\n" "" from-data)) 653 (setq from-data "")) 654 655 (if to-data 656 (setq to-data 657 (replace-regexp-in-string "\\.P\n" "" to-data)) 658 (setq from-data "")) 659 660 (concat 661 (cond 662 (from-data 663 (format ".WA \"%s\" \"%s\" \n%s\n.WE\n" author (or at-item "") from-data)) 664 ((and author email (not (string= "" email))) 665 (format ".WA \"%s\"\n \"%s\"\n.WE\n" author email)) 666 (author (format ".WA \"%s\"\n.WE\n" author)) 667 (t ".WA \"\" \n.WE\n")) 668 669 ;; If TO then get data from TO 670 671 (when to-data 672 (format ".IA \n%s\n.IE\n" to-data))))) 673 674 675 ;;; Template 676 677 (defun org-groff-template (contents info) 678 "Return complete document string after Groff conversion. 679 CONTENTS is the transcoded contents string. INFO is a plist 680 holding export options." 681 (let* ((title (org-export-data (plist-get info :title) info)) 682 (attr (read 683 (format "(%s)" 684 (mapconcat 685 #'identity 686 (list (plist-get info :groff-class-options)) 687 " ")))) 688 (class (plist-get info :groff-class)) 689 (class-options (plist-get info :groff-class-options)) 690 (classes (assoc class org-groff-classes)) 691 (classes-options (car (last classes))) 692 (heading-option (plist-get classes-options :heading)) 693 (type-option (plist-get classes-options :type)) 694 (last-option (plist-get classes-options :last-section)) 695 (hyphenate (plist-get attr :hyphenate)) 696 (justify-right (plist-get attr :justify-right)) 697 698 (document-class-string 699 (progn 700 (org-element-normalize-string 701 (let* ((header (nth 1 (assoc class org-groff-classes))) 702 (document-class-item (if (stringp header) header ""))) 703 document-class-item))))) 704 705 706 (concat 707 (if justify-right 708 (case justify-right 709 ('yes ".SA 1 \n") 710 ('no ".SA 0 \n") 711 (t "")) 712 "") 713 714 (if hyphenate 715 (case hyphenate 716 ('yes ".nr Hy 1 \n") 717 ('no ".nr Hy 0 \n") 718 (t "")) 719 "") 720 721 (cond 722 ((string= type-option "custom") "") 723 724 ((and (stringp document-class-string) 725 (string= type-option "cover")) 726 727 (concat 728 (format ".COVER %s\n" document-class-string) 729 (org-groff--mt-head title contents attr info) 730 ".COVEND\n")) 731 732 ((string= type-option "memo") 733 (concat 734 (org-groff--mt-head title contents attr info) 735 document-class-string)) 736 ((string= type-option "letter") 737 (concat 738 (org-groff--letter-head title contents attr info) 739 (let ((sa-item (plist-get attr :salutation)) 740 (cn-item (plist-get attr :confidential)) 741 (sj-item (plist-get attr :subject)) 742 (rn-item (plist-get attr :reference)) 743 (at-item (plist-get attr :attention))) 744 745 (concat 746 747 (if (stringp sa-item) 748 (format ".LO SA \"%s\" \n" sa-item) 749 ".LO SA\n") 750 751 (when cn-item 752 (if (stringp cn-item) 753 (format ".LO CN \"%s\"\n" cn-item) 754 ".LO CN\n")) 755 756 (when (and at-item (stringp at-item)) 757 (format ".LO AT \"%s\" \n" at-item)) 758 (when (and title rn-item) 759 (format ".LO RN \"%s\"\n" title)) 760 761 (when (and sj-item (stringp sj-item)) 762 (format ".LO SJ \"%s\" \n" sj-item)) 763 764 765 ".LT " document-class-string "\n")))) 766 767 (t "")) 768 769 contents 770 771 (cond 772 ((string= last-option "toc") 773 ".TC") 774 ((string= last-option "sign") 775 (let ((fc-item (plist-get attr :closing))) 776 (concat (if (stringp fc-item) 777 (format ".FC \"%s\" \n" fc-item) 778 ".FC\n") 779 ".SG\n"))) 780 (t "")) 781 782 (progn 783 (mapconcat 784 (lambda (item) 785 (when (string= (car item) "NS") 786 (replace-regexp-in-string 787 "\\.P\n" "" (cdr item)))) 788 (reverse org-groff-special-content) "\n"))))) 789 790 791 792 ;;; Transcode Functions 793 794 ;;; Babel Call 795 ;; 796 ;; Babel Calls are ignored. 797 798 799 ;;; Bold 800 801 (defun org-groff-bold (bold contents info) 802 "Transcode BOLD from Org to Groff. 803 CONTENTS is the text with bold markup. INFO is a plist holding 804 contextual information." 805 (org-groff--text-markup contents 'bold)) 806 807 ;;; Center Block 808 809 (defun org-groff-center-block (center-block contents info) 810 "Transcode a CENTER-BLOCK element from Org to Groff. 811 CONTENTS holds the contents of the center block. INFO is a plist 812 holding contextual information." 813 (org-groff--wrap-label 814 center-block 815 (format ".DS C \n%s\n.DE" contents))) 816 817 ;;; Clock 818 819 (defun org-groff-clock (clock contents info) 820 "Transcode a CLOCK element from Org to Groff. 821 CONTENTS is nil. INFO is a plist holding contextual 822 information." 823 (concat 824 (format "\\fB%s\\fP " org-clock-string) 825 (format org-groff-inactive-timestamp-format 826 (concat (org-timestamp-translate (org-element-property :value clock)) 827 (let ((time (org-element-property :duration clock))) 828 (and time (format " (%s)" time))))))) 829 830 ;;; Code 831 832 (defun org-groff-code (code contents info) 833 "Transcode a CODE object from Org to Groff. 834 CONTENTS is nil. INFO is a plist used as a communication 835 channel." 836 (org-groff--text-markup (org-element-property :value code) 'code)) 837 838 ;;; Comments and Comment Blocks are ignored. 839 840 ;;; Drawer 841 842 (defun org-groff-drawer (drawer contents info) 843 "Transcode a DRAWER element from Org to Groff. 844 CONTENTS holds the contents of the block. INFO is a plist 845 holding contextual information." 846 (let* ((name (org-element-property :drawer-name drawer)) 847 (output (if (functionp org-groff-format-drawer-function) 848 (funcall org-groff-format-drawer-function 849 name contents) 850 ;; If there's no user defined function: simply 851 ;; display contents of the drawer. 852 contents))) 853 (org-groff--wrap-label drawer output))) 854 855 ;;; Dynamic Block 856 857 (defun org-groff-dynamic-block (dynamic-block contents info) 858 "Transcode a DYNAMIC-BLOCK element from Org to Groff. 859 CONTENTS holds the contents of the block. INFO is a plist 860 holding contextual information. See `org-export-data'." 861 (org-groff--wrap-label dynamic-block contents)) 862 863 ;;; Entity 864 865 (defun org-groff-entity (entity contents info) 866 "Transcode an ENTITY object from Org to Groff. 867 CONTENTS are the definition itself. INFO is a plist holding 868 contextual information." 869 (org-element-property :utf-8 entity)) 870 871 ;;; Example Block 872 873 (defun org-groff-example-block (example-block contents info) 874 "Transcode an EXAMPLE-BLOCK element from Org to Groff. 875 CONTENTS is nil. INFO is a plist holding contextual 876 information." 877 (org-groff--wrap-label 878 example-block 879 (format ".DS L\n%s\n.DE" 880 (org-export-format-code-default example-block info)))) 881 882 ;;; Export Block 883 884 (defun org-groff-export-block (export-block contents info) 885 "Transcode a EXPORT-BLOCK element from Org to Groff. 886 CONTENTS is nil. INFO is a plist holding contextual information." 887 (when (string= (org-element-property :type export-block) "GROFF") 888 (org-remove-indentation (org-element-property :value export-block)))) 889 890 ;;; Export Snippet 891 892 (defun org-groff-export-snippet (export-snippet contents info) 893 "Transcode a EXPORT-SNIPPET object from Org to Groff. 894 CONTENTS is nil. INFO is a plist holding contextual information." 895 (when (eq (org-export-snippet-backend export-snippet) 'groff) 896 (org-element-property :value export-snippet))) 897 898 ;;; Fixed Width 899 900 (defun org-groff-fixed-width (fixed-width contents info) 901 "Transcode a FIXED-WIDTH element from Org to Groff. 902 CONTENTS is nil. INFO is a plist holding contextual information." 903 (org-groff--wrap-label 904 fixed-width 905 (format "\\fC\n%s\n\\fP" 906 (org-remove-indentation 907 (org-element-property :value fixed-width))))) 908 909 ;;; Footnote Definition 910 ;; 911 ;; Footnote Definitions are ignored. 912 ;; 913 ;; Footnotes are handled automatically in GROFF. Although manual 914 ;; references can be added, not really required. 915 916 (defun org-groff-footnote-reference (footnote-reference contents info) 917 ;; Changing from info to footnote-reference 918 (let* ((raw (org-export-get-footnote-definition footnote-reference info)) 919 (n (org-export-get-footnote-number footnote-reference info)) 920 (data (org-trim (org-export-data raw info))) 921 (ref-id (plist-get (nth 1 footnote-reference) :label))) 922 ;; It is a reference 923 (if (string-match "fn:rl" ref-id) 924 (if (member ref-id org-groff-registered-references) 925 (format "\\*[%s]" ref-id) 926 (progn 927 (push ref-id org-groff-registered-references) 928 (format "\\*(Rf\n.RS \"%s\" \n%s\n.RF\n" ref-id data))) 929 ;; else it is a footnote 930 (format "\\u\\s-2%s\\d\\s+2\n.FS %s\n%s\n.FE\n" n n data)))) 931 932 ;;; Headline 933 934 (defun org-groff-headline (headline contents info) 935 "Transcode a HEADLINE element from Org to Groff. 936 CONTENTS holds the contents of the headline. INFO is a plist 937 holding contextual information." 938 (let* ((class (plist-get info :groff-class)) 939 (level (org-export-get-relative-level headline info)) 940 (numberedp (org-export-numbered-headline-p headline info)) 941 ;; Section formatting will set two placeholders: one for the 942 ;; title and the other for the contents. 943 (classes (assoc class org-groff-classes)) 944 (classes-options (car (last classes))) 945 (heading-option (plist-get classes-options :heading)) 946 (section-fmt 947 (progn 948 (cond 949 ((and (symbolp heading-option) 950 (fboundp heading-option)) 951 (funcall heading-option level numberedp)) 952 ((> level 7) nil) 953 (t (if numberedp 954 (concat ".H " (number-to-string level) " \"%s\"\n%s") 955 ".HU \"%s\"\n%s"))))) 956 ;; End of section-fmt 957 (text (org-export-data (org-element-property :title headline) info)) 958 (todo 959 (and (plist-get info :with-todo-keywords) 960 (let ((todo (org-element-property :todo-keyword headline))) 961 (and todo (org-export-data todo info))))) 962 (todo-type (and todo (org-element-property :todo-type headline))) 963 (tags (and (plist-get info :with-tags) 964 (org-export-get-tags headline info))) 965 (priority (and (plist-get info :with-priority) 966 (org-element-property :priority headline))) 967 ;; Create the headline text along with a no-tag version. The 968 ;; latter is required to remove tags from table of contents. 969 (full-text (if (functionp org-groff-format-headline-function) 970 ;; User-defined formatting function. 971 (funcall org-groff-format-headline-function 972 todo todo-type priority text tags) 973 ;; Default formatting. 974 (concat 975 (when todo 976 (format "\\fB%s\\fP " todo)) 977 (when priority (format " [\\#%c] " priority)) 978 text 979 (when tags 980 (format " \\fC%s\\fP " (org-make-tag-string tags)))))) 981 (full-text-no-tag 982 (if (functionp org-groff-format-headline-function) 983 ;; User-defined formatting function. 984 (funcall org-groff-format-headline-function 985 todo todo-type priority text nil) 986 ;; Default formatting. 987 (concat 988 (when todo (format "\\fB%s\\fP " todo)) 989 (when priority (format " [\\#%c] " priority)) 990 text))) 991 ;; Associate some \label to the headline for internal links. 992 ;; (headline-label 993 ;; (format "\\label{sec-%s}\n" 994 ;; (mapconcat 'number-to-string 995 ;; (org-export-get-headline-number headline info) 996 ;; "-"))) 997 (headline-label "") 998 (pre-blanks 999 (make-string (org-element-property :pre-blank headline) 10))) 1000 1001 (cond 1002 ;; Case 1: Special Tag 1003 ((member (car tags) org-groff-special-tags) 1004 (cond 1005 ((string= (car tags) "BODY") contents) 1006 1007 ((string= (car tags) "NS") 1008 (progn 1009 (push (cons (car tags) 1010 (format ".NS \"%s\" 1 \n%s" 1011 (car (org-element-property :title headline)) 1012 (or contents " "))) 1013 org-groff-special-content) nil)) 1014 1015 (t 1016 (progn 1017 (push (cons (car tags) contents) org-groff-special-content) 1018 nil)))) 1019 1020 ;; Case 2: This is a footnote section: ignore it. 1021 ((org-element-property :footnote-section-p headline) nil) 1022 1023 ;; Case 3: This is a deep sub-tree: export it as a list item. 1024 ;; Also export as items headlines for which no section 1025 ;; format has been found. 1026 ((or (not section-fmt) (org-export-low-level-p headline info)) 1027 ;; Build the real contents of the sub-tree. 1028 (let ((low-level-body 1029 (concat 1030 ;; If the headline is the first sibling, start a list. 1031 (when (org-export-first-sibling-p headline info) 1032 (format "%s\n" (if numberedp ".AL 1\n" ".DL \n"))) 1033 ;; Itemize headline 1034 ".LI\n" full-text "\n" headline-label pre-blanks contents))) 1035 ;; If headline is not the last sibling simply return 1036 ;; LOW-LEVEL-BODY. Otherwise, also close the list, before any 1037 ;; blank line. 1038 (if (not (org-export-last-sibling-p headline info)) low-level-body 1039 (replace-regexp-in-string 1040 "[ \t\n]*\\'" 1041 (concat "\n.LE") 1042 low-level-body)))) 1043 1044 ;; Case 4. Standard headline. Export it as a section. 1045 (t 1046 (format section-fmt full-text 1047 (concat headline-label pre-blanks contents)))))) 1048 1049 ;;; Horizontal Rule 1050 ;; Not supported 1051 1052 ;;; Inline Babel Call 1053 ;; 1054 ;; Inline Babel Calls are ignored. 1055 1056 ;;; Inline Src Block 1057 1058 (defun org-groff-inline-src-block (inline-src-block contents info) 1059 "Transcode an INLINE-SRC-BLOCK element from Org to Groff. 1060 CONTENTS holds the contents of the item. INFO is a plist holding 1061 contextual information." 1062 (let* ((code (org-element-property :value inline-src-block))) 1063 (cond 1064 (org-groff-source-highlight 1065 (let* ((tmpdir temporary-file-directory) 1066 (in-file (make-temp-name 1067 (expand-file-name "srchilite" tmpdir))) 1068 (out-file (make-temp-name 1069 (expand-file-name "reshilite" tmpdir))) 1070 (org-lang (org-element-property :language inline-src-block)) 1071 (lst-lang (cadr (assq (intern org-lang) 1072 org-groff-source-highlight-langs))) 1073 1074 (cmd (concat (expand-file-name "source-highlight") 1075 " -s " lst-lang 1076 " -f groff_mm_color " 1077 " -i " in-file 1078 " -o " out-file))) 1079 (if lst-lang 1080 (let ((code-block "")) 1081 (with-temp-file in-file (insert code)) 1082 (shell-command cmd) 1083 (setq code-block (org-file-contents out-file)) 1084 (delete-file in-file) 1085 (delete-file out-file) 1086 code-block) 1087 (format ".DS I\n\\fC\\m[black]%s\\m[]\\fP\n.DE\n" 1088 code)))) 1089 1090 ;; Do not use a special package: transcode it verbatim. 1091 (t 1092 (concat ".DS I\n" "\\fC" code "\\fP\n.DE\n"))))) 1093 1094 ;;; Inlinetask 1095 1096 (defun org-groff-inlinetask (inlinetask contents info) 1097 "Transcode an INLINETASK element from Org to Groff. 1098 CONTENTS holds the contents of the block. INFO is a plist 1099 holding contextual information." 1100 (let ((title (org-export-data (org-element-property :title inlinetask) info)) 1101 (todo (and (plist-get info :with-todo-keywords) 1102 (let ((todo (org-element-property :todo-keyword inlinetask))) 1103 (and todo (org-export-data todo info))))) 1104 (todo-type (org-element-property :todo-type inlinetask)) 1105 (tags (and (plist-get info :with-tags) 1106 (org-export-get-tags inlinetask info))) 1107 (priority (and (plist-get info :with-priority) 1108 (org-element-property :priority inlinetask)))) 1109 ;; If `org-groff-format-inlinetask-function' is provided, call it 1110 ;; with appropriate arguments. 1111 (if (functionp org-groff-format-inlinetask-function) 1112 (funcall org-groff-format-inlinetask-function 1113 todo todo-type priority title tags contents) 1114 ;; Otherwise, use a default template. 1115 (org-groff--wrap-label 1116 inlinetask 1117 (let ((full-title 1118 (concat 1119 (when todo (format "\\fB%s\\fP " todo)) 1120 (when priority (format " [\\#%c] " priority)) 1121 title 1122 (when tags (format " \\fC%s\\fP " (org-make-tag-string tags)))))) 1123 (format (concat "\n.DS I\n" 1124 "%s\n" 1125 ".sp" 1126 "%s\n" 1127 ".DE") 1128 full-title contents)))))) 1129 1130 ;;; Italic 1131 1132 (defun org-groff-italic (italic contents info) 1133 "Transcode ITALIC from Org to Groff. 1134 CONTENTS is the text with italic markup. INFO is a plist holding 1135 contextual information." 1136 (org-groff--text-markup contents 'italic)) 1137 1138 ;;; Item 1139 1140 (defun org-groff-item (item contents info) 1141 "Transcode an ITEM element from Org to Groff. 1142 CONTENTS holds the contents of the item. INFO is a plist holding 1143 contextual information." 1144 (let* ((bullet (org-element-property :bullet item)) 1145 (type (org-element-property 1146 :type (org-element-property :parent item))) 1147 (checkbox (case (org-element-property :checkbox item) 1148 (on "\\o'\\(sq\\(mu'") 1149 (off "\\(sq") 1150 (trans "\\o'\\(sq\\(mi'"))) 1151 (tag (let ((tag (org-element-property :tag item))) 1152 ;; Check-boxes must belong to the tag. 1153 (and tag (format "%s" 1154 (concat checkbox 1155 (org-export-data tag info))))))) 1156 1157 (cond 1158 ((or checkbox tag) 1159 (concat ".LI ""\"" (or tag (concat "\\ " checkbox)) "\"" 1160 "\n" 1161 (org-trim (or contents " ")))) 1162 ((eq type 'ordered) 1163 (concat ".LI" 1164 "\n" 1165 (org-trim (or contents " ")))) 1166 (t 1167 (let* ((bullet (org-trim bullet)) 1168 (marker (cond ((string= "-" bullet) "\\(em") 1169 ((string= "*" bullet) "\\(bu") 1170 (t "\\(dg")))) 1171 (concat ".LI " marker "\n" 1172 (org-trim (or contents " ")))))))) 1173 1174 ;;; Keyword 1175 1176 (defun org-groff-keyword (keyword contents info) 1177 "Transcode a KEYWORD element from Org to Groff. 1178 CONTENTS is nil. INFO is a plist holding contextual information." 1179 (let ((key (org-element-property :key keyword)) 1180 (value (org-element-property :value keyword))) 1181 (cond 1182 ((string= key "GROFF") value) 1183 (t nil)))) 1184 1185 ;;; Line Break 1186 1187 (defun org-groff-line-break (line-break contents info) 1188 "Transcode a LINE-BREAK object from Org to Groff. 1189 CONTENTS is nil. INFO is a plist holding contextual information." 1190 ".br\n") 1191 1192 ;;; Link 1193 ;; Inline images just place a call to .PSPIC or .PS/.PE 1194 ;; and load the graph. 1195 1196 (defun org-groff-link--inline-image (link info) 1197 "Return Groff code for an inline image. 1198 LINK is the link pointing to the inline image. INFO is a plist 1199 used as a communication channel." 1200 (let* ((parent (org-export-get-parent-element link)) 1201 (path (let ((raw-path (org-element-property :path link))) 1202 (if (not (file-name-absolute-p raw-path)) raw-path 1203 (expand-file-name raw-path)))) 1204 (attr (org-export-read-attribute :attr_groff link)) 1205 (placement 1206 (let ((pos (plist-get attr :position))) 1207 (cond ((string= pos 'center) "") 1208 ((string= pos 'left) "-L") 1209 ((string= pos 'right) "-R") 1210 (t "")))) 1211 (width (or (plist-get attr :width) "")) 1212 (height (or (plist-get attr :height) "")) 1213 (caption (and (not (plist-get attr :disable-caption)) 1214 (org-groff--caption/label-string parent info)))) 1215 ;; Now clear ATTR from any special keyword and set a default value 1216 ;; if nothing is left. Return proper string. 1217 (concat 1218 (cond 1219 ((and org-groff-raster-to-ps 1220 (or (string-match ".\.png$" path) 1221 (string-match ".\.jpg$" path))) 1222 (let ((eps-path (concat path ".eps"))) 1223 (shell-command (format org-groff-raster-to-ps path eps-path)) 1224 (format "\n.DS L F\n.PSPIC %s \"%s\" %s %s\n.DE " 1225 placement eps-path width height))) 1226 ((string-match ".\.pic$" path) 1227 (format "\n.PS\ncopy \"%s\"\n.PE" path)) 1228 (t (format "\n.DS L F\n.PSPIC %s \"%s\" %s %s\n.DE " 1229 placement path width height))) 1230 (and caption (format "\n.FG \"%s\"" caption))))) 1231 1232 (defun org-groff-link (link desc info) 1233 "Transcode a LINK object from Org to Groff. 1234 1235 DESC is the description part of the link, or the empty string. 1236 INFO is a plist holding contextual information. See 1237 `org-export-data'." 1238 1239 (let* ((type (org-element-property :type link)) 1240 (raw-path (org-element-property :path link)) 1241 ;; Ensure DESC really exists, or set it to nil. 1242 (desc (and (not (string= desc "")) desc)) 1243 (imagep (org-export-inline-image-p 1244 link org-groff-inline-image-rules)) 1245 (path (cond 1246 ((member type '("http" "https" "ftp" "mailto")) 1247 (concat type ":" raw-path)) 1248 ((string= type "file") (org-export-file-uri raw-path)) 1249 (t raw-path)))) 1250 (cond 1251 ((org-export-custom-protocol-maybe link desc 'groff info)) 1252 ;; Image file. 1253 (imagep (org-groff-link--inline-image link info)) 1254 ;; import groff files 1255 ((and (string= type "file") 1256 (string-match ".\.groff$" raw-path)) 1257 (concat ".so " raw-path "\n")) 1258 ;; Radio link: transcode target's contents and use them as link's 1259 ;; description. 1260 ((string= type "radio") 1261 (let ((destination (org-export-resolve-radio-link link info))) 1262 (if (not destination) desc 1263 (format "\\fI [%s] \\fP" 1264 (org-export-get-reference destination info))))) 1265 1266 ;; Links pointing to a headline: find destination and build 1267 ;; appropriate referencing command. 1268 ((member type '("custom-id" "fuzzy" "id")) 1269 (let ((destination (if (string= type "fuzzy") 1270 (org-export-resolve-fuzzy-link link info) 1271 (org-export-resolve-id-link link info)))) 1272 (case (org-element-type destination) 1273 ;; Id link points to an external file. 1274 (plain-text 1275 (if desc (format "%s \\fBat\\fP \\fIfile://%s\\fP" desc destination) 1276 (format "\\fI file://%s \\fP" destination))) 1277 ;; Fuzzy link points nowhere. 1278 ('nil 1279 (format org-groff-link-with-unknown-path-format 1280 (or desc 1281 (org-export-data 1282 (org-element-property :raw-link link) info)))) 1283 ;; LINK points to a headline. If headlines are numbered and 1284 ;; the link has no description, display headline's number. 1285 ;; Otherwise, display description or headline's title. 1286 (headline 1287 (let ((label "")) 1288 (if (and (plist-get info :section-numbers) (not desc)) 1289 (format "\\fI%s\\fP" label) 1290 (format "\\fI%s\\fP" 1291 (or desc 1292 (org-export-data 1293 (org-element-property :title destination) info)))))) 1294 ;; Fuzzy link points to a target. Do as above. 1295 (otherwise 1296 (let ((ref (org-export-get-reference destination info))) 1297 (if (not desc) (format "\\fI%s\\fP" ref) 1298 (format "%s \\fBat\\fP \\fI%s\\fP" desc ref))))))) 1299 ;; External link with a description part. 1300 ((and path desc) (format "%s \\fBat\\fP \\fI%s\\fP" path desc)) 1301 ;; External link without a description part. 1302 (path (format "\\fI%s\\fP" path)) 1303 ;; No path, only description. Try to do something useful. 1304 (t (format org-groff-link-with-unknown-path-format desc))))) 1305 1306 ;;; Node Property 1307 1308 (defun org-groff-node-property (node-property contents info) 1309 "Transcode a NODE-PROPERTY element from Org to Groff. 1310 CONTENTS is nil. INFO is a plist holding contextual 1311 information." 1312 (format "%s:%s" 1313 (org-element-property :key node-property) 1314 (let ((value (org-element-property :value node-property))) 1315 (if value (concat " " value) "")))) 1316 1317 ;;; Paragraph 1318 1319 (defun org-groff-paragraph (paragraph contents info) 1320 "Transcode a PARAGRAPH element from Org to Groff. 1321 CONTENTS is the contents of the paragraph, as a string. INFO is 1322 the plist used as a communication channel." 1323 (let ((parent (plist-get (nth 1 paragraph) :parent))) 1324 (when parent 1325 (let* ((parent-type (car parent)) 1326 (fixed-paragraph "") 1327 (class (plist-get info :groff-class)) 1328 (class-options (plist-get info :groff-class-options)) 1329 (classes (assoc class org-groff-classes)) 1330 (classes-options (car (last classes))) 1331 (paragraph-option (plist-get classes-options :paragraph))) 1332 (cond 1333 ((and (symbolp paragraph-option) 1334 (fboundp paragraph-option)) 1335 (funcall paragraph-option parent-type parent contents)) 1336 ((and (eq parent-type 'item) 1337 (plist-get (nth 1 parent) :bullet)) 1338 (setq fixed-paragraph (concat "" contents))) 1339 ((eq parent-type 'section) 1340 (setq fixed-paragraph (concat ".P\n" contents))) 1341 ((eq parent-type 'footnote-definition) 1342 (setq fixed-paragraph (concat "" contents))) 1343 (t (setq fixed-paragraph (concat "" contents)))) 1344 fixed-paragraph)))) 1345 1346 ;;; Plain List 1347 1348 (defun org-groff-plain-list (plain-list contents info) 1349 "Transcode a PLAIN-LIST element from Org to Groff. 1350 CONTENTS is the contents of the list. INFO is a plist holding 1351 contextual information." 1352 (let* ((type (org-element-property :type plain-list)) 1353 (attr (mapconcat #'identity 1354 (org-element-property :attr_groff plain-list) 1355 " ")) 1356 (groff-type (cond 1357 ((eq type 'ordered) ".AL") 1358 ((eq type 'unordered) ".BL") 1359 ((eq type 'descriptive) ".VL 2.0i")))) 1360 (org-groff--wrap-label 1361 plain-list 1362 (format "%s\n%s\n.LE" groff-type contents)))) 1363 1364 ;;; Plain Text 1365 1366 (defun org-groff-plain-text (text info) 1367 "Transcode a TEXT string from Org to Groff. 1368 TEXT is the string to transcode. INFO is a plist holding 1369 contextual information." 1370 (let ((output text)) 1371 ;; Protect various characters. 1372 (setq output (replace-regexp-in-string 1373 "\\(?:[^\\]\\|^\\)\\(\\\\\\)\\(?:[^%$#&{}~^_\\]\\|$\\)" 1374 "$\\" output nil t 1)) 1375 ;; Activate smart quotes. Be sure to provide original TEXT string 1376 ;; since OUTPUT may have been modified. 1377 (when (plist-get info :with-smart-quotes) 1378 (setq output (org-export-activate-smart-quotes output :utf-8 info text))) 1379 ;; Handle Special Characters 1380 (if org-groff-special-char 1381 (dolist (special-char-list org-groff-special-char) 1382 (setq output 1383 (replace-regexp-in-string (car special-char-list) 1384 (cdr special-char-list) output)))) 1385 ;; Handle break preservation if required. 1386 (when (plist-get info :preserve-breaks) 1387 (setq output (replace-regexp-in-string 1388 "\\(\\\\\\\\\\)?[ \t]*\n" ".br\n" output))) 1389 ;; Return value. 1390 output)) 1391 1392 ;;; Planning 1393 1394 (defun org-groff-planning (planning contents info) 1395 "Transcode a PLANNING element from Org to Groff. 1396 CONTENTS is nil. INFO is a plist holding contextual 1397 information." 1398 (concat 1399 (mapconcat 1400 'identity 1401 (delq nil 1402 (list 1403 (let ((closed (org-element-property :closed planning))) 1404 (when closed 1405 (concat 1406 (format "\\fR %s \\fP" org-closed-string) 1407 (format org-groff-inactive-timestamp-format 1408 (org-timestamp-translate closed))))) 1409 (let ((deadline (org-element-property :deadline planning))) 1410 (when deadline 1411 (concat 1412 (format "\\fB %s \\fP" org-deadline-string) 1413 (format org-groff-active-timestamp-format 1414 (org-timestamp-translate deadline))))) 1415 (let ((scheduled (org-element-property :scheduled planning))) 1416 (when scheduled 1417 (concat 1418 (format "\\fR %s \\fP" org-scheduled-string) 1419 (format org-groff-active-timestamp-format 1420 (org-timestamp-translate scheduled))))))) 1421 "") 1422 "")) 1423 1424 ;;;; Property Drawer 1425 1426 (defun org-groff-property-drawer (property-drawer contents info) 1427 "Transcode a PROPERTY-DRAWER element from Org to Groff. 1428 CONTENTS holds the contents of the drawer. INFO is a plist 1429 holding contextual information." 1430 (and (org-string-nw-p contents) 1431 (format "\\fC\n%s\\fP" contents))) 1432 1433 ;;; Quote Block 1434 1435 (defun org-groff-quote-block (quote-block contents info) 1436 "Transcode a QUOTE-BLOCK element from Org to Groff. 1437 CONTENTS holds the contents of the block. INFO is a plist 1438 holding contextual information." 1439 (org-groff--wrap-label 1440 quote-block 1441 (format ".DS I\n.I\n%s\n.R\n.DE" contents))) 1442 1443 ;;; Radio Target 1444 1445 (defun org-groff-radio-target (radio-target text info) 1446 "Transcode a RADIO-TARGET object from Org to Groff. 1447 TEXT is the text of the target. INFO is a plist holding 1448 contextual information." 1449 (format "%s - %s" (org-export-get-reference radio-target info) text)) 1450 1451 ;;; Section 1452 1453 (defun org-groff-section (section contents info) 1454 "Transcode a SECTION element from Org to Groff. 1455 CONTENTS holds the contents of the section. INFO is a plist 1456 holding contextual information." 1457 contents) 1458 1459 ;;; Special Block 1460 1461 (defun org-groff-special-block (special-block contents info) 1462 "Transcode a SPECIAL-BLOCK element from Org to Groff. 1463 CONTENTS holds the contents of the block. INFO is a plist 1464 holding contextual information." 1465 (let ((type (org-element-property :type special-block))) 1466 (org-groff--wrap-label 1467 special-block 1468 (format "%s\n" contents)))) 1469 1470 ;;; Src Block 1471 1472 (defun org-groff-src-block (src-block contents info) 1473 "Transcode a SRC-BLOCK element from Org to Groff. 1474 CONTENTS holds the contents of the item. INFO is a plist holding 1475 contextual information." 1476 (let* ((lang (org-element-property :language src-block)) 1477 (label (org-element-property :name src-block)) 1478 (code (org-element-property :value src-block)) 1479 (custom-env (and lang 1480 (cadr (assq (intern lang) 1481 org-groff-custom-lang-environments)))) 1482 (num-start (org-export-get-loc src-block info)) 1483 (retain-labels (org-element-property :retain-labels src-block)) 1484 (caption (and (not (org-export-read-attribute 1485 :attr_groff src-block :disable-caption)) 1486 (org-groff--caption/label-string src-block info)))) 1487 1488 (cond 1489 ;; Case 1. No source fontification. 1490 ((not org-groff-source-highlight) 1491 (concat 1492 (format ".DS I\n\\fC%s\\fP\n.DE\n" 1493 (org-export-format-code-default src-block info)) 1494 (and caption (format ".EX \"%s\" " caption)))) 1495 1496 ;; Case 2. Source fontification. 1497 (org-groff-source-highlight 1498 (let* ((tmpdir temporary-file-directory) 1499 (in-file (make-temp-name 1500 (expand-file-name "srchilite" tmpdir))) 1501 (out-file (make-temp-name 1502 (expand-file-name "reshilite" tmpdir))) 1503 1504 (org-lang (org-element-property :language src-block)) 1505 (lst-lang (cadr (assq (intern org-lang) 1506 org-groff-source-highlight-langs))) 1507 1508 (cmd (concat "source-highlight" 1509 " -s " lst-lang 1510 " -f groff_mm_color " 1511 " -i " in-file 1512 " -o " out-file))) 1513 1514 (concat 1515 (if lst-lang 1516 (let ((code-block "")) 1517 (with-temp-file in-file (insert code)) 1518 (shell-command cmd) 1519 (setq code-block (org-file-contents out-file)) 1520 (delete-file in-file) 1521 (delete-file out-file) 1522 (format "%s\n" code-block)) 1523 (format ".DS I\n\\fC\\m[black]%s\\m[]\\fP\n.DE\n" 1524 code)) 1525 (and caption (format ".EX \"%s\" " caption)))))))) 1526 1527 1528 ;;; Statistics Cookie 1529 1530 (defun org-groff-statistics-cookie (statistics-cookie contents info) 1531 "Transcode a STATISTICS-COOKIE object from Org to Groff. 1532 CONTENTS is nil. INFO is a plist holding contextual information." 1533 (org-element-property :value statistics-cookie)) 1534 1535 1536 ;;; Strike-Through 1537 1538 (defun org-groff-strike-through (strike-through contents info) 1539 "Transcode STRIKE-THROUGH from Org to Groff. 1540 CONTENTS is the text with strike-through markup. INFO is a plist 1541 holding contextual information." 1542 (org-groff--text-markup contents 'strike-through)) 1543 1544 ;;; Subscript 1545 1546 (defun org-groff-subscript (subscript contents info) 1547 "Transcode a SUBSCRIPT object from Org to Groff. 1548 CONTENTS is the contents of the object. INFO is a plist holding 1549 contextual information." 1550 (format "\\d\\s-2%s\\s+2\\u" contents)) 1551 1552 ;;; Superscript "^_%s$ 1553 1554 (defun org-groff-superscript (superscript contents info) 1555 "Transcode a SUPERSCRIPT object from Org to Groff. 1556 CONTENTS is the contents of the object. INFO is a plist holding 1557 contextual information." 1558 (format "\\u\\s-2%s\\s+2\\d" contents)) 1559 1560 1561 ;;; Table 1562 ;; 1563 ;; `org-groff-table' is the entry point for table transcoding. It 1564 ;; takes care of tables with a "verbatim" attribute. Otherwise, it 1565 ;; delegates the job to `org-groff-table--org-table' function, 1566 ;; depending of the type of the table. 1567 ;; 1568 ;; `org-groff-table--align-string' is a subroutine used to build 1569 ;; alignment string for Org tables. 1570 1571 (defun org-groff-table (table contents info) 1572 "Transcode a TABLE element from Org to Groff. 1573 CONTENTS is the contents of the table. INFO is a plist holding 1574 contextual information." 1575 (cond 1576 ;; Case 1: verbatim table. 1577 ((or org-groff-tables-verbatim 1578 (let ((attr (read (format "(%s)" 1579 (mapconcat 1580 #'identity 1581 (org-element-property :attr_groff table) " "))))) 1582 (and attr (plist-get attr :verbatim)))) 1583 1584 (format ".DS L\n\\fC%s\\fP\n.DE" 1585 ;; Re-create table, without affiliated keywords. 1586 (org-trim 1587 (org-element-interpret-data 1588 `(table nil ,@(org-element-contents table)))))) 1589 1590 ;; Case 2: Standard table. 1591 (t (org-groff-table--org-table table contents info)))) 1592 1593 (defun org-groff-table--align-string (divider table info) 1594 "Return an appropriate Groff alignment string. 1595 TABLE is the considered table. INFO is a plist used as 1596 a communication channel." 1597 (let (alignment) 1598 ;; Extract column groups and alignment from first (non-rule) row. 1599 (org-element-map 1600 (org-element-map table 'table-row 1601 (lambda (row) 1602 (and (eq (org-element-property :type row) 'standard) row)) 1603 info 'first-match) 1604 'table-cell 1605 (lambda (cell) 1606 (let* ((borders (org-export-table-cell-borders cell info)) 1607 (raw-width (org-export-table-cell-width cell info)) 1608 (width-cm (when raw-width (/ raw-width 5))) 1609 (width (if raw-width (format "w(%dc)" 1610 (if (< width-cm 1) 1 width-cm)) ""))) 1611 ;; Check left border for the first cell only. 1612 ;; Alignment is nil on assignment 1613 1614 (when (and (memq 'left borders) (not alignment)) 1615 (push "|" alignment)) 1616 (push 1617 (case (org-export-table-cell-alignment cell info) 1618 (left (concat "l" width divider)) 1619 (right (concat "r" width divider)) 1620 (center (concat "c" width divider))) 1621 alignment) 1622 (when (memq 'right borders) (push "|" alignment)))) 1623 info) 1624 (apply 'concat (reverse alignment)))) 1625 1626 (defun org-groff-table--org-table (table contents info) 1627 "Return appropriate Groff code for an Org table. 1628 1629 TABLE is the table type element to transcode. CONTENTS is its 1630 contents, as a string. INFO is a plist used as a communication 1631 channel. 1632 1633 This function assumes TABLE has `org' as its `:type' attribute." 1634 (let* ((attr (org-export-read-attribute :attr_groff table)) 1635 (label (org-element-property :name table)) 1636 (caption (and (not (plist-get attr :disable-caption)) 1637 (org-groff--caption/label-string table info))) 1638 (divider (if (plist-get attr :divider) "|" " ")) 1639 1640 ;; Determine alignment string. 1641 (alignment (org-groff-table--align-string divider table info)) 1642 1643 ;; Extract others display options. 1644 1645 (lines (org-split-string contents "\n")) 1646 1647 (attr-list 1648 (delq nil 1649 (list (and (plist-get attr :expand) "expand") 1650 (let ((placement (plist-get attr :placement))) 1651 (cond ((string= placement 'center) "center") 1652 ((string= placement 'left) nil) 1653 (t (if org-groff-tables-centered "center" "")))) 1654 (or (plist-get attr :boxtype) "box")))) 1655 1656 (title-line (plist-get attr :title-line)) 1657 (long-cells (plist-get attr :long-cells)) 1658 1659 (table-format 1660 (concat 1661 (or (car attr-list) "") 1662 (or 1663 (let (output-list) 1664 (when (cdr attr-list) 1665 (dolist (attr-item (cdr attr-list)) 1666 (setq output-list (concat output-list 1667 (format ",%s" attr-item))))) 1668 output-list) ""))) 1669 (first-line 1670 (when lines (org-split-string (car lines) "\t")))) 1671 ;; Prepare the final format string for the table. 1672 1673 1674 (cond 1675 ;; Others. 1676 (lines 1677 (concat ".TS\n " table-format ";\n" 1678 (format "%s.\n" 1679 (let ((final-line "")) 1680 (when title-line 1681 (dotimes (i (length first-line)) 1682 (setq final-line (concat final-line "cb" divider)))) 1683 1684 (setq final-line (concat final-line "\n")) 1685 1686 (if alignment 1687 (setq final-line (concat final-line alignment)) 1688 (dotimes (i (length first-line)) 1689 (setq final-line (concat final-line "c" divider)))) 1690 final-line)) 1691 1692 (format "%s.TE\n" 1693 (let ((final-line "") 1694 (long-line "") 1695 (lines (org-split-string contents "\n"))) 1696 1697 (dolist (line-item lines) 1698 (setq long-line "") 1699 1700 (if long-cells 1701 (progn 1702 (if (string= line-item "_") 1703 (setq long-line (format "%s\n" line-item)) 1704 ;; else string = 1705 (let ((cell-item-list (org-split-string line-item "\t"))) 1706 (dolist (cell-item cell-item-list) 1707 1708 (cond ((eq cell-item (car (last cell-item-list))) 1709 (setq long-line (concat long-line 1710 (format "T{\n%s\nT}\t\n" cell-item)))) 1711 (t 1712 (setq long-line (concat long-line 1713 (format "T{\n%s\nT}\t" cell-item)))))) 1714 long-line)) 1715 ;; else long cells 1716 (setq final-line (concat final-line long-line))) 1717 1718 (setq final-line (concat final-line line-item "\n")))) 1719 final-line)) 1720 1721 (if caption (format ".TB \"%s\"" caption) "")))))) 1722 1723 ;;; Table Cell 1724 1725 (defun org-groff-table-cell (table-cell contents info) 1726 "Transcode a TABLE-CELL element from Org to Groff 1727 CONTENTS is the cell contents. INFO is a plist used as 1728 a communication channel." 1729 (progn 1730 (concat (if (and contents 1731 org-groff-table-scientific-notation 1732 (string-match orgtbl-exp-regexp contents)) 1733 ;; Use appropriate format string for scientific 1734 ;; notation. 1735 (format org-groff-table-scientific-notation 1736 (match-string 1 contents) 1737 (match-string 2 contents)) 1738 contents) 1739 (when (org-export-get-next-element table-cell info) "\t")))) 1740 1741 1742 ;;; Table Row 1743 1744 (defun org-groff-table-row (table-row contents info) 1745 "Transcode a TABLE-ROW element from Org to Groff 1746 CONTENTS is the contents of the row. INFO is a plist used as 1747 a communication channel." 1748 ;; Rules are ignored since table separators are deduced from 1749 ;; borders of the current row. 1750 (when (eq (org-element-property :type table-row) 'standard) 1751 (let* ((attr (mapconcat 'identity 1752 (org-element-property 1753 :attr_groff (org-export-get-parent table-row)) 1754 " ")) 1755 ;; TABLE-ROW's borders are extracted from its first cell. 1756 (borders 1757 (org-export-table-cell-borders 1758 (car (org-element-contents table-row)) info))) 1759 (concat 1760 ;; Mark horizontal lines 1761 (cond ((and (memq 'top borders) (memq 'above borders)) "_\n")) 1762 contents 1763 (cond 1764 ;; When BOOKTABS are activated enforce bottom rule even when 1765 ;; no hline was specifically marked. 1766 ((and (memq 'bottom borders) (memq 'below borders)) "\n_") 1767 ((memq 'below borders) "\n_")))))) 1768 1769 ;;; Target 1770 1771 (defun org-groff-target (target contents info) 1772 "Transcode a TARGET object from Org to Groff. 1773 CONTENTS is nil. INFO is a plist holding contextual 1774 information." 1775 (format "\\fI%s\\fP" (org-export-get-reference target info))) 1776 1777 ;;; Timestamp 1778 1779 (defun org-groff-timestamp (timestamp contents info) 1780 "Transcode a TIMESTAMP object from Org to Groff. 1781 CONTENTS is nil. INFO is a plist holding contextual 1782 information." 1783 (let ((value (org-groff-plain-text 1784 (org-timestamp-translate timestamp) info))) 1785 (case (org-element-property :type timestamp) 1786 ((active active-range) 1787 (format org-groff-active-timestamp-format value)) 1788 ((inactive inactive-range) 1789 (format org-groff-inactive-timestamp-format value)) 1790 (t (format org-groff-diary-timestamp-format value))))) 1791 1792 ;;; Underline 1793 1794 (defun org-groff-underline (underline contents info) 1795 "Transcode UNDERLINE from Org to Groff. 1796 CONTENTS is the text with underline markup. INFO is a plist 1797 holding contextual information." 1798 (org-groff--text-markup contents 'underline)) 1799 1800 ;;; Verbatim 1801 1802 (defun org-groff-verbatim (verbatim contents info) 1803 "Transcode a VERBATIM object from Org to Groff. 1804 CONTENTS is nil. INFO is a plist used as a communication 1805 channel." 1806 (org-groff--text-markup (org-element-property :value verbatim) 'verbatim)) 1807 1808 ;;; Verse Block 1809 1810 (defun org-groff-verse-block (verse-block contents info) 1811 "Transcode a VERSE-BLOCK element from Org to Groff. 1812 CONTENTS is verse block contents. INFO is a plist holding 1813 contextual information." 1814 (format ".DS C\n.ft HI\n%s\n.ft\n.DE" contents)) 1815 1816 1817 ;;; Interactive functions 1818 1819 (defun org-groff-export-to-groff 1820 (&optional async subtreep visible-only body-only ext-plist) 1821 "Export current buffer to a Groff file. 1822 1823 If narrowing is active in the current buffer, only export its 1824 narrowed part. 1825 1826 If a region is active, export that region. 1827 1828 A non-nil optional argument ASYNC means the process should happen 1829 asynchronously. The resulting file should be accessible through 1830 the `org-export-stack' interface. 1831 1832 When optional argument SUBTREEP is non-nil, export the sub-tree 1833 at point, extracting information from the headline properties 1834 first. 1835 1836 When optional argument VISIBLE-ONLY is non-nil, don't export 1837 contents of hidden elements. 1838 1839 EXT-PLIST, when provided, is a property list with external 1840 parameters overriding Org default settings, but still inferior to 1841 file-local settings. 1842 1843 Return output file's name." 1844 (interactive) 1845 (let ((outfile (org-export-output-file-name ".groff" subtreep)) 1846 (org-groff-registered-references nil) 1847 (org-groff-special-content nil)) 1848 (org-export-to-file 'groff outfile 1849 async subtreep visible-only body-only ext-plist))) 1850 1851 (defun org-groff-export-to-pdf 1852 (&optional async subtreep visible-only body-only ext-plist) 1853 "Export current buffer to Groff then process through to PDF. 1854 1855 If narrowing is active in the current buffer, only export its 1856 narrowed part. 1857 1858 If a region is active, export that region. 1859 1860 A non-nil optional argument ASYNC means the process should happen 1861 asynchronously. The resulting file should be accessible through 1862 the `org-export-stack' interface. 1863 1864 When optional argument SUBTREEP is non-nil, export the sub-tree 1865 at point, extracting information from the headline properties 1866 first. 1867 1868 When optional argument VISIBLE-ONLY is non-nil, don't export 1869 contents of hidden elements. 1870 1871 EXT-PLIST, when provided, is a property list with external 1872 parameters overriding Org default settings, but still inferior to 1873 file-local settings. 1874 1875 Return PDF file's name." 1876 (interactive) 1877 (let ((outfile (org-export-output-file-name ".groff" subtreep))) 1878 (org-export-to-file 'groff outfile 1879 async subtreep visible-only body-only ext-plist 1880 (lambda (file) (org-groff-compile file))))) 1881 1882 ;; Port to Emacs 26 and earlier. 1883 (defun org-groff--time-sec (time) 1884 (if (fboundp 'time-convert) 1885 (time-convert time 'integer) 1886 (cl-subseq (or time (current-time)) 0 2))) 1887 1888 (defun org-groff-compile (file) 1889 "Compile a Groff file. 1890 1891 FILE is the name of the file being compiled. Processing is done 1892 through the command specified in `org-groff-pdf-process'. 1893 1894 Return PDF file name or an error if it couldn't be produced." 1895 (let* ((base-name (file-name-sans-extension (file-name-nondirectory file))) 1896 (full-name (file-truename file)) 1897 (out-dir (file-name-directory full-name)) 1898 (time (org-groff--time-sec nil)) 1899 ;; Properly set working directory for compilation. 1900 (default-directory (if (file-name-absolute-p file) 1901 (file-name-directory full-name) 1902 default-directory)) 1903 errors) 1904 (message (format "Processing Groff file %s ..." file)) 1905 (save-window-excursion 1906 (cond 1907 ;; A function is provided: Apply it. 1908 ((functionp org-groff-pdf-process) 1909 (funcall org-groff-pdf-process (shell-quote-argument file))) 1910 ;; A list is provided: Replace %b, %f and %o with appropriate 1911 ;; values in each command before applying it. Output is 1912 ;; redirected to "*Org PDF Groff Output*" buffer. 1913 ((consp org-groff-pdf-process) 1914 (let ((outbuf (get-buffer-create "*Org PDF Groff Output*"))) 1915 (mapc 1916 (lambda (command) 1917 (shell-command 1918 (replace-regexp-in-string 1919 "%b" (shell-quote-argument base-name) 1920 (replace-regexp-in-string 1921 "%f" (shell-quote-argument full-name) 1922 (replace-regexp-in-string 1923 "%o" (shell-quote-argument out-dir) command t t) 1924 t t) t t) 1925 outbuf)) 1926 org-groff-pdf-process) 1927 ;; Collect standard errors from output buffer. 1928 (setq errors (org-groff-collect-errors outbuf)))) 1929 (t (error "No valid command to process to PDF"))) 1930 (let ((pdffile (concat out-dir base-name ".pdf"))) 1931 ;; Check for process failure. Provide collected errors if 1932 ;; possible. 1933 (if (or (not (file-exists-p pdffile)) 1934 ;; Only compare times up to whole seconds as some 1935 ;; filesystems (e.g. HFS+) do not retain any finer 1936 ;; granularity. 1937 (time-less-p (org-groff--time-sec 1938 (nth 5 (file-attributes pdffile))) 1939 time)) 1940 (error (concat (format "PDF file %s wasn't produced" pdffile) 1941 (when errors (concat ": " errors)))) 1942 ;; Else remove log files, when specified, and signal end of 1943 ;; process to user, along with any error encountered. 1944 (when org-groff-remove-logfiles 1945 (dolist (ext org-groff-logfiles-extensions) 1946 (let ((file (concat out-dir base-name "." ext))) 1947 (when (file-exists-p file) (delete-file file))))) 1948 (message (concat "Process completed" 1949 (if (not errors) "." 1950 (concat " with errors: " errors))))) 1951 ;; Return output file name. 1952 pdffile)))) 1953 1954 (defun org-groff-collect-errors (buffer) 1955 "Collect some kind of errors from \"groff\" output 1956 BUFFER is the buffer containing output. 1957 Return collected error types as a string, or nil if there was 1958 none." 1959 (with-current-buffer buffer 1960 (save-excursion 1961 (goto-char (point-max)) 1962 ;; Find final run 1963 nil))) 1964 1965 1966 (provide 'ox-groff) 1967 ;;; ox-groff.el ends here