test-org-table.el 104 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359
  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. ;;; Tables as Lisp
  1219. (ert-deftest test-org-table/to-lisp ()
  1220. "Test `orgtbl-to-lisp' specifications."
  1221. ;; 2x2 no header
  1222. (should
  1223. (equal '(("a" "b") ("c" "d"))
  1224. (org-table-to-lisp "|a|b|\n|c|d|")))
  1225. ;; 2x2 with 1-line header
  1226. (should
  1227. (equal '(("a" "b") hline ("c" "d"))
  1228. (org-table-to-lisp "|a|b|\n|-\n|c|d|")))
  1229. ;; 2x4 with 2-line header
  1230. (should
  1231. (equal '(("a" "b") ("A" "B") hline ("c" "d") ("aa" "bb"))
  1232. (org-table-to-lisp "|a|b|\n|A|B|\n|-\n|c|d|\n|aa|bb|")))
  1233. ;; leading hlines do not get stripped
  1234. (should
  1235. (equal '(hline ("a" "b") hline ("c" "d"))
  1236. (org-table-to-lisp "|-\n|a|b|\n|-\n|c|d|")))
  1237. (should
  1238. (equal '(hline ("a" "b") ("c" "d"))
  1239. (org-table-to-lisp "|-\n|a|b|\n|c|d|")))
  1240. (should
  1241. (equal '(hline hline hline hline ("a" "b") ("c" "d"))
  1242. (org-table-to-lisp "|-\n|-\n|-\n|-\n|a|b|\n|c|d|"))))
  1243. (ert-deftest test-org-table/collapse-header ()
  1244. "Test `orgtbl-to-lisp' specifications."
  1245. ;; 2x2 no header - no collapsing
  1246. (should
  1247. (equal '(("a" "b") ("c" "d"))
  1248. (org-table-collapse-header (org-table-to-lisp "|a|b|\n|c|d|"))))
  1249. ;; 2x2 with 1-line header - no collapsing
  1250. (should
  1251. (equal '(("a" "b") hline ("c" "d"))
  1252. (org-table-collapse-header (org-table-to-lisp "|a|b|\n|-\n|c|d|"))))
  1253. ;; 2x4 with 2-line header - collapsed
  1254. (should
  1255. (equal '(("a A" "b B") hline ("c" "d") ("aa" "bb"))
  1256. (org-table-collapse-header (org-table-to-lisp "|a|b|\n|A|B|\n|-\n|c|d|\n|aa|bb|"))))
  1257. ;; 2x4 with 2-line header, custom glue - collapsed
  1258. (should
  1259. (equal '(("a.A" "b.B") hline ("c" "d") ("aa" "bb"))
  1260. (org-table-collapse-header (org-table-to-lisp "|a|b|\n|A|B|\n|-\n|c|d|\n|aa|bb|") ".")))
  1261. ;; 2x4 with 2-line header, threshold 1 - not collapsed
  1262. (should
  1263. (equal '(("a" "b") ("A" "B") hline ("c" "d") ("aa" "bb"))
  1264. (org-table-collapse-header (org-table-to-lisp "|a|b|\n|A|B|\n|-\n|c|d|\n|aa|bb|") nil 1)))
  1265. ;; 2x4 with 2-line header, threshold 2 - collapsed
  1266. (should
  1267. (equal '(("a A" "b B") hline ("c" "d") ("aa" "bb"))
  1268. (org-table-collapse-header (org-table-to-lisp "|a|b|\n|A|B|\n|-\n|c|d|\n|aa|bb|") nil 2)))
  1269. ;; 2x8 with 6-line header, default threshold 5 - not collapsed
  1270. (should
  1271. (equal '(("a" "b") ("A" "B") ("a" "b") ("A" "B") ("a" "b") ("A" "B") hline ("c" "d") ("aa" "bb"))
  1272. (org-table-collapse-header (org-table-to-lisp "|a|b|\n|A|B|\n|a|b|\n|A|B|\n|a|b|\n|A|B|\n|-\n|c|d|\n|aa|bb|")))))
  1273. ;;; Radio Tables
  1274. (ert-deftest test-org-table/to-generic ()
  1275. "Test `orgtbl-to-generic' specifications."
  1276. ;; Test :hline parameter.
  1277. (should
  1278. (equal "a\nb"
  1279. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1280. '(:hline nil))))
  1281. (should
  1282. (equal "a\n~\nb"
  1283. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1284. '(:hline "~"))))
  1285. ;; Test :sep parameter.
  1286. (should
  1287. (equal "a!b\nc!d"
  1288. (orgtbl-to-generic
  1289. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1290. '(:sep "!"))))
  1291. ;; Test :hsep parameter.
  1292. (should
  1293. (equal "a!b\nc?d"
  1294. (orgtbl-to-generic
  1295. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1296. '(:sep "?" :hsep "!"))))
  1297. ;; Test :tstart parameter.
  1298. (should
  1299. (equal "<begin>\na"
  1300. (orgtbl-to-generic (org-table-to-lisp "| a |") '(:tstart "<begin>"))))
  1301. (should
  1302. (equal "<begin>\na"
  1303. (orgtbl-to-generic (org-table-to-lisp "| a |")
  1304. '(:tstart (lambda () "<begin>")))))
  1305. (should
  1306. (equal "a"
  1307. (orgtbl-to-generic (org-table-to-lisp "| a |")
  1308. '(:tstart "<begin>" :splice t))))
  1309. ;; Test :tend parameter.
  1310. (should
  1311. (equal "a\n<end>"
  1312. (orgtbl-to-generic (org-table-to-lisp "| a |") '(:tend "<end>"))))
  1313. (should
  1314. (equal "a\n<end>"
  1315. (orgtbl-to-generic (org-table-to-lisp "| a |")
  1316. '(:tend (lambda () "<end>")))))
  1317. (should
  1318. (equal "a"
  1319. (orgtbl-to-generic (org-table-to-lisp "| a |")
  1320. '(:tend "<end>" :splice t))))
  1321. ;; Test :lstart parameter.
  1322. (should
  1323. (equal "> a"
  1324. (orgtbl-to-generic
  1325. (org-table-to-lisp "| a |") '(:lstart "> "))))
  1326. (should
  1327. (equal "> a"
  1328. (orgtbl-to-generic (org-table-to-lisp "| a |")
  1329. '(:lstart (lambda () "> ")))))
  1330. ;; Test :llstart parameter.
  1331. (should
  1332. (equal "> a\n>> b"
  1333. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1334. '(:lstart "> " :llstart ">> "))))
  1335. ;; Test :hlstart parameter.
  1336. (should
  1337. (equal "!> a\n> b"
  1338. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1339. '(:lstart "> " :hlstart "!> "))))
  1340. ;; Test :hllstart parameter.
  1341. (should
  1342. (equal "!> a\n!!> b\n> c"
  1343. (orgtbl-to-generic (org-table-to-lisp "| a |\n| b |\n|---|\n| c |")
  1344. '(:lstart "> " :hlstart "!> " :hllstart "!!> "))))
  1345. ;; Test :lend parameter.
  1346. (should
  1347. (equal "a <"
  1348. (orgtbl-to-generic (org-table-to-lisp "| a |") '(:lend " <"))))
  1349. ;; Test :llend parameter.
  1350. (should
  1351. (equal "a <\nb <<"
  1352. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1353. '(:lend " <" :llend " <<"))))
  1354. ;; Test :hlend parameter.
  1355. (should
  1356. (equal "a <!\nb <"
  1357. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1358. '(:lend " <" :hlend " <!"))))
  1359. ;; Test :hllend parameter.
  1360. (should
  1361. (equal "a <!\nb <!!\nc <"
  1362. (orgtbl-to-generic (org-table-to-lisp "| a |\n| b |\n|---|\n| c |")
  1363. '(:lend " <" :hlend " <!" :hllend " <!!"))))
  1364. ;; Test :lfmt parameter.
  1365. (should
  1366. (equal "a!b"
  1367. (orgtbl-to-generic (org-table-to-lisp "| a | b |")
  1368. '(:lfmt "%s!%s"))))
  1369. (should
  1370. (equal "a+b"
  1371. (orgtbl-to-generic
  1372. (org-table-to-lisp "| a | b |")
  1373. '(:lfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
  1374. (should
  1375. (equal "a!b"
  1376. (orgtbl-to-generic (org-table-to-lisp "| a | b |")
  1377. '(:lfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
  1378. ;; Test :llfmt parameter.
  1379. (should
  1380. (equal "a!b"
  1381. (orgtbl-to-generic (org-table-to-lisp "| a | b |")
  1382. '(:llfmt "%s!%s"))))
  1383. (should
  1384. (equal "a!b\nc+d"
  1385. (orgtbl-to-generic
  1386. (org-table-to-lisp "| a | b |\n| c | d |")
  1387. '(:lfmt "%s!%s" :llfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
  1388. (should
  1389. (equal "a!b"
  1390. (orgtbl-to-generic (org-table-to-lisp "| a | b |")
  1391. '(:llfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
  1392. ;; Test :hlfmt parameter.
  1393. (should
  1394. (equal "a!b\ncd"
  1395. (orgtbl-to-generic
  1396. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1397. '(:hlfmt "%s!%s"))))
  1398. (should
  1399. (equal "a+b\ncd"
  1400. (orgtbl-to-generic
  1401. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1402. '(:hlfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
  1403. (should
  1404. (equal "a!b\n>c d<"
  1405. (orgtbl-to-generic
  1406. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1407. '(:hlfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
  1408. ;; Test :hllfmt parameter.
  1409. (should
  1410. (equal "a!b\ncd"
  1411. (orgtbl-to-generic
  1412. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1413. '(:hllfmt "%s!%s"))))
  1414. (should
  1415. (equal "a+b\ncd"
  1416. (orgtbl-to-generic
  1417. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1418. '(:hllfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
  1419. (should
  1420. (equal "a!b\n>c d<"
  1421. (orgtbl-to-generic
  1422. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1423. '(:hllfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
  1424. ;; Test :fmt parameter.
  1425. (should
  1426. (equal ">a<\n>b<"
  1427. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1428. '(:fmt ">%s<"))))
  1429. (should
  1430. (equal ">a<b"
  1431. (orgtbl-to-generic (org-table-to-lisp "| a | b |")
  1432. '(:fmt (1 ">%s<" 2 (lambda (c) c))))))
  1433. (should
  1434. (equal "a b"
  1435. (orgtbl-to-generic (org-table-to-lisp "| a | b |")
  1436. '(:fmt (2 " %s")))))
  1437. (should
  1438. (equal ">a<"
  1439. (orgtbl-to-generic (org-table-to-lisp "| a |")
  1440. '(:fmt (lambda (c) (format ">%s<" c))))))
  1441. ;; Test :hfmt parameter.
  1442. (should
  1443. (equal ">a<\nb"
  1444. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1445. '(:hfmt ">%s<"))))
  1446. (should
  1447. (equal ">a<b\ncd"
  1448. (orgtbl-to-generic
  1449. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1450. '(:hfmt (1 ">%s<" 2 identity)))))
  1451. (should
  1452. (equal "a b\ncd"
  1453. (orgtbl-to-generic
  1454. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1455. '(:hfmt (2 " %s")))))
  1456. (should
  1457. (equal ">a<\nb"
  1458. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1459. '(:hfmt (lambda (c) (format ">%s<" c))))))
  1460. ;; Test :efmt parameter.
  1461. (should
  1462. (equal "2x10^3"
  1463. (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
  1464. '(:efmt "%sx10^%s"))))
  1465. (should
  1466. (equal "2x10^3"
  1467. (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
  1468. '(:efmt (lambda (m e) (concat m "x10^" e))))))
  1469. (should
  1470. (equal "2x10^3"
  1471. (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
  1472. '(:efmt (1 "%sx10^%s")))))
  1473. (should
  1474. (equal "2x10^3"
  1475. (orgtbl-to-generic
  1476. (org-table-to-lisp "| 2e3 |")
  1477. '(:efmt (1 (lambda (m e) (format "%sx10^%s" m e)))))))
  1478. (should
  1479. (equal "2e3"
  1480. (orgtbl-to-generic (org-table-to-lisp "| 2e3 |") '(:efmt nil))))
  1481. ;; Test :skip parameter.
  1482. (should
  1483. (equal "cd"
  1484. (orgtbl-to-generic
  1485. (org-table-to-lisp "| \ | <c> |\n| a | b |\n|---+---|\n| c | d |")
  1486. '(:skip 2))))
  1487. ;; Test :skipcols parameter.
  1488. (should
  1489. (equal "a\nc"
  1490. (orgtbl-to-generic
  1491. (org-table-to-lisp "| a | b |\n| c | d |") '(:skipcols (2)))))
  1492. (should
  1493. (equal "a\nc"
  1494. (orgtbl-to-generic
  1495. (org-table-to-lisp
  1496. "| / | <c> | <c> |\n| # | a | b |\n|---+---+---|\n| | c | d |")
  1497. '(:skipcols (2)))))
  1498. ;; Test :raw parameter.
  1499. (when (featurep 'ox-latex)
  1500. (should
  1501. (string-match-p
  1502. "/a/"
  1503. (orgtbl-to-generic (org-table-to-lisp "| /a/ | b |")
  1504. '(:backend latex :raw t)))))
  1505. ;; Hooks are ignored.
  1506. (should
  1507. (equal
  1508. "a\nb"
  1509. (let* ((fun-list (list (lambda (backend) (search-forward "a") (insert "hook"))))
  1510. (org-export-before-parsing-hook fun-list)
  1511. (org-export-before-processing-hook fun-list))
  1512. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1513. '(:hline nil)))))
  1514. ;; User-defined export filters are ignored.
  1515. (should
  1516. (equal
  1517. "a\nb"
  1518. (let ((org-export-filter-table-cell-functions (list (lambda (c b i) "filter"))))
  1519. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1520. '(:hline nil)))))
  1521. ;; Macros, even if unknown, are returned as-is.
  1522. (should
  1523. (equal "{{{macro}}}"
  1524. (orgtbl-to-generic (org-table-to-lisp "| {{{macro}}} |") nil))))
  1525. (ert-deftest test-org-table/to-latex ()
  1526. "Test `orgtbl-to-latex' specifications."
  1527. (should
  1528. (equal "\\begin{tabular}{l}\na\\\\\n\\end{tabular}"
  1529. (orgtbl-to-latex (org-table-to-lisp "| a |") nil)))
  1530. ;; Test :environment parameter.
  1531. (should
  1532. (equal "\\begin{tabularx}{l}\na\\\\\n\\end{tabularx}"
  1533. (orgtbl-to-latex (org-table-to-lisp "| a |")
  1534. '(:environment "tabularx"))))
  1535. ;; Test :booktabs parameter.
  1536. (should
  1537. (string-match-p
  1538. "\\toprule" (orgtbl-to-latex (org-table-to-lisp "| a |") '(:booktabs t))))
  1539. ;; Handle LaTeX snippets.
  1540. (should
  1541. (equal "\\begin{tabular}{l}\n\\(x\\)\\\\\n\\end{tabular}"
  1542. (orgtbl-to-latex (org-table-to-lisp "| $x$ |") nil)))
  1543. ;; Test pseudo objects and :raw parameter.
  1544. (should
  1545. (string-match-p
  1546. "\\$x\\$" (orgtbl-to-latex (org-table-to-lisp "| $x$ |") '(:raw t)))))
  1547. (ert-deftest test-org-table/to-html ()
  1548. "Test `orgtbl-to-html' specifications."
  1549. (should
  1550. (equal (orgtbl-to-html (org-table-to-lisp "| a |") nil)
  1551. "<table border=\"2\" cellspacing=\"0\" cellpadding=\"6\" rules=\"groups\" frame=\"hsides\">
  1552. <colgroup>
  1553. <col class=\"org-left\" />
  1554. </colgroup>
  1555. <tbody>
  1556. <tr>
  1557. <td class=\"org-left\">a</td>
  1558. </tr>
  1559. </tbody>
  1560. </table>"))
  1561. ;; Test :attributes parameter.
  1562. (should
  1563. (string-match-p
  1564. "<table>"
  1565. (orgtbl-to-html (org-table-to-lisp "| a |") '(:attributes nil))))
  1566. (should
  1567. (string-match-p
  1568. "<table border=\"2\">"
  1569. (orgtbl-to-html (org-table-to-lisp "| a |") '(:attributes (:border "2"))))))
  1570. (ert-deftest test-org-table/to-texinfo ()
  1571. "Test `orgtbl-to-texinfo' specifications."
  1572. (should
  1573. (equal "@multitable {a}\n@item a\n@end multitable"
  1574. (orgtbl-to-texinfo (org-table-to-lisp "| a |") nil)))
  1575. ;; Test :columns parameter.
  1576. (should
  1577. (equal "@multitable @columnfractions .4 .6\n@item a\n@tab b\n@end multitable"
  1578. (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
  1579. '(:columns ".4 .6"))))
  1580. (should
  1581. (equal "@multitable @columnfractions .4 .6\n@item a\n@tab b\n@end multitable"
  1582. (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
  1583. '(:columns "@columnfractions .4 .6"))))
  1584. (should
  1585. (equal "@multitable {xxx} {xx}\n@item a\n@tab b\n@end multitable"
  1586. (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
  1587. '(:columns "{xxx} {xx}")))))
  1588. (ert-deftest test-org-table/to-orgtbl ()
  1589. "Test `orgtbl-to-orgtbl' specifications."
  1590. (should
  1591. (equal "| a | b |\n|---+---|\n| c | d |"
  1592. (orgtbl-to-orgtbl
  1593. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |") nil))))
  1594. (ert-deftest test-org-table/to-unicode ()
  1595. "Test `orgtbl-to-unicode' specifications."
  1596. (should
  1597. (equal "━━━\n a \n━━━"
  1598. (orgtbl-to-unicode (org-table-to-lisp "| a |") nil)))
  1599. ;; Test :narrow parameter.
  1600. (should
  1601. (equal "━━━━\n => \n━━━━"
  1602. (orgtbl-to-unicode (org-table-to-lisp "| <2> |\n| xxx |")
  1603. '(:narrow t)))))
  1604. (ert-deftest test-org-table/send-region ()
  1605. "Test `orgtbl-send-table' specifications."
  1606. ;; Error when not at a table.
  1607. (should-error
  1608. (org-test-with-temp-text "Paragraph"
  1609. (orgtbl-send-table)))
  1610. ;; Error when destination is missing.
  1611. (should-error
  1612. (org-test-with-temp-text "#+ORGTBL: SEND\n<point>| a |"
  1613. (orgtbl-send-table)))
  1614. ;; Error when transformation function is not specified.
  1615. (should-error
  1616. (org-test-with-temp-text "
  1617. # BEGIN RECEIVE ORGTBL table
  1618. # END RECEIVE ORGTBL table
  1619. #+ORGTBL: SEND table
  1620. <point>| a |"
  1621. (orgtbl-send-table)))
  1622. ;; Standard test.
  1623. (should
  1624. (equal "| a |\n|---|\n| b |\n"
  1625. (org-test-with-temp-text "
  1626. # BEGIN RECEIVE ORGTBL table
  1627. # END RECEIVE ORGTBL table
  1628. #+ORGTBL: SEND table orgtbl-to-orgtbl :hlines nil
  1629. <point>| a |\n|---|\n| b |"
  1630. (orgtbl-send-table)
  1631. (goto-char (point-min))
  1632. (buffer-substring-no-properties
  1633. (search-forward "# BEGIN RECEIVE ORGTBL table\n")
  1634. (progn (search-forward "# END RECEIVE ORGTBL table")
  1635. (match-beginning 0))))))
  1636. ;; Allow multiple receiver locations.
  1637. (should
  1638. (org-test-with-temp-text "
  1639. # BEGIN RECEIVE ORGTBL table
  1640. # END RECEIVE ORGTBL table
  1641. #+ORGTBL: SEND table orgtbl-to-orgtbl :hlines nil
  1642. <point>| a |
  1643. # BEGIN RECEIVE ORGTBL table
  1644. # END RECEIVE ORGTBL table"
  1645. (orgtbl-send-table)
  1646. (goto-char (point-min))
  1647. (search-forward "| a |" nil t 3))))
  1648. ;;; Align
  1649. (ert-deftest test-org-table/align ()
  1650. "Test `org-table-align' specifications."
  1651. ;; Regular test.
  1652. (should
  1653. (equal "| a |\n"
  1654. (org-test-with-temp-text "| a |"
  1655. (org-table-align)
  1656. (buffer-string))))
  1657. ;; Preserve alignment.
  1658. (should
  1659. (equal " | a |\n"
  1660. (org-test-with-temp-text " | a |"
  1661. (org-table-align)
  1662. (buffer-string))))
  1663. ;; Handle horizontal lines.
  1664. (should
  1665. (equal "| 123 |\n|-----|\n"
  1666. (org-test-with-temp-text "| 123 |\n|-|"
  1667. (org-table-align)
  1668. (buffer-string))))
  1669. (should
  1670. (equal "| a | b |\n|---+---|\n"
  1671. (org-test-with-temp-text "| a | b |\n|-+-|"
  1672. (org-table-align)
  1673. (buffer-string))))
  1674. ;; Handle empty fields.
  1675. (should
  1676. (equal "| a | bc |\n| bcd | |\n"
  1677. (org-test-with-temp-text "| a | bc |\n| bcd | |"
  1678. (org-table-align)
  1679. (buffer-string))))
  1680. (should
  1681. (equal "| abc | bc |\n| | bcd |\n"
  1682. (org-test-with-temp-text "| abc | bc |\n| | bcd |"
  1683. (org-table-align)
  1684. (buffer-string))))
  1685. ;; Handle missing fields.
  1686. (should
  1687. (equal "| a | b |\n| c | |\n"
  1688. (org-test-with-temp-text "| a | b |\n| c |"
  1689. (org-table-align)
  1690. (buffer-string))))
  1691. (should
  1692. (equal "| a | b |\n|---+---|\n"
  1693. (org-test-with-temp-text "| a | b |\n|---|"
  1694. (org-table-align)
  1695. (buffer-string))))
  1696. ;; Alignment is done to the right when the ratio of numbers in the
  1697. ;; column is superior to `org-table-number-fraction'.
  1698. (should
  1699. (equal "| 1 |\n| 12 |\n| abc |"
  1700. (org-test-with-temp-text "| 1 |\n| 12 |\n| abc |"
  1701. (let ((org-table-number-fraction 0.5)) (org-table-align))
  1702. (buffer-string))))
  1703. (should
  1704. (equal "| 1 |\n| ab |\n| abc |"
  1705. (org-test-with-temp-text "| 1 |\n| ab |\n| abc |"
  1706. (let ((org-table-number-fraction 0.5)) (org-table-align))
  1707. (buffer-string))))
  1708. ;; Obey to alignment cookies.
  1709. (should
  1710. (equal "| <r> |\n| ab |\n| abc |"
  1711. (org-test-with-temp-text "| <r> |\n| ab |\n| abc |"
  1712. (let ((org-table-number-fraction 0.5)) (org-table-align))
  1713. (buffer-string))))
  1714. (should
  1715. (equal "| <l> |\n| 12 |\n| 123 |"
  1716. (org-test-with-temp-text "| <l> |\n| 12 |\n| 123 |"
  1717. (let ((org-table-number-fraction 0.5)) (org-table-align))
  1718. (buffer-string))))
  1719. (should
  1720. (equal "| <c> |\n| 1 |\n| 123 |"
  1721. (org-test-with-temp-text "| <c> |\n| 1 |\n| 123 |"
  1722. (let ((org-table-number-fraction 0.5)) (org-table-align))
  1723. (buffer-string))))
  1724. ;; Handle gracefully tables with only horizontal rules.
  1725. (should
  1726. (org-test-with-temp-text "|-<point>--|"
  1727. (org-table-align)
  1728. t))
  1729. (should
  1730. (org-test-with-temp-text "|-<point>--|---------|\n|---|---|-----|"
  1731. (org-table-align)
  1732. t)))
  1733. (ert-deftest test-org-table/align-buffer-tables ()
  1734. "Align all tables when updating buffer."
  1735. (let ((before "
  1736. | a b |
  1737. | c d |
  1738. ")
  1739. (after "
  1740. | a b |
  1741. | c d |
  1742. "))
  1743. (should (equal (org-test-with-temp-text before
  1744. (org-table-recalculate-buffer-tables)
  1745. (buffer-string))
  1746. after))
  1747. (should (equal (org-test-with-temp-text before
  1748. (org-table-iterate-buffer-tables)
  1749. (buffer-string))
  1750. after))))
  1751. ;;; Sorting
  1752. (ert-deftest test-org-table/sort-lines ()
  1753. "Test `org-table-sort-lines' specifications."
  1754. ;; Sort numerically.
  1755. (should
  1756. (equal "| 1 | 2 |\n| 2 | 4 |\n| 5 | 3 |\n"
  1757. (org-test-with-temp-text "| <point>1 | 2 |\n| 5 | 3 |\n| 2 | 4 |\n"
  1758. (org-table-sort-lines nil ?n)
  1759. (buffer-string))))
  1760. (should
  1761. (equal "| 5 | 3 |\n| 2 | 4 |\n| 1 | 2 |\n"
  1762. (org-test-with-temp-text "| <point>1 | 2 |\n| 5 | 3 |\n| 2 | 4 |\n"
  1763. (org-table-sort-lines nil ?N)
  1764. (buffer-string))))
  1765. ;; Sort alphabetically. Enforce the C locale for consistent results.
  1766. (let ((original-string-collate-lessp (symbol-function 'string-collate-lessp)))
  1767. (cl-letf (((symbol-function 'string-collate-lessp)
  1768. (lambda (s1 s2 &optional locale ignore-case)
  1769. (funcall original-string-collate-lessp
  1770. s1 s2 "C" ignore-case))))
  1771. (should
  1772. (equal "| a | x |\n| B | 4 |\n| c | 3 |\n"
  1773. (org-test-with-temp-text "| <point>a | x |\n| c | 3 |\n| B | 4 |\n"
  1774. (org-table-sort-lines nil ?a)
  1775. (buffer-string))))
  1776. (should
  1777. (equal "| c | 3 |\n| B | 4 |\n| a | x |\n"
  1778. (org-test-with-temp-text "| <point>a | x |\n| c | 3 |\n| B | 4 |\n"
  1779. (org-table-sort-lines nil ?A)
  1780. (buffer-string))))
  1781. ;; Sort alphabetically with case.
  1782. (should
  1783. (equal "| C |\n| a |\n| b |\n"
  1784. (org-test-with-temp-text "| <point>a |\n| C |\n| b |\n"
  1785. (org-table-sort-lines t ?a)
  1786. (buffer-string))))
  1787. (should
  1788. (equal "| C |\n| b |\n| a |\n"
  1789. (org-test-with-temp-text "| <point>a |\n| C |\n| b |\n"
  1790. (org-table-sort-lines nil ?A)
  1791. (buffer-string))))))
  1792. ;; Sort by time (timestamps)
  1793. (should
  1794. (equal
  1795. "| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n| <2014-03-04 tue.> |\n"
  1796. (org-test-with-temp-text
  1797. "| <2014-03-04 tue.> |\n| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n"
  1798. (org-table-sort-lines nil ?t)
  1799. (buffer-string))))
  1800. (should
  1801. (equal
  1802. "| <2014-03-04 tue.> |\n| <2012-03-29 thu.> |\n| <2008-08-08 sat.> |\n"
  1803. (org-test-with-temp-text
  1804. "| <2014-03-04 tue.> |\n| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n"
  1805. (org-table-sort-lines nil ?T)
  1806. (buffer-string))))
  1807. ;; Sort by time (HH:MM values)
  1808. (should
  1809. (equal "| 1:00 |\n| 17:00 |\n| 114:00 |\n"
  1810. (org-test-with-temp-text "| 114:00 |\n| 17:00 |\n| 1:00 |\n"
  1811. (org-table-sort-lines nil ?t)
  1812. (buffer-string))))
  1813. (should
  1814. (equal "| 114:00 |\n| 17:00 |\n| 1:00 |\n"
  1815. (org-test-with-temp-text "| 114:00 |\n| 17:00 |\n| 1:00 |\n"
  1816. (org-table-sort-lines nil ?T)
  1817. (buffer-string))))
  1818. ;; Sort by time (durations)
  1819. (should
  1820. (equal "| 1d 3:00 |\n| 28:00 |\n"
  1821. (org-test-with-temp-text "| 28:00 |\n| 1d 3:00 |\n"
  1822. (org-table-sort-lines nil ?t)
  1823. (buffer-string))))
  1824. ;; Sort with custom functions.
  1825. (should
  1826. (equal "| 22 |\n| 15 |\n| 18 |\n"
  1827. (org-test-with-temp-text "| 15 |\n| 22 |\n| 18 |\n"
  1828. (org-table-sort-lines nil ?f
  1829. (lambda (s) (% (string-to-number s) 10))
  1830. #'<)
  1831. (buffer-string))))
  1832. (should
  1833. (equal "| 18 |\n| 15 |\n| 22 |\n"
  1834. (org-test-with-temp-text "| 15 |\n| 22 |\n| 18 |\n"
  1835. (org-table-sort-lines nil ?F
  1836. (lambda (s) (% (string-to-number s) 10))
  1837. #'<)
  1838. (buffer-string))))
  1839. ;; Sort according to current column.
  1840. (should
  1841. (equal "| 1 | 2 |\n| 7 | 3 |\n| 5 | 4 |\n"
  1842. (org-test-with-temp-text "| 1 | <point>2 |\n| 5 | 4 |\n| 7 | 3 |\n"
  1843. (org-table-sort-lines nil ?n)
  1844. (buffer-string))))
  1845. ;; Sort between horizontal separators if possible.
  1846. (should
  1847. (equal
  1848. "| 9 | 8 |\n|---+---|\n| 5 | 3 |\n| 7 | 4 |\n|---+---|\n| 1 | 2 |\n"
  1849. (org-test-with-temp-text
  1850. "| 9 | 8 |\n|---+---|\n| <point>7 | 4 |\n| 5 | 3 |\n|---+---|\n| 1 | 2 |\n"
  1851. (org-table-sort-lines nil ?n)
  1852. (buffer-string)))))
  1853. ;;; Formulas
  1854. (ert-deftest test-org-table/eval-formula ()
  1855. "Test `org-table-eval-formula' specifications."
  1856. ;; Error when not on a table field.
  1857. (should-error
  1858. (org-test-with-temp-text "Text"
  1859. (org-table-eval-formula)))
  1860. (should-error
  1861. (org-test-with-temp-text "| a |\n|---|<point>"
  1862. (org-table-eval-formula)))
  1863. (should-error
  1864. (org-test-with-temp-text "| a |\n#+TBLFM:<point>"
  1865. (org-table-eval-formula)))
  1866. ;; Handle @<, @>, $< and $>.
  1867. (should
  1868. (equal "| 1 |\n| 1 |"
  1869. (org-test-with-temp-text "| <point> |\n| 1 |"
  1870. (org-table-eval-formula nil "@>" nil nil t)
  1871. (buffer-string))))
  1872. (should
  1873. (equal "| 1 |\n| 1 |"
  1874. (org-test-with-temp-text "| 1 |\n| <point> |"
  1875. (org-table-eval-formula nil "@<" nil nil t)
  1876. (buffer-string))))
  1877. (should
  1878. (equal "| 1 | 1 |"
  1879. (org-test-with-temp-text "| <point> | 1 |"
  1880. (org-table-eval-formula nil "$>" nil nil t)
  1881. (buffer-string))))
  1882. (should
  1883. (equal "| 1 | 1 |"
  1884. (org-test-with-temp-text "| 1 | <point> |"
  1885. (org-table-eval-formula nil "$<" nil nil t)
  1886. (buffer-string)))))
  1887. (ert-deftest test-org-table/field-formula-outside-table ()
  1888. "Test `org-table-formula-create-columns' variable."
  1889. ;; Refuse to create column if variable is nil.
  1890. (should-error
  1891. (org-test-with-temp-text "
  1892. | 2 |
  1893. | 4 |
  1894. | 8 |
  1895. <point>#+TBLFM: @1$2=5"
  1896. (let ((org-table-formula-create-columns nil))
  1897. (org-table-calc-current-TBLFM))
  1898. (buffer-string))
  1899. :type (list 'error 'user-error))
  1900. ;; If the variable is non-nil, field formulas and columns formulas
  1901. ;; can create tables.
  1902. (should
  1903. (equal
  1904. "
  1905. | 2 | 5 |
  1906. | 4 | |
  1907. | 8 | |
  1908. #+TBLFM: @1$2=5"
  1909. (org-test-with-temp-text "
  1910. | 2 |
  1911. | 4 |
  1912. | 8 |
  1913. <point>#+TBLFM: @1$2=5"
  1914. (let ((org-table-formula-create-columns t))
  1915. (org-table-calc-current-TBLFM))
  1916. (buffer-string))))
  1917. (should
  1918. (equal
  1919. "
  1920. | 2 | | 15 |
  1921. | 4 | | 15 |
  1922. | 8 | | 15 |
  1923. #+TBLFM: $3=15"
  1924. (org-test-with-temp-text "
  1925. | 2 |
  1926. | 4 |
  1927. | 8 |
  1928. <point>#+TBLFM: $3=15"
  1929. (let ((org-table-formula-create-columns t))
  1930. (org-table-calc-current-TBLFM))
  1931. (buffer-string)))))
  1932. (ert-deftest test-org-table/duration ()
  1933. "Test durations in table formulas."
  1934. ;; Durations in cells.
  1935. (should
  1936. (string-match "| 2:12 | 1:47 | 03:59:00 |"
  1937. (org-test-with-temp-text "
  1938. | 2:12 | 1:47 | |
  1939. <point>#+TBLFM: @1$3=$1+$2;T"
  1940. (org-table-calc-current-TBLFM)
  1941. (buffer-string))))
  1942. (should
  1943. (string-match "| 2:12 | 1:47 | 03:59 |"
  1944. (org-test-with-temp-text "
  1945. | 2:12 | 1:47 | |
  1946. <point>#+TBLFM: @1$3=$1+$2;U"
  1947. (org-table-calc-current-TBLFM)
  1948. (buffer-string))))
  1949. (should
  1950. (string-match "| 3:02:20 | -2:07:00 | 0.92 |"
  1951. (org-test-with-temp-text "
  1952. | 3:02:20 | -2:07:00 | |
  1953. <point>#+TBLFM: @1$3=$1+$2;t"
  1954. (org-table-calc-current-TBLFM)
  1955. (buffer-string))))
  1956. ;; Durations set through properties.
  1957. (should
  1958. (string-match "| 16:00:00 |"
  1959. (org-test-with-temp-text "* H
  1960. :PROPERTIES:
  1961. :time_constant: 08:00:00
  1962. :END:
  1963. | |
  1964. <point>#+TBLFM: $1=2*$PROP_time_constant;T"
  1965. (org-table-calc-current-TBLFM)
  1966. (buffer-string))))
  1967. (should
  1968. (string-match "| 16.00 |"
  1969. (org-test-with-temp-text "* H
  1970. :PROPERTIES:
  1971. :time_constant: 08:00:00
  1972. :END:
  1973. | |
  1974. <point>#+TBLFM: $1=2*$PROP_time_constant;t"
  1975. (org-table-calc-current-TBLFM)
  1976. (buffer-string)))))
  1977. (ert-deftest test-org-table/end-on-hline ()
  1978. "Test with a table ending on a hline."
  1979. (should
  1980. (equal
  1981. (org-test-with-temp-text
  1982. "
  1983. | 1 | 2 | 3 |
  1984. | 4 | 5 | 6 |
  1985. | | | |
  1986. |---+---+---|
  1987. <point>#+TBLFM: @3$2..@3$>=vsum(@1..@2)"
  1988. (org-table-calc-current-TBLFM)
  1989. (buffer-string))
  1990. "
  1991. | 1 | 2 | 3 |
  1992. | 4 | 5 | 6 |
  1993. | | 7 | 9 |
  1994. |---+---+---|
  1995. #+TBLFM: @3$2..@3$>=vsum(@1..@2)")))
  1996. (ert-deftest test-org-table/named-field ()
  1997. "Test formula with a named field."
  1998. (should
  1999. (string-match-p
  2000. "| +| +1 +|"
  2001. (org-test-with-temp-text "
  2002. | | |
  2003. | ^ | name |
  2004. <point>#+TBLFM: $name=1"
  2005. (org-table-calc-current-TBLFM)
  2006. (buffer-string))))
  2007. (should
  2008. (string-match-p
  2009. "| +| +1 +|"
  2010. (org-test-with-temp-text "
  2011. | _ | name |
  2012. | | |
  2013. <point>#+TBLFM: $name=1"
  2014. (org-table-calc-current-TBLFM)
  2015. (buffer-string)))))
  2016. (ert-deftest test-org-table/named-column ()
  2017. "Test formula with a named field."
  2018. (should
  2019. (string-match-p
  2020. "| +| +1 +| +1 +|"
  2021. (org-test-with-temp-text "
  2022. | ! | name | |
  2023. | | 1 | |
  2024. <point>#+TBLFM: @2$3=$name"
  2025. (org-table-calc-current-TBLFM)
  2026. (buffer-string)))))
  2027. (ert-deftest test-org-table/formula-priority ()
  2028. "Test field formula priority over column formula."
  2029. ;; Field formulas bind stronger than column formulas.
  2030. (should
  2031. (equal
  2032. "| 1 | 3 |\n| 2 | 99 |\n"
  2033. (org-test-with-temp-text
  2034. "| 1 | |\n| 2 | |\n<point>#+tblfm: $2=3*$1::@2$2=99"
  2035. (org-table-calc-current-TBLFM)
  2036. (buffer-substring-no-properties (point-min) (point)))))
  2037. ;; When field formula is removed, table formulas is applied again.
  2038. (should
  2039. (equal
  2040. "| 1 | 3 |\n| 2 | 6 |\n"
  2041. (org-test-with-temp-text
  2042. "| 1 | |\n| 2 | |\n#+tblfm: $2=3*$1<point>::@2$2=99"
  2043. (org-table-calc-current-TBLFM)
  2044. (delete-region (point) (line-end-position))
  2045. (org-table-calc-current-TBLFM)
  2046. (buffer-substring-no-properties (point-min) (line-beginning-position))))))
  2047. (ert-deftest test-org-table/tab-indent ()
  2048. "Test named fields with tab indentation."
  2049. (should
  2050. (string-match-p
  2051. "| # | 111 |"
  2052. (org-test-with-temp-text
  2053. "
  2054. | ! | sum | | a | b | c |
  2055. |---+------+------+---+----+-----|
  2056. | # | 1011 | 1000 | 1 | 10 | 100 |
  2057. <point>#+TBLFM: $2=$a+$b+$c
  2058. "
  2059. (org-table-calc-current-TBLFM)
  2060. (buffer-string)))))
  2061. (ert-deftest test-org-table/first-rc ()
  2062. "Test \"$<\" and \"@<\" constructs in formulas."
  2063. (should
  2064. (string-match-p
  2065. "| 1 | 2 |"
  2066. (org-test-with-temp-text
  2067. "| | 2 |
  2068. <point>#+TBLFM: $<=1"
  2069. (org-table-calc-current-TBLFM)
  2070. (buffer-string))))
  2071. (should
  2072. (string-match-p
  2073. "| 2 |\n| 2 |"
  2074. (org-test-with-temp-text
  2075. "| 2 |\n| |
  2076. <point>#+TBLFM: @2$1=@<"
  2077. (org-table-calc-current-TBLFM)
  2078. (buffer-string)))))
  2079. (ert-deftest test-org-table/last-rc ()
  2080. "Test \"$>\" and \"@>\" constructs in formulas."
  2081. (should
  2082. (string-match-p
  2083. "| 2 | 1 |"
  2084. (org-test-with-temp-text
  2085. "| 2 | |\n<point>#+TBLFM: $>=1"
  2086. (org-table-calc-current-TBLFM)
  2087. (buffer-string))))
  2088. (should
  2089. (string-match-p
  2090. "| 2 |\n| 2 |"
  2091. (org-test-with-temp-text
  2092. "| 2 |\n| |\n<point>#+TBLFM: @>$1=@<"
  2093. (org-table-calc-current-TBLFM)
  2094. (buffer-string)))))
  2095. (ert-deftest test-org-table/time-stamps ()
  2096. "Test time-stamps handling."
  2097. ;; Standard test.
  2098. (should
  2099. (string-match-p
  2100. "| 1 |"
  2101. (org-test-with-temp-text
  2102. "| <2016-07-07 Sun> | <2016-07-08 Fri> | |\n<point>#+TBLFM: $3=$2-$1"
  2103. (org-table-calc-current-TBLFM)
  2104. (buffer-string))))
  2105. ;; Handle locale specific time-stamps.
  2106. (should
  2107. (string-match-p
  2108. "| 1 |"
  2109. (org-test-with-temp-text
  2110. "| <2016-07-07 Do> | <2016-07-08 Fr> | |\n<point>#+TBLFM: $3=$2-$1"
  2111. (org-table-calc-current-TBLFM)
  2112. (buffer-string)))))
  2113. (ert-deftest test-org-table/orgtbl-ascii-draw ()
  2114. "Test `orgtbl-ascii-draw'."
  2115. ;; First value: Make sure that an integer input value is converted to a
  2116. ;; float before division. Further values: Show some float input value
  2117. ;; ranges corresponding to the same bar width.
  2118. (should
  2119. (equal
  2120. (org-test-with-temp-text
  2121. "
  2122. | Value | <l> |
  2123. |----------+---------|
  2124. | 19 | replace |
  2125. |----------+---------|
  2126. | -0.50001 | replace |
  2127. | -0.49999 | replace |
  2128. | 0.49999 | replace |
  2129. | 0.50001 | replace |
  2130. | 1.49999 | replace |
  2131. | 22.50001 | replace |
  2132. | 23.49999 | replace |
  2133. | 23.50001 | replace |
  2134. | 24.49999 | replace |
  2135. | 24.50001 | replace |
  2136. <point>#+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 24 3 \" 12345678\")"
  2137. (org-table-calc-current-TBLFM)
  2138. (buffer-string))
  2139. "
  2140. | Value | <l> |
  2141. |----------+-----------|
  2142. | 19 | 883 |
  2143. |----------+-----------|
  2144. | -0.50001 | too small |
  2145. | -0.49999 | |
  2146. | 0.49999 | |
  2147. | 0.50001 | 1 |
  2148. | 1.49999 | 1 |
  2149. | 22.50001 | 887 |
  2150. | 23.49999 | 887 |
  2151. | 23.50001 | 888 |
  2152. | 24.49999 | 888 |
  2153. | 24.50001 | too large |
  2154. #+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 24 3 \" 12345678\")"))
  2155. ;; Draw bars with a bullet. The bullet does not count in the parameter
  2156. ;; WIDTH of `orgtbl-ascii-draw'.
  2157. (should
  2158. (equal
  2159. (org-test-with-temp-text
  2160. "
  2161. | -1 | replace |
  2162. | 0 | replace |
  2163. | 1 | replace |
  2164. | 2 | replace |
  2165. | 3 | replace |
  2166. | 4 | replace |
  2167. <point>#+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 3 3 \"$-\")"
  2168. (org-table-calc-current-TBLFM)
  2169. (buffer-string))
  2170. "
  2171. | -1 | too small |
  2172. | 0 | $ |
  2173. | 1 | -$ |
  2174. | 2 | --$ |
  2175. | 3 | ---$ |
  2176. | 4 | too large |
  2177. #+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 3 3 \"$-\")")))
  2178. (ert-deftest test-org-table/single-rowgroup ()
  2179. "Test column formula in a table with a single rowgroup."
  2180. (should
  2181. (equal
  2182. "
  2183. |---+---|
  2184. | 1 | 0 |
  2185. |---+---|
  2186. #+TBLFM: $2=$1-1"
  2187. (org-test-with-temp-text "
  2188. |---+---|
  2189. | 1 | |
  2190. |---+---|
  2191. <point>#+TBLFM: $2=$1-1"
  2192. (org-table-calc-current-TBLFM)
  2193. (buffer-string))))
  2194. (should
  2195. (equal
  2196. "
  2197. | 1 | 0 |
  2198. #+TBLFM: $2=$1-1"
  2199. (org-test-with-temp-text "
  2200. | 1 | |
  2201. <point>#+TBLFM: $2=$1-1"
  2202. (org-table-calc-current-TBLFM)
  2203. (buffer-string)))))
  2204. ;;; Navigation
  2205. (ert-deftest test-org-table/next-field ()
  2206. "Test `org-table-next-field' specifications."
  2207. ;; Regular test.
  2208. (should
  2209. (equal
  2210. "b"
  2211. (org-test-with-temp-text "| a<point> | b |"
  2212. (org-table-next-field)
  2213. (org-trim (org-table-get-field)))))
  2214. ;; Create new rows as needed.
  2215. (should
  2216. (equal
  2217. "| a |\n| |\n"
  2218. (org-test-with-temp-text "| a<point> |"
  2219. (org-table-next-field)
  2220. (buffer-string))))
  2221. ;; Jump over hlines, if `org-table-tab-jumps-over-hlines' is
  2222. ;; non-nil.
  2223. (should
  2224. (equal
  2225. "b"
  2226. (org-test-with-temp-text "| a<point> |\n|---|\n| b |"
  2227. (let ((org-table-tab-jumps-over-hlines t)) (org-table-next-field))
  2228. (org-trim (org-table-get-field)))))
  2229. ;; If `org-table-tab-jumps-over-hlines' is nil, however, create
  2230. ;; a new row before the rule.
  2231. (should
  2232. (equal
  2233. "| a |\n| |\n|---|\n| b |"
  2234. (org-test-with-temp-text "| a<point> |\n|---|\n| b |"
  2235. (let ((org-table-tab-jumps-over-hlines nil)) (org-table-next-field))
  2236. (buffer-string)))))
  2237. (ert-deftest test-org-table/previous-field ()
  2238. "Test `org-table-previous-field' specifications."
  2239. ;; Regular tests.
  2240. (should
  2241. (eq ?a
  2242. (org-test-with-temp-text "| a | <point>b |"
  2243. (org-table-previous-field)
  2244. (char-after))))
  2245. (should
  2246. (eq ?a
  2247. (org-test-with-temp-text "| a |\n| <point>b |"
  2248. (org-table-previous-field)
  2249. (char-after))))
  2250. ;; Find previous field across horizontal rules.
  2251. (should
  2252. (eq ?a
  2253. (org-test-with-temp-text "| a |\n|---|\n| <point>b |"
  2254. (org-table-previous-field)
  2255. (char-after))))
  2256. ;; When called on a horizontal rule, find previous data field.
  2257. (should
  2258. (eq ?b
  2259. (org-test-with-temp-text "| a | b |\n|---+-<point>--|"
  2260. (org-table-previous-field)
  2261. (char-after))))
  2262. ;; Error when at first field. Make sure to preserve original
  2263. ;; position.
  2264. (should-error
  2265. (org-test-with-temp-text "| <point> a|"
  2266. (org-table-previous-field)))
  2267. (should-error
  2268. (org-test-with-temp-text "|---|\n| <point>a |"
  2269. (org-table-previous-field)))
  2270. (should
  2271. (eq ?a
  2272. (org-test-with-temp-text "|---|\n| <point>a |"
  2273. (ignore-errors (org-table-previous-field))
  2274. (char-after)))))
  2275. ;;; Deleting columns
  2276. (ert-deftest test-org-table/delete-column ()
  2277. "Test `org-table-delete-column'."
  2278. ;; Error when outside a table.
  2279. (should-error
  2280. (org-test-with-temp-text "Paragraph"
  2281. (org-table-delete-column)))
  2282. ;; Delete first column.
  2283. (should
  2284. (equal "| a |\n"
  2285. (org-test-with-temp-text
  2286. "| <point> | a |\n"
  2287. (org-table-delete-column)
  2288. (buffer-string))))
  2289. ;; Delete column and check location of point.
  2290. (should
  2291. (= 2
  2292. (org-test-with-temp-text
  2293. "| a | <point>b | c |"
  2294. (org-table-delete-column)
  2295. (org-table-current-column))))
  2296. ;; Delete column when at end of line and after a "|".
  2297. (should
  2298. (equal "| a |\n"
  2299. (org-test-with-temp-text
  2300. "| a | b |<point>\n"
  2301. (org-table-delete-column)
  2302. (buffer-string))))
  2303. (should
  2304. (equal "| a |\n"
  2305. (org-test-with-temp-text
  2306. "| a | b | <point>\n"
  2307. (org-table-delete-column)
  2308. (buffer-string))))
  2309. ;; Delete two columns starting with the last column.
  2310. (should
  2311. (equal "| a |\n"
  2312. (org-test-with-temp-text
  2313. "| a | b | c<point> |"
  2314. (org-table-delete-column)
  2315. (org-table-delete-column)
  2316. (buffer-string)))))
  2317. ;;; Inserting rows, inserting columns
  2318. (ert-deftest test-org-table/insert-column ()
  2319. "Test `org-table-insert-column' specifications."
  2320. ;; Error when outside a table.
  2321. (should-error
  2322. (org-test-with-temp-text "Paragraph"
  2323. (org-table-insert-column)))
  2324. ;; Insert new column after current one.
  2325. (should
  2326. (equal "| | a |\n"
  2327. (org-test-with-temp-text "| a |"
  2328. (org-table-insert-column)
  2329. (buffer-string))))
  2330. (should
  2331. (equal "| | a | b |\n"
  2332. (org-test-with-temp-text "| <point>a | b |"
  2333. (org-table-insert-column)
  2334. (buffer-string))))
  2335. ;; Move point into the newly created column.
  2336. (should
  2337. (equal " | a |"
  2338. (org-test-with-temp-text "| <point>a |"
  2339. (org-table-insert-column)
  2340. (buffer-substring-no-properties (point) (line-end-position)))))
  2341. (should
  2342. (equal " | a | b |"
  2343. (org-test-with-temp-text "| <point>a | b |"
  2344. (org-table-insert-column)
  2345. (buffer-substring-no-properties (point) (line-end-position)))))
  2346. ;; Handle missing vertical bar in the last column.
  2347. (should
  2348. (equal "| | a |\n"
  2349. (org-test-with-temp-text "| a"
  2350. (org-table-insert-column)
  2351. (buffer-string))))
  2352. (should
  2353. (equal " | a |"
  2354. (org-test-with-temp-text "| <point>a"
  2355. (org-table-insert-column)
  2356. (buffer-substring-no-properties (point) (line-end-position)))))
  2357. ;; Handle column insertion when point is before first column.
  2358. (should
  2359. (equal " | | a |\n"
  2360. (org-test-with-temp-text " | a |"
  2361. (org-table-insert-column)
  2362. (buffer-string))))
  2363. (should
  2364. (equal " | | a | b |\n"
  2365. (org-test-with-temp-text " | a | b |"
  2366. (org-table-insert-column)
  2367. (buffer-string)))))
  2368. (ert-deftest test-org-table/insert-column-with-formula ()
  2369. "Test `org-table-insert-column' with a formula in place."
  2370. (should
  2371. (equal "| | 1 | 1 | 2 |
  2372. #+TBLFM: $4=$2+$3"
  2373. (org-test-with-temp-text
  2374. "| 1<point> | 1 | 2 |
  2375. #+TBLFM: $3=$1+$2"
  2376. (org-table-insert-column)
  2377. (buffer-substring-no-properties (point-min) (point-max))))))
  2378. ;;; Moving single cells
  2379. (ert-deftest test-org-table/move-cell-down ()
  2380. "Test `org-table-move-cell-down' specifications."
  2381. ;; Error out when cell cannot be moved due to not in table, in the
  2382. ;; last row of the table, or is on a hline.
  2383. (should-error
  2384. (org-test-with-temp-text "not in\na table\n"
  2385. (org-table-move-cell-down)))
  2386. (should-error
  2387. (org-test-with-temp-text "| a |"
  2388. (org-table-move-cell-down)))
  2389. (should-error
  2390. (org-test-with-temp-text "| a |\n"
  2391. (org-table-move-cell-down)))
  2392. (should-error
  2393. (org-test-with-temp-text "| a | <point>b |\n"
  2394. (org-table-move-cell-down)))
  2395. (should-error
  2396. (org-test-with-temp-text "| a | b |\n| <point>c | d |\n"
  2397. (org-table-move-cell-down)))
  2398. (should-error
  2399. (org-test-with-temp-text "| a | b |\n| c | <point>d |\n"
  2400. (org-table-move-cell-down)))
  2401. (should-error
  2402. (org-test-with-temp-text "| <point>a |\n|---|\n"
  2403. (org-table-move-cell-down)))
  2404. (should-error
  2405. (org-test-with-temp-text "|<point>---|\n| a |\n"
  2406. (org-table-move-cell-down)))
  2407. ;; Check for correct cell movement
  2408. (should (equal (concat "| c | b |\n"
  2409. "| a | d |\n"
  2410. "| e | f |\n")
  2411. (org-test-with-temp-text
  2412. (concat "| <point>a | b |\n"
  2413. "| c | d |\n"
  2414. "| e | f |\n")
  2415. (org-table-move-cell-down)
  2416. (buffer-string))))
  2417. (should (equal (concat "| a | d |\n"
  2418. "| c | b |\n"
  2419. "| e | f |\n")
  2420. (org-test-with-temp-text
  2421. (concat "| a | <point>b |\n"
  2422. "| c | d |\n"
  2423. "| e | f |\n")
  2424. (org-table-move-cell-down)
  2425. (buffer-string))))
  2426. (should (equal (concat "| a | b |\n"
  2427. "| e | d |\n"
  2428. "| c | f |\n")
  2429. (org-test-with-temp-text
  2430. (concat "| a | b |\n"
  2431. "| <point>c | d |\n"
  2432. "| e | f |\n")
  2433. (org-table-move-cell-down)
  2434. (buffer-string))))
  2435. (should (equal (concat "| a | d |\n"
  2436. "| c | f |\n"
  2437. "| e | b |\n")
  2438. (org-test-with-temp-text
  2439. (concat "| a |<point> b |\n"
  2440. "| c | d |\n"
  2441. "| e | f |\n")
  2442. (org-table-move-cell-down)
  2443. (org-table-move-cell-down)
  2444. (buffer-string))))
  2445. ;; Check for correct handling of hlines which should not change
  2446. ;; position on single cell moves.
  2447. (should (equal (concat "| c | b |\n"
  2448. "|---+---|\n"
  2449. "| a | d |\n"
  2450. "| e | f |\n")
  2451. (org-test-with-temp-text
  2452. (concat "| <point>a | b |\n"
  2453. "|---+---|\n"
  2454. "| c | d |\n"
  2455. "| e | f |\n")
  2456. (org-table-move-cell-down)
  2457. (buffer-string))))
  2458. (should (equal (concat "| a | d |\n"
  2459. "|---+---|\n"
  2460. "| c | f |\n"
  2461. "| e | b |\n")
  2462. (org-test-with-temp-text
  2463. (concat "| a | <point>b |\n"
  2464. "|---+---|\n"
  2465. "| c | d |\n"
  2466. "| e | f |\n")
  2467. (org-table-move-cell-down)
  2468. (org-table-move-cell-down)
  2469. (buffer-string))))
  2470. (should (equal (concat "| a | b |\n"
  2471. "|---+---|\n"
  2472. "| c | f |\n"
  2473. "| e | d |\n")
  2474. (org-test-with-temp-text
  2475. (concat "| a | b |\n"
  2476. "|---+---|\n"
  2477. "| c | <point>d |\n"
  2478. "| e | f |\n")
  2479. (org-table-move-cell-down)
  2480. (buffer-string))))
  2481. ;; Move single cell even without a final newline.
  2482. (should (equal (concat "| a | d |\n"
  2483. "|---+---|\n"
  2484. "| c | f |\n"
  2485. "| e | b |\n")
  2486. (org-test-with-temp-text
  2487. (concat "| a | <point>b |\n"
  2488. "|---+---|\n"
  2489. "| c | d |\n"
  2490. "| e | f |")
  2491. (org-table-move-cell-down)
  2492. (org-table-move-cell-down)
  2493. (buffer-string)))))
  2494. (ert-deftest test-org-table/move-cell-up ()
  2495. "Test `org-table-move-cell-up' specifications."
  2496. ;; Error out when cell cannot be moved due to not in table, in the
  2497. ;; last row of the table, or is on a hline.
  2498. (should-error
  2499. (org-test-with-temp-text "not in\na table\n"
  2500. (org-table-move-cell-up)))
  2501. (should-error
  2502. (org-test-with-temp-text "| a |"
  2503. (org-table-move-cell-up)))
  2504. (should-error
  2505. (org-test-with-temp-text "| a |\n"
  2506. (org-table-move-cell-up)))
  2507. (should-error
  2508. (org-test-with-temp-text "| <point>a | b |\n"
  2509. (org-table-move-cell-up)))
  2510. (should-error
  2511. (org-test-with-temp-text "| a | <point>b |\n| c | d |\n"
  2512. (org-table-move-cell-up)))
  2513. (should-error
  2514. (org-test-with-temp-text "| <point>a |\n|---|\n"
  2515. (org-table-move-cell-up)))
  2516. (should-error
  2517. (org-test-with-temp-text "|<point>---|\n| a |\n"
  2518. (org-table-move-cell-up)))
  2519. ;; Check for correct cell movement.
  2520. (should (equal (concat "| c | b |\n"
  2521. "| a | d |\n"
  2522. "| e | f |\n")
  2523. (org-test-with-temp-text
  2524. (concat "| a | b |\n"
  2525. "| <point>c | d |\n"
  2526. "| e | f |\n")
  2527. (org-table-move-cell-up)
  2528. (buffer-string))))
  2529. (should (equal (concat "| a | d |\n"
  2530. "| c | b |\n"
  2531. "| e | f |\n")
  2532. (org-test-with-temp-text
  2533. (concat "| a | b |\n"
  2534. "| c | <point>d |\n"
  2535. "| e | f |\n")
  2536. (org-table-move-cell-up)
  2537. (buffer-string))))
  2538. (should (equal (concat "| a | b |\n"
  2539. "| e | d |\n"
  2540. "| c | f |\n")
  2541. (org-test-with-temp-text
  2542. (concat "| a | b |\n"
  2543. "| c | d |\n"
  2544. "| <point>e | f |\n")
  2545. (org-table-move-cell-up)
  2546. (buffer-string))))
  2547. (should (equal (concat "| a | f |\n"
  2548. "| c | b |\n"
  2549. "| e | d |\n")
  2550. (org-test-with-temp-text
  2551. (concat "| a | b |\n"
  2552. "| c | d |\n"
  2553. "| e |<point> f |\n")
  2554. (org-table-move-cell-up)
  2555. (org-table-move-cell-up)
  2556. (buffer-string))))
  2557. ;; Check for correct handling of hlines which should not change
  2558. ;; position on single cell moves.
  2559. (should (equal (concat "| c | b |\n"
  2560. "|---+---|\n"
  2561. "| a | d |\n"
  2562. "| e | f |\n")
  2563. (org-test-with-temp-text
  2564. (concat "| a | b |\n"
  2565. "|---+---|\n"
  2566. "| <point>c | d |\n"
  2567. "| e | f |\n")
  2568. (org-table-move-cell-up)
  2569. (buffer-string))))
  2570. (should (equal (concat "| a | f |\n"
  2571. "|---+---|\n"
  2572. "| c | b |\n"
  2573. "| e | d |\n")
  2574. (org-test-with-temp-text
  2575. (concat "| a | b |\n"
  2576. "|---+---|\n"
  2577. "| c | d |\n"
  2578. "| e | <point>f |\n")
  2579. (org-table-move-cell-up)
  2580. (org-table-move-cell-up)
  2581. (buffer-string))))
  2582. (should (equal (concat "| a | b |\n"
  2583. "|---+---|\n"
  2584. "| c | f |\n"
  2585. "| e | d |\n")
  2586. (org-test-with-temp-text
  2587. (concat "| a | b |\n"
  2588. "|---+---|\n"
  2589. "| c | d |\n"
  2590. "| e | <point>f |\n")
  2591. (org-table-move-cell-up)
  2592. (buffer-string))))
  2593. ;; Move single cell even without a final newline.
  2594. (should (equal (concat "| a | f |\n"
  2595. "|---+---|\n"
  2596. "| c | b |\n"
  2597. "| e | d |\n")
  2598. (org-test-with-temp-text
  2599. (concat "| a | b |\n"
  2600. "|---+---|\n"
  2601. "| c | d |\n"
  2602. "| e | <point>f |")
  2603. (org-table-move-cell-up)
  2604. (org-table-move-cell-up)
  2605. (buffer-string)))))
  2606. (ert-deftest test-org-table/move-cell-right ()
  2607. "Test `org-table-move-cell-right' specifications."
  2608. ;; Error out when cell cannot be moved due to not in table, in the
  2609. ;; last col of the table, or is on a hline.
  2610. (should-error
  2611. (org-test-with-temp-text "not in\na table\n"
  2612. (org-table-move-cell-right)))
  2613. (should-error
  2614. (org-test-with-temp-text "| a |"
  2615. (org-table-move-cell-right)))
  2616. (should-error
  2617. (org-test-with-temp-text "| a |\n"
  2618. (org-table-move-cell-right)))
  2619. (should-error
  2620. (org-test-with-temp-text "| <point>a |\n| b |\n"
  2621. (org-table-move-cell-right)))
  2622. (should-error
  2623. (org-test-with-temp-text "| a | <point>b |\n| c | d |\n"
  2624. (org-table-move-cell-right)))
  2625. (should-error
  2626. (org-test-with-temp-text "| <point>a |\n|---|\n"
  2627. (org-table-move-cell-right)))
  2628. (should-error
  2629. (org-test-with-temp-text "|<point>---|\n| a |\n"
  2630. (org-table-move-cell-right)))
  2631. ;; Check for correct cell movement.
  2632. (should (equal (concat "| b | a | c |\n"
  2633. "| d | e | f |\n")
  2634. (org-test-with-temp-text
  2635. (concat "| <point>a | b | c |\n"
  2636. "| d | e | f |\n")
  2637. (org-table-move-cell-right)
  2638. (buffer-string))))
  2639. (should (equal (concat "| b | c | a |\n"
  2640. "| d | e | f |\n")
  2641. (org-test-with-temp-text
  2642. (concat "| <point>a | b | c |\n"
  2643. "| d | e | f |\n")
  2644. (org-table-move-cell-right)
  2645. (org-table-move-cell-right)
  2646. (buffer-string))))
  2647. (should (equal (concat "| a | b | c |\n"
  2648. "| e | f | d |\n")
  2649. (org-test-with-temp-text
  2650. (concat "| a | b | c |\n"
  2651. "| <point> d | e | f |\n")
  2652. (org-table-move-cell-right)
  2653. (org-table-move-cell-right)
  2654. (buffer-string))))
  2655. (should (equal (concat "| a | b | c |\n"
  2656. "| d | f | e |\n")
  2657. (org-test-with-temp-text
  2658. (concat "| a | b | c |\n"
  2659. "| d | <point>e | f |\n")
  2660. (org-table-move-cell-right)
  2661. (buffer-string))))
  2662. (should (equal (concat "| a | b | c |\n"
  2663. "|---+---+---|\n"
  2664. "| e | f | d |\n")
  2665. (org-test-with-temp-text
  2666. (concat "| a | b | c |\n"
  2667. "|---+---+---|\n"
  2668. "| <point>d | e | f |\n")
  2669. (org-table-move-cell-right)
  2670. (org-table-move-cell-right)
  2671. (buffer-string))))
  2672. ;; Move single cell even without a final newline.
  2673. (should (equal (concat "| a | b | c |\n"
  2674. "|---+---+---|\n"
  2675. "| e | d | f |\n")
  2676. (org-test-with-temp-text
  2677. (concat "| a | b | c |\n"
  2678. "|---+---+---|\n"
  2679. "| <point>d | e | f |")
  2680. (org-table-move-cell-right)
  2681. (buffer-string)))))
  2682. (ert-deftest test-org-table/move-cell-left ()
  2683. "Test `org-table-move-cell-left' specifications."
  2684. ;; Error out when cell cannot be moved due to not in table, in the
  2685. ;; last col of the table, or is on a hline.
  2686. (should-error
  2687. (org-test-with-temp-text "not in\na table\n"
  2688. (org-table-move-cell-left)))
  2689. (should-error
  2690. (org-test-with-temp-text "| a |"
  2691. (org-table-move-cell-left)))
  2692. (should-error
  2693. (org-test-with-temp-text "| a |\n"
  2694. (org-table-move-cell-left)))
  2695. (should-error
  2696. (org-test-with-temp-text "| <point>a |\n| b |\n"
  2697. (org-table-move-cell-left)))
  2698. (should-error
  2699. (org-test-with-temp-text "| <point>a | b |\n| c | d |\n"
  2700. (org-table-move-cell-left)))
  2701. (should-error
  2702. (org-test-with-temp-text "| <point>a |\n|---|\n"
  2703. (org-table-move-cell-left)))
  2704. (should-error
  2705. (org-test-with-temp-text "|<point>---|\n| a |\n"
  2706. (org-table-move-cell-left)))
  2707. ;; Check for correct cell movement.
  2708. (should (equal (concat "| b | a | c |\n"
  2709. "| d | e | f |\n")
  2710. (org-test-with-temp-text
  2711. (concat "| a | <point>b | c |\n"
  2712. "| d | e | f |\n")
  2713. (org-table-move-cell-left)
  2714. (buffer-string))))
  2715. (should (equal (concat "| c | a | b |\n"
  2716. "| d | e | f |\n")
  2717. (org-test-with-temp-text
  2718. (concat "| a | b | <point>c |\n"
  2719. "| d | e | f |\n")
  2720. (org-table-move-cell-left)
  2721. (org-table-move-cell-left)
  2722. (buffer-string))))
  2723. (should (equal (concat "| a | b | c |\n"
  2724. "| f | d | e |\n")
  2725. (org-test-with-temp-text
  2726. (concat "| a | b | c |\n"
  2727. "| d | e | <point>f |\n")
  2728. (org-table-move-cell-left)
  2729. (org-table-move-cell-left)
  2730. (buffer-string))))
  2731. (should (equal (concat "| a | b | c |\n"
  2732. "| d | f | e |\n")
  2733. (org-test-with-temp-text
  2734. (concat "| a | b | c |\n"
  2735. "| d | e | <point>f |\n")
  2736. (org-table-move-cell-left)
  2737. (buffer-string))))
  2738. (should (equal (concat "| a | b | c |\n"
  2739. "|---+---+---|\n"
  2740. "| f | d | e |\n")
  2741. (org-test-with-temp-text
  2742. (concat "| a | b | c |\n"
  2743. "|---+---+---|\n"
  2744. "| d | e | <point>f |\n")
  2745. (org-table-move-cell-left)
  2746. (org-table-move-cell-left)
  2747. (buffer-string))))
  2748. ;; Move single cell even without a final newline.
  2749. (should (equal (concat "| a | b | c |\n"
  2750. "|---+---+---|\n"
  2751. "| e | d | f |\n")
  2752. (org-test-with-temp-text
  2753. (concat "| a | b | c |\n"
  2754. "|---+---+---|\n"
  2755. "| d | <point>e | f |")
  2756. (org-table-move-cell-left)
  2757. (buffer-string)))))
  2758. ;;; Moving rows, moving columns
  2759. (ert-deftest test-org-table/move-row-down ()
  2760. "Test `org-table-move-row-down' specifications."
  2761. ;; Error out when row cannot be moved, e.g., it is the last row in
  2762. ;; the table.
  2763. (should-error
  2764. (org-test-with-temp-text "| a |"
  2765. (org-table-move-row-down)))
  2766. (should-error
  2767. (org-test-with-temp-text "| a |\n"
  2768. (org-table-move-row-down)))
  2769. (should-error
  2770. (org-test-with-temp-text "| a |\n| <point>b |"
  2771. (org-table-move-row-down)))
  2772. ;; Move data lines.
  2773. (should
  2774. (equal "| b |\n| a |\n"
  2775. (org-test-with-temp-text "| a |\n| b |\n"
  2776. (org-table-move-row-down)
  2777. (buffer-string))))
  2778. (should
  2779. (equal "|---|\n| a |\n"
  2780. (org-test-with-temp-text "| a |\n|---|\n"
  2781. (org-table-move-row-down)
  2782. (buffer-string))))
  2783. ;; Move hlines.
  2784. (should
  2785. (equal "| b |\n|---|\n"
  2786. (org-test-with-temp-text "|---|\n| b |\n"
  2787. (org-table-move-row-down)
  2788. (buffer-string))))
  2789. (should
  2790. (equal "|---|\n|---|\n"
  2791. (org-test-with-temp-text "|---|\n|---|\n"
  2792. (org-table-move-row-down)
  2793. (buffer-string))))
  2794. ;; Move rows even without a final newline.
  2795. (should
  2796. (equal "| b |\n| a |\n"
  2797. (org-test-with-temp-text "| a |\n| b |"
  2798. (org-table-move-row-down)
  2799. (buffer-string)))))
  2800. (ert-deftest test-org-table/move-row-up ()
  2801. "Test `org-table-move-row-up' specifications."
  2802. ;; Error out when row cannot be moved, e.g., it is the first row in
  2803. ;; the table.
  2804. (should-error
  2805. (org-test-with-temp-text "| a |"
  2806. (org-table-move-row-up)))
  2807. (should-error
  2808. (org-test-with-temp-text "| a |\n"
  2809. (org-table-move-row-up)))
  2810. ;; Move data lines.
  2811. (should
  2812. (equal "| b |\n| a |\n"
  2813. (org-test-with-temp-text "| a |\n| <point>b |\n"
  2814. (org-table-move-row-up)
  2815. (buffer-string))))
  2816. (should
  2817. (equal "| b |\n|---|\n"
  2818. (org-test-with-temp-text "|---|\n| <point>b |\n"
  2819. (org-table-move-row-up)
  2820. (buffer-string))))
  2821. ;; Move hlines.
  2822. (should
  2823. (equal "|---|\n| a |\n"
  2824. (org-test-with-temp-text "| a |\n|<point>---|\n"
  2825. (org-table-move-row-up)
  2826. (buffer-string))))
  2827. (should
  2828. (equal "|---|\n|---|\n"
  2829. (org-test-with-temp-text "|---|\n|<point>---|\n"
  2830. (org-table-move-row-up)
  2831. (buffer-string))))
  2832. ;; Move rows even without a final newline.
  2833. (should
  2834. (equal "| b |\n| a |\n"
  2835. (org-test-with-temp-text "| a |\n| <point>b |"
  2836. (org-table-move-row-up)
  2837. (buffer-string)))))
  2838. ;;; Shrunk columns
  2839. (ert-deftest test-org-table/toggle-column-width ()
  2840. "Test `org-table-toggle-columns-width' specifications."
  2841. ;; Error when not at a column.
  2842. (should-error
  2843. (org-test-with-temp-text "<point>a"
  2844. (org-table-toggle-column-width)))
  2845. ;; A shrunk column is overlaid with
  2846. ;; `org-table-shrunk-column-indicator'.
  2847. (should
  2848. (equal org-table-shrunk-column-indicator
  2849. (org-test-with-temp-text "| <point>a |"
  2850. (org-table-toggle-column-width)
  2851. (overlay-get (car (overlays-at (point))) 'display))))
  2852. (should
  2853. (equal org-table-shrunk-column-indicator
  2854. (org-test-with-temp-text "| a |\n|-<point>--|"
  2855. (org-table-toggle-column-width)
  2856. (overlay-get (car (overlays-at (point))) 'display))))
  2857. ;; Shrink every field in the same column.
  2858. (should
  2859. (equal org-table-shrunk-column-indicator
  2860. (org-test-with-temp-text "| a |\n|-<point>--|"
  2861. (org-table-toggle-column-width)
  2862. (overlay-get (car (overlays-at (1+ (line-beginning-position 0))))
  2863. 'display))))
  2864. ;; When column is already shrunk, expand it, i.e., remove overlays.
  2865. (should-not
  2866. (org-test-with-temp-text "| <point>a |"
  2867. (org-table-toggle-column-width)
  2868. (org-table-toggle-column-width)
  2869. (overlays-in (point-min) (point-max))))
  2870. (should-not
  2871. (org-test-with-temp-text "| a |\n| <point>b |"
  2872. (org-table-toggle-column-width)
  2873. (org-table-toggle-column-width)
  2874. (overlays-in (point-min) (point-max))))
  2875. ;; With a column width cookie, limit overlay to the specified number
  2876. ;; of characters.
  2877. (should
  2878. (equal "| abc"
  2879. (org-test-with-temp-text "| <3> |\n| <point>abcd |"
  2880. (org-table-toggle-column-width)
  2881. (buffer-substring (line-beginning-position)
  2882. (overlay-start
  2883. (car (overlays-in (line-beginning-position)
  2884. (line-end-position))))))))
  2885. (should
  2886. (equal "| a "
  2887. (org-test-with-temp-text "| <3> |\n| <point>a |"
  2888. (org-table-toggle-column-width)
  2889. (buffer-substring (line-beginning-position)
  2890. (overlay-start
  2891. (car (overlays-in (line-beginning-position)
  2892. (line-end-position))))))))
  2893. (should
  2894. (equal (concat "----" org-table-shrunk-column-indicator)
  2895. (org-test-with-temp-text "| <3> |\n|--<point>----|"
  2896. (org-table-toggle-column-width)
  2897. (overlay-get
  2898. (car (overlays-in (line-beginning-position)
  2899. (line-end-position)))
  2900. 'display))))
  2901. ;; Width only takes into account visible characters.
  2902. (should
  2903. (equal "| [[http"
  2904. (org-test-with-temp-text "| <4> |\n| <point>[[http://orgmode.org]] |"
  2905. (org-table-toggle-column-width)
  2906. (buffer-substring (line-beginning-position)
  2907. (overlay-start
  2908. (car (overlays-in (line-beginning-position)
  2909. (line-end-position))))))))
  2910. ;; Before the first column or after the last one, ask for columns
  2911. ;; ranges.
  2912. (should
  2913. (catch :exit
  2914. (org-test-with-temp-text "| a |"
  2915. (cl-letf (((symbol-function 'read-string)
  2916. (lambda (&rest_) (throw :exit t))))
  2917. (org-table-toggle-column-width)
  2918. nil))))
  2919. (should
  2920. (catch :exit
  2921. (org-test-with-temp-text "| a |<point>"
  2922. (cl-letf (((symbol-function 'read-string)
  2923. (lambda (&rest_) (throw :exit t))))
  2924. (org-table-toggle-column-width)
  2925. nil))))
  2926. ;; When optional argument ARG is a string, toggle specified columns.
  2927. (should
  2928. (equal org-table-shrunk-column-indicator
  2929. (org-test-with-temp-text "| <point>a | b |"
  2930. (org-table-toggle-column-width "2")
  2931. (overlay-get (car (overlays-at (- (point-max) 2))) 'display))))
  2932. (should
  2933. (equal '("b" "c")
  2934. (org-test-with-temp-text "| a | b | c | d |"
  2935. (org-table-toggle-column-width "2-3")
  2936. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2937. (overlays-in (point-min) (point-max)))
  2938. #'string-lessp))))
  2939. (should
  2940. (equal '("b" "c" "d")
  2941. (org-test-with-temp-text "| a | b | c | d |"
  2942. (org-table-toggle-column-width "2-")
  2943. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2944. (overlays-in (point-min) (point-max)))
  2945. #'string-lessp))))
  2946. (should
  2947. (equal '("a" "b")
  2948. (org-test-with-temp-text "| a | b | c | d |"
  2949. (org-table-toggle-column-width "-2")
  2950. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2951. (overlays-in (point-min) (point-max)))
  2952. #'string-lessp))))
  2953. (should
  2954. (equal '("a" "b" "c" "d")
  2955. (org-test-with-temp-text "| a | b | c | d |"
  2956. (org-table-toggle-column-width "-")
  2957. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2958. (overlays-in (point-min) (point-max)))
  2959. #'string-lessp))))
  2960. (should
  2961. (equal '("a" "d")
  2962. (org-test-with-temp-text "| a | b | c | d |"
  2963. (org-table-toggle-column-width "1-3")
  2964. (org-table-toggle-column-width "2-4")
  2965. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2966. (overlays-in (point-min) (point-max)))
  2967. #'string-lessp))))
  2968. ;; When ARG is (16), remove any column overlay.
  2969. (should-not
  2970. (org-test-with-temp-text "| <point>a |"
  2971. (org-table-toggle-column-width)
  2972. (org-table-toggle-column-width '(16))
  2973. (overlays-in (point-min) (point-max))))
  2974. (should-not
  2975. (org-test-with-temp-text "| a | b | c | d |"
  2976. (org-table-toggle-column-width "-")
  2977. (org-table-toggle-column-width '(16))
  2978. (overlays-in (point-min) (point-max)))))
  2979. (ert-deftest test-org-table/shrunk-columns ()
  2980. "Test behaviour of shrunk column."
  2981. ;; Edition automatically expands a shrunk column.
  2982. (should-not
  2983. (org-test-with-temp-text "| <point>a |"
  2984. (org-table-toggle-column-width)
  2985. (insert "a")
  2986. (overlays-in (point-min) (point-max))))
  2987. ;; Other columns are not changed.
  2988. (should
  2989. (org-test-with-temp-text "| <point>a | b |"
  2990. (org-table-toggle-column-width "-")
  2991. (insert "a")
  2992. (overlays-in (point-min) (point-max))))
  2993. ;; Moving a shrunk column doesn't alter its state.
  2994. (should
  2995. (equal "a"
  2996. (org-test-with-temp-text "| <point>a | b |"
  2997. (org-table-toggle-column-width)
  2998. (org-table-move-column-right)
  2999. (overlay-get (car (overlays-at (point))) 'help-echo))))
  3000. (should
  3001. (equal "a"
  3002. (org-test-with-temp-text "| <point>a |\n| b |"
  3003. (org-table-toggle-column-width)
  3004. (org-table-move-row-down)
  3005. (overlay-get (car (overlays-at (point))) 'help-echo))))
  3006. ;; State is preserved upon inserting a column.
  3007. (should
  3008. (equal '("a")
  3009. (org-test-with-temp-text "| <point>a |"
  3010. (org-table-toggle-column-width)
  3011. (org-table-insert-column)
  3012. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  3013. (overlays-in (point-min) (point-max)))
  3014. #'string-lessp))))
  3015. ;; State is preserved upon deleting a column.
  3016. (should
  3017. (equal '("a" "c")
  3018. (org-test-with-temp-text "| a | <point>b | c |"
  3019. (org-table-toggle-column-width "-")
  3020. (org-table-delete-column)
  3021. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  3022. (overlays-in (point-min) (point-max)))
  3023. #'string-lessp))))
  3024. ;; State is preserved upon deleting a row.
  3025. (should
  3026. (equal '("b1" "b2")
  3027. (org-test-with-temp-text "| a1 | a2 |\n| b1 | b2 |"
  3028. (org-table-toggle-column-width "-")
  3029. (org-table-kill-row)
  3030. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  3031. (overlays-in (point-min) (point-max)))
  3032. #'string-lessp))))
  3033. (should
  3034. (equal '("a1" "a2")
  3035. (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
  3036. (org-table-toggle-column-width "-")
  3037. (org-table-kill-row)
  3038. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  3039. (overlays-in (point-min) (point-max)))
  3040. #'string-lessp))))
  3041. ;; State is preserved upon inserting a row or hline.
  3042. (should
  3043. (equal '("" "a1" "b1")
  3044. (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
  3045. (org-table-toggle-column-width)
  3046. (org-table-insert-row)
  3047. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  3048. (overlays-in (point-min) (point-max)))
  3049. #'string-lessp))))
  3050. (should
  3051. (equal '("a1" "b1")
  3052. (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
  3053. (org-table-toggle-column-width)
  3054. (org-table-insert-hline)
  3055. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  3056. (overlays-in (point-min) (point-max)))
  3057. #'string-lessp))))
  3058. ;; State is preserved upon sorting a column for all the columns but
  3059. ;; the one being sorted.
  3060. (should
  3061. (equal '("a2" "b2")
  3062. (org-test-with-temp-text "| <point>a1 | a2 |\n| <point>b1 | b2 |"
  3063. (org-table-toggle-column-width "-")
  3064. (org-table-sort-lines nil ?A)
  3065. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  3066. (overlays-in (point-min) (point-max)))
  3067. #'string-lessp))))
  3068. ;; State is preserved upon replacing a field non-interactively.
  3069. (should
  3070. (equal '("a")
  3071. (org-test-with-temp-text "| <point>a |"
  3072. (org-table-toggle-column-width)
  3073. (org-table-get-field nil "b")
  3074. (mapcar (lambda (o) (overlay-get o 'help-echo))
  3075. (overlays-in (point-min) (point-max))))))
  3076. ;; Moving to next field doesn't change shrunk state.
  3077. (should
  3078. (equal "a"
  3079. (org-test-with-temp-text "| <point>a | b |"
  3080. (org-table-toggle-column-width)
  3081. (org-table-next-field)
  3082. (overlay-get (car (overlays-at (1+ (line-beginning-position))))
  3083. 'help-echo))))
  3084. (should
  3085. (equal "b"
  3086. (org-test-with-temp-text "| a | <point>b |"
  3087. (org-table-toggle-column-width)
  3088. (goto-char 2)
  3089. (org-table-next-field)
  3090. (overlay-get (car (overlays-at (point))) 'help-echo))))
  3091. ;; Aligning table doesn't alter shrunk state.
  3092. (should
  3093. (equal "a"
  3094. (org-test-with-temp-text "| <point>a | b |"
  3095. (org-table-toggle-column-width)
  3096. (org-table-align)
  3097. (overlay-get (car (overlays-at (1+ (line-beginning-position))))
  3098. 'help-echo))))
  3099. (should
  3100. (equal "b"
  3101. (org-test-with-temp-text "|---+-----|\n| a | <point>b |"
  3102. (org-table-toggle-column-width)
  3103. (org-table-align)
  3104. (overlay-get (car (overlays-at (point)))
  3105. 'help-echo))))
  3106. (should
  3107. (equal
  3108. '("b")
  3109. (org-test-with-temp-text "|---+-----|\n| a | <point>b |"
  3110. (org-table-toggle-column-width)
  3111. (org-table-align)
  3112. (mapcar (lambda (o) (overlay-get o 'help-echo))
  3113. (overlays-in (line-beginning-position) (line-end-position))))))
  3114. ;; Recalculating formulas doesn't change shrunk state.
  3115. (should
  3116. (equal "2"
  3117. (org-test-with-temp-text "| 1 | <point>0 |\n#+TBLFM: $2=$1+1\n"
  3118. (org-table-toggle-column-width)
  3119. (org-table-recalculate)
  3120. (overlay-get (car (overlays-at (point))) 'help-echo)))))
  3121. ;;; Miscellaneous
  3122. (ert-deftest test-org-table/current-column ()
  3123. "Test `org-table-current-column' specifications."
  3124. (should
  3125. (= 1 (org-test-with-temp-text "| <point>a |"
  3126. (org-table-current-column))))
  3127. (should
  3128. (= 1 (org-test-with-temp-text "|-<point>--|"
  3129. (org-table-current-column))))
  3130. (should
  3131. (= 2 (org-test-with-temp-text "| 1 | <point>2 |"
  3132. (org-table-current-column))))
  3133. (should
  3134. (= 2 (org-test-with-temp-text "|---+-<point>--|"
  3135. (org-table-current-column)))))
  3136. (ert-deftest test-org-table/get-field ()
  3137. "Test `org-table-get-field' specifications."
  3138. ;; Regular test.
  3139. (should
  3140. (equal " a "
  3141. (org-test-with-temp-text "| <point>a |" (org-table-get-field))))
  3142. ;; Get field in open last column.
  3143. (should
  3144. (equal " a "
  3145. (org-test-with-temp-text "| <point>a " (org-table-get-field))))
  3146. ;; Get empty field.
  3147. (should
  3148. (equal ""
  3149. (org-test-with-temp-text "|<point>|" (org-table-get-field))))
  3150. (should
  3151. (equal " "
  3152. (org-test-with-temp-text "| <point>|" (org-table-get-field))))
  3153. ;; Outside the table, return the empty string.
  3154. (should
  3155. (equal ""
  3156. (org-test-with-temp-text "<point>| a |" (org-table-get-field))))
  3157. (should
  3158. (equal ""
  3159. (org-test-with-temp-text "| a |<point>" (org-table-get-field))))
  3160. ;; With optional N argument, select a particular column in current
  3161. ;; row.
  3162. (should
  3163. (equal " 3 "
  3164. (org-test-with-temp-text "| 1 | 2 | 3 |" (org-table-get-field 3))))
  3165. (should
  3166. (equal " 4 "
  3167. (org-test-with-temp-text "| 1 | 2 |\n<point>| 3 | 4 |"
  3168. (org-table-get-field 2))))
  3169. ;; REPLACE optional argument is used to replace selected field.
  3170. (should
  3171. (equal "| foo |"
  3172. (org-test-with-temp-text "| <point>1 |"
  3173. (org-table-get-field nil " foo ")
  3174. (buffer-string))))
  3175. (should
  3176. (equal "| 1 | 2 | foo |"
  3177. (org-test-with-temp-text "| 1 | 2 | 3 |"
  3178. (org-table-get-field 3 " foo ")
  3179. (buffer-string))))
  3180. (should
  3181. (equal " 4 "
  3182. (org-test-with-temp-text "| 1 | 2 |\n<point>| 3 | 4 |"
  3183. (org-table-get-field 2))))
  3184. ;; An empty REPLACE string clears the field.
  3185. (should
  3186. (equal "| |"
  3187. (org-test-with-temp-text "| <point>1 |"
  3188. (org-table-get-field nil "")
  3189. (buffer-string))))
  3190. ;; When using REPLACE still return old value.
  3191. (should
  3192. (equal " 1 "
  3193. (org-test-with-temp-text "| <point>1 |"
  3194. (org-table-get-field nil " foo ")))))
  3195. (provide 'test-org-table)
  3196. ;;; test-org-table.el ends here