org-e-groff.el 74 KB

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