test-org-table.el 102 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284
  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 immediately 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. ;; Delete two columns starting with the last column.
  2240. (should
  2241. (equal "| a |\n"
  2242. (org-test-with-temp-text
  2243. "| a | b | c<point> |"
  2244. (org-table-delete-column)
  2245. (org-table-delete-column)
  2246. (buffer-string)))))
  2247. ;;; Inserting rows, inserting columns
  2248. (ert-deftest test-org-table/insert-column ()
  2249. "Test `org-table-insert-column' specifications."
  2250. ;; Error when outside a table.
  2251. (should-error
  2252. (org-test-with-temp-text "Paragraph"
  2253. (org-table-insert-column)))
  2254. ;; Insert new column after current one.
  2255. (should
  2256. (equal "| | a |\n"
  2257. (org-test-with-temp-text "| a |"
  2258. (org-table-insert-column)
  2259. (buffer-string))))
  2260. (should
  2261. (equal "| | a | b |\n"
  2262. (org-test-with-temp-text "| <point>a | b |"
  2263. (org-table-insert-column)
  2264. (buffer-string))))
  2265. ;; Move point into the newly created column.
  2266. (should
  2267. (equal " | a |"
  2268. (org-test-with-temp-text "| <point>a |"
  2269. (org-table-insert-column)
  2270. (buffer-substring-no-properties (point) (line-end-position)))))
  2271. (should
  2272. (equal " | a | b |"
  2273. (org-test-with-temp-text "| <point>a | b |"
  2274. (org-table-insert-column)
  2275. (buffer-substring-no-properties (point) (line-end-position)))))
  2276. ;; Handle missing vertical bar in the last column.
  2277. (should
  2278. (equal "| | a |\n"
  2279. (org-test-with-temp-text "| a"
  2280. (org-table-insert-column)
  2281. (buffer-string))))
  2282. (should
  2283. (equal " | a |"
  2284. (org-test-with-temp-text "| <point>a"
  2285. (org-table-insert-column)
  2286. (buffer-substring-no-properties (point) (line-end-position)))))
  2287. ;; Handle column insertion when point is before first column.
  2288. (should
  2289. (equal " | | a |\n"
  2290. (org-test-with-temp-text " | a |"
  2291. (org-table-insert-column)
  2292. (buffer-string))))
  2293. (should
  2294. (equal " | | a | b |\n"
  2295. (org-test-with-temp-text " | a | b |"
  2296. (org-table-insert-column)
  2297. (buffer-string)))))
  2298. (ert-deftest test-org-table/insert-column-with-formula ()
  2299. "Test `org-table-insert-column' with a formula in place."
  2300. (should
  2301. (equal "| | 1 | 1 | 2 |
  2302. #+TBLFM: $4=$2+$3"
  2303. (org-test-with-temp-text
  2304. "| 1<point> | 1 | 2 |
  2305. #+TBLFM: $3=$1+$2"
  2306. (org-table-insert-column)
  2307. (buffer-substring-no-properties (point-min) (point-max))))))
  2308. ;;; Moving single cells
  2309. (ert-deftest test-org-table/move-cell-down ()
  2310. "Test `org-table-move-cell-down' specifications."
  2311. ;; Error out when cell cannot be moved due to not in table, in the
  2312. ;; last row of the table, or is on a hline.
  2313. (should-error
  2314. (org-test-with-temp-text "not in\na table\n"
  2315. (org-table-move-cell-down)))
  2316. (should-error
  2317. (org-test-with-temp-text "| a |"
  2318. (org-table-move-cell-down)))
  2319. (should-error
  2320. (org-test-with-temp-text "| a |\n"
  2321. (org-table-move-cell-down)))
  2322. (should-error
  2323. (org-test-with-temp-text "| a | <point>b |\n"
  2324. (org-table-move-cell-down)))
  2325. (should-error
  2326. (org-test-with-temp-text "| a | b |\n| <point>c | d |\n"
  2327. (org-table-move-cell-down)))
  2328. (should-error
  2329. (org-test-with-temp-text "| a | b |\n| c | <point>d |\n"
  2330. (org-table-move-cell-down)))
  2331. (should-error
  2332. (org-test-with-temp-text "| <point>a |\n|---|\n"
  2333. (org-table-move-cell-down)))
  2334. (should-error
  2335. (org-test-with-temp-text "|<point>---|\n| a |\n"
  2336. (org-table-move-cell-down)))
  2337. ;; Check for correct cell movement
  2338. (should (equal (concat "| c | b |\n"
  2339. "| a | d |\n"
  2340. "| e | f |\n")
  2341. (org-test-with-temp-text
  2342. (concat "| <point>a | b |\n"
  2343. "| c | d |\n"
  2344. "| e | f |\n")
  2345. (org-table-move-cell-down)
  2346. (buffer-string))))
  2347. (should (equal (concat "| a | d |\n"
  2348. "| c | b |\n"
  2349. "| e | f |\n")
  2350. (org-test-with-temp-text
  2351. (concat "| a | <point>b |\n"
  2352. "| c | d |\n"
  2353. "| e | f |\n")
  2354. (org-table-move-cell-down)
  2355. (buffer-string))))
  2356. (should (equal (concat "| a | b |\n"
  2357. "| e | d |\n"
  2358. "| c | f |\n")
  2359. (org-test-with-temp-text
  2360. (concat "| a | b |\n"
  2361. "| <point>c | d |\n"
  2362. "| e | f |\n")
  2363. (org-table-move-cell-down)
  2364. (buffer-string))))
  2365. (should (equal (concat "| a | d |\n"
  2366. "| c | f |\n"
  2367. "| e | b |\n")
  2368. (org-test-with-temp-text
  2369. (concat "| a |<point> b |\n"
  2370. "| c | d |\n"
  2371. "| e | f |\n")
  2372. (org-table-move-cell-down)
  2373. (org-table-move-cell-down)
  2374. (buffer-string))))
  2375. ;; Check for correct handling of hlines which should not change
  2376. ;; position on single cell moves.
  2377. (should (equal (concat "| c | b |\n"
  2378. "|---+---|\n"
  2379. "| a | d |\n"
  2380. "| e | f |\n")
  2381. (org-test-with-temp-text
  2382. (concat "| <point>a | b |\n"
  2383. "|---+---|\n"
  2384. "| c | d |\n"
  2385. "| e | f |\n")
  2386. (org-table-move-cell-down)
  2387. (buffer-string))))
  2388. (should (equal (concat "| a | d |\n"
  2389. "|---+---|\n"
  2390. "| c | f |\n"
  2391. "| e | b |\n")
  2392. (org-test-with-temp-text
  2393. (concat "| a | <point>b |\n"
  2394. "|---+---|\n"
  2395. "| c | d |\n"
  2396. "| e | f |\n")
  2397. (org-table-move-cell-down)
  2398. (org-table-move-cell-down)
  2399. (buffer-string))))
  2400. (should (equal (concat "| a | b |\n"
  2401. "|---+---|\n"
  2402. "| c | f |\n"
  2403. "| e | d |\n")
  2404. (org-test-with-temp-text
  2405. (concat "| a | b |\n"
  2406. "|---+---|\n"
  2407. "| c | <point>d |\n"
  2408. "| e | f |\n")
  2409. (org-table-move-cell-down)
  2410. (buffer-string))))
  2411. ;; Move single cell even without a final newline.
  2412. (should (equal (concat "| a | d |\n"
  2413. "|---+---|\n"
  2414. "| c | f |\n"
  2415. "| e | b |\n")
  2416. (org-test-with-temp-text
  2417. (concat "| a | <point>b |\n"
  2418. "|---+---|\n"
  2419. "| c | d |\n"
  2420. "| e | f |")
  2421. (org-table-move-cell-down)
  2422. (org-table-move-cell-down)
  2423. (buffer-string)))))
  2424. (ert-deftest test-org-table/move-cell-up ()
  2425. "Test `org-table-move-cell-up' specifications."
  2426. ;; Error out when cell cannot be moved due to not in table, in the
  2427. ;; last row of the table, or is on a hline.
  2428. (should-error
  2429. (org-test-with-temp-text "not in\na table\n"
  2430. (org-table-move-cell-up)))
  2431. (should-error
  2432. (org-test-with-temp-text "| a |"
  2433. (org-table-move-cell-up)))
  2434. (should-error
  2435. (org-test-with-temp-text "| a |\n"
  2436. (org-table-move-cell-up)))
  2437. (should-error
  2438. (org-test-with-temp-text "| <point>a | b |\n"
  2439. (org-table-move-cell-up)))
  2440. (should-error
  2441. (org-test-with-temp-text "| a | <point>b |\n| c | d |\n"
  2442. (org-table-move-cell-up)))
  2443. (should-error
  2444. (org-test-with-temp-text "| <point>a |\n|---|\n"
  2445. (org-table-move-cell-up)))
  2446. (should-error
  2447. (org-test-with-temp-text "|<point>---|\n| a |\n"
  2448. (org-table-move-cell-up)))
  2449. ;; Check for correct cell movement.
  2450. (should (equal (concat "| c | b |\n"
  2451. "| a | d |\n"
  2452. "| e | f |\n")
  2453. (org-test-with-temp-text
  2454. (concat "| a | b |\n"
  2455. "| <point>c | d |\n"
  2456. "| e | f |\n")
  2457. (org-table-move-cell-up)
  2458. (buffer-string))))
  2459. (should (equal (concat "| a | d |\n"
  2460. "| c | b |\n"
  2461. "| e | f |\n")
  2462. (org-test-with-temp-text
  2463. (concat "| a | b |\n"
  2464. "| c | <point>d |\n"
  2465. "| e | f |\n")
  2466. (org-table-move-cell-up)
  2467. (buffer-string))))
  2468. (should (equal (concat "| a | b |\n"
  2469. "| e | d |\n"
  2470. "| c | f |\n")
  2471. (org-test-with-temp-text
  2472. (concat "| a | b |\n"
  2473. "| c | d |\n"
  2474. "| <point>e | f |\n")
  2475. (org-table-move-cell-up)
  2476. (buffer-string))))
  2477. (should (equal (concat "| a | f |\n"
  2478. "| c | b |\n"
  2479. "| e | d |\n")
  2480. (org-test-with-temp-text
  2481. (concat "| a | b |\n"
  2482. "| c | d |\n"
  2483. "| e |<point> f |\n")
  2484. (org-table-move-cell-up)
  2485. (org-table-move-cell-up)
  2486. (buffer-string))))
  2487. ;; Check for correct handling of hlines which should not change
  2488. ;; position on single cell moves.
  2489. (should (equal (concat "| c | b |\n"
  2490. "|---+---|\n"
  2491. "| a | d |\n"
  2492. "| e | f |\n")
  2493. (org-test-with-temp-text
  2494. (concat "| a | b |\n"
  2495. "|---+---|\n"
  2496. "| <point>c | d |\n"
  2497. "| e | f |\n")
  2498. (org-table-move-cell-up)
  2499. (buffer-string))))
  2500. (should (equal (concat "| a | f |\n"
  2501. "|---+---|\n"
  2502. "| c | b |\n"
  2503. "| e | d |\n")
  2504. (org-test-with-temp-text
  2505. (concat "| a | b |\n"
  2506. "|---+---|\n"
  2507. "| c | d |\n"
  2508. "| e | <point>f |\n")
  2509. (org-table-move-cell-up)
  2510. (org-table-move-cell-up)
  2511. (buffer-string))))
  2512. (should (equal (concat "| a | b |\n"
  2513. "|---+---|\n"
  2514. "| c | f |\n"
  2515. "| e | d |\n")
  2516. (org-test-with-temp-text
  2517. (concat "| a | b |\n"
  2518. "|---+---|\n"
  2519. "| c | d |\n"
  2520. "| e | <point>f |\n")
  2521. (org-table-move-cell-up)
  2522. (buffer-string))))
  2523. ;; Move single cell even without a final newline.
  2524. (should (equal (concat "| a | f |\n"
  2525. "|---+---|\n"
  2526. "| c | b |\n"
  2527. "| e | d |\n")
  2528. (org-test-with-temp-text
  2529. (concat "| a | b |\n"
  2530. "|---+---|\n"
  2531. "| c | d |\n"
  2532. "| e | <point>f |")
  2533. (org-table-move-cell-up)
  2534. (org-table-move-cell-up)
  2535. (buffer-string)))))
  2536. (ert-deftest test-org-table/move-cell-right ()
  2537. "Test `org-table-move-cell-right' specifications."
  2538. ;; Error out when cell cannot be moved due to not in table, in the
  2539. ;; last col of the table, or is on a hline.
  2540. (should-error
  2541. (org-test-with-temp-text "not in\na table\n"
  2542. (org-table-move-cell-right)))
  2543. (should-error
  2544. (org-test-with-temp-text "| a |"
  2545. (org-table-move-cell-right)))
  2546. (should-error
  2547. (org-test-with-temp-text "| a |\n"
  2548. (org-table-move-cell-right)))
  2549. (should-error
  2550. (org-test-with-temp-text "| <point>a |\n| b |\n"
  2551. (org-table-move-cell-right)))
  2552. (should-error
  2553. (org-test-with-temp-text "| a | <point>b |\n| c | d |\n"
  2554. (org-table-move-cell-right)))
  2555. (should-error
  2556. (org-test-with-temp-text "| <point>a |\n|---|\n"
  2557. (org-table-move-cell-right)))
  2558. (should-error
  2559. (org-test-with-temp-text "|<point>---|\n| a |\n"
  2560. (org-table-move-cell-right)))
  2561. ;; Check for correct cell movement.
  2562. (should (equal (concat "| b | a | c |\n"
  2563. "| d | e | f |\n")
  2564. (org-test-with-temp-text
  2565. (concat "| <point>a | b | c |\n"
  2566. "| d | e | f |\n")
  2567. (org-table-move-cell-right)
  2568. (buffer-string))))
  2569. (should (equal (concat "| b | c | a |\n"
  2570. "| d | e | f |\n")
  2571. (org-test-with-temp-text
  2572. (concat "| <point>a | b | c |\n"
  2573. "| d | e | f |\n")
  2574. (org-table-move-cell-right)
  2575. (org-table-move-cell-right)
  2576. (buffer-string))))
  2577. (should (equal (concat "| a | b | c |\n"
  2578. "| e | f | d |\n")
  2579. (org-test-with-temp-text
  2580. (concat "| a | b | c |\n"
  2581. "| <point> d | e | f |\n")
  2582. (org-table-move-cell-right)
  2583. (org-table-move-cell-right)
  2584. (buffer-string))))
  2585. (should (equal (concat "| a | b | c |\n"
  2586. "| d | f | e |\n")
  2587. (org-test-with-temp-text
  2588. (concat "| a | b | c |\n"
  2589. "| d | <point>e | f |\n")
  2590. (org-table-move-cell-right)
  2591. (buffer-string))))
  2592. (should (equal (concat "| a | b | c |\n"
  2593. "|---+---+---|\n"
  2594. "| e | f | d |\n")
  2595. (org-test-with-temp-text
  2596. (concat "| a | b | c |\n"
  2597. "|---+---+---|\n"
  2598. "| <point>d | e | f |\n")
  2599. (org-table-move-cell-right)
  2600. (org-table-move-cell-right)
  2601. (buffer-string))))
  2602. ;; Move single cell even without a final newline.
  2603. (should (equal (concat "| a | b | c |\n"
  2604. "|---+---+---|\n"
  2605. "| e | d | f |\n")
  2606. (org-test-with-temp-text
  2607. (concat "| a | b | c |\n"
  2608. "|---+---+---|\n"
  2609. "| <point>d | e | f |")
  2610. (org-table-move-cell-right)
  2611. (buffer-string)))))
  2612. (ert-deftest test-org-table/move-cell-left ()
  2613. "Test `org-table-move-cell-left' specifications."
  2614. ;; Error out when cell cannot be moved due to not in table, in the
  2615. ;; last col of the table, or is on a hline.
  2616. (should-error
  2617. (org-test-with-temp-text "not in\na table\n"
  2618. (org-table-move-cell-left)))
  2619. (should-error
  2620. (org-test-with-temp-text "| a |"
  2621. (org-table-move-cell-left)))
  2622. (should-error
  2623. (org-test-with-temp-text "| a |\n"
  2624. (org-table-move-cell-left)))
  2625. (should-error
  2626. (org-test-with-temp-text "| <point>a |\n| b |\n"
  2627. (org-table-move-cell-left)))
  2628. (should-error
  2629. (org-test-with-temp-text "| <point>a | b |\n| c | d |\n"
  2630. (org-table-move-cell-left)))
  2631. (should-error
  2632. (org-test-with-temp-text "| <point>a |\n|---|\n"
  2633. (org-table-move-cell-left)))
  2634. (should-error
  2635. (org-test-with-temp-text "|<point>---|\n| a |\n"
  2636. (org-table-move-cell-left)))
  2637. ;; Check for correct cell movement.
  2638. (should (equal (concat "| b | a | c |\n"
  2639. "| d | e | f |\n")
  2640. (org-test-with-temp-text
  2641. (concat "| a | <point>b | c |\n"
  2642. "| d | e | f |\n")
  2643. (org-table-move-cell-left)
  2644. (buffer-string))))
  2645. (should (equal (concat "| c | a | b |\n"
  2646. "| d | e | f |\n")
  2647. (org-test-with-temp-text
  2648. (concat "| a | b | <point>c |\n"
  2649. "| d | e | f |\n")
  2650. (org-table-move-cell-left)
  2651. (org-table-move-cell-left)
  2652. (buffer-string))))
  2653. (should (equal (concat "| a | b | c |\n"
  2654. "| f | d | e |\n")
  2655. (org-test-with-temp-text
  2656. (concat "| a | b | c |\n"
  2657. "| d | e | <point>f |\n")
  2658. (org-table-move-cell-left)
  2659. (org-table-move-cell-left)
  2660. (buffer-string))))
  2661. (should (equal (concat "| a | b | c |\n"
  2662. "| d | f | e |\n")
  2663. (org-test-with-temp-text
  2664. (concat "| a | b | c |\n"
  2665. "| d | e | <point>f |\n")
  2666. (org-table-move-cell-left)
  2667. (buffer-string))))
  2668. (should (equal (concat "| a | b | c |\n"
  2669. "|---+---+---|\n"
  2670. "| f | d | e |\n")
  2671. (org-test-with-temp-text
  2672. (concat "| a | b | c |\n"
  2673. "|---+---+---|\n"
  2674. "| d | e | <point>f |\n")
  2675. (org-table-move-cell-left)
  2676. (org-table-move-cell-left)
  2677. (buffer-string))))
  2678. ;; Move single cell even without a final newline.
  2679. (should (equal (concat "| a | b | c |\n"
  2680. "|---+---+---|\n"
  2681. "| e | d | f |\n")
  2682. (org-test-with-temp-text
  2683. (concat "| a | b | c |\n"
  2684. "|---+---+---|\n"
  2685. "| d | <point>e | f |")
  2686. (org-table-move-cell-left)
  2687. (buffer-string)))))
  2688. ;;; Moving rows, moving columns
  2689. (ert-deftest test-org-table/move-row-down ()
  2690. "Test `org-table-move-row-down' specifications."
  2691. ;; Error out when row cannot be moved, e.g., it is the last row in
  2692. ;; the table.
  2693. (should-error
  2694. (org-test-with-temp-text "| a |"
  2695. (org-table-move-row-down)))
  2696. (should-error
  2697. (org-test-with-temp-text "| a |\n"
  2698. (org-table-move-row-down)))
  2699. (should-error
  2700. (org-test-with-temp-text "| a |\n| <point>b |"
  2701. (org-table-move-row-down)))
  2702. ;; Move data lines.
  2703. (should
  2704. (equal "| b |\n| a |\n"
  2705. (org-test-with-temp-text "| a |\n| b |\n"
  2706. (org-table-move-row-down)
  2707. (buffer-string))))
  2708. (should
  2709. (equal "|---|\n| a |\n"
  2710. (org-test-with-temp-text "| a |\n|---|\n"
  2711. (org-table-move-row-down)
  2712. (buffer-string))))
  2713. ;; Move hlines.
  2714. (should
  2715. (equal "| b |\n|---|\n"
  2716. (org-test-with-temp-text "|---|\n| b |\n"
  2717. (org-table-move-row-down)
  2718. (buffer-string))))
  2719. (should
  2720. (equal "|---|\n|---|\n"
  2721. (org-test-with-temp-text "|---|\n|---|\n"
  2722. (org-table-move-row-down)
  2723. (buffer-string))))
  2724. ;; Move rows even without a final newline.
  2725. (should
  2726. (equal "| b |\n| a |\n"
  2727. (org-test-with-temp-text "| a |\n| b |"
  2728. (org-table-move-row-down)
  2729. (buffer-string)))))
  2730. (ert-deftest test-org-table/move-row-up ()
  2731. "Test `org-table-move-row-up' specifications."
  2732. ;; Error out when row cannot be moved, e.g., it is the first row in
  2733. ;; the table.
  2734. (should-error
  2735. (org-test-with-temp-text "| a |"
  2736. (org-table-move-row-up)))
  2737. (should-error
  2738. (org-test-with-temp-text "| a |\n"
  2739. (org-table-move-row-up)))
  2740. ;; Move data lines.
  2741. (should
  2742. (equal "| b |\n| a |\n"
  2743. (org-test-with-temp-text "| a |\n| <point>b |\n"
  2744. (org-table-move-row-up)
  2745. (buffer-string))))
  2746. (should
  2747. (equal "| b |\n|---|\n"
  2748. (org-test-with-temp-text "|---|\n| <point>b |\n"
  2749. (org-table-move-row-up)
  2750. (buffer-string))))
  2751. ;; Move hlines.
  2752. (should
  2753. (equal "|---|\n| a |\n"
  2754. (org-test-with-temp-text "| a |\n|<point>---|\n"
  2755. (org-table-move-row-up)
  2756. (buffer-string))))
  2757. (should
  2758. (equal "|---|\n|---|\n"
  2759. (org-test-with-temp-text "|---|\n|<point>---|\n"
  2760. (org-table-move-row-up)
  2761. (buffer-string))))
  2762. ;; Move rows even without a final newline.
  2763. (should
  2764. (equal "| b |\n| a |\n"
  2765. (org-test-with-temp-text "| a |\n| <point>b |"
  2766. (org-table-move-row-up)
  2767. (buffer-string)))))
  2768. ;;; Shrunk columns
  2769. (ert-deftest test-org-table/toggle-column-width ()
  2770. "Test `org-table-toggle-columns-width' specifications."
  2771. ;; Error when not at a column.
  2772. (should-error
  2773. (org-test-with-temp-text "<point>a"
  2774. (org-table-toggle-column-width)))
  2775. ;; A shrunk column is overlaid with
  2776. ;; `org-table-shrunk-column-indicator'.
  2777. (should
  2778. (equal org-table-shrunk-column-indicator
  2779. (org-test-with-temp-text "| <point>a |"
  2780. (org-table-toggle-column-width)
  2781. (overlay-get (car (overlays-at (point))) 'display))))
  2782. (should
  2783. (equal org-table-shrunk-column-indicator
  2784. (org-test-with-temp-text "| a |\n|-<point>--|"
  2785. (org-table-toggle-column-width)
  2786. (overlay-get (car (overlays-at (point))) 'display))))
  2787. ;; Shrink every field in the same column.
  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 (1+ (line-beginning-position 0))))
  2793. 'display))))
  2794. ;; When column is already shrunk, expand it, i.e., remove overlays.
  2795. (should-not
  2796. (org-test-with-temp-text "| <point>a |"
  2797. (org-table-toggle-column-width)
  2798. (org-table-toggle-column-width)
  2799. (overlays-in (point-min) (point-max))))
  2800. (should-not
  2801. (org-test-with-temp-text "| a |\n| <point>b |"
  2802. (org-table-toggle-column-width)
  2803. (org-table-toggle-column-width)
  2804. (overlays-in (point-min) (point-max))))
  2805. ;; With a column width cookie, limit overlay to the specified number
  2806. ;; of characters.
  2807. (should
  2808. (equal "| abc"
  2809. (org-test-with-temp-text "| <3> |\n| <point>abcd |"
  2810. (org-table-toggle-column-width)
  2811. (buffer-substring (line-beginning-position)
  2812. (overlay-start
  2813. (car (overlays-in (line-beginning-position)
  2814. (line-end-position))))))))
  2815. (should
  2816. (equal "| a "
  2817. (org-test-with-temp-text "| <3> |\n| <point>a |"
  2818. (org-table-toggle-column-width)
  2819. (buffer-substring (line-beginning-position)
  2820. (overlay-start
  2821. (car (overlays-in (line-beginning-position)
  2822. (line-end-position))))))))
  2823. (should
  2824. (equal (concat "----" org-table-shrunk-column-indicator)
  2825. (org-test-with-temp-text "| <3> |\n|--<point>----|"
  2826. (org-table-toggle-column-width)
  2827. (overlay-get
  2828. (car (overlays-in (line-beginning-position)
  2829. (line-end-position)))
  2830. 'display))))
  2831. ;; Width only takes into account visible characters.
  2832. (should
  2833. (equal "| [[http"
  2834. (org-test-with-temp-text "| <4> |\n| <point>[[http://orgmode.org]] |"
  2835. (org-table-toggle-column-width)
  2836. (buffer-substring (line-beginning-position)
  2837. (overlay-start
  2838. (car (overlays-in (line-beginning-position)
  2839. (line-end-position))))))))
  2840. ;; Before the first column or after the last one, ask for columns
  2841. ;; ranges.
  2842. (should
  2843. (catch :exit
  2844. (org-test-with-temp-text "| a |"
  2845. (cl-letf (((symbol-function 'read-string)
  2846. (lambda (&rest_) (throw :exit t))))
  2847. (org-table-toggle-column-width)
  2848. nil))))
  2849. (should
  2850. (catch :exit
  2851. (org-test-with-temp-text "| a |<point>"
  2852. (cl-letf (((symbol-function 'read-string)
  2853. (lambda (&rest_) (throw :exit t))))
  2854. (org-table-toggle-column-width)
  2855. nil))))
  2856. ;; When optional argument ARG is a string, toggle specified columns.
  2857. (should
  2858. (equal org-table-shrunk-column-indicator
  2859. (org-test-with-temp-text "| <point>a | b |"
  2860. (org-table-toggle-column-width "2")
  2861. (overlay-get (car (overlays-at (- (point-max) 2))) 'display))))
  2862. (should
  2863. (equal '("b" "c")
  2864. (org-test-with-temp-text "| a | b | c | d |"
  2865. (org-table-toggle-column-width "2-3")
  2866. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2867. (overlays-in (point-min) (point-max)))
  2868. #'string-lessp))))
  2869. (should
  2870. (equal '("b" "c" "d")
  2871. (org-test-with-temp-text "| a | b | c | d |"
  2872. (org-table-toggle-column-width "2-")
  2873. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2874. (overlays-in (point-min) (point-max)))
  2875. #'string-lessp))))
  2876. (should
  2877. (equal '("a" "b")
  2878. (org-test-with-temp-text "| a | b | c | d |"
  2879. (org-table-toggle-column-width "-2")
  2880. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2881. (overlays-in (point-min) (point-max)))
  2882. #'string-lessp))))
  2883. (should
  2884. (equal '("a" "b" "c" "d")
  2885. (org-test-with-temp-text "| a | b | c | d |"
  2886. (org-table-toggle-column-width "-")
  2887. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2888. (overlays-in (point-min) (point-max)))
  2889. #'string-lessp))))
  2890. (should
  2891. (equal '("a" "d")
  2892. (org-test-with-temp-text "| a | b | c | d |"
  2893. (org-table-toggle-column-width "1-3")
  2894. (org-table-toggle-column-width "2-4")
  2895. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2896. (overlays-in (point-min) (point-max)))
  2897. #'string-lessp))))
  2898. ;; When ARG is (16), remove any column overlay.
  2899. (should-not
  2900. (org-test-with-temp-text "| <point>a |"
  2901. (org-table-toggle-column-width)
  2902. (org-table-toggle-column-width '(16))
  2903. (overlays-in (point-min) (point-max))))
  2904. (should-not
  2905. (org-test-with-temp-text "| a | b | c | d |"
  2906. (org-table-toggle-column-width "-")
  2907. (org-table-toggle-column-width '(16))
  2908. (overlays-in (point-min) (point-max)))))
  2909. (ert-deftest test-org-table/shrunk-columns ()
  2910. "Test behaviour of shrunk column."
  2911. ;; Edition automatically expands a shrunk column.
  2912. (should-not
  2913. (org-test-with-temp-text "| <point>a |"
  2914. (org-table-toggle-column-width)
  2915. (insert "a")
  2916. (overlays-in (point-min) (point-max))))
  2917. ;; Other columns are not changed.
  2918. (should
  2919. (org-test-with-temp-text "| <point>a | b |"
  2920. (org-table-toggle-column-width "-")
  2921. (insert "a")
  2922. (overlays-in (point-min) (point-max))))
  2923. ;; Moving a shrunk column doesn't alter its state.
  2924. (should
  2925. (equal "a"
  2926. (org-test-with-temp-text "| <point>a | b |"
  2927. (org-table-toggle-column-width)
  2928. (org-table-move-column-right)
  2929. (overlay-get (car (overlays-at (point))) 'help-echo))))
  2930. (should
  2931. (equal "a"
  2932. (org-test-with-temp-text "| <point>a |\n| b |"
  2933. (org-table-toggle-column-width)
  2934. (org-table-move-row-down)
  2935. (overlay-get (car (overlays-at (point))) 'help-echo))))
  2936. ;; State is preserved upon inserting a column.
  2937. (should
  2938. (equal '("a")
  2939. (org-test-with-temp-text "| <point>a |"
  2940. (org-table-toggle-column-width)
  2941. (org-table-insert-column)
  2942. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2943. (overlays-in (point-min) (point-max)))
  2944. #'string-lessp))))
  2945. ;; State is preserved upon deleting a column.
  2946. (should
  2947. (equal '("a" "c")
  2948. (org-test-with-temp-text "| a | <point>b | c |"
  2949. (org-table-toggle-column-width "-")
  2950. (org-table-delete-column)
  2951. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2952. (overlays-in (point-min) (point-max)))
  2953. #'string-lessp))))
  2954. ;; State is preserved upon deleting a row.
  2955. (should
  2956. (equal '("b1" "b2")
  2957. (org-test-with-temp-text "| a1 | a2 |\n| b1 | b2 |"
  2958. (org-table-toggle-column-width "-")
  2959. (org-table-kill-row)
  2960. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2961. (overlays-in (point-min) (point-max)))
  2962. #'string-lessp))))
  2963. (should
  2964. (equal '("a1" "a2")
  2965. (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
  2966. (org-table-toggle-column-width "-")
  2967. (org-table-kill-row)
  2968. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2969. (overlays-in (point-min) (point-max)))
  2970. #'string-lessp))))
  2971. ;; State is preserved upon inserting a row or hline.
  2972. (should
  2973. (equal '("" "a1" "b1")
  2974. (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
  2975. (org-table-toggle-column-width)
  2976. (org-table-insert-row)
  2977. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2978. (overlays-in (point-min) (point-max)))
  2979. #'string-lessp))))
  2980. (should
  2981. (equal '("a1" "b1")
  2982. (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
  2983. (org-table-toggle-column-width)
  2984. (org-table-insert-hline)
  2985. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2986. (overlays-in (point-min) (point-max)))
  2987. #'string-lessp))))
  2988. ;; State is preserved upon sorting a column for all the columns but
  2989. ;; the one being sorted.
  2990. (should
  2991. (equal '("a2" "b2")
  2992. (org-test-with-temp-text "| <point>a1 | a2 |\n| <point>b1 | b2 |"
  2993. (org-table-toggle-column-width "-")
  2994. (org-table-sort-lines nil ?A)
  2995. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2996. (overlays-in (point-min) (point-max)))
  2997. #'string-lessp))))
  2998. ;; State is preserved upon replacing a field non-interactively.
  2999. (should
  3000. (equal '("a")
  3001. (org-test-with-temp-text "| <point>a |"
  3002. (org-table-toggle-column-width)
  3003. (org-table-get-field nil "b")
  3004. (mapcar (lambda (o) (overlay-get o 'help-echo))
  3005. (overlays-in (point-min) (point-max))))))
  3006. ;; Moving to next field doesn't change shrunk state.
  3007. (should
  3008. (equal "a"
  3009. (org-test-with-temp-text "| <point>a | b |"
  3010. (org-table-toggle-column-width)
  3011. (org-table-next-field)
  3012. (overlay-get (car (overlays-at (1+ (line-beginning-position))))
  3013. 'help-echo))))
  3014. (should
  3015. (equal "b"
  3016. (org-test-with-temp-text "| a | <point>b |"
  3017. (org-table-toggle-column-width)
  3018. (goto-char 2)
  3019. (org-table-next-field)
  3020. (overlay-get (car (overlays-at (point))) 'help-echo))))
  3021. ;; Aligning table doesn't alter shrunk state.
  3022. (should
  3023. (equal "a"
  3024. (org-test-with-temp-text "| <point>a | b |"
  3025. (org-table-toggle-column-width)
  3026. (org-table-align)
  3027. (overlay-get (car (overlays-at (1+ (line-beginning-position))))
  3028. 'help-echo))))
  3029. (should
  3030. (equal "b"
  3031. (org-test-with-temp-text "|---+-----|\n| a | <point>b |"
  3032. (org-table-toggle-column-width)
  3033. (org-table-align)
  3034. (overlay-get (car (overlays-at (point)))
  3035. 'help-echo))))
  3036. (should
  3037. (equal
  3038. '("b")
  3039. (org-test-with-temp-text "|---+-----|\n| a | <point>b |"
  3040. (org-table-toggle-column-width)
  3041. (org-table-align)
  3042. (mapcar (lambda (o) (overlay-get o 'help-echo))
  3043. (overlays-in (line-beginning-position) (line-end-position))))))
  3044. ;; Recalculating formulas doesn't change shrunk state.
  3045. (should
  3046. (equal "2"
  3047. (org-test-with-temp-text "| 1 | <point>0 |\n#+TBLFM: $2=$1+1\n"
  3048. (org-table-toggle-column-width)
  3049. (org-table-recalculate)
  3050. (overlay-get (car (overlays-at (point))) 'help-echo)))))
  3051. ;;; Miscellaneous
  3052. (ert-deftest test-org-table/current-column ()
  3053. "Test `org-table-current-column' specifications."
  3054. (should
  3055. (= 1 (org-test-with-temp-text "| <point>a |"
  3056. (org-table-current-column))))
  3057. (should
  3058. (= 1 (org-test-with-temp-text "|-<point>--|"
  3059. (org-table-current-column))))
  3060. (should
  3061. (= 2 (org-test-with-temp-text "| 1 | <point>2 |"
  3062. (org-table-current-column))))
  3063. (should
  3064. (= 2 (org-test-with-temp-text "|---+-<point>--|"
  3065. (org-table-current-column)))))
  3066. (ert-deftest test-org-table/get-field ()
  3067. "Test `org-table-get-field' specifications."
  3068. ;; Regular test.
  3069. (should
  3070. (equal " a "
  3071. (org-test-with-temp-text "| <point>a |" (org-table-get-field))))
  3072. ;; Get field in open last column.
  3073. (should
  3074. (equal " a "
  3075. (org-test-with-temp-text "| <point>a " (org-table-get-field))))
  3076. ;; Get empty field.
  3077. (should
  3078. (equal ""
  3079. (org-test-with-temp-text "|<point>|" (org-table-get-field))))
  3080. (should
  3081. (equal " "
  3082. (org-test-with-temp-text "| <point>|" (org-table-get-field))))
  3083. ;; Outside the table, return the empty string.
  3084. (should
  3085. (equal ""
  3086. (org-test-with-temp-text "<point>| a |" (org-table-get-field))))
  3087. (should
  3088. (equal ""
  3089. (org-test-with-temp-text "| a |<point>" (org-table-get-field))))
  3090. ;; With optional N argument, select a particular column in current
  3091. ;; row.
  3092. (should
  3093. (equal " 3 "
  3094. (org-test-with-temp-text "| 1 | 2 | 3 |" (org-table-get-field 3))))
  3095. (should
  3096. (equal " 4 "
  3097. (org-test-with-temp-text "| 1 | 2 |\n<point>| 3 | 4 |"
  3098. (org-table-get-field 2))))
  3099. ;; REPLACE optional argument is used to replace selected field.
  3100. (should
  3101. (equal "| foo |"
  3102. (org-test-with-temp-text "| <point>1 |"
  3103. (org-table-get-field nil " foo ")
  3104. (buffer-string))))
  3105. (should
  3106. (equal "| 1 | 2 | foo |"
  3107. (org-test-with-temp-text "| 1 | 2 | 3 |"
  3108. (org-table-get-field 3 " foo ")
  3109. (buffer-string))))
  3110. (should
  3111. (equal " 4 "
  3112. (org-test-with-temp-text "| 1 | 2 |\n<point>| 3 | 4 |"
  3113. (org-table-get-field 2))))
  3114. ;; An empty REPLACE string clears the field.
  3115. (should
  3116. (equal "| |"
  3117. (org-test-with-temp-text "| <point>1 |"
  3118. (org-table-get-field nil "")
  3119. (buffer-string))))
  3120. ;; When using REPLACE still return old value.
  3121. (should
  3122. (equal " 1 "
  3123. (org-test-with-temp-text "| <point>1 |"
  3124. (org-table-get-field nil " foo ")))))
  3125. (provide 'test-org-table)
  3126. ;;; test-org-table.el ends here