test-org-table.el 102 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290
  1. ;;; test-org-table.el --- tests for org-table.el
  2. ;; Copyright (c) David Maus
  3. ;; Authors: David Maus, Michael Brand
  4. ;; This file is not part of GNU Emacs.
  5. ;; This program is free software; you can redistribute it and/or modify
  6. ;; it under the terms of the GNU General Public License as published by
  7. ;; the Free Software Foundation, either version 3 of the License, or
  8. ;; (at your option) any later version.
  9. ;; This program is distributed in the hope that it will be useful,
  10. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. ;; GNU General Public License for more details.
  13. ;; You should have received a copy of the GNU General Public License
  14. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  15. ;;;; Comments:
  16. ;; Template test file for Org tests. Many tests are also a howto
  17. ;; example collection as a user documentation, more or less all those
  18. ;; using `org-test-table-target-expect'. See also the doc string of
  19. ;; `org-test-table-target-expect'.
  20. ;;; Code:
  21. (require 'org-table) ; `org-table-make-reference'
  22. (ert-deftest test-org-table/simple-formula/no-grouping/no-title-row ()
  23. "Simple sum without grouping rows, without title row."
  24. (org-test-table-target-expect
  25. "
  26. | 2 |
  27. | 4 |
  28. | 8 |
  29. | replace |
  30. "
  31. "
  32. | 2 |
  33. | 4 |
  34. | 8 |
  35. | 14 |
  36. "
  37. 1
  38. ;; Calc formula
  39. "#+TBLFM: @>$1 = vsum(@<..@>>)"
  40. ;; Lisp formula
  41. "#+TBLFM: @>$1 = '(+ @<..@>>); N"))
  42. (ert-deftest test-org-table/simple-formula/no-grouping/with-title-row ()
  43. "Simple sum without grouping rows, with title row."
  44. (org-test-table-target-expect
  45. "
  46. | foo |
  47. |---------|
  48. | 2 |
  49. | 4 |
  50. | 8 |
  51. | replace |
  52. "
  53. "
  54. | foo |
  55. |-----|
  56. | 2 |
  57. | 4 |
  58. | 8 |
  59. | 14 |
  60. "
  61. 1
  62. ;; Calc formula
  63. "#+TBLFM: @>$1 = vsum(@I..@>>)"
  64. ;; Lisp formula
  65. "#+TBLFM: @>$1 = '(+ @I..@>>); N"))
  66. (ert-deftest test-org-table/simple-formula/with-grouping/no-title-row ()
  67. "Simple sum with grouping rows, how not to do."
  68. ;; The first example has a problem, see the second example in this
  69. ;; ert-deftest.
  70. (org-test-table-target-expect
  71. "
  72. | 2 |
  73. | 4 |
  74. | 8 |
  75. |---------|
  76. | replace |
  77. "
  78. "
  79. | 2 |
  80. | 4 |
  81. | 8 |
  82. |----|
  83. | 14 |
  84. "
  85. 1
  86. ;; Calc formula
  87. "#+TBLFM: $1 = vsum(@<..@>>)"
  88. ;; Lisp formula
  89. "#+TBLFM: $1 = '(+ @<..@>>); N")
  90. ;; The problem is that the first three rows with the summands are
  91. ;; considered the header and therefore column formulas are not
  92. ;; applied on them as shown below. Also export behaves unexpected.
  93. ;; See next ert-deftest how to group rows right.
  94. (org-test-table-target-expect
  95. "
  96. | 2 | header |
  97. | 4 | header |
  98. | 8 | header |
  99. |---------+---------|
  100. | replace | replace |
  101. "
  102. "
  103. | 2 | header |
  104. | 4 | header |
  105. | 8 | header |
  106. |----+--------|
  107. | 14 | 28 |
  108. "
  109. 2
  110. ;; Calc formula
  111. "#+TBLFM: @>$1 = vsum(@<..@>>) :: $2 = 2 * $1"
  112. ;; Lisp formula
  113. "#+TBLFM: @>$1 = '(+ @<..@>>); N :: $2 = '(* 2 $1); N"))
  114. (ert-deftest test-org-table/simple-formula/with-grouping/with-title-row ()
  115. "Simple sum with grouping rows, how to do it right."
  116. ;; Always add a top row with the column names separated by hline to
  117. ;; get the desired header when you want to group rows.
  118. (org-test-table-target-expect
  119. "
  120. | foo | bar |
  121. |---------+---------|
  122. | 2 | replace |
  123. | 4 | replace |
  124. | 8 | replace |
  125. |---------+---------|
  126. | replace | replace |
  127. "
  128. "
  129. | foo | bar |
  130. |-----+-----|
  131. | 2 | 4 |
  132. | 4 | 8 |
  133. | 8 | 16 |
  134. |-----+-----|
  135. | 14 | 28 |
  136. "
  137. 2
  138. ;; Calc formula
  139. "#+TBLFM: @>$1 = vsum(@I..@>>) :: $2 = 2 * $1"
  140. ;; Lisp formula
  141. "#+TBLFM: @>$1 = '(+ @I..@>>); N :: $2 = '(* 2 $1); N"))
  142. (defconst references/target-normal "
  143. | 0 | 1 | replace | replace | replace | replace | replace | replace |
  144. | z | 1 | replace | replace | replace | replace | replace | replace |
  145. | | 1 | replace | replace | replace | replace | replace | replace |
  146. | | | replace | replace | replace | replace | replace | replace |
  147. "
  148. "Normal numbers and non-numbers for Lisp and Calc formula.")
  149. (defconst references/target-special "
  150. | nan | 1 | replace | replace | replace | replace | replace | replace |
  151. | uinf | 1 | replace | replace | replace | replace | replace | replace |
  152. | -inf | 1 | replace | replace | replace | replace | replace | replace |
  153. | inf | 1 | replace | replace | replace | replace | replace | replace |
  154. "
  155. "Special numbers for Calc formula.")
  156. (ert-deftest test-org-table/references/mode-string-EL ()
  157. "Basic: Assign field reference, sum of field references, sum
  158. and len of simple range reference (no row) and complex range
  159. reference (with row). Mode string EL."
  160. ;; Empty fields are kept during parsing field but lost as list
  161. ;; elements within Lisp formula syntactically when used literally
  162. ;; and not enclosed with " within fields, see last columns with len.
  163. (org-test-table-target-expect
  164. references/target-normal
  165. ;; All the #ERROR show that for Lisp calculations N has to be used.
  166. "
  167. | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  168. | z | 1 | z | #ERROR | #ERROR | #ERROR | 2 | 2 |
  169. | | 1 | | 1 | 1 | 1 | 1 | 1 |
  170. | | | | 0 | 0 | 0 | 0 | 0 |
  171. "
  172. 1 (concat
  173. "#+TBLFM: $3 = '(identity \"$1\"); EL :: $4 = '(+ $1 $2); EL :: "
  174. "$5 = '(+ $1..$2); EL :: $6 = '(+ @0$1..@0$2); EL :: "
  175. "$7 = '(length '($1..$2)); EL :: $8 = '(length '(@0$1..@0$2)); EL"))
  176. ;; Empty fields are kept during parsing field _and_ as list elements
  177. ;; within Lisp formula syntactically even when used literally when
  178. ;; enclosed with " within fields, see last columns with len.
  179. (org-test-table-target-expect
  180. "
  181. | \"0\" | \"1\" | repl | repl | repl | repl | repl | repl |
  182. | \"z\" | \"1\" | repl | repl | repl | repl | repl | repl |
  183. | \"\" | \"1\" | repl | repl | repl | repl | repl | repl |
  184. | \"\" | \"\" | repl | repl | repl | repl | repl | repl |
  185. "
  186. "
  187. | \"0\" | \"1\" | \"0\" | 1 | #ERROR | #ERROR | 2 | 2 |
  188. | \"z\" | \"1\" | \"z\" | 1 | #ERROR | #ERROR | 2 | 2 |
  189. | \"\" | \"1\" | \"\" | 1 | #ERROR | #ERROR | 2 | 2 |
  190. | \"\" | \"\" | \"\" | 0 | #ERROR | #ERROR | 2 | 2 |
  191. "
  192. 1 (concat
  193. "#+TBLFM: $3 = '(concat \"\\\"\" $1 \"\\\"\"); EL :: "
  194. "$4 = '(+ (string-to-number $1) (string-to-number $2)); EL :: "
  195. "$5 = '(+ $1..$2); EL :: $6 = '(+ @0$1..@0$2); EL :: "
  196. "$7 = '(length '($1..$2)); EL :: $8 = '(length '(@0$1..@0$2)); EL")))
  197. (ert-deftest test-org-table/references/mode-string-E ()
  198. "Basic: Assign field reference, sum of field references, sum
  199. and len of simple range reference (no row) and complex range
  200. reference (with row). Mode string E."
  201. (let ((lisp
  202. (concat
  203. "#+TBLFM: $3 = '(identity $1); E :: $4 = '(+ $1 $2); E :: "
  204. "$5 = '(+ $1..$2); E :: $6 = '(+ @0$1..@0$2); E :: "
  205. "$7 = '(length '($1..$2)); E :: $8 = '(length '(@0$1..@0$2)); E"))
  206. (calc
  207. (concat
  208. "#+TBLFM: $3 = $1; E :: $4 = $1 + $2; E :: "
  209. "$5 = vsum($1..$2); E :: $6 = vsum(@0$1..@0$2); E :: "
  210. "$7 = vlen($1..$2); E :: $8 = vlen(@0$1..@0$2); E")))
  211. (org-test-table-target-expect
  212. references/target-normal
  213. ;; All the #ERROR show that for Lisp calculations N has to be used.
  214. "
  215. | 0 | 1 | 0 | #ERROR | #ERROR | #ERROR | 2 | 2 |
  216. | z | 1 | z | #ERROR | #ERROR | #ERROR | 2 | 2 |
  217. | | 1 | | #ERROR | #ERROR | #ERROR | 2 | 2 |
  218. | | | | #ERROR | #ERROR | #ERROR | 2 | 2 |
  219. "
  220. 1 lisp)
  221. (org-test-table-target-expect
  222. references/target-normal
  223. "
  224. | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  225. | z | 1 | z | z + 1 | z + 1 | z + 1 | 2 | 2 |
  226. | | 1 | nan | nan | nan | nan | 2 | 2 |
  227. | | | nan | nan | nan | nan | 2 | 2 |
  228. "
  229. 1 calc)
  230. (org-test-table-target-expect
  231. references/target-special
  232. "
  233. | nan | 1 | nan | nan | nan | nan | 2 | 2 |
  234. | uinf | 1 | uinf | uinf | uinf | uinf | 2 | 2 |
  235. | -inf | 1 | -inf | -inf | -inf | -inf | 2 | 2 |
  236. | inf | 1 | inf | inf | inf | inf | 2 | 2 |
  237. "
  238. 1 calc)))
  239. (ert-deftest test-org-table/references/mode-string-EN ()
  240. "Basic: Assign field reference, sum of field references, sum
  241. and len of simple range reference (no row) and complex range
  242. reference (with row). Mode string EN."
  243. (let ((lisp (concat
  244. "#+TBLFM: $3 = '(identity $1); EN :: $4 = '(+ $1 $2); EN :: "
  245. "$5 = '(+ $1..$2); EN :: $6 = '(+ @0$1..@0$2); EN :: "
  246. "$7 = '(length '($1..$2)); EN :: "
  247. "$8 = '(length '(@0$1..@0$2)); EN"))
  248. (calc (concat
  249. "#+TBLFM: $3 = $1; EN :: $4 = $1 + $2; EN :: "
  250. "$5 = vsum($1..$2); EN :: $6 = vsum(@0$1..@0$2); EN :: "
  251. "$7 = vlen($1..$2); EN :: $8 = vlen(@0$1..@0$2); EN")))
  252. (org-test-table-target-expect
  253. references/target-normal
  254. "
  255. | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  256. | z | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  257. | | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  258. | | | 0 | 0 | 0 | 0 | 2 | 2 |
  259. "
  260. 1 lisp calc)
  261. (org-test-table-target-expect
  262. references/target-special
  263. "
  264. | nan | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  265. | uinf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  266. | -inf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  267. | inf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  268. "
  269. 1 calc)))
  270. (ert-deftest test-org-table/references/mode-string-L ()
  271. "Basic: Assign field reference, sum of field references, sum
  272. and len of simple range reference (no row) and complex range
  273. reference (with row). Mode string L."
  274. (org-test-table-target-expect
  275. references/target-normal
  276. ;; All the #ERROR show that for Lisp calculations N has to be used.
  277. "
  278. | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  279. | z | 1 | z | #ERROR | #ERROR | #ERROR | 2 | 2 |
  280. | | 1 | | 1 | 1 | 1 | 1 | 1 |
  281. | | | | 0 | 0 | 0 | 0 | 0 |
  282. "
  283. 1 (concat
  284. "#+TBLFM: $3 = '(identity \"$1\"); L :: $4 = '(+ $1 $2); L :: "
  285. "$5 = '(+ $1..$2); L :: $6 = '(+ @0$1..@0$2); L :: "
  286. "$7 = '(length '($1..$2)); L :: $8 = '(length '(@0$1..@0$2)); L")))
  287. (ert-deftest test-org-table/references/mode-string-none ()
  288. "Basic: Assign field reference, sum of field references, sum
  289. and len of simple range reference (no row) and complex range
  290. reference (with row). No mode string."
  291. (let ((lisp (concat
  292. "#+TBLFM: $3 = '(identity $1) :: $4 = '(+ $1 $2) :: "
  293. "$5 = '(+ $1..$2) :: $6 = '(+ @0$1..@0$2) :: "
  294. "$7 = '(length '($1..$2)) :: $8 = '(length '(@0$1..@0$2))"))
  295. (calc (concat
  296. "#+TBLFM: $3 = $1 :: $4 = $1 + $2 :: "
  297. "$5 = vsum($1..$2) :: $6 = vsum(@0$1..@0$2) :: "
  298. "$7 = vlen($1..$2) :: $8 = vlen(@0$1..@0$2)")))
  299. (org-test-table-target-expect
  300. references/target-normal
  301. ;; All the #ERROR show that for Lisp calculations N has to be used.
  302. "
  303. | 0 | 1 | 0 | #ERROR | #ERROR | #ERROR | 2 | 2 |
  304. | z | 1 | z | #ERROR | #ERROR | #ERROR | 2 | 2 |
  305. | | 1 | | #ERROR | #ERROR | #ERROR | 1 | 1 |
  306. | | | | #ERROR | 0 | 0 | 0 | 0 |
  307. "
  308. 1 lisp)
  309. (org-test-table-target-expect
  310. references/target-normal
  311. "
  312. | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  313. | z | 1 | z | z + 1 | z + 1 | z + 1 | 2 | 2 |
  314. | | 1 | 0 | 1 | 1 | 1 | 1 | 1 |
  315. | | | 0 | 0 | 0 | 0 | 0 | 0 |
  316. "
  317. 1 calc)
  318. (org-test-table-target-expect
  319. references/target-special
  320. "
  321. | nan | 1 | nan | nan | nan | nan | 2 | 2 |
  322. | uinf | 1 | uinf | uinf | uinf | uinf | 2 | 2 |
  323. | -inf | 1 | -inf | -inf | -inf | -inf | 2 | 2 |
  324. | inf | 1 | inf | inf | inf | inf | 2 | 2 |
  325. "
  326. 1 calc)))
  327. (ert-deftest test-org-table/references/mode-string-N ()
  328. "Basic: Assign field reference, sum of field references, sum
  329. and len of simple range reference (no row) and complex range
  330. reference (with row). Mode string N."
  331. (let ((lisp
  332. (concat
  333. "#+TBLFM: $3 = '(identity $1); N :: $4 = '(+ $1 $2); N :: "
  334. "$5 = '(+ $1..$2); N :: $6 = '(+ @0$1..@0$2); N :: "
  335. "$7 = '(length '($1..$2)); N :: $8 = '(length '(@0$1..@0$2)); N"))
  336. (calc
  337. (concat
  338. "#+TBLFM: $3 = $1; N :: $4 = $1 + $2; N :: "
  339. "$5 = vsum($1..$2); N :: $6 = vsum(@0$1..@0$2); N :: "
  340. "$7 = vlen($1..$2); N :: $8 = vlen(@0$1..@0$2); N")))
  341. (org-test-table-target-expect
  342. references/target-normal
  343. "
  344. | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  345. | z | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  346. | | 1 | 0 | 1 | 1 | 1 | 1 | 1 |
  347. | | | 0 | 0 | 0 | 0 | 0 | 0 |
  348. "
  349. 1 lisp calc)
  350. (org-test-table-target-expect
  351. references/target-special
  352. "
  353. | nan | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  354. | uinf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  355. | -inf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  356. | inf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  357. "
  358. 1 calc)))
  359. (ert-deftest test-org-table/lisp-return-value ()
  360. "Basic: Return value of Lisp formulas."
  361. (org-test-table-target-expect
  362. "
  363. | | nil | (list) | '() |
  364. |-------------------------+-------------+--------+-----|
  365. | type-of, no L | replace (r) | r | r |
  366. | type-of identity, no L | r | r | r |
  367. | identity, no L | r | r | r |
  368. |-------------------------+-------------+--------+-----|
  369. | type-of \"@1\" | r | r | r |
  370. | type-of (identity \"@1\") | r | r | r |
  371. | identity \"@1\" | r | r | r |
  372. |-------------------------+-------------+--------+-----|
  373. | type-of @1 | r | r | r |
  374. | type-of (identity @1) | r | r | r |
  375. | identity @1 | r | r | r |
  376. "
  377. "
  378. | | nil | (list) | '() |
  379. |-------------------------+--------+--------+--------|
  380. | type-of, no L | string | string | string |
  381. | type-of identity, no L | string | string | string |
  382. | identity, no L | nil | (list) | '() |
  383. |-------------------------+--------+--------+--------|
  384. | type-of \"@1\" | string | string | string |
  385. | type-of (identity \"@1\") | string | string | string |
  386. | identity \"@1\" | nil | (list) | '() |
  387. |-------------------------+--------+--------+--------|
  388. | type-of @1 | symbol | symbol | symbol |
  389. | type-of (identity @1) | symbol | symbol | symbol |
  390. | identity @1 | nil | nil | nil |
  391. "
  392. 1 (concat "#+TBLFM: @2$<<..@2$> = '(type-of @1) :: "
  393. "@3$<<..@3$> = '(type-of (identity @1)) :: "
  394. "@4$<<..@4$> = '(identity @1) :: @5$<<..@>$> = '(@0$1); L")))
  395. (ert-deftest test-org-table/compare ()
  396. "Basic: Compare field references in Calc."
  397. (org-test-table-target-expect
  398. "
  399. | | 0 | z | | nan | uinf | -inf | inf |
  400. |------+------+------+------+------+------+------+------|
  401. | 0 | repl | repl | repl | repl | repl | repl | repl |
  402. | z | repl | repl | repl | repl | repl | repl | repl |
  403. | | repl | repl | repl | repl | repl | repl | repl |
  404. | nan | repl | repl | repl | repl | repl | repl | repl |
  405. | uinf | repl | repl | repl | repl | repl | repl | repl |
  406. | -inf | repl | repl | repl | repl | repl | repl | repl |
  407. | inf | repl | repl | repl | repl | repl | repl | repl |
  408. "
  409. "
  410. | | 0 | z | | nan | uinf | -inf | inf |
  411. |------+---+---+---+-----+------+------+-----|
  412. | 0 | x | | | | | | |
  413. | z | | x | | | | | |
  414. | | | | x | | | | |
  415. | nan | | | | x | | | |
  416. | uinf | | | | | x | | |
  417. | -inf | | | | | | x | |
  418. | inf | | | | | | | x |
  419. "
  420. 1
  421. ;; Compare field reference ($1) with field reference (@1)
  422. "#+TBLFM: @<<$<<..@>$> = if(\"$1\" == \"@1\", x, string(\"\")); E"
  423. ;; Compare field reference ($1) with absolute term
  424. (concat "#+TBLFM: "
  425. "$2 = if(\"$1\" == \"(0)\" , x, string(\"\")); E :: "
  426. "$3 = if(\"$1\" == \"(z)\" , x, string(\"\")); E :: "
  427. "$4 = if(\"$1\" == \"nan\" , x, string(\"\")); E :: "
  428. "$5 = if(\"$1\" == \"(nan)\" , x, string(\"\")); E :: "
  429. "$6 = if(\"$1\" == \"(uinf)\", x, string(\"\")); E :: "
  430. "$7 = if(\"$1\" == \"(-inf)\", x, string(\"\")); E :: "
  431. "$8 = if(\"$1\" == \"(inf)\" , x, string(\"\")); E"))
  432. ;; Check field reference converted from an empty field: Despite this
  433. ;; field reference will not end up in a result, Calc evaluates it.
  434. ;; Make sure that also then there is no Calc error.
  435. (org-test-table-target-expect
  436. "
  437. | 0 | replace |
  438. | z | replace |
  439. | | replace |
  440. | nan | replace |
  441. "
  442. "
  443. | 0 | 1 |
  444. | z | z + 1 |
  445. | | |
  446. | nan | nan |
  447. "
  448. 1 "#+TBLFM: $2 = if(\"$1\" == \"nan\", string(\"\"), $1 + 1); E"))
  449. (ert-deftest test-org-table/empty-field ()
  450. "Examples how to deal with empty fields."
  451. ;; Test if one field is empty, else do a calculation
  452. (org-test-table-target-expect
  453. "
  454. | -1 | replace |
  455. | 0 | replace |
  456. | | replace |
  457. "
  458. "
  459. | -1 | 0 |
  460. | 0 | 1 |
  461. | | |
  462. "
  463. 1
  464. ;; Calc formula
  465. "#+TBLFM: $2 = if(\"$1\" == \"nan\", string(\"\"), $1 + 1); E"
  466. ;; Lisp formula
  467. "#+TBLFM: $2 = '(if (eq \"$1\" \"\") \"\" (1+ $1)); L")
  468. ;; Test if several fields are empty, else do a calculation
  469. (org-test-table-target-expect
  470. "
  471. | 1 | 2 | replace |
  472. | 4 | | replace |
  473. | | 8 | replace |
  474. | | | replace |
  475. "
  476. "
  477. | 1 | 2 | 3 |
  478. | 4 | | |
  479. | | 8 | |
  480. | | | |
  481. "
  482. 1
  483. ;; Calc formula
  484. (concat "#+TBLFM: $3 = if(\"$1\" == \"nan\" || \"$2\" == \"nan\", "
  485. "string(\"\"), $1 + $2); E")
  486. ;; Lisp formula
  487. (concat "#+TBLFM: $3 = '(if (or (eq \"$1\" \"\") (eq \"$2\" \"\")) "
  488. "\"\" (+ $1 $2)); L"))
  489. ;; $2: Use $1 + 0.5 if $1 available, else only reformat $2 if $2 available
  490. (org-test-table-target-expect
  491. "
  492. | 1.5 | 0 |
  493. | 3.5 | |
  494. | | 5 |
  495. | | |
  496. "
  497. "
  498. | 1.5 | 2.0 |
  499. | 3.5 | 4.0 |
  500. | | 5.0 |
  501. | | |
  502. "
  503. 1
  504. ;; Calc formula
  505. (concat "#+TBLFM: $2 = if(\"$1\" == \"nan\", "
  506. "if(\"$2\" == \"nan\", string(\"\"), $2 +.0), $1 + 0.5); E f-1")
  507. ;; Lisp formula not implemented yet
  508. )
  509. ;; Empty fields in simple and complex range reference
  510. (org-test-table-target-expect
  511. "
  512. | | | | | repl | repl | repl | repl | repl | repl |
  513. | | | 5 | 7 | repl | repl | repl | repl | repl | repl |
  514. | 1 | 3 | 5 | 7 | repl | repl | repl | repl | repl | repl |
  515. "
  516. "
  517. | | | | | | | | | 0 | 0 |
  518. | | | 5 | 7 | | | 6 | 6 | 3 | 3 |
  519. | 1 | 3 | 5 | 7 | 4 | 4 | 4 | 4 | 4 | 4 |
  520. "
  521. 1
  522. ;; Calc formula
  523. (concat
  524. "#+TBLFM: "
  525. "$5 = if(typeof(vmean($1..$4)) == 12, "
  526. "string(\"\"), vmean($1..$4)); E :: "
  527. "$6 = if(typeof(vmean(@0$1..@0$4)) == 12, "
  528. "string(\"\"), vmean(@0$1..@0$4)); E :: "
  529. "$7 = if(\"$1..$4\" == \"[]\", string(\"\"), vmean($1..$4)) :: "
  530. "$8 = if(\"@0$1..@0$4\" == \"[]\", string(\"\"), vmean(@0$1..@0$4)) :: "
  531. "$9 = vmean($1..$4); EN :: "
  532. "$10 = vmean(@0$1..@0$4); EN")
  533. ;; Lisp formula
  534. (concat
  535. "#+TBLFM: "
  536. "$5 = '(let ((l '($1..$4))) (if (member \"\" l) \"\" "
  537. "(/ (apply '+ (mapcar 'string-to-number l)) (length l)))); E :: "
  538. "$6 = '(let ((l '(@0$1..@0$4))) (if (member \"\" l) \"\" "
  539. "(/ (apply '+ (mapcar 'string-to-number l)) (length l)))); E :: "
  540. "$7 = '(let ((l '($1..$4))) "
  541. "(if l (/ (apply '+ l) (length l)) \"\")); N :: "
  542. "$8 = '(let ((l '(@0$1..@0$4))) "
  543. "(if l (/ (apply '+ l) (length l)) \"\")); N :: "
  544. "$9 = '(/ (+ $1..$4) (length '($1..$4))); EN :: "
  545. "$10 = '(/ (+ @0$1..@0$4) (length '(@0$1..@0$4))); EN")))
  546. (ert-deftest test-org-table/copy-field ()
  547. "Experiments on how to copy one field into another field.
  548. See also `test-org-table/remote-reference-access'."
  549. (let ((target "
  550. | 0 | replace |
  551. | a b | replace |
  552. | c d | replace |
  553. | | replace |
  554. | 2012-12 | replace |
  555. | [2012-12-31 Mon] | replace |
  556. "))
  557. ;; Lisp formula to copy literally
  558. (org-test-table-target-expect
  559. target
  560. "
  561. | 0 | 0 |
  562. | a b | a b |
  563. | c d | c d |
  564. | | |
  565. | 2012-12 | 2012-12 |
  566. | [2012-12-31 Mon] | [2012-12-31 Mon] |
  567. "
  568. 1 "#+TBLFM: $2 = '(identity $1)")
  569. ;; Calc formula to copy quite literally
  570. (org-test-table-target-expect
  571. target
  572. "
  573. | 0 | 0 |
  574. | a b | a b |
  575. | c d | c d |
  576. | | |
  577. | 2012-12 | 2012-12 |
  578. | [2012-12-31 Mon] | [2012-12-31 Mon] |
  579. "
  580. 1 (concat "#+TBLFM: $2 = if(\"$1\" == \"nan\", "
  581. "string(\"\"), string(subvec(\"$1\", 2, vlen(\"$1\")))); E"))
  582. ;; Calc formula simple
  583. (org-test-table-target-expect
  584. target
  585. "
  586. | 0 | 0 |
  587. | a b | a b |
  588. | c d | c d |
  589. | | |
  590. | 2012-12 | 2000 |
  591. | [2012-12-31 Mon] | [2012-12-31 Mon] |
  592. "
  593. 1 "#+TBLFM: $2 = if(\"$1\" == \"nan\", string(\"\"), $1); E")))
  594. (ert-deftest test-org-table/copy-down ()
  595. "Test `org-table-copy-down' specifications."
  596. ;; Error when there is nothing to copy in the current field or the
  597. ;; field above.
  598. (should-error
  599. (org-test-with-temp-text "| |\n| <point> |"
  600. (org-table-copy-down 1)))
  601. ;; Error when there is nothing to copy in the Nth field.
  602. (should-error
  603. (org-test-with-temp-text "| |\n| foo |\n| <point> |"
  604. (org-table-copy-down 2)))
  605. ;; In an empty field, copy field above.
  606. (should
  607. (equal "| foo |\n| foo |"
  608. (org-test-with-temp-text "| foo |\n| <point> |"
  609. (org-table-copy-down 1)
  610. (buffer-string))))
  611. ;; In a non-empty field, copy it below.
  612. (should
  613. (equal "| foo |\n| foo |\n"
  614. (org-test-with-temp-text "| <point>foo |"
  615. (org-table-copy-down 1)
  616. (buffer-string))))
  617. ;; If field is a number or a timestamp, or is prefixed or suffixed
  618. ;; with a number, increment it by one unit.
  619. (should
  620. (equal "| 1 |\n| 2 |\n"
  621. (org-test-with-temp-text "| <point>1 |"
  622. (let ((org-table-copy-increment t)) (org-table-copy-down 1))
  623. (buffer-string))))
  624. (should
  625. (string-match-p "<2012-03-30"
  626. (org-test-with-temp-text "| <point><2012-03-29> |"
  627. (let ((org-table-copy-increment t))
  628. (org-table-copy-down 1))
  629. (buffer-string))))
  630. (should
  631. (equal "| A1 |\n| A2 |\n"
  632. (org-test-with-temp-text "| <point>A1 |"
  633. (let ((org-table-copy-increment t)) (org-table-copy-down 1))
  634. (buffer-string))))
  635. (should
  636. (equal "| 1A |\n| 2A |\n"
  637. (org-test-with-temp-text "| <point>1A |"
  638. (let ((org-table-copy-increment t)) (org-table-copy-down 1))
  639. (buffer-string))))
  640. ;; When `org-table-copy-increment' is nil, or when argument is 0, do
  641. ;; not increment.
  642. (should
  643. (equal "| 1 |\n| 1 |\n"
  644. (org-test-with-temp-text "| <point>1 |"
  645. (let ((org-table-copy-increment nil)) (org-table-copy-down 1))
  646. (buffer-string))))
  647. (should
  648. (equal "| 1 |\n| 1 |\n"
  649. (org-test-with-temp-text "| <point>1 |"
  650. (let ((org-table-copy-increment t)) (org-table-copy-down 0))
  651. (buffer-string))))
  652. ;; When there is a field just above field being incremented, try to
  653. ;; use it to guess increment step.
  654. (should
  655. (equal "| 4 |\n| 3 |\n| 2 |\n"
  656. (org-test-with-temp-text "| 4 |\n| <point>3 |"
  657. (let ((org-table-copy-increment t)) (org-table-copy-down 1))
  658. (buffer-string))))
  659. (should
  660. (equal "| A0 |\n| A2 |\n| A4 |\n"
  661. (org-test-with-temp-text "| A0 |\n| <point>A2 |"
  662. (let ((org-table-copy-increment t)) (org-table-copy-down 1))
  663. (buffer-string))))
  664. ;; Both fields need to have the same type. In the special case of
  665. ;; number-prefixed or suffixed fields, make sure both fields have
  666. ;; the same pattern.
  667. (should
  668. (equal "| A4 |\n| 3 |\n| 4 |\n"
  669. (org-test-with-temp-text "| A4 |\n| <point>3 |"
  670. (let ((org-table-copy-increment t)) (org-table-copy-down 1))
  671. (buffer-string))))
  672. (should
  673. (equal "| 0A |\n| A2 |\n| A3 |\n"
  674. (org-test-with-temp-text "| 0A |\n| <point>A2 |"
  675. (let ((org-table-copy-increment t)) (org-table-copy-down 1))
  676. (buffer-string))))
  677. (should
  678. (equal "| A0 |\n| 2A |\n| 3A |\n"
  679. (org-test-with-temp-text "| A0 |\n| <point>2A |"
  680. (let ((org-table-copy-increment t)) (org-table-copy-down 1))
  681. (buffer-string))))
  682. ;; Do not search field above past blank fields and horizontal
  683. ;; separators.
  684. (should
  685. (equal "| 4 |\n|---|\n| 3 |\n| 4 |\n"
  686. (org-test-with-temp-text "| 4 |\n|---|\n| <point>3 |"
  687. (let ((org-table-copy-increment t)) (org-table-copy-down 1))
  688. (buffer-string))))
  689. (should
  690. (equal "| 4 |\n| |\n| 3 |\n| 4 |\n"
  691. (org-test-with-temp-text "| 4 |\n| |\n| <point>3 |"
  692. (let ((org-table-copy-increment t)) (org-table-copy-down 1))
  693. (buffer-string))))
  694. ;; When `org-table-copy-increment' is a number, use it as the
  695. ;; increment step, ignoring any previous field.
  696. (should
  697. (equal "| 1 |\n| 3 |\n| 6 |\n"
  698. (org-test-with-temp-text "| 1 |\n| <point>3 |"
  699. (let ((org-table-copy-increment 3)) (org-table-copy-down 1))
  700. (buffer-string))))
  701. ;; However, if argument is 0, do not increment whatsoever.
  702. (should
  703. (equal "| 1 |\n| 3 |\n| 3 |\n"
  704. (org-test-with-temp-text "| 1 |\n| <point>3 |"
  705. (let ((org-table-copy-increment t)) (org-table-copy-down 0))
  706. (buffer-string))))
  707. (should
  708. (equal "| 1 |\n| 3 |\n| 3 |\n"
  709. (org-test-with-temp-text "| 1 |\n| <point>3 |"
  710. (let ((org-table-copy-increment 3)) (org-table-copy-down 0))
  711. (buffer-string)))))
  712. (ert-deftest test-org-table/sub-total ()
  713. "Grouped rows with sub-total.
  714. Begin range with \"@II\" to handle multiline header. Convert
  715. integer to float with \"+.0\" for sub-total of items c1 and c2.
  716. Sum empty fields as value zero but without ignoring them for
  717. \"vlen\" with format specifier \"EN\". Format possibly empty
  718. results with the Calc formatter \"f-1\" instead of the printf
  719. formatter \"%.1f\"."
  720. (org-test-table-target-expect
  721. "
  722. |-------+---------+---------|
  723. | Item | Item | Sub- |
  724. | name | value | total |
  725. |-------+---------+---------|
  726. | a1 | 4.1 | replace |
  727. | a2 | 8.2 | replace |
  728. | a3 | | replace |
  729. |-------+---------+---------|
  730. | b1 | 16.0 | replace |
  731. |-------+---------+---------|
  732. | c1 | 32 | replace |
  733. | c2 | 64 | replace |
  734. |-------+---------+---------|
  735. | Total | replace | replace |
  736. |-------+---------+---------|
  737. "
  738. "
  739. |-------+-------+-------|
  740. | Item | Item | Sub- |
  741. | name | value | total |
  742. |-------+-------+-------|
  743. | a1 | 4.1 | |
  744. | a2 | 8.2 | |
  745. | a3 | | 12.3 |
  746. |-------+-------+-------|
  747. | b1 | 16.0 | 16.0 |
  748. |-------+-------+-------|
  749. | c1 | 32 | |
  750. | c2 | 64 | 96.0 |
  751. |-------+-------+-------|
  752. | Total | 124.3 | |
  753. |-------+-------+-------|
  754. "
  755. 1 (concat "#+TBLFM: @>$2 = vsum(@II..@>>) ::"
  756. "$3 = if(vlen(@0..@+I) == 1, "
  757. "vsum(@-I$2..@+I$2) +.0, string(\"\")); EN f-1 :: "
  758. "@>$3 = string(\"\")")))
  759. (ert-deftest test-org-table/org-lookup-all ()
  760. "Use `org-lookup-all' for several GROUP BY as in SQL and for ranking.
  761. See also URL `https://orgmode.org/worg/org-tutorials/org-lookups.html'."
  762. (let ((data "
  763. #+NAME: data
  764. | Purchase | Product | Shop | Rating |
  765. |----------+---------+------+--------|
  766. | a | p1 | s1 | 1 |
  767. | b | p1 | s2 | 4 |
  768. | c | p2 | s1 | 2 |
  769. | d | p3 | s2 | 8 |
  770. "))
  771. ;; Product rating and ranking by average purchase from "#+NAME: data"
  772. (org-test-table-target-expect
  773. (concat data "
  774. | Product | Rating | Ranking |
  775. |---------+---------+---------|
  776. | p1 | replace | replace |
  777. | p2 | replace | replace |
  778. | p3 | replace | replace |
  779. ")
  780. (concat data "
  781. | Product | Rating | Ranking |
  782. |---------+--------+---------|
  783. | p1 | 2.5 | 2 |
  784. | p2 | 2.0 | 3 |
  785. | p3 | 8.0 | 1 |
  786. ")
  787. 2 (concat
  788. "#+TBLFM: $2 = '(let ((all (org-lookup-all '$1 "
  789. "'(remote(data, @I$2..@>$2)) '(remote(data, @I$4..@>$4))))) "
  790. "(/ (apply '+ all) (length all) 1.0)); L :: "
  791. "$3 = '(+ 1 (length (org-lookup-all $2 '(@I$2..@>$2) nil '<))); N"))
  792. ;; Shop rating and ranking by average purchase from "#+NAME: data"
  793. (org-test-table-target-expect
  794. (concat data "
  795. | Shop | Rating | Ranking |
  796. |------+---------+---------|
  797. | s1 | replace | replace |
  798. | s2 | replace | replace |
  799. ")
  800. (concat data "
  801. | Shop | Rating | Ranking |
  802. |------+--------+---------|
  803. | s1 | 1.5 | 2 |
  804. | s2 | 6.0 | 1 |
  805. ")
  806. 2 (concat
  807. "#+TBLFM: $2 = '(let ((all (org-lookup-all '$1 "
  808. "'(remote(data, @I$3..@>$3)) '(remote(data, @I$4..@>$4))))) "
  809. "(/ (apply '+ all) (length all) 1.0)); L :: "
  810. "$3 = '(+ 1 (length (org-lookup-all $2 '(@I$2..@>$2) nil '<))); N"))))
  811. (ert-deftest test-org-table/org-table-make-reference/mode-string-EL ()
  812. ;; For Lisp formula only
  813. (should (equal "0" (org-table-make-reference "0" t nil 'literal)))
  814. (should (equal "z" (org-table-make-reference "z" t nil 'literal)))
  815. (should (equal "" (org-table-make-reference "" t nil 'literal)))
  816. (should (equal "0 1" (org-table-make-reference '("0" "1") t nil 'literal)))
  817. (should (equal "z 1" (org-table-make-reference '("z" "1") t nil 'literal)))
  818. (should (equal " 1" (org-table-make-reference '("" "1") t nil 'literal)))
  819. (should (equal " " (org-table-make-reference '("" "") t nil 'literal))))
  820. (ert-deftest test-org-table/org-table-make-reference/mode-string-E ()
  821. ;; For Lisp formula
  822. (should (equal "\"0\"" (org-table-make-reference "0" t nil t)))
  823. (should (equal "\"z\"" (org-table-make-reference "z" t nil t)))
  824. (should (equal"\"\"" (org-table-make-reference "" t nil t)))
  825. (should (equal "\"0\" \"1\"" (org-table-make-reference '("0""1") t nil t)))
  826. (should (equal "\"z\" \"1\"" (org-table-make-reference '("z""1") t nil t)))
  827. (should (equal"\"\" \"1\"" (org-table-make-reference '("""1") t nil t)))
  828. (should (equal"\"\" \"\""(org-table-make-reference '("""" ) t nil t)))
  829. ;; For Calc formula
  830. (should (equal "(0)" (org-table-make-reference "0" t nil nil)))
  831. (should (equal "(z)" (org-table-make-reference "z" t nil nil)))
  832. (should (equal "nan" (org-table-make-reference "" t nil nil)))
  833. (should (equal "[0,1]" (org-table-make-reference '("0" "1") t nil nil)))
  834. (should (equal "[z,1]" (org-table-make-reference '("z" "1") t nil nil)))
  835. (should (equal "[nan,1]" (org-table-make-reference '("" "1") t nil nil)))
  836. (should (equal "[nan,nan]" (org-table-make-reference '("" "") t nil nil)))
  837. ;; For Calc formula, special numbers
  838. (should (equal "(nan)" (org-table-make-reference "nan" t nil nil)))
  839. (should (equal "(uinf)" (org-table-make-reference "uinf" t nil nil)))
  840. (should (equal "(-inf)" (org-table-make-reference "-inf" t nil nil)))
  841. (should (equal "(inf)" (org-table-make-reference "inf" t nil nil)))
  842. (should (equal "[nan,1]" (org-table-make-reference '("nan" "1") t nil nil)))
  843. (should (equal "[uinf,1]" (org-table-make-reference '("uinf" "1") t nil nil)))
  844. (should (equal "[-inf,1]" (org-table-make-reference '("-inf" "1") t nil nil)))
  845. (should (equal "[inf,1]" (org-table-make-reference '("inf" "1") t nil nil))))
  846. (ert-deftest test-org-table/org-table-make-reference/mode-string-EN ()
  847. ;; For Lisp formula
  848. (should (equal "0" (org-table-make-reference "0" t t t)))
  849. (should (equal "0" (org-table-make-reference "z" t t t)))
  850. (should (equal "0" (org-table-make-reference "" t t t)))
  851. (should (equal "0 1" (org-table-make-reference '("0" "1") t t t)))
  852. (should (equal "0 1" (org-table-make-reference '("z" "1") t t t)))
  853. (should (equal "0 1" (org-table-make-reference '("" "1") t t t)))
  854. (should (equal "0 0" (org-table-make-reference '("" "" ) t t t)))
  855. ;; For Calc formula
  856. (should (equal "(0)" (org-table-make-reference "0" t t nil)))
  857. (should (equal "(0)" (org-table-make-reference "z" t t nil)))
  858. (should (equal "(0)" (org-table-make-reference "" t t nil)))
  859. (should (equal "[0,1]" (org-table-make-reference '("0" "1") t t nil)))
  860. (should (equal "[0,1]" (org-table-make-reference '("z" "1") t t nil)))
  861. (should (equal "[0,1]" (org-table-make-reference '("" "1") t t nil)))
  862. (should (equal "[0,0]" (org-table-make-reference '("" "" ) t t nil)))
  863. ;; For Calc formula, special numbers
  864. (should (equal "(0)" (org-table-make-reference "nan" t t nil)))
  865. (should (equal "(0)" (org-table-make-reference "uinf" t t nil)))
  866. (should (equal "(0)" (org-table-make-reference "-inf" t t nil)))
  867. (should (equal "(0)" (org-table-make-reference "inf" t t nil)))
  868. (should (equal "[0,1]" (org-table-make-reference '( "nan" "1") t t nil)))
  869. (should (equal "[0,1]" (org-table-make-reference '("uinf" "1") t t nil)))
  870. (should (equal "[0,1]" (org-table-make-reference '("-inf" "1") t t nil)))
  871. (should (equal "[0,1]" (org-table-make-reference '( "inf" "1") t t nil))))
  872. (ert-deftest test-org-table/org-table-make-reference/mode-string-L ()
  873. ;; For Lisp formula only
  874. (should (equal "0" (org-table-make-reference "0" nil nil 'literal)))
  875. (should (equal "z" (org-table-make-reference "z" nil nil 'literal)))
  876. (should (equal "" (org-table-make-reference "" nil nil 'literal)))
  877. (should (equal "0 1" (org-table-make-reference '("0" "1") nil nil 'literal)))
  878. (should (equal "z 1" (org-table-make-reference '("z" "1") nil nil 'literal)))
  879. (should (equal "1" (org-table-make-reference '("" "1") nil nil 'literal)))
  880. (should (equal "" (org-table-make-reference '("" "" ) nil nil 'literal))))
  881. (ert-deftest test-org-table/org-table-make-reference/mode-string-none ()
  882. ;; For Lisp formula
  883. (should (equal "\"0\"" (org-table-make-reference "0" nil nil t)))
  884. (should (equal "\"z\"" (org-table-make-reference "z" nil nil t)))
  885. (should (equal "" (org-table-make-reference "" nil nil t)))
  886. (should (equal "\"0\" \"1\"" (org-table-make-reference '("0" "1") nil nil t)))
  887. (should (equal "\"z\" \"1\"" (org-table-make-reference '("z" "1") nil nil t)))
  888. (should (equal "\"1\"" (org-table-make-reference '("" "1") nil nil t)))
  889. (should (equal "" (org-table-make-reference '("" "" ) nil nil t)))
  890. ;; For Calc formula
  891. (should (equal "(0)" (org-table-make-reference "0" nil nil nil)))
  892. (should (equal "(z)" (org-table-make-reference "z" nil nil nil)))
  893. (should (equal "(0)" (org-table-make-reference "" nil nil nil)))
  894. (should (equal "[0,1]" (org-table-make-reference '("0" "1") nil nil nil)))
  895. (should (equal "[z,1]" (org-table-make-reference '("z" "1") nil nil nil)))
  896. (should (equal "[1]" (org-table-make-reference '("" "1") nil nil nil)))
  897. (should (equal "[]" (org-table-make-reference '("" "" ) nil nil nil)))
  898. ;; For Calc formula, special numbers
  899. (should (equal "(nan)" (org-table-make-reference "nan" nil nil nil)))
  900. (should (equal "(uinf)" (org-table-make-reference "uinf" nil nil nil)))
  901. (should (equal "(-inf)" (org-table-make-reference "-inf" nil nil nil)))
  902. (should (equal "(inf)" (org-table-make-reference "inf" nil nil nil)))
  903. (should (equal "[nan,1]" (org-table-make-reference '( "nan" "1") nil nil nil)))
  904. (should (equal "[uinf,1]" (org-table-make-reference '("uinf" "1") nil nil nil)))
  905. (should (equal "[-inf,1]" (org-table-make-reference '("-inf" "1") nil nil nil)))
  906. (should (equal "[inf,1]" (org-table-make-reference '( "inf" "1") nil nil nil))))
  907. (ert-deftest test-org-table/org-table-make-reference/mode-string-N ()
  908. ;; For Lisp formula
  909. (should (equal "0" (org-table-make-reference "0" nil t t)))
  910. (should (equal "0" (org-table-make-reference "z" nil t t)))
  911. (should (equal "" (org-table-make-reference "" nil t t)))
  912. (should (equal "0 1" (org-table-make-reference '("0" "1") nil t t)))
  913. (should (equal "0 1" (org-table-make-reference '("z" "1") nil t t)))
  914. (should (equal "1" (org-table-make-reference '("" "1") nil t t)))
  915. (should (equal "" (org-table-make-reference '("" "" ) nil t t)))
  916. ;; For Calc formula
  917. (should (equal "(0)" (org-table-make-reference "0" nil t nil)))
  918. (should (equal "(0)" (org-table-make-reference "z" nil t nil)))
  919. (should (equal "(0)" (org-table-make-reference "" nil t nil)))
  920. (should (equal "[0,1]" (org-table-make-reference '("0" "1") nil t nil)))
  921. (should (equal "[0,1]" (org-table-make-reference '("z" "1") nil t nil)))
  922. (should (equal "[1]" (org-table-make-reference '("" "1") nil t nil)))
  923. (should (equal "[]" (org-table-make-reference '("" "" ) nil t nil)))
  924. ;; For Calc formula, special numbers
  925. (should (equal "(0)" (org-table-make-reference "nan" nil t nil)))
  926. (should (equal "(0)" (org-table-make-reference "uinf" nil t nil)))
  927. (should (equal "(0)" (org-table-make-reference "-inf" nil t nil)))
  928. (should (equal "(0)" (org-table-make-reference "inf" nil t nil)))
  929. (should (equal "[0,1]" (org-table-make-reference '( "nan" "1") nil t nil)))
  930. (should (equal "[0,1]" (org-table-make-reference '("uinf" "1") nil t nil)))
  931. (should (equal "[0,1]" (org-table-make-reference '("-inf" "1") nil t nil)))
  932. (should (equal "[0,1]" (org-table-make-reference '( "inf" "1") nil t nil))))
  933. (ert-deftest test-org-table/org-table-convert-refs-to-an/1 ()
  934. "Simple reference @2$1."
  935. (should
  936. (string= "A2" (org-table-convert-refs-to-an "@2$1"))))
  937. ;; TODO: Test broken
  938. ;; (ert-deftest test-org-table/org-table-convert-refs-to-an/2 ()
  939. ;; "Self reference @1$1."
  940. ;; (should
  941. ;; (string= "A1 = $0" (org-table-convert-refs-to-an "@1$1 = $0"))))
  942. (ert-deftest test-org-table/org-table-convert-refs-to-an/3 ()
  943. "Remote reference."
  944. (should
  945. (string= "C& = remote(FOO, @@#B&)" (org-table-convert-refs-to-an "$3 = remote(FOO, @@#$2)"))))
  946. (ert-deftest test-org-table/org-table-convert-refs-to-rc/1 ()
  947. "Simple reference @2$1."
  948. (should
  949. (string= "@2$1" (org-table-convert-refs-to-rc "A2"))))
  950. (ert-deftest test-org-table/org-table-convert-refs-to-rc/2 ()
  951. "Self reference $0."
  952. (should
  953. (string= "@1$1 = $0" (org-table-convert-refs-to-rc "A1 = $0"))))
  954. ;; TODO: Test Broken
  955. ;; (ert-deftest test-org-table/org-table-convert-refs-to-rc/3 ()
  956. ;; "Remote reference."
  957. ;; (should
  958. ;; (string= "$3 = remote(FOO, @@#$2)" (org-table-convert-refs-to-rc "C& = remote(FOO, @@#B&)"))))
  959. (ert-deftest test-org-table/remote-reference-access ()
  960. "Access to remote reference.
  961. See also `test-org-table/copy-field'."
  962. (org-test-table-target-expect
  963. "
  964. #+NAME: table
  965. | | x 42 | |
  966. | replace | replace |
  967. "
  968. "
  969. #+NAME: table
  970. | | x 42 | |
  971. | x 42 | 84 x |
  972. "
  973. 1 (concat "#+TBLFM: "
  974. ;; Copy text without calculation: Use Lisp formula
  975. "$1 = '(identity remote(table, @1$2)) :: "
  976. ;; Do a calculation: Use Calc (or Lisp ) formula
  977. "$2 = 2 * remote(table, @1$2)")))
  978. (ert-deftest test-org-table/remote-reference-indirect ()
  979. "Access to remote reference with indirection of name or ID."
  980. (let ((source-tables "
  981. #+NAME: 2012
  982. | amount |
  983. |--------|
  984. | 1 |
  985. | 2 |
  986. |--------|
  987. | 3 |
  988. #+TBLFM: @>$1 = vsum(@I..@II)
  989. #+NAME: 2013
  990. | amount |
  991. |--------|
  992. | 4 |
  993. | 8 |
  994. |--------|
  995. | 12 |
  996. #+TBLFM: @>$1 = vsum(@I..@II)
  997. "))
  998. ;; Read several remote references from same column
  999. (org-test-table-target-expect
  1000. (concat source-tables "
  1001. #+NAME: summary
  1002. | year | amount |
  1003. |-------+---------|
  1004. | 2012 | replace |
  1005. | 2013 | replace |
  1006. |-------+---------|
  1007. | total | replace |
  1008. ")
  1009. (concat source-tables "
  1010. #+NAME: summary
  1011. | year | amount |
  1012. |-------+--------|
  1013. | 2012 | 3 |
  1014. | 2013 | 12 |
  1015. |-------+--------|
  1016. | total | 15 |
  1017. ")
  1018. 1
  1019. ;; Calc formula
  1020. "#+TBLFM: @<<$2..@>>$2 = remote($<, @>$1) :: @>$2 = vsum(@I..@II)"
  1021. ;; Lisp formula
  1022. (concat "#+TBLFM: @<<$2..@>>$2 = '(identity remote($<, @>$1)); N :: "
  1023. "@>$2 = '(+ @I..@II); N"))
  1024. ;; Read several remote references from same row
  1025. (org-test-table-target-expect
  1026. (concat source-tables "
  1027. #+NAME: summary
  1028. | year | 2012 | 2013 | total |
  1029. |--------+---------+---------+---------|
  1030. | amount | replace | replace | replace |
  1031. ")
  1032. (concat source-tables "
  1033. #+NAME: summary
  1034. | year | 2012 | 2013 | total |
  1035. |--------+------+------+-------|
  1036. | amount | 3 | 12 | 15 |
  1037. ")
  1038. 1
  1039. ;; Calc formula
  1040. "#+TBLFM: @2$<<..@2$>> = remote(@<, @>$1) :: @2$> = vsum($<<..$>>)"
  1041. ;; Lisp formula
  1042. (concat "#+TBLFM: @2$<<..@2$>> = '(identity remote(@<, @>$1)); N :: "
  1043. "@2$> = '(+ $<<..$>>); N"))))
  1044. (ert-deftest test-org-table/org-at-TBLFM-p ()
  1045. (org-test-with-temp-text-in-file
  1046. "
  1047. | 1 |
  1048. | 2 |
  1049. #+TBLFM: $2=$1*2
  1050. "
  1051. (goto-char (point-min))
  1052. (forward-line 2)
  1053. (should (equal (org-at-TBLFM-p) nil))
  1054. (goto-char (point-min))
  1055. (forward-line 3)
  1056. (should (equal (org-at-TBLFM-p) t))
  1057. (goto-char (point-min))
  1058. (forward-line 4)
  1059. (should (equal (org-at-TBLFM-p) nil))))
  1060. (ert-deftest test-org-table/org-table-TBLFM-begin ()
  1061. (org-test-with-temp-text-in-file
  1062. "
  1063. | 1 |
  1064. | 2 |
  1065. #+TBLFM: $2=$1*2
  1066. "
  1067. (goto-char (point-min))
  1068. (should (equal (org-table-TBLFM-begin)
  1069. nil))
  1070. (goto-char (point-min))
  1071. (forward-line 1)
  1072. (should (equal (org-table-TBLFM-begin)
  1073. nil))
  1074. (goto-char (point-min))
  1075. (forward-line 3)
  1076. (should (= (org-table-TBLFM-begin)
  1077. 14))
  1078. (goto-char (point-min))
  1079. (forward-line 4)
  1080. (should (= (org-table-TBLFM-begin)
  1081. 14))
  1082. ))
  1083. (ert-deftest test-org-table/org-table-TBLFM-begin-for-multiple-TBLFM-lines ()
  1084. "For multiple #+TBLFM lines."
  1085. (org-test-with-temp-text-in-file
  1086. "
  1087. | 1 |
  1088. | 2 |
  1089. #+TBLFM: $2=$1*1
  1090. #+TBLFM: $2=$1*2
  1091. "
  1092. (goto-char (point-min))
  1093. (should (equal (org-table-TBLFM-begin)
  1094. nil))
  1095. (goto-char (point-min))
  1096. (forward-line 1)
  1097. (should (equal (org-table-TBLFM-begin)
  1098. nil))
  1099. (goto-char (point-min))
  1100. (forward-line 3)
  1101. (should (= (org-table-TBLFM-begin)
  1102. 14))
  1103. (goto-char (point-min))
  1104. (forward-line 4)
  1105. (should (= (org-table-TBLFM-begin)
  1106. 14))
  1107. (goto-char (point-min))
  1108. (forward-line 5)
  1109. (should (= (org-table-TBLFM-begin)
  1110. 14))
  1111. ))
  1112. (ert-deftest test-org-table/org-table-TBLFM-begin-for-pultiple-TBLFM-lines-blocks ()
  1113. (org-test-with-temp-text-in-file
  1114. "
  1115. | 1 |
  1116. | 2 |
  1117. #+TBLFM: $2=$1*1
  1118. #+TBLFM: $2=$1*2
  1119. | 6 |
  1120. | 7 |
  1121. #+TBLFM: $2=$1*1
  1122. #+TBLFM: $2=$1*2
  1123. "
  1124. (goto-char (point-min))
  1125. (should (equal (org-table-TBLFM-begin)
  1126. nil))
  1127. (goto-char (point-min))
  1128. (forward-line 1)
  1129. (should (equal (org-table-TBLFM-begin)
  1130. nil))
  1131. (goto-char (point-min))
  1132. (forward-line 3)
  1133. (should (= (org-table-TBLFM-begin)
  1134. 14))
  1135. (goto-char (point-min))
  1136. (forward-line 4)
  1137. (should (= (org-table-TBLFM-begin)
  1138. 14))
  1139. (goto-char (point-min))
  1140. (forward-line 5)
  1141. (should (= (org-table-TBLFM-begin)
  1142. 14))
  1143. (goto-char (point-min))
  1144. (forward-line 6)
  1145. (should (= (org-table-TBLFM-begin)
  1146. 14))
  1147. (goto-char (point-min))
  1148. (forward-line 8)
  1149. (should (= (org-table-TBLFM-begin)
  1150. 61))
  1151. (goto-char (point-min))
  1152. (forward-line 9)
  1153. (should (= (org-table-TBLFM-begin)
  1154. 61))
  1155. (goto-char (point-min))
  1156. (forward-line 10)
  1157. (should (= (org-table-TBLFM-begin)
  1158. 61))))
  1159. (ert-deftest test-org-table/org-table-calc-current-TBLFM ()
  1160. (org-test-with-temp-text-in-file
  1161. "
  1162. | 1 | |
  1163. | 2 | |
  1164. #+TBLFM: $2=$1*1
  1165. #+TBLFM: $2=$1*2
  1166. #+TBLFM: $2=$1*3
  1167. "
  1168. (let ((got (progn (goto-char (point-min))
  1169. (forward-line 3)
  1170. (org-table-calc-current-TBLFM)
  1171. (buffer-string)))
  1172. (expect "
  1173. | 1 | 1 |
  1174. | 2 | 2 |
  1175. #+TBLFM: $2=$1*1
  1176. #+TBLFM: $2=$1*2
  1177. #+TBLFM: $2=$1*3
  1178. "))
  1179. (should (string= got
  1180. expect)))
  1181. (let ((got (progn (goto-char (point-min))
  1182. (forward-line 4)
  1183. (org-table-calc-current-TBLFM)
  1184. (buffer-string)))
  1185. (expect "
  1186. | 1 | 2 |
  1187. | 2 | 4 |
  1188. #+TBLFM: $2=$1*1
  1189. #+TBLFM: $2=$1*2
  1190. #+TBLFM: $2=$1*3
  1191. "))
  1192. (should (string= got
  1193. expect)))))
  1194. (ert-deftest test-org-table/org-table-calc-current-TBLFM-when-stop-because-of-error ()
  1195. "org-table-calc-current-TBLFM should preserve the input as it was."
  1196. (org-test-with-temp-text-in-file
  1197. "
  1198. | 1 | 1 |
  1199. | 2 | 2 |
  1200. #+TBLFM: $2=$1*1
  1201. #+TBLFM: $2=$1*2::$2=$1*2
  1202. #+TBLFM: $2=$1*3
  1203. "
  1204. (let ((expect "
  1205. | 1 | 1 |
  1206. | 2 | 2 |
  1207. #+TBLFM: $2=$1*1
  1208. #+TBLFM: $2=$1*2::$2=$1*2
  1209. #+TBLFM: $2=$1*3
  1210. "))
  1211. (goto-char (point-min))
  1212. (forward-line 4)
  1213. (should-error (org-table-calc-current-TBLFM))
  1214. (setq got (buffer-string))
  1215. (message "%s" got)
  1216. (should (string= got
  1217. expect)))))
  1218. ;;; Radio Tables
  1219. (ert-deftest test-org-table/to-generic ()
  1220. "Test `orgtbl-to-generic' specifications."
  1221. ;; Test :hline parameter.
  1222. (should
  1223. (equal "a\nb"
  1224. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1225. '(:hline nil))))
  1226. (should
  1227. (equal "a\n~\nb"
  1228. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1229. '(:hline "~"))))
  1230. ;; Test :sep parameter.
  1231. (should
  1232. (equal "a!b\nc!d"
  1233. (orgtbl-to-generic
  1234. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1235. '(:sep "!"))))
  1236. ;; Test :hsep parameter.
  1237. (should
  1238. (equal "a!b\nc?d"
  1239. (orgtbl-to-generic
  1240. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1241. '(:sep "?" :hsep "!"))))
  1242. ;; Test :tstart parameter.
  1243. (should
  1244. (equal "<begin>\na"
  1245. (orgtbl-to-generic (org-table-to-lisp "| a |") '(:tstart "<begin>"))))
  1246. (should
  1247. (equal "<begin>\na"
  1248. (orgtbl-to-generic (org-table-to-lisp "| a |")
  1249. '(:tstart (lambda () "<begin>")))))
  1250. (should
  1251. (equal "a"
  1252. (orgtbl-to-generic (org-table-to-lisp "| a |")
  1253. '(:tstart "<begin>" :splice t))))
  1254. ;; Test :tend parameter.
  1255. (should
  1256. (equal "a\n<end>"
  1257. (orgtbl-to-generic (org-table-to-lisp "| a |") '(:tend "<end>"))))
  1258. (should
  1259. (equal "a\n<end>"
  1260. (orgtbl-to-generic (org-table-to-lisp "| a |")
  1261. '(:tend (lambda () "<end>")))))
  1262. (should
  1263. (equal "a"
  1264. (orgtbl-to-generic (org-table-to-lisp "| a |")
  1265. '(:tend "<end>" :splice t))))
  1266. ;; Test :lstart parameter.
  1267. (should
  1268. (equal "> a"
  1269. (orgtbl-to-generic
  1270. (org-table-to-lisp "| a |") '(:lstart "> "))))
  1271. (should
  1272. (equal "> a"
  1273. (orgtbl-to-generic (org-table-to-lisp "| a |")
  1274. '(:lstart (lambda () "> ")))))
  1275. ;; Test :llstart parameter.
  1276. (should
  1277. (equal "> a\n>> b"
  1278. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1279. '(:lstart "> " :llstart ">> "))))
  1280. ;; Test :hlstart parameter.
  1281. (should
  1282. (equal "!> a\n> b"
  1283. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1284. '(:lstart "> " :hlstart "!> "))))
  1285. ;; Test :hllstart parameter.
  1286. (should
  1287. (equal "!> a\n!!> b\n> c"
  1288. (orgtbl-to-generic (org-table-to-lisp "| a |\n| b |\n|---|\n| c |")
  1289. '(:lstart "> " :hlstart "!> " :hllstart "!!> "))))
  1290. ;; Test :lend parameter.
  1291. (should
  1292. (equal "a <"
  1293. (orgtbl-to-generic (org-table-to-lisp "| a |") '(:lend " <"))))
  1294. ;; Test :llend parameter.
  1295. (should
  1296. (equal "a <\nb <<"
  1297. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1298. '(:lend " <" :llend " <<"))))
  1299. ;; Test :hlend parameter.
  1300. (should
  1301. (equal "a <!\nb <"
  1302. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1303. '(:lend " <" :hlend " <!"))))
  1304. ;; Test :hllend parameter.
  1305. (should
  1306. (equal "a <!\nb <!!\nc <"
  1307. (orgtbl-to-generic (org-table-to-lisp "| a |\n| b |\n|---|\n| c |")
  1308. '(:lend " <" :hlend " <!" :hllend " <!!"))))
  1309. ;; Test :lfmt parameter.
  1310. (should
  1311. (equal "a!b"
  1312. (orgtbl-to-generic (org-table-to-lisp "| a | b |")
  1313. '(:lfmt "%s!%s"))))
  1314. (should
  1315. (equal "a+b"
  1316. (orgtbl-to-generic
  1317. (org-table-to-lisp "| a | b |")
  1318. '(:lfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
  1319. (should
  1320. (equal "a!b"
  1321. (orgtbl-to-generic (org-table-to-lisp "| a | b |")
  1322. '(:lfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
  1323. ;; Test :llfmt parameter.
  1324. (should
  1325. (equal "a!b"
  1326. (orgtbl-to-generic (org-table-to-lisp "| a | b |")
  1327. '(:llfmt "%s!%s"))))
  1328. (should
  1329. (equal "a!b\nc+d"
  1330. (orgtbl-to-generic
  1331. (org-table-to-lisp "| a | b |\n| c | d |")
  1332. '(:lfmt "%s!%s" :llfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
  1333. (should
  1334. (equal "a!b"
  1335. (orgtbl-to-generic (org-table-to-lisp "| a | b |")
  1336. '(:llfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
  1337. ;; Test :hlfmt parameter.
  1338. (should
  1339. (equal "a!b\ncd"
  1340. (orgtbl-to-generic
  1341. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1342. '(:hlfmt "%s!%s"))))
  1343. (should
  1344. (equal "a+b\ncd"
  1345. (orgtbl-to-generic
  1346. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1347. '(:hlfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
  1348. (should
  1349. (equal "a!b\n>c d<"
  1350. (orgtbl-to-generic
  1351. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1352. '(:hlfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
  1353. ;; Test :hllfmt parameter.
  1354. (should
  1355. (equal "a!b\ncd"
  1356. (orgtbl-to-generic
  1357. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1358. '(:hllfmt "%s!%s"))))
  1359. (should
  1360. (equal "a+b\ncd"
  1361. (orgtbl-to-generic
  1362. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1363. '(:hllfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
  1364. (should
  1365. (equal "a!b\n>c d<"
  1366. (orgtbl-to-generic
  1367. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1368. '(:hllfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
  1369. ;; Test :fmt parameter.
  1370. (should
  1371. (equal ">a<\n>b<"
  1372. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1373. '(:fmt ">%s<"))))
  1374. (should
  1375. (equal ">a<b"
  1376. (orgtbl-to-generic (org-table-to-lisp "| a | b |")
  1377. '(:fmt (1 ">%s<" 2 (lambda (c) c))))))
  1378. (should
  1379. (equal "a b"
  1380. (orgtbl-to-generic (org-table-to-lisp "| a | b |")
  1381. '(:fmt (2 " %s")))))
  1382. (should
  1383. (equal ">a<"
  1384. (orgtbl-to-generic (org-table-to-lisp "| a |")
  1385. '(:fmt (lambda (c) (format ">%s<" c))))))
  1386. ;; Test :hfmt parameter.
  1387. (should
  1388. (equal ">a<\nb"
  1389. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1390. '(:hfmt ">%s<"))))
  1391. (should
  1392. (equal ">a<b\ncd"
  1393. (orgtbl-to-generic
  1394. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1395. '(:hfmt (1 ">%s<" 2 identity)))))
  1396. (should
  1397. (equal "a b\ncd"
  1398. (orgtbl-to-generic
  1399. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1400. '(:hfmt (2 " %s")))))
  1401. (should
  1402. (equal ">a<\nb"
  1403. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1404. '(:hfmt (lambda (c) (format ">%s<" c))))))
  1405. ;; Test :efmt parameter.
  1406. (should
  1407. (equal "2x10^3"
  1408. (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
  1409. '(:efmt "%sx10^%s"))))
  1410. (should
  1411. (equal "2x10^3"
  1412. (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
  1413. '(:efmt (lambda (m e) (concat m "x10^" e))))))
  1414. (should
  1415. (equal "2x10^3"
  1416. (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
  1417. '(:efmt (1 "%sx10^%s")))))
  1418. (should
  1419. (equal "2x10^3"
  1420. (orgtbl-to-generic
  1421. (org-table-to-lisp "| 2e3 |")
  1422. '(:efmt (1 (lambda (m e) (format "%sx10^%s" m e)))))))
  1423. (should
  1424. (equal "2e3"
  1425. (orgtbl-to-generic (org-table-to-lisp "| 2e3 |") '(:efmt nil))))
  1426. ;; Test :skip parameter.
  1427. (should
  1428. (equal "cd"
  1429. (orgtbl-to-generic
  1430. (org-table-to-lisp "| \ | <c> |\n| a | b |\n|---+---|\n| c | d |")
  1431. '(:skip 2))))
  1432. ;; Test :skipcols parameter.
  1433. (should
  1434. (equal "a\nc"
  1435. (orgtbl-to-generic
  1436. (org-table-to-lisp "| a | b |\n| c | d |") '(:skipcols (2)))))
  1437. (should
  1438. (equal "a\nc"
  1439. (orgtbl-to-generic
  1440. (org-table-to-lisp
  1441. "| / | <c> | <c> |\n| # | a | b |\n|---+---+---|\n| | c | d |")
  1442. '(:skipcols (2)))))
  1443. ;; Test :raw parameter.
  1444. (when (featurep 'ox-latex)
  1445. (should
  1446. (string-match-p
  1447. "/a/"
  1448. (orgtbl-to-generic (org-table-to-lisp "| /a/ | b |")
  1449. '(:backend latex :raw t)))))
  1450. ;; Hooks are ignored.
  1451. (should
  1452. (equal
  1453. "a\nb"
  1454. (let* ((fun-list (list (lambda (backend) (search-forward "a") (insert "hook"))))
  1455. (org-export-before-parsing-hook fun-list)
  1456. (org-export-before-processing-hook fun-list))
  1457. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1458. '(:hline nil)))))
  1459. ;; User-defined export filters are ignored.
  1460. (should
  1461. (equal
  1462. "a\nb"
  1463. (let ((org-export-filter-table-cell-functions (list (lambda (c b i) "filter"))))
  1464. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1465. '(:hline nil)))))
  1466. ;; Macros, even if unknown, are returned as-is.
  1467. (should
  1468. (equal "{{{macro}}}"
  1469. (orgtbl-to-generic (org-table-to-lisp "| {{{macro}}} |") nil))))
  1470. (ert-deftest test-org-table/to-latex ()
  1471. "Test `orgtbl-to-latex' specifications."
  1472. (should
  1473. (equal "\\begin{tabular}{l}\na\\\\\n\\end{tabular}"
  1474. (orgtbl-to-latex (org-table-to-lisp "| a |") nil)))
  1475. ;; Test :environment parameter.
  1476. (should
  1477. (equal "\\begin{tabularx}{l}\na\\\\\n\\end{tabularx}"
  1478. (orgtbl-to-latex (org-table-to-lisp "| a |")
  1479. '(:environment "tabularx"))))
  1480. ;; Test :booktabs parameter.
  1481. (should
  1482. (string-match-p
  1483. "\\toprule" (orgtbl-to-latex (org-table-to-lisp "| a |") '(:booktabs t))))
  1484. ;; Handle LaTeX snippets.
  1485. (should
  1486. (equal "\\begin{tabular}{l}\n\\(x\\)\\\\\n\\end{tabular}"
  1487. (orgtbl-to-latex (org-table-to-lisp "| $x$ |") nil)))
  1488. ;; Test pseudo objects and :raw parameter.
  1489. (should
  1490. (string-match-p
  1491. "\\$x\\$" (orgtbl-to-latex (org-table-to-lisp "| $x$ |") '(:raw t)))))
  1492. (ert-deftest test-org-table/to-html ()
  1493. "Test `orgtbl-to-html' specifications."
  1494. (should
  1495. (equal (orgtbl-to-html (org-table-to-lisp "| a |") nil)
  1496. "<table border=\"2\" cellspacing=\"0\" cellpadding=\"6\" rules=\"groups\" frame=\"hsides\">
  1497. <colgroup>
  1498. <col class=\"org-left\" />
  1499. </colgroup>
  1500. <tbody>
  1501. <tr>
  1502. <td class=\"org-left\">a</td>
  1503. </tr>
  1504. </tbody>
  1505. </table>"))
  1506. ;; Test :attributes parameter.
  1507. (should
  1508. (string-match-p
  1509. "<table>"
  1510. (orgtbl-to-html (org-table-to-lisp "| a |") '(:attributes nil))))
  1511. (should
  1512. (string-match-p
  1513. "<table border=\"2\">"
  1514. (orgtbl-to-html (org-table-to-lisp "| a |") '(:attributes (:border "2"))))))
  1515. (ert-deftest test-org-table/to-texinfo ()
  1516. "Test `orgtbl-to-texinfo' specifications."
  1517. (should
  1518. (equal "@multitable {a}\n@item a\n@end multitable"
  1519. (orgtbl-to-texinfo (org-table-to-lisp "| a |") nil)))
  1520. ;; Test :columns parameter.
  1521. (should
  1522. (equal "@multitable @columnfractions .4 .6\n@item a\n@tab b\n@end multitable"
  1523. (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
  1524. '(:columns ".4 .6"))))
  1525. (should
  1526. (equal "@multitable @columnfractions .4 .6\n@item a\n@tab b\n@end multitable"
  1527. (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
  1528. '(:columns "@columnfractions .4 .6"))))
  1529. (should
  1530. (equal "@multitable {xxx} {xx}\n@item a\n@tab b\n@end multitable"
  1531. (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
  1532. '(:columns "{xxx} {xx}")))))
  1533. (ert-deftest test-org-table/to-orgtbl ()
  1534. "Test `orgtbl-to-orgtbl' specifications."
  1535. (should
  1536. (equal "| a | b |\n|---+---|\n| c | d |"
  1537. (orgtbl-to-orgtbl
  1538. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |") nil))))
  1539. (ert-deftest test-org-table/to-unicode ()
  1540. "Test `orgtbl-to-unicode' specifications."
  1541. (should
  1542. (equal "━━━\n a \n━━━"
  1543. (orgtbl-to-unicode (org-table-to-lisp "| a |") nil)))
  1544. ;; Test :narrow parameter.
  1545. (should
  1546. (equal "━━━━\n => \n━━━━"
  1547. (orgtbl-to-unicode (org-table-to-lisp "| <2> |\n| xxx |")
  1548. '(:narrow t)))))
  1549. (ert-deftest test-org-table/send-region ()
  1550. "Test `orgtbl-send-table' specifications."
  1551. ;; Error when not at a table.
  1552. (should-error
  1553. (org-test-with-temp-text "Paragraph"
  1554. (orgtbl-send-table)))
  1555. ;; Error when destination is missing.
  1556. (should-error
  1557. (org-test-with-temp-text "#+ORGTBL: SEND\n<point>| a |"
  1558. (orgtbl-send-table)))
  1559. ;; Error when transformation function is not specified.
  1560. (should-error
  1561. (org-test-with-temp-text "
  1562. # BEGIN RECEIVE ORGTBL table
  1563. # END RECEIVE ORGTBL table
  1564. #+ORGTBL: SEND table
  1565. <point>| a |"
  1566. (orgtbl-send-table)))
  1567. ;; Standard test.
  1568. (should
  1569. (equal "| a |\n|---|\n| b |\n"
  1570. (org-test-with-temp-text "
  1571. # BEGIN RECEIVE ORGTBL table
  1572. # END RECEIVE ORGTBL table
  1573. #+ORGTBL: SEND table orgtbl-to-orgtbl :hlines nil
  1574. <point>| a |\n|---|\n| b |"
  1575. (orgtbl-send-table)
  1576. (goto-char (point-min))
  1577. (buffer-substring-no-properties
  1578. (search-forward "# BEGIN RECEIVE ORGTBL table\n")
  1579. (progn (search-forward "# END RECEIVE ORGTBL table")
  1580. (match-beginning 0))))))
  1581. ;; Allow multiple receiver locations.
  1582. (should
  1583. (org-test-with-temp-text "
  1584. # BEGIN RECEIVE ORGTBL table
  1585. # END RECEIVE ORGTBL table
  1586. #+ORGTBL: SEND table orgtbl-to-orgtbl :hlines nil
  1587. <point>| a |
  1588. # BEGIN RECEIVE ORGTBL table
  1589. # END RECEIVE ORGTBL table"
  1590. (orgtbl-send-table)
  1591. (goto-char (point-min))
  1592. (search-forward "| a |" nil t 3))))
  1593. ;;; Align
  1594. (ert-deftest test-org-table/align ()
  1595. "Test `org-table-align' specifications."
  1596. ;; Regular test.
  1597. (should
  1598. (equal "| a |\n"
  1599. (org-test-with-temp-text "| a |"
  1600. (org-table-align)
  1601. (buffer-string))))
  1602. ;; Preserve alignment.
  1603. (should
  1604. (equal " | a |\n"
  1605. (org-test-with-temp-text " | a |"
  1606. (org-table-align)
  1607. (buffer-string))))
  1608. ;; Handle horizontal lines.
  1609. (should
  1610. (equal "| 123 |\n|-----|\n"
  1611. (org-test-with-temp-text "| 123 |\n|-|"
  1612. (org-table-align)
  1613. (buffer-string))))
  1614. (should
  1615. (equal "| a | b |\n|---+---|\n"
  1616. (org-test-with-temp-text "| a | b |\n|-+-|"
  1617. (org-table-align)
  1618. (buffer-string))))
  1619. ;; Handle empty fields.
  1620. (should
  1621. (equal "| a | bc |\n| bcd | |\n"
  1622. (org-test-with-temp-text "| a | bc |\n| bcd | |"
  1623. (org-table-align)
  1624. (buffer-string))))
  1625. (should
  1626. (equal "| abc | bc |\n| | bcd |\n"
  1627. (org-test-with-temp-text "| abc | bc |\n| | bcd |"
  1628. (org-table-align)
  1629. (buffer-string))))
  1630. ;; Handle missing fields.
  1631. (should
  1632. (equal "| a | b |\n| c | |\n"
  1633. (org-test-with-temp-text "| a | b |\n| c |"
  1634. (org-table-align)
  1635. (buffer-string))))
  1636. (should
  1637. (equal "| a | b |\n|---+---|\n"
  1638. (org-test-with-temp-text "| a | b |\n|---|"
  1639. (org-table-align)
  1640. (buffer-string))))
  1641. ;; Alignment is done to the right when the ratio of numbers in the
  1642. ;; column is superior to `org-table-number-fraction'.
  1643. (should
  1644. (equal "| 1 |\n| 12 |\n| abc |"
  1645. (org-test-with-temp-text "| 1 |\n| 12 |\n| abc |"
  1646. (let ((org-table-number-fraction 0.5)) (org-table-align))
  1647. (buffer-string))))
  1648. (should
  1649. (equal "| 1 |\n| ab |\n| abc |"
  1650. (org-test-with-temp-text "| 1 |\n| ab |\n| abc |"
  1651. (let ((org-table-number-fraction 0.5)) (org-table-align))
  1652. (buffer-string))))
  1653. ;; Obey to alignment cookies.
  1654. (should
  1655. (equal "| <r> |\n| ab |\n| abc |"
  1656. (org-test-with-temp-text "| <r> |\n| ab |\n| abc |"
  1657. (let ((org-table-number-fraction 0.5)) (org-table-align))
  1658. (buffer-string))))
  1659. (should
  1660. (equal "| <l> |\n| 12 |\n| 123 |"
  1661. (org-test-with-temp-text "| <l> |\n| 12 |\n| 123 |"
  1662. (let ((org-table-number-fraction 0.5)) (org-table-align))
  1663. (buffer-string))))
  1664. (should
  1665. (equal "| <c> |\n| 1 |\n| 123 |"
  1666. (org-test-with-temp-text "| <c> |\n| 1 |\n| 123 |"
  1667. (let ((org-table-number-fraction 0.5)) (org-table-align))
  1668. (buffer-string)))))
  1669. (ert-deftest test-org-table/align-buffer-tables ()
  1670. "Align all tables when updating buffer."
  1671. (let ((before "
  1672. | a b |
  1673. | c d |
  1674. ")
  1675. (after "
  1676. | a b |
  1677. | c d |
  1678. "))
  1679. (should (equal (org-test-with-temp-text before
  1680. (org-table-recalculate-buffer-tables)
  1681. (buffer-string))
  1682. after))
  1683. (should (equal (org-test-with-temp-text before
  1684. (org-table-iterate-buffer-tables)
  1685. (buffer-string))
  1686. after))))
  1687. ;;; Sorting
  1688. (ert-deftest test-org-table/sort-lines ()
  1689. "Test `org-table-sort-lines' specifications."
  1690. ;; Sort numerically.
  1691. (should
  1692. (equal "| 1 | 2 |\n| 2 | 4 |\n| 5 | 3 |\n"
  1693. (org-test-with-temp-text "| <point>1 | 2 |\n| 5 | 3 |\n| 2 | 4 |\n"
  1694. (org-table-sort-lines nil ?n)
  1695. (buffer-string))))
  1696. (should
  1697. (equal "| 5 | 3 |\n| 2 | 4 |\n| 1 | 2 |\n"
  1698. (org-test-with-temp-text "| <point>1 | 2 |\n| 5 | 3 |\n| 2 | 4 |\n"
  1699. (org-table-sort-lines nil ?N)
  1700. (buffer-string))))
  1701. ;; Sort alphabetically. Enforce the C locale for consistent results.
  1702. (let ((original-string-collate-lessp (symbol-function 'string-collate-lessp)))
  1703. (cl-letf (((symbol-function 'string-collate-lessp)
  1704. (lambda (s1 s2 &optional locale ignore-case)
  1705. (funcall original-string-collate-lessp
  1706. s1 s2 "C" ignore-case))))
  1707. (should
  1708. (equal "| a | x |\n| B | 4 |\n| c | 3 |\n"
  1709. (org-test-with-temp-text "| <point>a | x |\n| c | 3 |\n| B | 4 |\n"
  1710. (org-table-sort-lines nil ?a)
  1711. (buffer-string))))
  1712. (should
  1713. (equal "| c | 3 |\n| B | 4 |\n| a | x |\n"
  1714. (org-test-with-temp-text "| <point>a | x |\n| c | 3 |\n| B | 4 |\n"
  1715. (org-table-sort-lines nil ?A)
  1716. (buffer-string))))
  1717. ;; Sort alphabetically with case.
  1718. (should
  1719. (equal "| C |\n| a |\n| b |\n"
  1720. (org-test-with-temp-text "| <point>a |\n| C |\n| b |\n"
  1721. (org-table-sort-lines t ?a)
  1722. (buffer-string))))
  1723. (should
  1724. (equal "| C |\n| b |\n| a |\n"
  1725. (org-test-with-temp-text "| <point>a |\n| C |\n| b |\n"
  1726. (org-table-sort-lines nil ?A)
  1727. (buffer-string))))))
  1728. ;; Sort by time (timestamps)
  1729. (should
  1730. (equal
  1731. "| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n| <2014-03-04 tue.> |\n"
  1732. (org-test-with-temp-text
  1733. "| <2014-03-04 tue.> |\n| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n"
  1734. (org-table-sort-lines nil ?t)
  1735. (buffer-string))))
  1736. (should
  1737. (equal
  1738. "| <2014-03-04 tue.> |\n| <2012-03-29 thu.> |\n| <2008-08-08 sat.> |\n"
  1739. (org-test-with-temp-text
  1740. "| <2014-03-04 tue.> |\n| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n"
  1741. (org-table-sort-lines nil ?T)
  1742. (buffer-string))))
  1743. ;; Sort by time (HH:MM values)
  1744. (should
  1745. (equal "| 1:00 |\n| 17:00 |\n| 114:00 |\n"
  1746. (org-test-with-temp-text "| 114:00 |\n| 17:00 |\n| 1:00 |\n"
  1747. (org-table-sort-lines nil ?t)
  1748. (buffer-string))))
  1749. (should
  1750. (equal "| 114:00 |\n| 17:00 |\n| 1:00 |\n"
  1751. (org-test-with-temp-text "| 114:00 |\n| 17:00 |\n| 1:00 |\n"
  1752. (org-table-sort-lines nil ?T)
  1753. (buffer-string))))
  1754. ;; Sort by time (durations)
  1755. (should
  1756. (equal "| 1d 3:00 |\n| 28:00 |\n"
  1757. (org-test-with-temp-text "| 28:00 |\n| 1d 3:00 |\n"
  1758. (org-table-sort-lines nil ?t)
  1759. (buffer-string))))
  1760. ;; Sort with custom functions.
  1761. (should
  1762. (equal "| 22 |\n| 15 |\n| 18 |\n"
  1763. (org-test-with-temp-text "| 15 |\n| 22 |\n| 18 |\n"
  1764. (org-table-sort-lines nil ?f
  1765. (lambda (s) (% (string-to-number s) 10))
  1766. #'<)
  1767. (buffer-string))))
  1768. (should
  1769. (equal "| 18 |\n| 15 |\n| 22 |\n"
  1770. (org-test-with-temp-text "| 15 |\n| 22 |\n| 18 |\n"
  1771. (org-table-sort-lines nil ?F
  1772. (lambda (s) (% (string-to-number s) 10))
  1773. #'<)
  1774. (buffer-string))))
  1775. ;; Sort according to current column.
  1776. (should
  1777. (equal "| 1 | 2 |\n| 7 | 3 |\n| 5 | 4 |\n"
  1778. (org-test-with-temp-text "| 1 | <point>2 |\n| 5 | 4 |\n| 7 | 3 |\n"
  1779. (org-table-sort-lines nil ?n)
  1780. (buffer-string))))
  1781. ;; Sort between horizontal separators if possible.
  1782. (should
  1783. (equal
  1784. "| 9 | 8 |\n|---+---|\n| 5 | 3 |\n| 7 | 4 |\n|---+---|\n| 1 | 2 |\n"
  1785. (org-test-with-temp-text
  1786. "| 9 | 8 |\n|---+---|\n| <point>7 | 4 |\n| 5 | 3 |\n|---+---|\n| 1 | 2 |\n"
  1787. (org-table-sort-lines nil ?n)
  1788. (buffer-string)))))
  1789. ;;; Formulas
  1790. (ert-deftest test-org-table/eval-formula ()
  1791. "Test `org-table-eval-formula' specifications."
  1792. ;; Error when not on a table field.
  1793. (should-error
  1794. (org-test-with-temp-text "Text"
  1795. (org-table-eval-formula)))
  1796. (should-error
  1797. (org-test-with-temp-text "| a |\n|---|<point>"
  1798. (org-table-eval-formula)))
  1799. (should-error
  1800. (org-test-with-temp-text "| a |\n#+TBLFM:<point>"
  1801. (org-table-eval-formula)))
  1802. ;; Handle @<, @>, $< and $>.
  1803. (should
  1804. (equal "| 1 |\n| 1 |"
  1805. (org-test-with-temp-text "| <point> |\n| 1 |"
  1806. (org-table-eval-formula nil "@>" nil nil t)
  1807. (buffer-string))))
  1808. (should
  1809. (equal "| 1 |\n| 1 |"
  1810. (org-test-with-temp-text "| 1 |\n| <point> |"
  1811. (org-table-eval-formula nil "@<" nil nil t)
  1812. (buffer-string))))
  1813. (should
  1814. (equal "| 1 | 1 |"
  1815. (org-test-with-temp-text "| <point> | 1 |"
  1816. (org-table-eval-formula nil "$>" nil nil t)
  1817. (buffer-string))))
  1818. (should
  1819. (equal "| 1 | 1 |"
  1820. (org-test-with-temp-text "| 1 | <point> |"
  1821. (org-table-eval-formula nil "$<" nil nil t)
  1822. (buffer-string)))))
  1823. (ert-deftest test-org-table/field-formula-outside-table ()
  1824. "Test `org-table-formula-create-columns' variable."
  1825. ;; Refuse to create column if variable is nil.
  1826. (should-error
  1827. (org-test-with-temp-text "
  1828. | 2 |
  1829. | 4 |
  1830. | 8 |
  1831. <point>#+TBLFM: @1$2=5"
  1832. (let ((org-table-formula-create-columns nil))
  1833. (org-table-calc-current-TBLFM))
  1834. (buffer-string))
  1835. :type (list 'error 'user-error))
  1836. ;; If the variable is non-nil, field formulas and columns formulas
  1837. ;; can create tables.
  1838. (should
  1839. (equal
  1840. "
  1841. | 2 | 5 |
  1842. | 4 | |
  1843. | 8 | |
  1844. #+TBLFM: @1$2=5"
  1845. (org-test-with-temp-text "
  1846. | 2 |
  1847. | 4 |
  1848. | 8 |
  1849. <point>#+TBLFM: @1$2=5"
  1850. (let ((org-table-formula-create-columns t))
  1851. (org-table-calc-current-TBLFM))
  1852. (buffer-string))))
  1853. (should
  1854. (equal
  1855. "
  1856. | 2 | | 15 |
  1857. | 4 | | 15 |
  1858. | 8 | | 15 |
  1859. #+TBLFM: $3=15"
  1860. (org-test-with-temp-text "
  1861. | 2 |
  1862. | 4 |
  1863. | 8 |
  1864. <point>#+TBLFM: $3=15"
  1865. (let ((org-table-formula-create-columns t))
  1866. (org-table-calc-current-TBLFM))
  1867. (buffer-string)))))
  1868. (ert-deftest test-org-table/duration ()
  1869. "Test durations in table formulas."
  1870. ;; Durations in cells.
  1871. (should
  1872. (string-match "| 2:12 | 1:47 | 03:59:00 |"
  1873. (org-test-with-temp-text "
  1874. | 2:12 | 1:47 | |
  1875. <point>#+TBLFM: @1$3=$1+$2;T"
  1876. (org-table-calc-current-TBLFM)
  1877. (buffer-string))))
  1878. (should
  1879. (string-match "| 2:12 | 1:47 | 03:59 |"
  1880. (org-test-with-temp-text "
  1881. | 2:12 | 1:47 | |
  1882. <point>#+TBLFM: @1$3=$1+$2;U"
  1883. (org-table-calc-current-TBLFM)
  1884. (buffer-string))))
  1885. (should
  1886. (string-match "| 3:02:20 | -2:07:00 | 0.92 |"
  1887. (org-test-with-temp-text "
  1888. | 3:02:20 | -2:07:00 | |
  1889. <point>#+TBLFM: @1$3=$1+$2;t"
  1890. (org-table-calc-current-TBLFM)
  1891. (buffer-string))))
  1892. ;; Durations set through properties.
  1893. (should
  1894. (string-match "| 16:00:00 |"
  1895. (org-test-with-temp-text "* H
  1896. :PROPERTIES:
  1897. :time_constant: 08:00:00
  1898. :END:
  1899. | |
  1900. <point>#+TBLFM: $1=2*$PROP_time_constant;T"
  1901. (org-table-calc-current-TBLFM)
  1902. (buffer-string))))
  1903. (should
  1904. (string-match "| 16.00 |"
  1905. (org-test-with-temp-text "* H
  1906. :PROPERTIES:
  1907. :time_constant: 08:00:00
  1908. :END:
  1909. | |
  1910. <point>#+TBLFM: $1=2*$PROP_time_constant;t"
  1911. (org-table-calc-current-TBLFM)
  1912. (buffer-string)))))
  1913. (ert-deftest test-org-table/end-on-hline ()
  1914. "Test with a table ending on a hline."
  1915. (should
  1916. (equal
  1917. (org-test-with-temp-text
  1918. "
  1919. | 1 | 2 | 3 |
  1920. | 4 | 5 | 6 |
  1921. | | | |
  1922. |---+---+---|
  1923. <point>#+TBLFM: @3$2..@3$>=vsum(@1..@2)"
  1924. (org-table-calc-current-TBLFM)
  1925. (buffer-string))
  1926. "
  1927. | 1 | 2 | 3 |
  1928. | 4 | 5 | 6 |
  1929. | | 7 | 9 |
  1930. |---+---+---|
  1931. #+TBLFM: @3$2..@3$>=vsum(@1..@2)")))
  1932. (ert-deftest test-org-table/named-field ()
  1933. "Test formula with a named field."
  1934. (should
  1935. (string-match-p
  1936. "| +| +1 +|"
  1937. (org-test-with-temp-text "
  1938. | | |
  1939. | ^ | name |
  1940. <point>#+TBLFM: $name=1"
  1941. (org-table-calc-current-TBLFM)
  1942. (buffer-string))))
  1943. (should
  1944. (string-match-p
  1945. "| +| +1 +|"
  1946. (org-test-with-temp-text "
  1947. | _ | name |
  1948. | | |
  1949. <point>#+TBLFM: $name=1"
  1950. (org-table-calc-current-TBLFM)
  1951. (buffer-string)))))
  1952. (ert-deftest test-org-table/named-column ()
  1953. "Test formula with a named field."
  1954. (should
  1955. (string-match-p
  1956. "| +| +1 +| +1 +|"
  1957. (org-test-with-temp-text "
  1958. | ! | name | |
  1959. | | 1 | |
  1960. <point>#+TBLFM: @2$3=$name"
  1961. (org-table-calc-current-TBLFM)
  1962. (buffer-string)))))
  1963. (ert-deftest test-org-table/formula-priority ()
  1964. "Test field formula priority over column formula."
  1965. ;; Field formulas bind stronger than column formulas.
  1966. (should
  1967. (equal
  1968. "| 1 | 3 |\n| 2 | 99 |\n"
  1969. (org-test-with-temp-text
  1970. "| 1 | |\n| 2 | |\n<point>#+tblfm: $2=3*$1::@2$2=99"
  1971. (org-table-calc-current-TBLFM)
  1972. (buffer-substring-no-properties (point-min) (point)))))
  1973. ;; When field formula is removed, table formulas is applied again.
  1974. (should
  1975. (equal
  1976. "| 1 | 3 |\n| 2 | 6 |\n"
  1977. (org-test-with-temp-text
  1978. "| 1 | |\n| 2 | |\n#+tblfm: $2=3*$1<point>::@2$2=99"
  1979. (org-table-calc-current-TBLFM)
  1980. (delete-region (point) (line-end-position))
  1981. (org-table-calc-current-TBLFM)
  1982. (buffer-substring-no-properties (point-min) (line-beginning-position))))))
  1983. (ert-deftest test-org-table/tab-indent ()
  1984. "Test named fields with tab indentation."
  1985. (should
  1986. (string-match-p
  1987. "| # | 111 |"
  1988. (org-test-with-temp-text
  1989. "
  1990. | ! | sum | | a | b | c |
  1991. |---+------+------+---+----+-----|
  1992. | # | 1011 | 1000 | 1 | 10 | 100 |
  1993. <point>#+TBLFM: $2=$a+$b+$c
  1994. "
  1995. (org-table-calc-current-TBLFM)
  1996. (buffer-string)))))
  1997. (ert-deftest test-org-table/first-rc ()
  1998. "Test \"$<\" and \"@<\" constructs in formulas."
  1999. (should
  2000. (string-match-p
  2001. "| 1 | 2 |"
  2002. (org-test-with-temp-text
  2003. "| | 2 |
  2004. <point>#+TBLFM: $<=1"
  2005. (org-table-calc-current-TBLFM)
  2006. (buffer-string))))
  2007. (should
  2008. (string-match-p
  2009. "| 2 |\n| 2 |"
  2010. (org-test-with-temp-text
  2011. "| 2 |\n| |
  2012. <point>#+TBLFM: @2$1=@<"
  2013. (org-table-calc-current-TBLFM)
  2014. (buffer-string)))))
  2015. (ert-deftest test-org-table/last-rc ()
  2016. "Test \"$>\" and \"@>\" constructs in formulas."
  2017. (should
  2018. (string-match-p
  2019. "| 2 | 1 |"
  2020. (org-test-with-temp-text
  2021. "| 2 | |\n<point>#+TBLFM: $>=1"
  2022. (org-table-calc-current-TBLFM)
  2023. (buffer-string))))
  2024. (should
  2025. (string-match-p
  2026. "| 2 |\n| 2 |"
  2027. (org-test-with-temp-text
  2028. "| 2 |\n| |\n<point>#+TBLFM: @>$1=@<"
  2029. (org-table-calc-current-TBLFM)
  2030. (buffer-string)))))
  2031. (ert-deftest test-org-table/time-stamps ()
  2032. "Test time-stamps handling."
  2033. ;; Standard test.
  2034. (should
  2035. (string-match-p
  2036. "| 1 |"
  2037. (org-test-with-temp-text
  2038. "| <2016-07-07 Sun> | <2016-07-08 Fri> | |\n<point>#+TBLFM: $3=$2-$1"
  2039. (org-table-calc-current-TBLFM)
  2040. (buffer-string))))
  2041. ;; Handle locale specific time-stamps.
  2042. (should
  2043. (string-match-p
  2044. "| 1 |"
  2045. (org-test-with-temp-text
  2046. "| <2016-07-07 Do> | <2016-07-08 Fr> | |\n<point>#+TBLFM: $3=$2-$1"
  2047. (org-table-calc-current-TBLFM)
  2048. (buffer-string)))))
  2049. (ert-deftest test-org-table/orgtbl-ascii-draw ()
  2050. "Test `orgtbl-ascii-draw'."
  2051. ;; First value: Make sure that an integer input value is converted to a
  2052. ;; float before division. Further values: Show some float input value
  2053. ;; ranges corresponding to the same bar width.
  2054. (should
  2055. (equal
  2056. (org-test-with-temp-text
  2057. "
  2058. | Value | <l> |
  2059. |----------+---------|
  2060. | 19 | replace |
  2061. |----------+---------|
  2062. | -0.50001 | replace |
  2063. | -0.49999 | replace |
  2064. | 0.49999 | replace |
  2065. | 0.50001 | replace |
  2066. | 1.49999 | replace |
  2067. | 22.50001 | replace |
  2068. | 23.49999 | replace |
  2069. | 23.50001 | replace |
  2070. | 24.49999 | replace |
  2071. | 24.50001 | replace |
  2072. <point>#+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 24 3 \" 12345678\")"
  2073. (org-table-calc-current-TBLFM)
  2074. (buffer-string))
  2075. "
  2076. | Value | <l> |
  2077. |----------+-----------|
  2078. | 19 | 883 |
  2079. |----------+-----------|
  2080. | -0.50001 | too small |
  2081. | -0.49999 | |
  2082. | 0.49999 | |
  2083. | 0.50001 | 1 |
  2084. | 1.49999 | 1 |
  2085. | 22.50001 | 887 |
  2086. | 23.49999 | 887 |
  2087. | 23.50001 | 888 |
  2088. | 24.49999 | 888 |
  2089. | 24.50001 | too large |
  2090. #+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 24 3 \" 12345678\")"))
  2091. ;; Draw bars with a bullet. The bullet does not count in the parameter
  2092. ;; WIDTH of `orgtbl-ascii-draw'.
  2093. (should
  2094. (equal
  2095. (org-test-with-temp-text
  2096. "
  2097. | -1 | replace |
  2098. | 0 | replace |
  2099. | 1 | replace |
  2100. | 2 | replace |
  2101. | 3 | replace |
  2102. | 4 | replace |
  2103. <point>#+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 3 3 \"$-\")"
  2104. (org-table-calc-current-TBLFM)
  2105. (buffer-string))
  2106. "
  2107. | -1 | too small |
  2108. | 0 | $ |
  2109. | 1 | -$ |
  2110. | 2 | --$ |
  2111. | 3 | ---$ |
  2112. | 4 | too large |
  2113. #+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 3 3 \"$-\")")))
  2114. (ert-deftest test-org-table/single-rowgroup ()
  2115. "Test column formula in a table with a single rowgroup."
  2116. (should
  2117. (equal
  2118. "
  2119. |---+---|
  2120. | 1 | 0 |
  2121. |---+---|
  2122. #+TBLFM: $2=$1-1"
  2123. (org-test-with-temp-text "
  2124. |---+---|
  2125. | 1 | |
  2126. |---+---|
  2127. <point>#+TBLFM: $2=$1-1"
  2128. (org-table-calc-current-TBLFM)
  2129. (buffer-string))))
  2130. (should
  2131. (equal
  2132. "
  2133. | 1 | 0 |
  2134. #+TBLFM: $2=$1-1"
  2135. (org-test-with-temp-text "
  2136. | 1 | |
  2137. <point>#+TBLFM: $2=$1-1"
  2138. (org-table-calc-current-TBLFM)
  2139. (buffer-string)))))
  2140. ;;; Navigation
  2141. (ert-deftest test-org-table/next-field ()
  2142. "Test `org-table-next-field' specifications."
  2143. ;; Regular test.
  2144. (should
  2145. (equal
  2146. "b"
  2147. (org-test-with-temp-text "| a<point> | b |"
  2148. (org-table-next-field)
  2149. (org-trim (org-table-get-field)))))
  2150. ;; Create new rows as needed.
  2151. (should
  2152. (equal
  2153. "| a |\n| |\n"
  2154. (org-test-with-temp-text "| a<point> |"
  2155. (org-table-next-field)
  2156. (buffer-string))))
  2157. ;; Jump over hlines, if `org-table-tab-jumps-over-hlines' is
  2158. ;; non-nil.
  2159. (should
  2160. (equal
  2161. "b"
  2162. (org-test-with-temp-text "| a<point> |\n|---|\n| b |"
  2163. (let ((org-table-tab-jumps-over-hlines t)) (org-table-next-field))
  2164. (org-trim (org-table-get-field)))))
  2165. ;; If `org-table-tab-jumps-over-hlines' is nil, however, create
  2166. ;; a new row before the rule.
  2167. (should
  2168. (equal
  2169. "| a |\n| |\n|---|\n| b |"
  2170. (org-test-with-temp-text "| a<point> |\n|---|\n| b |"
  2171. (let ((org-table-tab-jumps-over-hlines nil)) (org-table-next-field))
  2172. (buffer-string)))))
  2173. (ert-deftest test-org-table/previous-field ()
  2174. "Test `org-table-previous-field' specifications."
  2175. ;; Regular tests.
  2176. (should
  2177. (eq ?a
  2178. (org-test-with-temp-text "| a | <point>b |"
  2179. (org-table-previous-field)
  2180. (char-after))))
  2181. (should
  2182. (eq ?a
  2183. (org-test-with-temp-text "| a |\n| <point>b |"
  2184. (org-table-previous-field)
  2185. (char-after))))
  2186. ;; Find previous field across horizontal rules.
  2187. (should
  2188. (eq ?a
  2189. (org-test-with-temp-text "| a |\n|---|\n| <point>b |"
  2190. (org-table-previous-field)
  2191. (char-after))))
  2192. ;; When called on a horizontal rule, find previous data field.
  2193. (should
  2194. (eq ?b
  2195. (org-test-with-temp-text "| a | b |\n|---+-<point>--|"
  2196. (org-table-previous-field)
  2197. (char-after))))
  2198. ;; Error when at first field. Make sure to preserve original
  2199. ;; position.
  2200. (should-error
  2201. (org-test-with-temp-text "| <point> a|"
  2202. (org-table-previous-field)))
  2203. (should-error
  2204. (org-test-with-temp-text "|---|\n| <point>a |"
  2205. (org-table-previous-field)))
  2206. (should
  2207. (eq ?a
  2208. (org-test-with-temp-text "|---|\n| <point>a |"
  2209. (ignore-errors (org-table-previous-field))
  2210. (char-after)))))
  2211. ;;; Deleting columns
  2212. (ert-deftest test-org-table/delete-column ()
  2213. "Test `org-table-delete-column'."
  2214. ;; Error when outside a table.
  2215. (should-error
  2216. (org-test-with-temp-text "Paragraph"
  2217. (org-table-delete-column)))
  2218. ;; Delete first column.
  2219. (should
  2220. (equal "| a |\n"
  2221. (org-test-with-temp-text
  2222. "| <point> | a |\n"
  2223. (org-table-delete-column)
  2224. (buffer-string))))
  2225. ;; Delete column and check location of point.
  2226. (should
  2227. (= 2
  2228. (org-test-with-temp-text
  2229. "| a | <point>b | c |"
  2230. (org-table-delete-column)
  2231. (org-table-current-column))))
  2232. ;; Delete column when at end of line and after a "|".
  2233. (should
  2234. (equal "| a |\n"
  2235. (org-test-with-temp-text
  2236. "| a | b |<point>\n"
  2237. (org-table-delete-column)
  2238. (buffer-string))))
  2239. (should
  2240. (equal "| a |\n"
  2241. (org-test-with-temp-text
  2242. "| a | b | <point>\n"
  2243. (org-table-delete-column)
  2244. (buffer-string))))
  2245. ;; Delete two columns starting with the last column.
  2246. (should
  2247. (equal "| a |\n"
  2248. (org-test-with-temp-text
  2249. "| a | b | c<point> |"
  2250. (org-table-delete-column)
  2251. (org-table-delete-column)
  2252. (buffer-string)))))
  2253. ;;; Inserting rows, inserting columns
  2254. (ert-deftest test-org-table/insert-column ()
  2255. "Test `org-table-insert-column' specifications."
  2256. ;; Error when outside a table.
  2257. (should-error
  2258. (org-test-with-temp-text "Paragraph"
  2259. (org-table-insert-column)))
  2260. ;; Insert new column after current one.
  2261. (should
  2262. (equal "| | a |\n"
  2263. (org-test-with-temp-text "| a |"
  2264. (org-table-insert-column)
  2265. (buffer-string))))
  2266. (should
  2267. (equal "| | a | b |\n"
  2268. (org-test-with-temp-text "| <point>a | b |"
  2269. (org-table-insert-column)
  2270. (buffer-string))))
  2271. ;; Move point into the newly created column.
  2272. (should
  2273. (equal " | a |"
  2274. (org-test-with-temp-text "| <point>a |"
  2275. (org-table-insert-column)
  2276. (buffer-substring-no-properties (point) (line-end-position)))))
  2277. (should
  2278. (equal " | a | b |"
  2279. (org-test-with-temp-text "| <point>a | b |"
  2280. (org-table-insert-column)
  2281. (buffer-substring-no-properties (point) (line-end-position)))))
  2282. ;; Handle missing vertical bar in the last column.
  2283. (should
  2284. (equal "| | a |\n"
  2285. (org-test-with-temp-text "| a"
  2286. (org-table-insert-column)
  2287. (buffer-string))))
  2288. (should
  2289. (equal " | a |"
  2290. (org-test-with-temp-text "| <point>a"
  2291. (org-table-insert-column)
  2292. (buffer-substring-no-properties (point) (line-end-position)))))
  2293. ;; Handle column insertion when point is before first column.
  2294. (should
  2295. (equal " | | a |\n"
  2296. (org-test-with-temp-text " | a |"
  2297. (org-table-insert-column)
  2298. (buffer-string))))
  2299. (should
  2300. (equal " | | a | b |\n"
  2301. (org-test-with-temp-text " | a | b |"
  2302. (org-table-insert-column)
  2303. (buffer-string)))))
  2304. (ert-deftest test-org-table/insert-column-with-formula ()
  2305. "Test `org-table-insert-column' with a formula in place."
  2306. (should
  2307. (equal "| | 1 | 1 | 2 |
  2308. #+TBLFM: $4=$2+$3"
  2309. (org-test-with-temp-text
  2310. "| 1<point> | 1 | 2 |
  2311. #+TBLFM: $3=$1+$2"
  2312. (org-table-insert-column)
  2313. (buffer-substring-no-properties (point-min) (point-max))))))
  2314. ;;; Moving single cells
  2315. (ert-deftest test-org-table/move-cell-down ()
  2316. "Test `org-table-move-cell-down' specifications."
  2317. ;; Error out when cell cannot be moved due to not in table, in the
  2318. ;; last row of the table, or is on a hline.
  2319. (should-error
  2320. (org-test-with-temp-text "not in\na table\n"
  2321. (org-table-move-cell-down)))
  2322. (should-error
  2323. (org-test-with-temp-text "| a |"
  2324. (org-table-move-cell-down)))
  2325. (should-error
  2326. (org-test-with-temp-text "| a |\n"
  2327. (org-table-move-cell-down)))
  2328. (should-error
  2329. (org-test-with-temp-text "| a | <point>b |\n"
  2330. (org-table-move-cell-down)))
  2331. (should-error
  2332. (org-test-with-temp-text "| a | b |\n| <point>c | d |\n"
  2333. (org-table-move-cell-down)))
  2334. (should-error
  2335. (org-test-with-temp-text "| a | b |\n| c | <point>d |\n"
  2336. (org-table-move-cell-down)))
  2337. (should-error
  2338. (org-test-with-temp-text "| <point>a |\n|---|\n"
  2339. (org-table-move-cell-down)))
  2340. (should-error
  2341. (org-test-with-temp-text "|<point>---|\n| a |\n"
  2342. (org-table-move-cell-down)))
  2343. ;; Check for correct cell movement
  2344. (should (equal (concat "| c | b |\n"
  2345. "| a | d |\n"
  2346. "| e | f |\n")
  2347. (org-test-with-temp-text
  2348. (concat "| <point>a | b |\n"
  2349. "| c | d |\n"
  2350. "| e | f |\n")
  2351. (org-table-move-cell-down)
  2352. (buffer-string))))
  2353. (should (equal (concat "| a | d |\n"
  2354. "| c | b |\n"
  2355. "| e | f |\n")
  2356. (org-test-with-temp-text
  2357. (concat "| a | <point>b |\n"
  2358. "| c | d |\n"
  2359. "| e | f |\n")
  2360. (org-table-move-cell-down)
  2361. (buffer-string))))
  2362. (should (equal (concat "| a | b |\n"
  2363. "| e | d |\n"
  2364. "| c | f |\n")
  2365. (org-test-with-temp-text
  2366. (concat "| a | b |\n"
  2367. "| <point>c | d |\n"
  2368. "| e | f |\n")
  2369. (org-table-move-cell-down)
  2370. (buffer-string))))
  2371. (should (equal (concat "| a | d |\n"
  2372. "| c | f |\n"
  2373. "| e | b |\n")
  2374. (org-test-with-temp-text
  2375. (concat "| a |<point> b |\n"
  2376. "| c | d |\n"
  2377. "| e | f |\n")
  2378. (org-table-move-cell-down)
  2379. (org-table-move-cell-down)
  2380. (buffer-string))))
  2381. ;; Check for correct handling of hlines which should not change
  2382. ;; position on single cell moves.
  2383. (should (equal (concat "| c | b |\n"
  2384. "|---+---|\n"
  2385. "| a | d |\n"
  2386. "| e | f |\n")
  2387. (org-test-with-temp-text
  2388. (concat "| <point>a | b |\n"
  2389. "|---+---|\n"
  2390. "| c | d |\n"
  2391. "| e | f |\n")
  2392. (org-table-move-cell-down)
  2393. (buffer-string))))
  2394. (should (equal (concat "| a | d |\n"
  2395. "|---+---|\n"
  2396. "| c | f |\n"
  2397. "| e | b |\n")
  2398. (org-test-with-temp-text
  2399. (concat "| a | <point>b |\n"
  2400. "|---+---|\n"
  2401. "| c | d |\n"
  2402. "| e | f |\n")
  2403. (org-table-move-cell-down)
  2404. (org-table-move-cell-down)
  2405. (buffer-string))))
  2406. (should (equal (concat "| a | b |\n"
  2407. "|---+---|\n"
  2408. "| c | f |\n"
  2409. "| e | d |\n")
  2410. (org-test-with-temp-text
  2411. (concat "| a | b |\n"
  2412. "|---+---|\n"
  2413. "| c | <point>d |\n"
  2414. "| e | f |\n")
  2415. (org-table-move-cell-down)
  2416. (buffer-string))))
  2417. ;; Move single cell even without a final newline.
  2418. (should (equal (concat "| a | d |\n"
  2419. "|---+---|\n"
  2420. "| c | f |\n"
  2421. "| e | b |\n")
  2422. (org-test-with-temp-text
  2423. (concat "| a | <point>b |\n"
  2424. "|---+---|\n"
  2425. "| c | d |\n"
  2426. "| e | f |")
  2427. (org-table-move-cell-down)
  2428. (org-table-move-cell-down)
  2429. (buffer-string)))))
  2430. (ert-deftest test-org-table/move-cell-up ()
  2431. "Test `org-table-move-cell-up' specifications."
  2432. ;; Error out when cell cannot be moved due to not in table, in the
  2433. ;; last row of the table, or is on a hline.
  2434. (should-error
  2435. (org-test-with-temp-text "not in\na table\n"
  2436. (org-table-move-cell-up)))
  2437. (should-error
  2438. (org-test-with-temp-text "| a |"
  2439. (org-table-move-cell-up)))
  2440. (should-error
  2441. (org-test-with-temp-text "| a |\n"
  2442. (org-table-move-cell-up)))
  2443. (should-error
  2444. (org-test-with-temp-text "| <point>a | b |\n"
  2445. (org-table-move-cell-up)))
  2446. (should-error
  2447. (org-test-with-temp-text "| a | <point>b |\n| c | d |\n"
  2448. (org-table-move-cell-up)))
  2449. (should-error
  2450. (org-test-with-temp-text "| <point>a |\n|---|\n"
  2451. (org-table-move-cell-up)))
  2452. (should-error
  2453. (org-test-with-temp-text "|<point>---|\n| a |\n"
  2454. (org-table-move-cell-up)))
  2455. ;; Check for correct cell movement.
  2456. (should (equal (concat "| c | b |\n"
  2457. "| a | d |\n"
  2458. "| e | f |\n")
  2459. (org-test-with-temp-text
  2460. (concat "| a | b |\n"
  2461. "| <point>c | d |\n"
  2462. "| e | f |\n")
  2463. (org-table-move-cell-up)
  2464. (buffer-string))))
  2465. (should (equal (concat "| a | d |\n"
  2466. "| c | b |\n"
  2467. "| e | f |\n")
  2468. (org-test-with-temp-text
  2469. (concat "| a | b |\n"
  2470. "| c | <point>d |\n"
  2471. "| e | f |\n")
  2472. (org-table-move-cell-up)
  2473. (buffer-string))))
  2474. (should (equal (concat "| a | b |\n"
  2475. "| e | d |\n"
  2476. "| c | f |\n")
  2477. (org-test-with-temp-text
  2478. (concat "| a | b |\n"
  2479. "| c | d |\n"
  2480. "| <point>e | f |\n")
  2481. (org-table-move-cell-up)
  2482. (buffer-string))))
  2483. (should (equal (concat "| a | f |\n"
  2484. "| c | b |\n"
  2485. "| e | d |\n")
  2486. (org-test-with-temp-text
  2487. (concat "| a | b |\n"
  2488. "| c | d |\n"
  2489. "| e |<point> f |\n")
  2490. (org-table-move-cell-up)
  2491. (org-table-move-cell-up)
  2492. (buffer-string))))
  2493. ;; Check for correct handling of hlines which should not change
  2494. ;; position on single cell moves.
  2495. (should (equal (concat "| c | b |\n"
  2496. "|---+---|\n"
  2497. "| a | d |\n"
  2498. "| e | f |\n")
  2499. (org-test-with-temp-text
  2500. (concat "| a | b |\n"
  2501. "|---+---|\n"
  2502. "| <point>c | d |\n"
  2503. "| e | f |\n")
  2504. (org-table-move-cell-up)
  2505. (buffer-string))))
  2506. (should (equal (concat "| a | f |\n"
  2507. "|---+---|\n"
  2508. "| c | b |\n"
  2509. "| e | d |\n")
  2510. (org-test-with-temp-text
  2511. (concat "| a | b |\n"
  2512. "|---+---|\n"
  2513. "| c | d |\n"
  2514. "| e | <point>f |\n")
  2515. (org-table-move-cell-up)
  2516. (org-table-move-cell-up)
  2517. (buffer-string))))
  2518. (should (equal (concat "| a | b |\n"
  2519. "|---+---|\n"
  2520. "| c | f |\n"
  2521. "| e | d |\n")
  2522. (org-test-with-temp-text
  2523. (concat "| a | b |\n"
  2524. "|---+---|\n"
  2525. "| c | d |\n"
  2526. "| e | <point>f |\n")
  2527. (org-table-move-cell-up)
  2528. (buffer-string))))
  2529. ;; Move single cell even without a final newline.
  2530. (should (equal (concat "| a | f |\n"
  2531. "|---+---|\n"
  2532. "| c | b |\n"
  2533. "| e | d |\n")
  2534. (org-test-with-temp-text
  2535. (concat "| a | b |\n"
  2536. "|---+---|\n"
  2537. "| c | d |\n"
  2538. "| e | <point>f |")
  2539. (org-table-move-cell-up)
  2540. (org-table-move-cell-up)
  2541. (buffer-string)))))
  2542. (ert-deftest test-org-table/move-cell-right ()
  2543. "Test `org-table-move-cell-right' specifications."
  2544. ;; Error out when cell cannot be moved due to not in table, in the
  2545. ;; last col of the table, or is on a hline.
  2546. (should-error
  2547. (org-test-with-temp-text "not in\na table\n"
  2548. (org-table-move-cell-right)))
  2549. (should-error
  2550. (org-test-with-temp-text "| a |"
  2551. (org-table-move-cell-right)))
  2552. (should-error
  2553. (org-test-with-temp-text "| a |\n"
  2554. (org-table-move-cell-right)))
  2555. (should-error
  2556. (org-test-with-temp-text "| <point>a |\n| b |\n"
  2557. (org-table-move-cell-right)))
  2558. (should-error
  2559. (org-test-with-temp-text "| a | <point>b |\n| c | d |\n"
  2560. (org-table-move-cell-right)))
  2561. (should-error
  2562. (org-test-with-temp-text "| <point>a |\n|---|\n"
  2563. (org-table-move-cell-right)))
  2564. (should-error
  2565. (org-test-with-temp-text "|<point>---|\n| a |\n"
  2566. (org-table-move-cell-right)))
  2567. ;; Check for correct cell movement.
  2568. (should (equal (concat "| b | a | c |\n"
  2569. "| d | e | f |\n")
  2570. (org-test-with-temp-text
  2571. (concat "| <point>a | b | c |\n"
  2572. "| d | e | f |\n")
  2573. (org-table-move-cell-right)
  2574. (buffer-string))))
  2575. (should (equal (concat "| b | c | a |\n"
  2576. "| d | e | f |\n")
  2577. (org-test-with-temp-text
  2578. (concat "| <point>a | b | c |\n"
  2579. "| d | e | f |\n")
  2580. (org-table-move-cell-right)
  2581. (org-table-move-cell-right)
  2582. (buffer-string))))
  2583. (should (equal (concat "| a | b | c |\n"
  2584. "| e | f | d |\n")
  2585. (org-test-with-temp-text
  2586. (concat "| a | b | c |\n"
  2587. "| <point> d | e | f |\n")
  2588. (org-table-move-cell-right)
  2589. (org-table-move-cell-right)
  2590. (buffer-string))))
  2591. (should (equal (concat "| a | b | c |\n"
  2592. "| d | f | e |\n")
  2593. (org-test-with-temp-text
  2594. (concat "| a | b | c |\n"
  2595. "| d | <point>e | f |\n")
  2596. (org-table-move-cell-right)
  2597. (buffer-string))))
  2598. (should (equal (concat "| a | b | c |\n"
  2599. "|---+---+---|\n"
  2600. "| e | f | d |\n")
  2601. (org-test-with-temp-text
  2602. (concat "| a | b | c |\n"
  2603. "|---+---+---|\n"
  2604. "| <point>d | e | f |\n")
  2605. (org-table-move-cell-right)
  2606. (org-table-move-cell-right)
  2607. (buffer-string))))
  2608. ;; Move single cell even without a final newline.
  2609. (should (equal (concat "| a | b | c |\n"
  2610. "|---+---+---|\n"
  2611. "| e | d | f |\n")
  2612. (org-test-with-temp-text
  2613. (concat "| a | b | c |\n"
  2614. "|---+---+---|\n"
  2615. "| <point>d | e | f |")
  2616. (org-table-move-cell-right)
  2617. (buffer-string)))))
  2618. (ert-deftest test-org-table/move-cell-left ()
  2619. "Test `org-table-move-cell-left' specifications."
  2620. ;; Error out when cell cannot be moved due to not in table, in the
  2621. ;; last col of the table, or is on a hline.
  2622. (should-error
  2623. (org-test-with-temp-text "not in\na table\n"
  2624. (org-table-move-cell-left)))
  2625. (should-error
  2626. (org-test-with-temp-text "| a |"
  2627. (org-table-move-cell-left)))
  2628. (should-error
  2629. (org-test-with-temp-text "| a |\n"
  2630. (org-table-move-cell-left)))
  2631. (should-error
  2632. (org-test-with-temp-text "| <point>a |\n| b |\n"
  2633. (org-table-move-cell-left)))
  2634. (should-error
  2635. (org-test-with-temp-text "| <point>a | b |\n| c | d |\n"
  2636. (org-table-move-cell-left)))
  2637. (should-error
  2638. (org-test-with-temp-text "| <point>a |\n|---|\n"
  2639. (org-table-move-cell-left)))
  2640. (should-error
  2641. (org-test-with-temp-text "|<point>---|\n| a |\n"
  2642. (org-table-move-cell-left)))
  2643. ;; Check for correct cell movement.
  2644. (should (equal (concat "| b | a | c |\n"
  2645. "| d | e | f |\n")
  2646. (org-test-with-temp-text
  2647. (concat "| a | <point>b | c |\n"
  2648. "| d | e | f |\n")
  2649. (org-table-move-cell-left)
  2650. (buffer-string))))
  2651. (should (equal (concat "| c | a | b |\n"
  2652. "| d | e | f |\n")
  2653. (org-test-with-temp-text
  2654. (concat "| a | b | <point>c |\n"
  2655. "| d | e | f |\n")
  2656. (org-table-move-cell-left)
  2657. (org-table-move-cell-left)
  2658. (buffer-string))))
  2659. (should (equal (concat "| a | b | c |\n"
  2660. "| f | d | e |\n")
  2661. (org-test-with-temp-text
  2662. (concat "| a | b | c |\n"
  2663. "| d | e | <point>f |\n")
  2664. (org-table-move-cell-left)
  2665. (org-table-move-cell-left)
  2666. (buffer-string))))
  2667. (should (equal (concat "| a | b | c |\n"
  2668. "| d | f | e |\n")
  2669. (org-test-with-temp-text
  2670. (concat "| a | b | c |\n"
  2671. "| d | e | <point>f |\n")
  2672. (org-table-move-cell-left)
  2673. (buffer-string))))
  2674. (should (equal (concat "| a | b | c |\n"
  2675. "|---+---+---|\n"
  2676. "| f | d | e |\n")
  2677. (org-test-with-temp-text
  2678. (concat "| a | b | c |\n"
  2679. "|---+---+---|\n"
  2680. "| d | e | <point>f |\n")
  2681. (org-table-move-cell-left)
  2682. (org-table-move-cell-left)
  2683. (buffer-string))))
  2684. ;; Move single cell even without a final newline.
  2685. (should (equal (concat "| a | b | c |\n"
  2686. "|---+---+---|\n"
  2687. "| e | d | f |\n")
  2688. (org-test-with-temp-text
  2689. (concat "| a | b | c |\n"
  2690. "|---+---+---|\n"
  2691. "| d | <point>e | f |")
  2692. (org-table-move-cell-left)
  2693. (buffer-string)))))
  2694. ;;; Moving rows, moving columns
  2695. (ert-deftest test-org-table/move-row-down ()
  2696. "Test `org-table-move-row-down' specifications."
  2697. ;; Error out when row cannot be moved, e.g., it is the last row in
  2698. ;; the table.
  2699. (should-error
  2700. (org-test-with-temp-text "| a |"
  2701. (org-table-move-row-down)))
  2702. (should-error
  2703. (org-test-with-temp-text "| a |\n"
  2704. (org-table-move-row-down)))
  2705. (should-error
  2706. (org-test-with-temp-text "| a |\n| <point>b |"
  2707. (org-table-move-row-down)))
  2708. ;; Move data lines.
  2709. (should
  2710. (equal "| b |\n| a |\n"
  2711. (org-test-with-temp-text "| a |\n| b |\n"
  2712. (org-table-move-row-down)
  2713. (buffer-string))))
  2714. (should
  2715. (equal "|---|\n| a |\n"
  2716. (org-test-with-temp-text "| a |\n|---|\n"
  2717. (org-table-move-row-down)
  2718. (buffer-string))))
  2719. ;; Move hlines.
  2720. (should
  2721. (equal "| b |\n|---|\n"
  2722. (org-test-with-temp-text "|---|\n| b |\n"
  2723. (org-table-move-row-down)
  2724. (buffer-string))))
  2725. (should
  2726. (equal "|---|\n|---|\n"
  2727. (org-test-with-temp-text "|---|\n|---|\n"
  2728. (org-table-move-row-down)
  2729. (buffer-string))))
  2730. ;; Move rows even without a final newline.
  2731. (should
  2732. (equal "| b |\n| a |\n"
  2733. (org-test-with-temp-text "| a |\n| b |"
  2734. (org-table-move-row-down)
  2735. (buffer-string)))))
  2736. (ert-deftest test-org-table/move-row-up ()
  2737. "Test `org-table-move-row-up' specifications."
  2738. ;; Error out when row cannot be moved, e.g., it is the first row in
  2739. ;; the table.
  2740. (should-error
  2741. (org-test-with-temp-text "| a |"
  2742. (org-table-move-row-up)))
  2743. (should-error
  2744. (org-test-with-temp-text "| a |\n"
  2745. (org-table-move-row-up)))
  2746. ;; Move data lines.
  2747. (should
  2748. (equal "| b |\n| a |\n"
  2749. (org-test-with-temp-text "| a |\n| <point>b |\n"
  2750. (org-table-move-row-up)
  2751. (buffer-string))))
  2752. (should
  2753. (equal "| b |\n|---|\n"
  2754. (org-test-with-temp-text "|---|\n| <point>b |\n"
  2755. (org-table-move-row-up)
  2756. (buffer-string))))
  2757. ;; Move hlines.
  2758. (should
  2759. (equal "|---|\n| a |\n"
  2760. (org-test-with-temp-text "| a |\n|<point>---|\n"
  2761. (org-table-move-row-up)
  2762. (buffer-string))))
  2763. (should
  2764. (equal "|---|\n|---|\n"
  2765. (org-test-with-temp-text "|---|\n|<point>---|\n"
  2766. (org-table-move-row-up)
  2767. (buffer-string))))
  2768. ;; Move rows even without a final newline.
  2769. (should
  2770. (equal "| b |\n| a |\n"
  2771. (org-test-with-temp-text "| a |\n| <point>b |"
  2772. (org-table-move-row-up)
  2773. (buffer-string)))))
  2774. ;;; Shrunk columns
  2775. (ert-deftest test-org-table/toggle-column-width ()
  2776. "Test `org-table-toggle-columns-width' specifications."
  2777. ;; Error when not at a column.
  2778. (should-error
  2779. (org-test-with-temp-text "<point>a"
  2780. (org-table-toggle-column-width)))
  2781. ;; A shrunk column is overlaid with
  2782. ;; `org-table-shrunk-column-indicator'.
  2783. (should
  2784. (equal org-table-shrunk-column-indicator
  2785. (org-test-with-temp-text "| <point>a |"
  2786. (org-table-toggle-column-width)
  2787. (overlay-get (car (overlays-at (point))) 'display))))
  2788. (should
  2789. (equal org-table-shrunk-column-indicator
  2790. (org-test-with-temp-text "| a |\n|-<point>--|"
  2791. (org-table-toggle-column-width)
  2792. (overlay-get (car (overlays-at (point))) 'display))))
  2793. ;; Shrink every field in the same column.
  2794. (should
  2795. (equal org-table-shrunk-column-indicator
  2796. (org-test-with-temp-text "| a |\n|-<point>--|"
  2797. (org-table-toggle-column-width)
  2798. (overlay-get (car (overlays-at (1+ (line-beginning-position 0))))
  2799. 'display))))
  2800. ;; When column is already shrunk, expand it, i.e., remove overlays.
  2801. (should-not
  2802. (org-test-with-temp-text "| <point>a |"
  2803. (org-table-toggle-column-width)
  2804. (org-table-toggle-column-width)
  2805. (overlays-in (point-min) (point-max))))
  2806. (should-not
  2807. (org-test-with-temp-text "| a |\n| <point>b |"
  2808. (org-table-toggle-column-width)
  2809. (org-table-toggle-column-width)
  2810. (overlays-in (point-min) (point-max))))
  2811. ;; With a column width cookie, limit overlay to the specified number
  2812. ;; of characters.
  2813. (should
  2814. (equal "| abc"
  2815. (org-test-with-temp-text "| <3> |\n| <point>abcd |"
  2816. (org-table-toggle-column-width)
  2817. (buffer-substring (line-beginning-position)
  2818. (overlay-start
  2819. (car (overlays-in (line-beginning-position)
  2820. (line-end-position))))))))
  2821. (should
  2822. (equal "| a "
  2823. (org-test-with-temp-text "| <3> |\n| <point>a |"
  2824. (org-table-toggle-column-width)
  2825. (buffer-substring (line-beginning-position)
  2826. (overlay-start
  2827. (car (overlays-in (line-beginning-position)
  2828. (line-end-position))))))))
  2829. (should
  2830. (equal (concat "----" org-table-shrunk-column-indicator)
  2831. (org-test-with-temp-text "| <3> |\n|--<point>----|"
  2832. (org-table-toggle-column-width)
  2833. (overlay-get
  2834. (car (overlays-in (line-beginning-position)
  2835. (line-end-position)))
  2836. 'display))))
  2837. ;; Width only takes into account visible characters.
  2838. (should
  2839. (equal "| [[http"
  2840. (org-test-with-temp-text "| <4> |\n| <point>[[http://orgmode.org]] |"
  2841. (org-table-toggle-column-width)
  2842. (buffer-substring (line-beginning-position)
  2843. (overlay-start
  2844. (car (overlays-in (line-beginning-position)
  2845. (line-end-position))))))))
  2846. ;; Before the first column or after the last one, ask for columns
  2847. ;; ranges.
  2848. (should
  2849. (catch :exit
  2850. (org-test-with-temp-text "| a |"
  2851. (cl-letf (((symbol-function 'read-string)
  2852. (lambda (&rest_) (throw :exit t))))
  2853. (org-table-toggle-column-width)
  2854. nil))))
  2855. (should
  2856. (catch :exit
  2857. (org-test-with-temp-text "| a |<point>"
  2858. (cl-letf (((symbol-function 'read-string)
  2859. (lambda (&rest_) (throw :exit t))))
  2860. (org-table-toggle-column-width)
  2861. nil))))
  2862. ;; When optional argument ARG is a string, toggle specified columns.
  2863. (should
  2864. (equal org-table-shrunk-column-indicator
  2865. (org-test-with-temp-text "| <point>a | b |"
  2866. (org-table-toggle-column-width "2")
  2867. (overlay-get (car (overlays-at (- (point-max) 2))) 'display))))
  2868. (should
  2869. (equal '("b" "c")
  2870. (org-test-with-temp-text "| a | b | c | d |"
  2871. (org-table-toggle-column-width "2-3")
  2872. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2873. (overlays-in (point-min) (point-max)))
  2874. #'string-lessp))))
  2875. (should
  2876. (equal '("b" "c" "d")
  2877. (org-test-with-temp-text "| a | b | c | d |"
  2878. (org-table-toggle-column-width "2-")
  2879. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2880. (overlays-in (point-min) (point-max)))
  2881. #'string-lessp))))
  2882. (should
  2883. (equal '("a" "b")
  2884. (org-test-with-temp-text "| a | b | c | d |"
  2885. (org-table-toggle-column-width "-2")
  2886. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2887. (overlays-in (point-min) (point-max)))
  2888. #'string-lessp))))
  2889. (should
  2890. (equal '("a" "b" "c" "d")
  2891. (org-test-with-temp-text "| a | b | c | d |"
  2892. (org-table-toggle-column-width "-")
  2893. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2894. (overlays-in (point-min) (point-max)))
  2895. #'string-lessp))))
  2896. (should
  2897. (equal '("a" "d")
  2898. (org-test-with-temp-text "| a | b | c | d |"
  2899. (org-table-toggle-column-width "1-3")
  2900. (org-table-toggle-column-width "2-4")
  2901. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2902. (overlays-in (point-min) (point-max)))
  2903. #'string-lessp))))
  2904. ;; When ARG is (16), remove any column overlay.
  2905. (should-not
  2906. (org-test-with-temp-text "| <point>a |"
  2907. (org-table-toggle-column-width)
  2908. (org-table-toggle-column-width '(16))
  2909. (overlays-in (point-min) (point-max))))
  2910. (should-not
  2911. (org-test-with-temp-text "| a | b | c | d |"
  2912. (org-table-toggle-column-width "-")
  2913. (org-table-toggle-column-width '(16))
  2914. (overlays-in (point-min) (point-max)))))
  2915. (ert-deftest test-org-table/shrunk-columns ()
  2916. "Test behaviour of shrunk column."
  2917. ;; Edition automatically expands a shrunk column.
  2918. (should-not
  2919. (org-test-with-temp-text "| <point>a |"
  2920. (org-table-toggle-column-width)
  2921. (insert "a")
  2922. (overlays-in (point-min) (point-max))))
  2923. ;; Other columns are not changed.
  2924. (should
  2925. (org-test-with-temp-text "| <point>a | b |"
  2926. (org-table-toggle-column-width "-")
  2927. (insert "a")
  2928. (overlays-in (point-min) (point-max))))
  2929. ;; Moving a shrunk column doesn't alter its state.
  2930. (should
  2931. (equal "a"
  2932. (org-test-with-temp-text "| <point>a | b |"
  2933. (org-table-toggle-column-width)
  2934. (org-table-move-column-right)
  2935. (overlay-get (car (overlays-at (point))) 'help-echo))))
  2936. (should
  2937. (equal "a"
  2938. (org-test-with-temp-text "| <point>a |\n| b |"
  2939. (org-table-toggle-column-width)
  2940. (org-table-move-row-down)
  2941. (overlay-get (car (overlays-at (point))) 'help-echo))))
  2942. ;; State is preserved upon inserting a column.
  2943. (should
  2944. (equal '("a")
  2945. (org-test-with-temp-text "| <point>a |"
  2946. (org-table-toggle-column-width)
  2947. (org-table-insert-column)
  2948. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2949. (overlays-in (point-min) (point-max)))
  2950. #'string-lessp))))
  2951. ;; State is preserved upon deleting a column.
  2952. (should
  2953. (equal '("a" "c")
  2954. (org-test-with-temp-text "| a | <point>b | c |"
  2955. (org-table-toggle-column-width "-")
  2956. (org-table-delete-column)
  2957. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2958. (overlays-in (point-min) (point-max)))
  2959. #'string-lessp))))
  2960. ;; State is preserved upon deleting a row.
  2961. (should
  2962. (equal '("b1" "b2")
  2963. (org-test-with-temp-text "| a1 | a2 |\n| b1 | b2 |"
  2964. (org-table-toggle-column-width "-")
  2965. (org-table-kill-row)
  2966. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2967. (overlays-in (point-min) (point-max)))
  2968. #'string-lessp))))
  2969. (should
  2970. (equal '("a1" "a2")
  2971. (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
  2972. (org-table-toggle-column-width "-")
  2973. (org-table-kill-row)
  2974. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2975. (overlays-in (point-min) (point-max)))
  2976. #'string-lessp))))
  2977. ;; State is preserved upon inserting a row or hline.
  2978. (should
  2979. (equal '("" "a1" "b1")
  2980. (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
  2981. (org-table-toggle-column-width)
  2982. (org-table-insert-row)
  2983. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2984. (overlays-in (point-min) (point-max)))
  2985. #'string-lessp))))
  2986. (should
  2987. (equal '("a1" "b1")
  2988. (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
  2989. (org-table-toggle-column-width)
  2990. (org-table-insert-hline)
  2991. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2992. (overlays-in (point-min) (point-max)))
  2993. #'string-lessp))))
  2994. ;; State is preserved upon sorting a column for all the columns but
  2995. ;; the one being sorted.
  2996. (should
  2997. (equal '("a2" "b2")
  2998. (org-test-with-temp-text "| <point>a1 | a2 |\n| <point>b1 | b2 |"
  2999. (org-table-toggle-column-width "-")
  3000. (org-table-sort-lines nil ?A)
  3001. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  3002. (overlays-in (point-min) (point-max)))
  3003. #'string-lessp))))
  3004. ;; State is preserved upon replacing a field non-interactively.
  3005. (should
  3006. (equal '("a")
  3007. (org-test-with-temp-text "| <point>a |"
  3008. (org-table-toggle-column-width)
  3009. (org-table-get-field nil "b")
  3010. (mapcar (lambda (o) (overlay-get o 'help-echo))
  3011. (overlays-in (point-min) (point-max))))))
  3012. ;; Moving to next field doesn't change shrunk state.
  3013. (should
  3014. (equal "a"
  3015. (org-test-with-temp-text "| <point>a | b |"
  3016. (org-table-toggle-column-width)
  3017. (org-table-next-field)
  3018. (overlay-get (car (overlays-at (1+ (line-beginning-position))))
  3019. 'help-echo))))
  3020. (should
  3021. (equal "b"
  3022. (org-test-with-temp-text "| a | <point>b |"
  3023. (org-table-toggle-column-width)
  3024. (goto-char 2)
  3025. (org-table-next-field)
  3026. (overlay-get (car (overlays-at (point))) 'help-echo))))
  3027. ;; Aligning table doesn't alter shrunk state.
  3028. (should
  3029. (equal "a"
  3030. (org-test-with-temp-text "| <point>a | b |"
  3031. (org-table-toggle-column-width)
  3032. (org-table-align)
  3033. (overlay-get (car (overlays-at (1+ (line-beginning-position))))
  3034. 'help-echo))))
  3035. (should
  3036. (equal "b"
  3037. (org-test-with-temp-text "|---+-----|\n| a | <point>b |"
  3038. (org-table-toggle-column-width)
  3039. (org-table-align)
  3040. (overlay-get (car (overlays-at (point)))
  3041. 'help-echo))))
  3042. (should
  3043. (equal
  3044. '("b")
  3045. (org-test-with-temp-text "|---+-----|\n| a | <point>b |"
  3046. (org-table-toggle-column-width)
  3047. (org-table-align)
  3048. (mapcar (lambda (o) (overlay-get o 'help-echo))
  3049. (overlays-in (line-beginning-position) (line-end-position))))))
  3050. ;; Recalculating formulas doesn't change shrunk state.
  3051. (should
  3052. (equal "2"
  3053. (org-test-with-temp-text "| 1 | <point>0 |\n#+TBLFM: $2=$1+1\n"
  3054. (org-table-toggle-column-width)
  3055. (org-table-recalculate)
  3056. (overlay-get (car (overlays-at (point))) 'help-echo)))))
  3057. ;;; Miscellaneous
  3058. (ert-deftest test-org-table/current-column ()
  3059. "Test `org-table-current-column' specifications."
  3060. (should
  3061. (= 1 (org-test-with-temp-text "| <point>a |"
  3062. (org-table-current-column))))
  3063. (should
  3064. (= 1 (org-test-with-temp-text "|-<point>--|"
  3065. (org-table-current-column))))
  3066. (should
  3067. (= 2 (org-test-with-temp-text "| 1 | <point>2 |"
  3068. (org-table-current-column))))
  3069. (should
  3070. (= 2 (org-test-with-temp-text "|---+-<point>--|"
  3071. (org-table-current-column)))))
  3072. (ert-deftest test-org-table/get-field ()
  3073. "Test `org-table-get-field' specifications."
  3074. ;; Regular test.
  3075. (should
  3076. (equal " a "
  3077. (org-test-with-temp-text "| <point>a |" (org-table-get-field))))
  3078. ;; Get field in open last column.
  3079. (should
  3080. (equal " a "
  3081. (org-test-with-temp-text "| <point>a " (org-table-get-field))))
  3082. ;; Get empty field.
  3083. (should
  3084. (equal ""
  3085. (org-test-with-temp-text "|<point>|" (org-table-get-field))))
  3086. (should
  3087. (equal " "
  3088. (org-test-with-temp-text "| <point>|" (org-table-get-field))))
  3089. ;; Outside the table, return the empty string.
  3090. (should
  3091. (equal ""
  3092. (org-test-with-temp-text "<point>| a |" (org-table-get-field))))
  3093. (should
  3094. (equal ""
  3095. (org-test-with-temp-text "| a |<point>" (org-table-get-field))))
  3096. ;; With optional N argument, select a particular column in current
  3097. ;; row.
  3098. (should
  3099. (equal " 3 "
  3100. (org-test-with-temp-text "| 1 | 2 | 3 |" (org-table-get-field 3))))
  3101. (should
  3102. (equal " 4 "
  3103. (org-test-with-temp-text "| 1 | 2 |\n<point>| 3 | 4 |"
  3104. (org-table-get-field 2))))
  3105. ;; REPLACE optional argument is used to replace selected field.
  3106. (should
  3107. (equal "| foo |"
  3108. (org-test-with-temp-text "| <point>1 |"
  3109. (org-table-get-field nil " foo ")
  3110. (buffer-string))))
  3111. (should
  3112. (equal "| 1 | 2 | foo |"
  3113. (org-test-with-temp-text "| 1 | 2 | 3 |"
  3114. (org-table-get-field 3 " foo ")
  3115. (buffer-string))))
  3116. (should
  3117. (equal " 4 "
  3118. (org-test-with-temp-text "| 1 | 2 |\n<point>| 3 | 4 |"
  3119. (org-table-get-field 2))))
  3120. ;; An empty REPLACE string clears the field.
  3121. (should
  3122. (equal "| |"
  3123. (org-test-with-temp-text "| <point>1 |"
  3124. (org-table-get-field nil "")
  3125. (buffer-string))))
  3126. ;; When using REPLACE still return old value.
  3127. (should
  3128. (equal " 1 "
  3129. (org-test-with-temp-text "| <point>1 |"
  3130. (org-table-get-field nil " foo ")))))
  3131. (provide 'test-org-table)
  3132. ;;; test-org-table.el ends here