1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373 |
- ;;; test-org-table.el --- tests for org-table.el -*- lexical-binding: t; -*-
- ;; Copyright (c) David Maus
- ;; Authors: David Maus, Michael Brand
- ;; This file is not part of GNU Emacs.
- ;; This program is free software; you can redistribute it and/or modify
- ;; it under the terms of the GNU General Public License as published by
- ;; the Free Software Foundation, either version 3 of the License, or
- ;; (at your option) any later version.
- ;; This program is distributed in the hope that it will be useful,
- ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
- ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- ;; GNU General Public License for more details.
- ;; You should have received a copy of the GNU General Public License
- ;; along with this program. If not, see <https://www.gnu.org/licenses/>.
- ;;;; Comments:
- ;; Template test file for Org tests. Many tests are also a howto
- ;; example collection as a user documentation, more or less all those
- ;; using `org-test-table-target-expect'. See also the doc string of
- ;; `org-test-table-target-expect'.
- ;;; Code:
- (require 'org-table) ; `org-table-make-reference'
- (require 'ox)
- (ert-deftest test-org-table/simple-formula/no-grouping/no-title-row ()
- "Simple sum without grouping rows, without title row."
- (org-test-table-target-expect
- "
- | 2 |
- | 4 |
- | 8 |
- | replace |
- "
- "
- | 2 |
- | 4 |
- | 8 |
- | 14 |
- "
- 1
- ;; Calc formula
- "#+TBLFM: @>$1 = vsum(@<..@>>)"
- ;; Lisp formula
- "#+TBLFM: @>$1 = '(+ @<..@>>); N"))
- (ert-deftest test-org-table/simple-formula/no-grouping/with-title-row ()
- "Simple sum without grouping rows, with title row."
- (org-test-table-target-expect
- "
- | foo |
- |---------|
- | 2 |
- | 4 |
- | 8 |
- | replace |
- "
- "
- | foo |
- |-----|
- | 2 |
- | 4 |
- | 8 |
- | 14 |
- "
- 1
- ;; Calc formula
- "#+TBLFM: @>$1 = vsum(@I..@>>)"
- ;; Lisp formula
- "#+TBLFM: @>$1 = '(+ @I..@>>); N"))
- (ert-deftest test-org-table/simple-formula/with-grouping/no-title-row ()
- "Simple sum with grouping rows, how not to do."
- ;; The first example has a problem, see the second example in this
- ;; ert-deftest.
- (org-test-table-target-expect
- "
- | 2 |
- | 4 |
- | 8 |
- |---------|
- | replace |
- "
- "
- | 2 |
- | 4 |
- | 8 |
- |----|
- | 14 |
- "
- 1
- ;; Calc formula
- "#+TBLFM: $1 = vsum(@<..@>>)"
- ;; Lisp formula
- "#+TBLFM: $1 = '(+ @<..@>>); N")
- ;; The problem is that the first three rows with the summands are
- ;; considered the header and therefore column formulas are not
- ;; applied on them as shown below. Also export behaves unexpected.
- ;; See next ert-deftest how to group rows right.
- (org-test-table-target-expect
- "
- | 2 | header |
- | 4 | header |
- | 8 | header |
- |---------+---------|
- | replace | replace |
- "
- "
- | 2 | header |
- | 4 | header |
- | 8 | header |
- |----+--------|
- | 14 | 28 |
- "
- 2
- ;; Calc formula
- "#+TBLFM: @>$1 = vsum(@<..@>>) :: $2 = 2 * $1"
- ;; Lisp formula
- "#+TBLFM: @>$1 = '(+ @<..@>>); N :: $2 = '(* 2 $1); N"))
- (ert-deftest test-org-table/simple-formula/with-grouping/with-title-row ()
- "Simple sum with grouping rows, how to do it right."
- ;; Always add a top row with the column names separated by hline to
- ;; get the desired header when you want to group rows.
- (org-test-table-target-expect
- "
- | foo | bar |
- |---------+---------|
- | 2 | replace |
- | 4 | replace |
- | 8 | replace |
- |---------+---------|
- | replace | replace |
- "
- "
- | foo | bar |
- |-----+-----|
- | 2 | 4 |
- | 4 | 8 |
- | 8 | 16 |
- |-----+-----|
- | 14 | 28 |
- "
- 2
- ;; Calc formula
- "#+TBLFM: @>$1 = vsum(@I..@>>) :: $2 = 2 * $1"
- ;; Lisp formula
- "#+TBLFM: @>$1 = '(+ @I..@>>); N :: $2 = '(* 2 $1); N"))
- (defconst references/target-normal "
- | 0 | 1 | replace | replace | replace | replace | replace | replace |
- | z | 1 | replace | replace | replace | replace | replace | replace |
- | | 1 | replace | replace | replace | replace | replace | replace |
- | | | replace | replace | replace | replace | replace | replace |
- "
- "Normal numbers and non-numbers for Lisp and Calc formula.")
- (defconst references/target-special "
- | nan | 1 | replace | replace | replace | replace | replace | replace |
- | uinf | 1 | replace | replace | replace | replace | replace | replace |
- | -inf | 1 | replace | replace | replace | replace | replace | replace |
- | inf | 1 | replace | replace | replace | replace | replace | replace |
- "
- "Special numbers for Calc formula.")
- (ert-deftest test-org-table/references/mode-string-EL ()
- "Basic: Assign field reference, sum of field references, sum
- and len of simple range reference (no row) and complex range
- reference (with row). Mode string EL."
- ;; Empty fields are kept during parsing field but lost as list
- ;; elements within Lisp formula syntactically when used literally
- ;; and not enclosed with " within fields, see last columns with len.
- (org-test-table-target-expect
- references/target-normal
- ;; All the #ERROR show that for Lisp calculations N has to be used.
- "
- | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | z | 1 | z | #ERROR | #ERROR | #ERROR | 2 | 2 |
- | | 1 | | 1 | 1 | 1 | 1 | 1 |
- | | | | 0 | 0 | 0 | 0 | 0 |
- "
- 1 (concat
- "#+TBLFM: $3 = '(identity \"$1\"); EL :: $4 = '(+ $1 $2); EL :: "
- "$5 = '(+ $1..$2); EL :: $6 = '(+ @0$1..@0$2); EL :: "
- "$7 = '(length '($1..$2)); EL :: $8 = '(length '(@0$1..@0$2)); EL"))
- ;; Empty fields are kept during parsing field _and_ as list elements
- ;; within Lisp formula syntactically even when used literally when
- ;; enclosed with " within fields, see last columns with len.
- (org-test-table-target-expect
- "
- | \"0\" | \"1\" | repl | repl | repl | repl | repl | repl |
- | \"z\" | \"1\" | repl | repl | repl | repl | repl | repl |
- | \"\" | \"1\" | repl | repl | repl | repl | repl | repl |
- | \"\" | \"\" | repl | repl | repl | repl | repl | repl |
- "
- "
- | \"0\" | \"1\" | \"0\" | 1 | #ERROR | #ERROR | 2 | 2 |
- | \"z\" | \"1\" | \"z\" | 1 | #ERROR | #ERROR | 2 | 2 |
- | \"\" | \"1\" | \"\" | 1 | #ERROR | #ERROR | 2 | 2 |
- | \"\" | \"\" | \"\" | 0 | #ERROR | #ERROR | 2 | 2 |
- "
- 1 (concat
- "#+TBLFM: $3 = '(concat \"\\\"\" $1 \"\\\"\"); EL :: "
- "$4 = '(+ (string-to-number $1) (string-to-number $2)); EL :: "
- "$5 = '(+ $1..$2); EL :: $6 = '(+ @0$1..@0$2); EL :: "
- "$7 = '(length '($1..$2)); EL :: $8 = '(length '(@0$1..@0$2)); EL")))
- (ert-deftest test-org-table/references/mode-string-E ()
- "Basic: Assign field reference, sum of field references, sum
- and len of simple range reference (no row) and complex range
- reference (with row). Mode string E."
- (let ((lisp
- (concat
- "#+TBLFM: $3 = '(identity $1); E :: $4 = '(+ $1 $2); E :: "
- "$5 = '(+ $1..$2); E :: $6 = '(+ @0$1..@0$2); E :: "
- "$7 = '(length '($1..$2)); E :: $8 = '(length '(@0$1..@0$2)); E"))
- (calc
- (concat
- "#+TBLFM: $3 = $1; E :: $4 = $1 + $2; E :: "
- "$5 = vsum($1..$2); E :: $6 = vsum(@0$1..@0$2); E :: "
- "$7 = vlen($1..$2); E :: $8 = vlen(@0$1..@0$2); E")))
- (org-test-table-target-expect
- references/target-normal
- ;; All the #ERROR show that for Lisp calculations N has to be used.
- "
- | 0 | 1 | 0 | #ERROR | #ERROR | #ERROR | 2 | 2 |
- | z | 1 | z | #ERROR | #ERROR | #ERROR | 2 | 2 |
- | | 1 | | #ERROR | #ERROR | #ERROR | 2 | 2 |
- | | | | #ERROR | #ERROR | #ERROR | 2 | 2 |
- "
- 1 lisp)
- (org-test-table-target-expect
- references/target-normal
- "
- | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | z | 1 | z | z + 1 | z + 1 | z + 1 | 2 | 2 |
- | | 1 | nan | nan | nan | nan | 2 | 2 |
- | | | nan | nan | nan | nan | 2 | 2 |
- "
- 1 calc)
- (org-test-table-target-expect
- references/target-special
- "
- | nan | 1 | nan | nan | nan | nan | 2 | 2 |
- | uinf | 1 | uinf | uinf | uinf | uinf | 2 | 2 |
- | -inf | 1 | -inf | -inf | -inf | -inf | 2 | 2 |
- | inf | 1 | inf | inf | inf | inf | 2 | 2 |
- "
- 1 calc)))
- (ert-deftest test-org-table/references/mode-string-EN ()
- "Basic: Assign field reference, sum of field references, sum
- and len of simple range reference (no row) and complex range
- reference (with row). Mode string EN."
- (let ((lisp (concat
- "#+TBLFM: $3 = '(identity $1); EN :: $4 = '(+ $1 $2); EN :: "
- "$5 = '(+ $1..$2); EN :: $6 = '(+ @0$1..@0$2); EN :: "
- "$7 = '(length '($1..$2)); EN :: "
- "$8 = '(length '(@0$1..@0$2)); EN"))
- (calc (concat
- "#+TBLFM: $3 = $1; EN :: $4 = $1 + $2; EN :: "
- "$5 = vsum($1..$2); EN :: $6 = vsum(@0$1..@0$2); EN :: "
- "$7 = vlen($1..$2); EN :: $8 = vlen(@0$1..@0$2); EN")))
- (org-test-table-target-expect
- references/target-normal
- "
- | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | z | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | | | 0 | 0 | 0 | 0 | 2 | 2 |
- "
- 1 lisp calc)
- (org-test-table-target-expect
- references/target-special
- "
- | nan | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | uinf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | -inf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | inf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- "
- 1 calc)))
- (ert-deftest test-org-table/references/mode-string-L ()
- "Basic: Assign field reference, sum of field references, sum
- and len of simple range reference (no row) and complex range
- reference (with row). Mode string L."
- (org-test-table-target-expect
- references/target-normal
- ;; All the #ERROR show that for Lisp calculations N has to be used.
- "
- | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | z | 1 | z | #ERROR | #ERROR | #ERROR | 2 | 2 |
- | | 1 | | 1 | 1 | 1 | 1 | 1 |
- | | | | 0 | 0 | 0 | 0 | 0 |
- "
- 1 (concat
- "#+TBLFM: $3 = '(identity \"$1\"); L :: $4 = '(+ $1 $2); L :: "
- "$5 = '(+ $1..$2); L :: $6 = '(+ @0$1..@0$2); L :: "
- "$7 = '(length '($1..$2)); L :: $8 = '(length '(@0$1..@0$2)); L")))
- (ert-deftest test-org-table/references/mode-string-none ()
- "Basic: Assign field reference, sum of field references, sum
- and len of simple range reference (no row) and complex range
- reference (with row). No mode string."
- (let ((lisp (concat
- "#+TBLFM: $3 = '(identity $1) :: $4 = '(+ $1 $2) :: "
- "$5 = '(+ $1..$2) :: $6 = '(+ @0$1..@0$2) :: "
- "$7 = '(length '($1..$2)) :: $8 = '(length '(@0$1..@0$2))"))
- (calc (concat
- "#+TBLFM: $3 = $1 :: $4 = $1 + $2 :: "
- "$5 = vsum($1..$2) :: $6 = vsum(@0$1..@0$2) :: "
- "$7 = vlen($1..$2) :: $8 = vlen(@0$1..@0$2)")))
- (org-test-table-target-expect
- references/target-normal
- ;; All the #ERROR show that for Lisp calculations N has to be used.
- "
- | 0 | 1 | 0 | #ERROR | #ERROR | #ERROR | 2 | 2 |
- | z | 1 | z | #ERROR | #ERROR | #ERROR | 2 | 2 |
- | | 1 | | #ERROR | #ERROR | #ERROR | 1 | 1 |
- | | | | #ERROR | 0 | 0 | 0 | 0 |
- "
- 1 lisp)
- (org-test-table-target-expect
- references/target-normal
- "
- | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | z | 1 | z | z + 1 | z + 1 | z + 1 | 2 | 2 |
- | | 1 | 0 | 1 | 1 | 1 | 1 | 1 |
- | | | 0 | 0 | 0 | 0 | 0 | 0 |
- "
- 1 calc)
- (org-test-table-target-expect
- references/target-special
- "
- | nan | 1 | nan | nan | nan | nan | 2 | 2 |
- | uinf | 1 | uinf | uinf | uinf | uinf | 2 | 2 |
- | -inf | 1 | -inf | -inf | -inf | -inf | 2 | 2 |
- | inf | 1 | inf | inf | inf | inf | 2 | 2 |
- "
- 1 calc)))
- (ert-deftest test-org-table/references/mode-string-N ()
- "Basic: Assign field reference, sum of field references, sum
- and len of simple range reference (no row) and complex range
- reference (with row). Mode string N."
- (let ((lisp
- (concat
- "#+TBLFM: $3 = '(identity $1); N :: $4 = '(+ $1 $2); N :: "
- "$5 = '(+ $1..$2); N :: $6 = '(+ @0$1..@0$2); N :: "
- "$7 = '(length '($1..$2)); N :: $8 = '(length '(@0$1..@0$2)); N"))
- (calc
- (concat
- "#+TBLFM: $3 = $1; N :: $4 = $1 + $2; N :: "
- "$5 = vsum($1..$2); N :: $6 = vsum(@0$1..@0$2); N :: "
- "$7 = vlen($1..$2); N :: $8 = vlen(@0$1..@0$2); N")))
- (org-test-table-target-expect
- references/target-normal
- "
- | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | z | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | | 1 | 0 | 1 | 1 | 1 | 1 | 1 |
- | | | 0 | 0 | 0 | 0 | 0 | 0 |
- "
- 1 lisp calc)
- (org-test-table-target-expect
- references/target-special
- "
- | nan | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | uinf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | -inf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | inf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- "
- 1 calc)))
- (ert-deftest test-org-table/mode-string-u ()
- "Basic: verify that mode string u results in units
- simplification mode applied to Calc formulas."
- (org-test-table-target-expect
- "
- | 1.5 A/B | 2.0 B | |
- "
- "
- | 1.5 A/B | 2.0 B | 3. A |
- "
- 1 "#+TBLFM: $3=$1*$2;u"))
- (ert-deftest test-org-table/lisp-return-value ()
- "Basic: Return value of Lisp formulas."
- (org-test-table-target-expect
- "
- | | nil | (list) | '() |
- |-------------------------+-------------+--------+-----|
- | type-of, no L | replace (r) | r | r |
- | type-of identity, no L | r | r | r |
- | identity, no L | r | r | r |
- |-------------------------+-------------+--------+-----|
- | type-of \"@1\" | r | r | r |
- | type-of (identity \"@1\") | r | r | r |
- | identity \"@1\" | r | r | r |
- |-------------------------+-------------+--------+-----|
- | type-of @1 | r | r | r |
- | type-of (identity @1) | r | r | r |
- | identity @1 | r | r | r |
- "
- "
- | | nil | (list) | '() |
- |-------------------------+--------+--------+--------|
- | type-of, no L | string | string | string |
- | type-of identity, no L | string | string | string |
- | identity, no L | nil | (list) | '() |
- |-------------------------+--------+--------+--------|
- | type-of \"@1\" | string | string | string |
- | type-of (identity \"@1\") | string | string | string |
- | identity \"@1\" | nil | (list) | '() |
- |-------------------------+--------+--------+--------|
- | type-of @1 | symbol | symbol | symbol |
- | type-of (identity @1) | symbol | symbol | symbol |
- | identity @1 | nil | nil | nil |
- "
- 1 (concat "#+TBLFM: @2$<<..@2$> = '(type-of @1) :: "
- "@3$<<..@3$> = '(type-of (identity @1)) :: "
- "@4$<<..@4$> = '(identity @1) :: @5$<<..@>$> = '(@0$1); L")))
- (ert-deftest test-org-table/compare ()
- "Basic: Compare field references in Calc."
- (org-test-table-target-expect
- "
- | | 0 | z | | nan | uinf | -inf | inf |
- |------+------+------+------+------+------+------+------|
- | 0 | repl | repl | repl | repl | repl | repl | repl |
- | z | repl | repl | repl | repl | repl | repl | repl |
- | | repl | repl | repl | repl | repl | repl | repl |
- | nan | repl | repl | repl | repl | repl | repl | repl |
- | uinf | repl | repl | repl | repl | repl | repl | repl |
- | -inf | repl | repl | repl | repl | repl | repl | repl |
- | inf | repl | repl | repl | repl | repl | repl | repl |
- "
- "
- | | 0 | z | | nan | uinf | -inf | inf |
- |------+---+---+---+-----+------+------+-----|
- | 0 | x | | | | | | |
- | z | | x | | | | | |
- | | | | x | | | | |
- | nan | | | | x | | | |
- | uinf | | | | | x | | |
- | -inf | | | | | | x | |
- | inf | | | | | | | x |
- "
- 1
- ;; Compare field reference ($1) with field reference (@1)
- "#+TBLFM: @<<$<<..@>$> = if(\"$1\" == \"@1\", x, string(\"\")); E"
- ;; Compare field reference ($1) with absolute term
- (concat "#+TBLFM: "
- "$2 = if(\"$1\" == \"(0)\" , x, string(\"\")); E :: "
- "$3 = if(\"$1\" == \"(z)\" , x, string(\"\")); E :: "
- "$4 = if(\"$1\" == \"nan\" , x, string(\"\")); E :: "
- "$5 = if(\"$1\" == \"(nan)\" , x, string(\"\")); E :: "
- "$6 = if(\"$1\" == \"(uinf)\", x, string(\"\")); E :: "
- "$7 = if(\"$1\" == \"(-inf)\", x, string(\"\")); E :: "
- "$8 = if(\"$1\" == \"(inf)\" , x, string(\"\")); E"))
- ;; Check field reference converted from an empty field: Despite this
- ;; field reference will not end up in a result, Calc evaluates it.
- ;; Make sure that also then there is no Calc error.
- (org-test-table-target-expect
- "
- | 0 | replace |
- | z | replace |
- | | replace |
- | nan | replace |
- "
- "
- | 0 | 1 |
- | z | z + 1 |
- | | |
- | nan | nan |
- "
- 1 "#+TBLFM: $2 = if(\"$1\" == \"nan\", string(\"\"), $1 + 1); E"))
- (ert-deftest test-org-table/empty-field ()
- "Examples how to deal with empty fields."
- ;; Test if one field is empty, else do a calculation
- (org-test-table-target-expect
- "
- | -1 | replace |
- | 0 | replace |
- | | replace |
- "
- "
- | -1 | 0 |
- | 0 | 1 |
- | | |
- "
- 1
- ;; Calc formula
- "#+TBLFM: $2 = if(\"$1\" == \"nan\", string(\"\"), $1 + 1); E"
- ;; Lisp formula
- "#+TBLFM: $2 = '(if (eq \"$1\" \"\") \"\" (1+ $1)); L")
- ;; Test if several fields are empty, else do a calculation
- (org-test-table-target-expect
- "
- | 1 | 2 | replace |
- | 4 | | replace |
- | | 8 | replace |
- | | | replace |
- "
- "
- | 1 | 2 | 3 |
- | 4 | | |
- | | 8 | |
- | | | |
- "
- 1
- ;; Calc formula
- (concat "#+TBLFM: $3 = if(\"$1\" == \"nan\" || \"$2\" == \"nan\", "
- "string(\"\"), $1 + $2); E")
- ;; Lisp formula
- (concat "#+TBLFM: $3 = '(if (or (eq \"$1\" \"\") (eq \"$2\" \"\")) "
- "\"\" (+ $1 $2)); L"))
- ;; $2: Use $1 + 0.5 if $1 available, else only reformat $2 if $2 available
- (org-test-table-target-expect
- "
- | 1.5 | 0 |
- | 3.5 | |
- | | 5 |
- | | |
- "
- "
- | 1.5 | 2.0 |
- | 3.5 | 4.0 |
- | | 5.0 |
- | | |
- "
- 1
- ;; Calc formula
- (concat "#+TBLFM: $2 = if(\"$1\" == \"nan\", "
- "if(\"$2\" == \"nan\", string(\"\"), $2 +.0), $1 + 0.5); E f-1")
- ;; Lisp formula not implemented yet
- )
- ;; Empty fields in simple and complex range reference
- (org-test-table-target-expect
- "
- | | | | | repl | repl | repl | repl | repl | repl |
- | | | 5 | 7 | repl | repl | repl | repl | repl | repl |
- | 1 | 3 | 5 | 7 | repl | repl | repl | repl | repl | repl |
- "
- "
- | | | | | | | | | 0 | 0 |
- | | | 5 | 7 | | | 6 | 6 | 3 | 3 |
- | 1 | 3 | 5 | 7 | 4 | 4 | 4 | 4 | 4 | 4 |
- "
- 1
- ;; Calc formula
- (concat
- "#+TBLFM: "
- "$5 = if(typeof(vmean($1..$4)) == 12, "
- "string(\"\"), vmean($1..$4)); E :: "
- "$6 = if(typeof(vmean(@0$1..@0$4)) == 12, "
- "string(\"\"), vmean(@0$1..@0$4)); E :: "
- "$7 = if(\"$1..$4\" == \"[]\", string(\"\"), vmean($1..$4)) :: "
- "$8 = if(\"@0$1..@0$4\" == \"[]\", string(\"\"), vmean(@0$1..@0$4)) :: "
- "$9 = vmean($1..$4); EN :: "
- "$10 = vmean(@0$1..@0$4); EN")
- ;; Lisp formula
- (concat
- "#+TBLFM: "
- "$5 = '(let ((l '($1..$4))) (if (member \"\" l) \"\" "
- "(/ (apply '+ (mapcar 'string-to-number l)) (length l)))); E :: "
- "$6 = '(let ((l '(@0$1..@0$4))) (if (member \"\" l) \"\" "
- "(/ (apply '+ (mapcar 'string-to-number l)) (length l)))); E :: "
- "$7 = '(let ((l '($1..$4))) "
- "(if l (/ (apply '+ l) (length l)) \"\")); N :: "
- "$8 = '(let ((l '(@0$1..@0$4))) "
- "(if l (/ (apply '+ l) (length l)) \"\")); N :: "
- "$9 = '(/ (+ $1..$4) (length '($1..$4))); EN :: "
- "$10 = '(/ (+ @0$1..@0$4) (length '(@0$1..@0$4))); EN")))
- (ert-deftest test-org-table/copy-field ()
- "Experiments on how to copy one field into another field.
- See also `test-org-table/remote-reference-access'."
- (let ((target "
- | 0 | replace |
- | a b | replace |
- | c d | replace |
- | | replace |
- | 2012-12 | replace |
- | [2012-12-31 Mon] | replace |
- "))
- ;; Lisp formula to copy literally
- (org-test-table-target-expect
- target
- "
- | 0 | 0 |
- | a b | a b |
- | c d | c d |
- | | |
- | 2012-12 | 2012-12 |
- | [2012-12-31 Mon] | [2012-12-31 Mon] |
- "
- 1 "#+TBLFM: $2 = '(identity $1)")
- ;; Calc formula to copy quite literally
- (org-test-table-target-expect
- target
- "
- | 0 | 0 |
- | a b | a b |
- | c d | c d |
- | | |
- | 2012-12 | 2012-12 |
- | [2012-12-31 Mon] | [2012-12-31 Mon] |
- "
- 1 (concat "#+TBLFM: $2 = if(\"$1\" == \"nan\", "
- "string(\"\"), string(subvec(\"$1\", 2, vlen(\"$1\")))); E"))
- ;; Calc formula simple
- (org-test-table-target-expect
- target
- "
- | 0 | 0 |
- | a b | a b |
- | c d | c d |
- | | |
- | 2012-12 | 2000 |
- | [2012-12-31 Mon] | [2012-12-31 Mon] |
- "
- 1 "#+TBLFM: $2 = if(\"$1\" == \"nan\", string(\"\"), $1); E")))
- (ert-deftest test-org-table/copy-down ()
- "Test `org-table-copy-down' specifications."
- ;; Error when there is nothing to copy in the current field or the
- ;; field above.
- (should-error
- (org-test-with-temp-text "| |\n| <point> |"
- (org-table-copy-down 1)))
- ;; Error when there is nothing to copy in the Nth field.
- (should-error
- (org-test-with-temp-text "| |\n| foo |\n| <point> |"
- (org-table-copy-down 2)))
- ;; In an empty field, copy field above.
- (should
- (equal "| foo |\n| foo |"
- (org-test-with-temp-text "| foo |\n| <point> |"
- (org-table-copy-down 1)
- (buffer-string))))
- ;; In a non-empty field, copy it below.
- (should
- (equal "| foo |\n| foo |\n"
- (org-test-with-temp-text "| <point>foo |"
- (org-table-copy-down 1)
- (buffer-string))))
- ;; If field is a number or a timestamp, or is prefixed or suffixed
- ;; with a number, increment it by one unit.
- (should
- (equal "| 1 |\n| 2 |\n"
- (org-test-with-temp-text "| <point>1 |"
- (let ((org-table-copy-increment t)) (org-table-copy-down 1))
- (buffer-string))))
- (should
- (string-match-p "<2012-03-30"
- (org-test-with-temp-text "| <point><2012-03-29> |"
- (let ((org-table-copy-increment t))
- (org-table-copy-down 1))
- (buffer-string))))
- (should
- (equal "| A1 |\n| A2 |\n"
- (org-test-with-temp-text "| <point>A1 |"
- (let ((org-table-copy-increment t)) (org-table-copy-down 1))
- (buffer-string))))
- (should
- (equal "| 1A |\n| 2A |\n"
- (org-test-with-temp-text "| <point>1A |"
- (let ((org-table-copy-increment t)) (org-table-copy-down 1))
- (buffer-string))))
- ;; When `org-table-copy-increment' is nil, or when argument is 0, do
- ;; not increment.
- (should
- (equal "| 1 |\n| 1 |\n"
- (org-test-with-temp-text "| <point>1 |"
- (let ((org-table-copy-increment nil)) (org-table-copy-down 1))
- (buffer-string))))
- (should
- (equal "| 1 |\n| 1 |\n"
- (org-test-with-temp-text "| <point>1 |"
- (let ((org-table-copy-increment t)) (org-table-copy-down 0))
- (buffer-string))))
- ;; When there is a field just above field being incremented, try to
- ;; use it to guess increment step.
- (should
- (equal "| 4 |\n| 3 |\n| 2 |\n"
- (org-test-with-temp-text "| 4 |\n| <point>3 |"
- (let ((org-table-copy-increment t)) (org-table-copy-down 1))
- (buffer-string))))
- (should
- (equal "| A0 |\n| A2 |\n| A4 |\n"
- (org-test-with-temp-text "| A0 |\n| <point>A2 |"
- (let ((org-table-copy-increment t)) (org-table-copy-down 1))
- (buffer-string))))
- ;; Both fields need to have the same type. In the special case of
- ;; number-prefixed or suffixed fields, make sure both fields have
- ;; the same pattern.
- (should
- (equal "| A4 |\n| 3 |\n| 4 |\n"
- (org-test-with-temp-text "| A4 |\n| <point>3 |"
- (let ((org-table-copy-increment t)) (org-table-copy-down 1))
- (buffer-string))))
- (should
- (equal "| 0A |\n| A2 |\n| A3 |\n"
- (org-test-with-temp-text "| 0A |\n| <point>A2 |"
- (let ((org-table-copy-increment t)) (org-table-copy-down 1))
- (buffer-string))))
- (should
- (equal "| A0 |\n| 2A |\n| 3A |\n"
- (org-test-with-temp-text "| A0 |\n| <point>2A |"
- (let ((org-table-copy-increment t)) (org-table-copy-down 1))
- (buffer-string))))
- ;; Do not search field above past blank fields and horizontal
- ;; separators.
- (should
- (equal "| 4 |\n|---|\n| 3 |\n| 4 |\n"
- (org-test-with-temp-text "| 4 |\n|---|\n| <point>3 |"
- (let ((org-table-copy-increment t)) (org-table-copy-down 1))
- (buffer-string))))
- (should
- (equal "| 4 |\n| |\n| 3 |\n| 4 |\n"
- (org-test-with-temp-text "| 4 |\n| |\n| <point>3 |"
- (let ((org-table-copy-increment t)) (org-table-copy-down 1))
- (buffer-string))))
- ;; When `org-table-copy-increment' is a number, use it as the
- ;; increment step, ignoring any previous field.
- (should
- (equal "| 1 |\n| 3 |\n| 6 |\n"
- (org-test-with-temp-text "| 1 |\n| <point>3 |"
- (let ((org-table-copy-increment 3)) (org-table-copy-down 1))
- (buffer-string))))
- ;; However, if argument is 0, do not increment whatsoever.
- (should
- (equal "| 1 |\n| 3 |\n| 3 |\n"
- (org-test-with-temp-text "| 1 |\n| <point>3 |"
- (let ((org-table-copy-increment t)) (org-table-copy-down 0))
- (buffer-string))))
- (should
- (equal "| 1 |\n| 3 |\n| 3 |\n"
- (org-test-with-temp-text "| 1 |\n| <point>3 |"
- (let ((org-table-copy-increment 3)) (org-table-copy-down 0))
- (buffer-string)))))
- (ert-deftest test-org-table/sub-total ()
- "Grouped rows with sub-total.
- Begin range with \"@II\" to handle multiline header. Convert
- integer to float with \"+.0\" for sub-total of items c1 and c2.
- Sum empty fields as value zero but without ignoring them for
- \"vlen\" with format specifier \"EN\". Format possibly empty
- results with the Calc formatter \"f-1\" instead of the printf
- formatter \"%.1f\"."
- (org-test-table-target-expect
- "
- |-------+---------+---------|
- | Item | Item | Sub- |
- | name | value | total |
- |-------+---------+---------|
- | a1 | 4.1 | replace |
- | a2 | 8.2 | replace |
- | a3 | | replace |
- |-------+---------+---------|
- | b1 | 16.0 | replace |
- |-------+---------+---------|
- | c1 | 32 | replace |
- | c2 | 64 | replace |
- |-------+---------+---------|
- | Total | replace | replace |
- |-------+---------+---------|
- "
- "
- |-------+-------+-------|
- | Item | Item | Sub- |
- | name | value | total |
- |-------+-------+-------|
- | a1 | 4.1 | |
- | a2 | 8.2 | |
- | a3 | | 12.3 |
- |-------+-------+-------|
- | b1 | 16.0 | 16.0 |
- |-------+-------+-------|
- | c1 | 32 | |
- | c2 | 64 | 96.0 |
- |-------+-------+-------|
- | Total | 124.3 | |
- |-------+-------+-------|
- "
- 1 (concat "#+TBLFM: @>$2 = vsum(@II..@>>) ::"
- "$3 = if(vlen(@0..@+I) == 1, "
- "vsum(@-I$2..@+I$2) +.0, string(\"\")); EN f-1 :: "
- "@>$3 = string(\"\")")))
- (ert-deftest test-org-table/org-lookup-all ()
- "Use `org-lookup-all' for several GROUP BY as in SQL and for ranking.
- See also URL `https://orgmode.org/worg/org-tutorials/org-lookups.html'."
- (let ((data "
- #+NAME: data
- | Purchase | Product | Shop | Rating |
- |----------+---------+------+--------|
- | a | p1 | s1 | 1 |
- | b | p1 | s2 | 4 |
- | c | p2 | s1 | 2 |
- | d | p3 | s2 | 8 |
- "))
- ;; Product rating and ranking by average purchase from "#+NAME: data"
- (org-test-table-target-expect
- (concat data "
- | Product | Rating | Ranking |
- |---------+---------+---------|
- | p1 | replace | replace |
- | p2 | replace | replace |
- | p3 | replace | replace |
- ")
- (concat data "
- | Product | Rating | Ranking |
- |---------+--------+---------|
- | p1 | 2.5 | 2 |
- | p2 | 2.0 | 3 |
- | p3 | 8.0 | 1 |
- ")
- 2 (concat
- "#+TBLFM: $2 = '(let ((all (org-lookup-all '$1 "
- "'(remote(data, @I$2..@>$2)) '(remote(data, @I$4..@>$4))))) "
- "(/ (apply '+ all) (length all) 1.0)); L :: "
- "$3 = '(+ 1 (length (org-lookup-all $2 '(@I$2..@>$2) nil '<))); N"))
- ;; Shop rating and ranking by average purchase from "#+NAME: data"
- (org-test-table-target-expect
- (concat data "
- | Shop | Rating | Ranking |
- |------+---------+---------|
- | s1 | replace | replace |
- | s2 | replace | replace |
- ")
- (concat data "
- | Shop | Rating | Ranking |
- |------+--------+---------|
- | s1 | 1.5 | 2 |
- | s2 | 6.0 | 1 |
- ")
- 2 (concat
- "#+TBLFM: $2 = '(let ((all (org-lookup-all '$1 "
- "'(remote(data, @I$3..@>$3)) '(remote(data, @I$4..@>$4))))) "
- "(/ (apply '+ all) (length all) 1.0)); L :: "
- "$3 = '(+ 1 (length (org-lookup-all $2 '(@I$2..@>$2) nil '<))); N"))))
- (ert-deftest test-org-table/org-table-make-reference/mode-string-EL ()
- ;; For Lisp formula only
- (should (equal "0" (org-table-make-reference "0" t nil 'literal)))
- (should (equal "z" (org-table-make-reference "z" t nil 'literal)))
- (should (equal "" (org-table-make-reference "" t nil 'literal)))
- (should (equal "0 1" (org-table-make-reference '("0" "1") t nil 'literal)))
- (should (equal "z 1" (org-table-make-reference '("z" "1") t nil 'literal)))
- (should (equal " 1" (org-table-make-reference '("" "1") t nil 'literal)))
- (should (equal " " (org-table-make-reference '("" "") t nil 'literal))))
- (ert-deftest test-org-table/org-table-make-reference/mode-string-E ()
- ;; For Lisp formula
- (should (equal "\"0\"" (org-table-make-reference "0" t nil t)))
- (should (equal "\"z\"" (org-table-make-reference "z" t nil t)))
- (should (equal"\"\"" (org-table-make-reference "" t nil t)))
- (should (equal "\"0\" \"1\"" (org-table-make-reference '("0""1") t nil t)))
- (should (equal "\"z\" \"1\"" (org-table-make-reference '("z""1") t nil t)))
- (should (equal"\"\" \"1\"" (org-table-make-reference '("""1") t nil t)))
- (should (equal"\"\" \"\""(org-table-make-reference '("""" ) t nil t)))
- ;; For Calc formula
- (should (equal "(0)" (org-table-make-reference "0" t nil nil)))
- (should (equal "(z)" (org-table-make-reference "z" t nil nil)))
- (should (equal "nan" (org-table-make-reference "" t nil nil)))
- (should (equal "[0,1]" (org-table-make-reference '("0" "1") t nil nil)))
- (should (equal "[z,1]" (org-table-make-reference '("z" "1") t nil nil)))
- (should (equal "[nan,1]" (org-table-make-reference '("" "1") t nil nil)))
- (should (equal "[nan,nan]" (org-table-make-reference '("" "") t nil nil)))
- ;; For Calc formula, special numbers
- (should (equal "(nan)" (org-table-make-reference "nan" t nil nil)))
- (should (equal "(uinf)" (org-table-make-reference "uinf" t nil nil)))
- (should (equal "(-inf)" (org-table-make-reference "-inf" t nil nil)))
- (should (equal "(inf)" (org-table-make-reference "inf" t nil nil)))
- (should (equal "[nan,1]" (org-table-make-reference '("nan" "1") t nil nil)))
- (should (equal "[uinf,1]" (org-table-make-reference '("uinf" "1") t nil nil)))
- (should (equal "[-inf,1]" (org-table-make-reference '("-inf" "1") t nil nil)))
- (should (equal "[inf,1]" (org-table-make-reference '("inf" "1") t nil nil))))
- (ert-deftest test-org-table/org-table-make-reference/mode-string-EN ()
- ;; For Lisp formula
- (should (equal "0" (org-table-make-reference "0" t t t)))
- (should (equal "0" (org-table-make-reference "z" t t t)))
- (should (equal "0" (org-table-make-reference "" t t t)))
- (should (equal "0 1" (org-table-make-reference '("0" "1") t t t)))
- (should (equal "0 1" (org-table-make-reference '("z" "1") t t t)))
- (should (equal "0 1" (org-table-make-reference '("" "1") t t t)))
- (should (equal "0 0" (org-table-make-reference '("" "" ) t t t)))
- ;; For Calc formula
- (should (equal "(0)" (org-table-make-reference "0" t t nil)))
- (should (equal "(0)" (org-table-make-reference "z" t t nil)))
- (should (equal "(0)" (org-table-make-reference "" t t nil)))
- (should (equal "[0,1]" (org-table-make-reference '("0" "1") t t nil)))
- (should (equal "[0,1]" (org-table-make-reference '("z" "1") t t nil)))
- (should (equal "[0,1]" (org-table-make-reference '("" "1") t t nil)))
- (should (equal "[0,0]" (org-table-make-reference '("" "" ) t t nil)))
- ;; For Calc formula, special numbers
- (should (equal "(0)" (org-table-make-reference "nan" t t nil)))
- (should (equal "(0)" (org-table-make-reference "uinf" t t nil)))
- (should (equal "(0)" (org-table-make-reference "-inf" t t nil)))
- (should (equal "(0)" (org-table-make-reference "inf" t t nil)))
- (should (equal "[0,1]" (org-table-make-reference '( "nan" "1") t t nil)))
- (should (equal "[0,1]" (org-table-make-reference '("uinf" "1") t t nil)))
- (should (equal "[0,1]" (org-table-make-reference '("-inf" "1") t t nil)))
- (should (equal "[0,1]" (org-table-make-reference '( "inf" "1") t t nil))))
- (ert-deftest test-org-table/org-table-make-reference/mode-string-L ()
- ;; For Lisp formula only
- (should (equal "0" (org-table-make-reference "0" nil nil 'literal)))
- (should (equal "z" (org-table-make-reference "z" nil nil 'literal)))
- (should (equal "" (org-table-make-reference "" nil nil 'literal)))
- (should (equal "0 1" (org-table-make-reference '("0" "1") nil nil 'literal)))
- (should (equal "z 1" (org-table-make-reference '("z" "1") nil nil 'literal)))
- (should (equal "1" (org-table-make-reference '("" "1") nil nil 'literal)))
- (should (equal "" (org-table-make-reference '("" "" ) nil nil 'literal))))
- (ert-deftest test-org-table/org-table-make-reference/mode-string-none ()
- ;; For Lisp formula
- (should (equal "\"0\"" (org-table-make-reference "0" nil nil t)))
- (should (equal "\"z\"" (org-table-make-reference "z" nil nil t)))
- (should (equal "" (org-table-make-reference "" nil nil t)))
- (should (equal "\"0\" \"1\"" (org-table-make-reference '("0" "1") nil nil t)))
- (should (equal "\"z\" \"1\"" (org-table-make-reference '("z" "1") nil nil t)))
- (should (equal "\"1\"" (org-table-make-reference '("" "1") nil nil t)))
- (should (equal "" (org-table-make-reference '("" "" ) nil nil t)))
- ;; For Calc formula
- (should (equal "(0)" (org-table-make-reference "0" nil nil nil)))
- (should (equal "(z)" (org-table-make-reference "z" nil nil nil)))
- (should (equal "(0)" (org-table-make-reference "" nil nil nil)))
- (should (equal "[0,1]" (org-table-make-reference '("0" "1") nil nil nil)))
- (should (equal "[z,1]" (org-table-make-reference '("z" "1") nil nil nil)))
- (should (equal "[1]" (org-table-make-reference '("" "1") nil nil nil)))
- (should (equal "[]" (org-table-make-reference '("" "" ) nil nil nil)))
- ;; For Calc formula, special numbers
- (should (equal "(nan)" (org-table-make-reference "nan" nil nil nil)))
- (should (equal "(uinf)" (org-table-make-reference "uinf" nil nil nil)))
- (should (equal "(-inf)" (org-table-make-reference "-inf" nil nil nil)))
- (should (equal "(inf)" (org-table-make-reference "inf" nil nil nil)))
- (should (equal "[nan,1]" (org-table-make-reference '( "nan" "1") nil nil nil)))
- (should (equal "[uinf,1]" (org-table-make-reference '("uinf" "1") nil nil nil)))
- (should (equal "[-inf,1]" (org-table-make-reference '("-inf" "1") nil nil nil)))
- (should (equal "[inf,1]" (org-table-make-reference '( "inf" "1") nil nil nil))))
- (ert-deftest test-org-table/org-table-make-reference/mode-string-N ()
- ;; For Lisp formula
- (should (equal "0" (org-table-make-reference "0" nil t t)))
- (should (equal "0" (org-table-make-reference "z" nil t t)))
- (should (equal "" (org-table-make-reference "" nil t t)))
- (should (equal "0 1" (org-table-make-reference '("0" "1") nil t t)))
- (should (equal "0 1" (org-table-make-reference '("z" "1") nil t t)))
- (should (equal "1" (org-table-make-reference '("" "1") nil t t)))
- (should (equal "" (org-table-make-reference '("" "" ) nil t t)))
- ;; For Calc formula
- (should (equal "(0)" (org-table-make-reference "0" nil t nil)))
- (should (equal "(0)" (org-table-make-reference "z" nil t nil)))
- (should (equal "(0)" (org-table-make-reference "" nil t nil)))
- (should (equal "[0,1]" (org-table-make-reference '("0" "1") nil t nil)))
- (should (equal "[0,1]" (org-table-make-reference '("z" "1") nil t nil)))
- (should (equal "[1]" (org-table-make-reference '("" "1") nil t nil)))
- (should (equal "[]" (org-table-make-reference '("" "" ) nil t nil)))
- ;; For Calc formula, special numbers
- (should (equal "(0)" (org-table-make-reference "nan" nil t nil)))
- (should (equal "(0)" (org-table-make-reference "uinf" nil t nil)))
- (should (equal "(0)" (org-table-make-reference "-inf" nil t nil)))
- (should (equal "(0)" (org-table-make-reference "inf" nil t nil)))
- (should (equal "[0,1]" (org-table-make-reference '( "nan" "1") nil t nil)))
- (should (equal "[0,1]" (org-table-make-reference '("uinf" "1") nil t nil)))
- (should (equal "[0,1]" (org-table-make-reference '("-inf" "1") nil t nil)))
- (should (equal "[0,1]" (org-table-make-reference '( "inf" "1") nil t nil))))
- (ert-deftest test-org-table/org-table-convert-refs-to-an/1 ()
- "Simple reference @2$1."
- (should
- (string= "A2" (org-table-convert-refs-to-an "@2$1"))))
- ;; TODO: Test broken
- ;; (ert-deftest test-org-table/org-table-convert-refs-to-an/2 ()
- ;; "Self reference @1$1."
- ;; (should
- ;; (string= "A1 = $0" (org-table-convert-refs-to-an "@1$1 = $0"))))
- (ert-deftest test-org-table/org-table-convert-refs-to-an/3 ()
- "Remote reference."
- (should
- (string= "C& = remote(FOO, @@#B&)" (org-table-convert-refs-to-an "$3 = remote(FOO, @@#$2)"))))
- (ert-deftest test-org-table/org-table-convert-refs-to-rc/1 ()
- "Simple reference @2$1."
- (should
- (string= "@2$1" (org-table-convert-refs-to-rc "A2"))))
- (ert-deftest test-org-table/org-table-convert-refs-to-rc/2 ()
- "Self reference $0."
- (should
- (string= "@1$1 = $0" (org-table-convert-refs-to-rc "A1 = $0"))))
- ;; TODO: Test Broken
- ;; (ert-deftest test-org-table/org-table-convert-refs-to-rc/3 ()
- ;; "Remote reference."
- ;; (should
- ;; (string= "$3 = remote(FOO, @@#$2)" (org-table-convert-refs-to-rc "C& = remote(FOO, @@#B&)"))))
- (ert-deftest test-org-table/remote-reference-access ()
- "Access to remote reference.
- See also `test-org-table/copy-field'."
- (org-test-table-target-expect
- "
- #+NAME: table
- | | x 42 | |
- | replace | replace |
- "
- "
- #+NAME: table
- | | x 42 | |
- | x 42 | 84 x |
- "
- 1 (concat "#+TBLFM: "
- ;; Copy text without calculation: Use Lisp formula
- "$1 = '(identity remote(table, @1$2)) :: "
- ;; Do a calculation: Use Calc (or Lisp ) formula
- "$2 = 2 * remote(table, @1$2)")))
- (ert-deftest test-org-table/remote-reference-indirect ()
- "Access to remote reference with indirection of name or ID."
- (let ((source-tables "
- #+NAME: 2012
- | amount |
- |--------|
- | 1 |
- | 2 |
- |--------|
- | 3 |
- #+TBLFM: @>$1 = vsum(@I..@II)
- #+NAME: 2013
- | amount |
- |--------|
- | 4 |
- | 8 |
- |--------|
- | 12 |
- #+TBLFM: @>$1 = vsum(@I..@II)
- "))
- ;; Read several remote references from same column
- (org-test-table-target-expect
- (concat source-tables "
- #+NAME: summary
- | year | amount |
- |-------+---------|
- | 2012 | replace |
- | 2013 | replace |
- |-------+---------|
- | total | replace |
- ")
- (concat source-tables "
- #+NAME: summary
- | year | amount |
- |-------+--------|
- | 2012 | 3 |
- | 2013 | 12 |
- |-------+--------|
- | total | 15 |
- ")
- 1
- ;; Calc formula
- "#+TBLFM: @<<$2..@>>$2 = remote($<, @>$1) :: @>$2 = vsum(@I..@II)"
- ;; Lisp formula
- (concat "#+TBLFM: @<<$2..@>>$2 = '(identity remote($<, @>$1)); N :: "
- "@>$2 = '(+ @I..@II); N"))
- ;; Read several remote references from same row
- (org-test-table-target-expect
- (concat source-tables "
- #+NAME: summary
- | year | 2012 | 2013 | total |
- |--------+---------+---------+---------|
- | amount | replace | replace | replace |
- ")
- (concat source-tables "
- #+NAME: summary
- | year | 2012 | 2013 | total |
- |--------+------+------+-------|
- | amount | 3 | 12 | 15 |
- ")
- 1
- ;; Calc formula
- "#+TBLFM: @2$<<..@2$>> = remote(@<, @>$1) :: @2$> = vsum($<<..$>>)"
- ;; Lisp formula
- (concat "#+TBLFM: @2$<<..@2$>> = '(identity remote(@<, @>$1)); N :: "
- "@2$> = '(+ $<<..$>>); N"))))
- (ert-deftest test-org-table/org-at-TBLFM-p ()
- (org-test-with-temp-text-in-file
- "
- | 1 |
- | 2 |
- #+TBLFM: $2=$1*2
- "
- (goto-char (point-min))
- (forward-line 2)
- (should (equal (org-at-TBLFM-p) nil))
- (goto-char (point-min))
- (forward-line 3)
- (should (equal (org-at-TBLFM-p) t))
- (goto-char (point-min))
- (forward-line 4)
- (should (equal (org-at-TBLFM-p) nil))))
- (ert-deftest test-org-table/org-table-TBLFM-begin ()
- (org-test-with-temp-text-in-file
- "
- | 1 |
- | 2 |
- #+TBLFM: $2=$1*2
- "
- (goto-char (point-min))
- (should (equal (org-table-TBLFM-begin)
- nil))
- (goto-char (point-min))
- (forward-line 1)
- (should (equal (org-table-TBLFM-begin)
- nil))
- (goto-char (point-min))
- (forward-line 3)
- (should (= (org-table-TBLFM-begin)
- 14))
- (goto-char (point-min))
- (forward-line 4)
- (should (= (org-table-TBLFM-begin)
- 14))
- ))
- (ert-deftest test-org-table/org-table-TBLFM-begin-for-multiple-TBLFM-lines ()
- "For multiple #+TBLFM lines."
- (org-test-with-temp-text-in-file
- "
- | 1 |
- | 2 |
- #+TBLFM: $2=$1*1
- #+TBLFM: $2=$1*2
- "
- (goto-char (point-min))
- (should (equal (org-table-TBLFM-begin)
- nil))
- (goto-char (point-min))
- (forward-line 1)
- (should (equal (org-table-TBLFM-begin)
- nil))
- (goto-char (point-min))
- (forward-line 3)
- (should (= (org-table-TBLFM-begin)
- 14))
- (goto-char (point-min))
- (forward-line 4)
- (should (= (org-table-TBLFM-begin)
- 14))
- (goto-char (point-min))
- (forward-line 5)
- (should (= (org-table-TBLFM-begin)
- 14))
- ))
- (ert-deftest test-org-table/org-table-TBLFM-begin-for-pultiple-TBLFM-lines-blocks ()
- (org-test-with-temp-text-in-file
- "
- | 1 |
- | 2 |
- #+TBLFM: $2=$1*1
- #+TBLFM: $2=$1*2
- | 6 |
- | 7 |
- #+TBLFM: $2=$1*1
- #+TBLFM: $2=$1*2
- "
- (goto-char (point-min))
- (should (equal (org-table-TBLFM-begin)
- nil))
- (goto-char (point-min))
- (forward-line 1)
- (should (equal (org-table-TBLFM-begin)
- nil))
- (goto-char (point-min))
- (forward-line 3)
- (should (= (org-table-TBLFM-begin)
- 14))
- (goto-char (point-min))
- (forward-line 4)
- (should (= (org-table-TBLFM-begin)
- 14))
- (goto-char (point-min))
- (forward-line 5)
- (should (= (org-table-TBLFM-begin)
- 14))
- (goto-char (point-min))
- (forward-line 6)
- (should (= (org-table-TBLFM-begin)
- 14))
- (goto-char (point-min))
- (forward-line 8)
- (should (= (org-table-TBLFM-begin)
- 61))
- (goto-char (point-min))
- (forward-line 9)
- (should (= (org-table-TBLFM-begin)
- 61))
- (goto-char (point-min))
- (forward-line 10)
- (should (= (org-table-TBLFM-begin)
- 61))))
- (ert-deftest test-org-table/org-table-calc-current-TBLFM ()
- (org-test-with-temp-text-in-file
- "
- | 1 | |
- | 2 | |
- #+TBLFM: $2=$1*1
- #+TBLFM: $2=$1*2
- #+TBLFM: $2=$1*3
- "
- (let ((got (progn (goto-char (point-min))
- (forward-line 3)
- (org-table-calc-current-TBLFM)
- (buffer-string)))
- (expect "
- | 1 | 1 |
- | 2 | 2 |
- #+TBLFM: $2=$1*1
- #+TBLFM: $2=$1*2
- #+TBLFM: $2=$1*3
- "))
- (should (string= got
- expect)))
- (let ((got (progn (goto-char (point-min))
- (forward-line 4)
- (org-table-calc-current-TBLFM)
- (buffer-string)))
- (expect "
- | 1 | 2 |
- | 2 | 4 |
- #+TBLFM: $2=$1*1
- #+TBLFM: $2=$1*2
- #+TBLFM: $2=$1*3
- "))
- (should (string= got
- expect)))))
- (ert-deftest test-org-table/org-table-calc-current-TBLFM-when-stop-because-of-error ()
- "org-table-calc-current-TBLFM should preserve the input as it was."
- (org-test-with-temp-text-in-file
- "
- | 1 | 1 |
- | 2 | 2 |
- #+TBLFM: $2=$1*1
- #+TBLFM: $2=$1*2::$2=$1*2
- #+TBLFM: $2=$1*3
- "
- (let ((expect "
- | 1 | 1 |
- | 2 | 2 |
- #+TBLFM: $2=$1*1
- #+TBLFM: $2=$1*2::$2=$1*2
- #+TBLFM: $2=$1*3
- "))
- (goto-char (point-min))
- (forward-line 4)
- (should-error (org-table-calc-current-TBLFM))
- (setq got (buffer-string))
- (message "%s" got)
- (should (string= got
- expect)))))
- ;;; Tables as Lisp
- (ert-deftest test-org-table/to-lisp ()
- "Test `orgtbl-to-lisp' specifications."
- ;; 2x2 no header
- (should
- (equal '(("a" "b") ("c" "d"))
- (org-table-to-lisp "|a|b|\n|c|d|")))
- ;; 2x2 with 1-line header
- (should
- (equal '(("a" "b") hline ("c" "d"))
- (org-table-to-lisp "|a|b|\n|-\n|c|d|")))
- ;; 2x4 with 2-line header
- (should
- (equal '(("a" "b") ("A" "B") hline ("c" "d") ("aa" "bb"))
- (org-table-to-lisp "|a|b|\n|A|B|\n|-\n|c|d|\n|aa|bb|")))
- ;; leading hlines do not get stripped
- (should
- (equal '(hline ("a" "b") hline ("c" "d"))
- (org-table-to-lisp "|-\n|a|b|\n|-\n|c|d|")))
- (should
- (equal '(hline ("a" "b") ("c" "d"))
- (org-table-to-lisp "|-\n|a|b|\n|c|d|")))
- (should
- (equal '(hline hline hline hline ("a" "b") ("c" "d"))
- (org-table-to-lisp "|-\n|-\n|-\n|-\n|a|b|\n|c|d|"))))
- (ert-deftest test-org-table/collapse-header ()
- "Test `orgtbl-to-lisp' specifications."
- ;; 2x2 no header - no collapsing
- (should
- (equal '(("a" "b") ("c" "d"))
- (org-table-collapse-header (org-table-to-lisp "|a|b|\n|c|d|"))))
- ;; 2x2 with 1-line header - no collapsing
- (should
- (equal '(("a" "b") hline ("c" "d"))
- (org-table-collapse-header (org-table-to-lisp "|a|b|\n|-\n|c|d|"))))
- ;; 2x4 with 2-line header - collapsed
- (should
- (equal '(("a A" "b B") hline ("c" "d") ("aa" "bb"))
- (org-table-collapse-header (org-table-to-lisp "|a|b|\n|A|B|\n|-\n|c|d|\n|aa|bb|"))))
- ;; 2x4 with 2-line header, custom glue - collapsed
- (should
- (equal '(("a.A" "b.B") hline ("c" "d") ("aa" "bb"))
- (org-table-collapse-header (org-table-to-lisp "|a|b|\n|A|B|\n|-\n|c|d|\n|aa|bb|") ".")))
- ;; 2x4 with 2-line header, threshold 1 - not collapsed
- (should
- (equal '(("a" "b") ("A" "B") hline ("c" "d") ("aa" "bb"))
- (org-table-collapse-header (org-table-to-lisp "|a|b|\n|A|B|\n|-\n|c|d|\n|aa|bb|") nil 1)))
- ;; 2x4 with 2-line header, threshold 2 - collapsed
- (should
- (equal '(("a A" "b B") hline ("c" "d") ("aa" "bb"))
- (org-table-collapse-header (org-table-to-lisp "|a|b|\n|A|B|\n|-\n|c|d|\n|aa|bb|") nil 2)))
- ;; 2x8 with 6-line header, default threshold 5 - not collapsed
- (should
- (equal '(("a" "b") ("A" "B") ("a" "b") ("A" "B") ("a" "b") ("A" "B") hline ("c" "d") ("aa" "bb"))
- (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|")))))
- ;;; Radio Tables
- (ert-deftest test-org-table/to-generic ()
- "Test `orgtbl-to-generic' specifications."
- ;; Test :hline parameter.
- (should
- (equal "a\nb"
- (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
- '(:hline nil))))
- (should
- (equal "a\n~\nb"
- (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
- '(:hline "~"))))
- ;; Test :sep parameter.
- (should
- (equal "a!b\nc!d"
- (orgtbl-to-generic
- (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
- '(:sep "!"))))
- ;; Test :hsep parameter.
- (should
- (equal "a!b\nc?d"
- (orgtbl-to-generic
- (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
- '(:sep "?" :hsep "!"))))
- ;; Test :tstart parameter.
- (should
- (equal "<begin>\na"
- (orgtbl-to-generic (org-table-to-lisp "| a |") '(:tstart "<begin>"))))
- (should
- (equal "<begin>\na"
- (orgtbl-to-generic (org-table-to-lisp "| a |")
- '(:tstart (lambda () "<begin>")))))
- (should
- (equal "a"
- (orgtbl-to-generic (org-table-to-lisp "| a |")
- '(:tstart "<begin>" :splice t))))
- ;; Test :tend parameter.
- (should
- (equal "a\n<end>"
- (orgtbl-to-generic (org-table-to-lisp "| a |") '(:tend "<end>"))))
- (should
- (equal "a\n<end>"
- (orgtbl-to-generic (org-table-to-lisp "| a |")
- '(:tend (lambda () "<end>")))))
- (should
- (equal "a"
- (orgtbl-to-generic (org-table-to-lisp "| a |")
- '(:tend "<end>" :splice t))))
- ;; Test :lstart parameter.
- (should
- (equal "> a"
- (orgtbl-to-generic
- (org-table-to-lisp "| a |") '(:lstart "> "))))
- (should
- (equal "> a"
- (orgtbl-to-generic (org-table-to-lisp "| a |")
- '(:lstart (lambda () "> ")))))
- ;; Test :llstart parameter.
- (should
- (equal "> a\n>> b"
- (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
- '(:lstart "> " :llstart ">> "))))
- ;; Test :hlstart parameter.
- (should
- (equal "!> a\n> b"
- (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
- '(:lstart "> " :hlstart "!> "))))
- ;; Test :hllstart parameter.
- (should
- (equal "!> a\n!!> b\n> c"
- (orgtbl-to-generic (org-table-to-lisp "| a |\n| b |\n|---|\n| c |")
- '(:lstart "> " :hlstart "!> " :hllstart "!!> "))))
- ;; Test :lend parameter.
- (should
- (equal "a <"
- (orgtbl-to-generic (org-table-to-lisp "| a |") '(:lend " <"))))
- ;; Test :llend parameter.
- (should
- (equal "a <\nb <<"
- (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
- '(:lend " <" :llend " <<"))))
- ;; Test :hlend parameter.
- (should
- (equal "a <!\nb <"
- (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
- '(:lend " <" :hlend " <!"))))
- ;; Test :hllend parameter.
- (should
- (equal "a <!\nb <!!\nc <"
- (orgtbl-to-generic (org-table-to-lisp "| a |\n| b |\n|---|\n| c |")
- '(:lend " <" :hlend " <!" :hllend " <!!"))))
- ;; Test :lfmt parameter.
- (should
- (equal "a!b"
- (orgtbl-to-generic (org-table-to-lisp "| a | b |")
- '(:lfmt "%s!%s"))))
- (should
- (equal "a+b"
- (orgtbl-to-generic
- (org-table-to-lisp "| a | b |")
- '(:lfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
- (should
- (equal "a!b"
- (orgtbl-to-generic (org-table-to-lisp "| a | b |")
- '(:lfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
- ;; Test :llfmt parameter.
- (should
- (equal "a!b"
- (orgtbl-to-generic (org-table-to-lisp "| a | b |")
- '(:llfmt "%s!%s"))))
- (should
- (equal "a!b\nc+d"
- (orgtbl-to-generic
- (org-table-to-lisp "| a | b |\n| c | d |")
- '(:lfmt "%s!%s" :llfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
- (should
- (equal "a!b"
- (orgtbl-to-generic (org-table-to-lisp "| a | b |")
- '(:llfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
- ;; Test :hlfmt parameter.
- (should
- (equal "a!b\ncd"
- (orgtbl-to-generic
- (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
- '(:hlfmt "%s!%s"))))
- (should
- (equal "a+b\ncd"
- (orgtbl-to-generic
- (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
- '(:hlfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
- (should
- (equal "a!b\n>c d<"
- (orgtbl-to-generic
- (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
- '(:hlfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
- ;; Test :hllfmt parameter.
- (should
- (equal "a!b\ncd"
- (orgtbl-to-generic
- (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
- '(:hllfmt "%s!%s"))))
- (should
- (equal "a+b\ncd"
- (orgtbl-to-generic
- (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
- '(:hllfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
- (should
- (equal "a!b\n>c d<"
- (orgtbl-to-generic
- (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
- '(:hllfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
- ;; Test :fmt parameter.
- (should
- (equal ">a<\n>b<"
- (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
- '(:fmt ">%s<"))))
- (should
- (equal ">a<b"
- (orgtbl-to-generic (org-table-to-lisp "| a | b |")
- '(:fmt (1 ">%s<" 2 (lambda (c) c))))))
- (should
- (equal "a b"
- (orgtbl-to-generic (org-table-to-lisp "| a | b |")
- '(:fmt (2 " %s")))))
- (should
- (equal ">a<"
- (orgtbl-to-generic (org-table-to-lisp "| a |")
- '(:fmt (lambda (c) (format ">%s<" c))))))
- ;; Test :hfmt parameter.
- (should
- (equal ">a<\nb"
- (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
- '(:hfmt ">%s<"))))
- (should
- (equal ">a<b\ncd"
- (orgtbl-to-generic
- (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
- '(:hfmt (1 ">%s<" 2 identity)))))
- (should
- (equal "a b\ncd"
- (orgtbl-to-generic
- (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
- '(:hfmt (2 " %s")))))
- (should
- (equal ">a<\nb"
- (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
- '(:hfmt (lambda (c) (format ">%s<" c))))))
- ;; Test :efmt parameter.
- (should
- (equal "2x10^3"
- (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
- '(:efmt "%sx10^%s"))))
- (should
- (equal "2x10^3"
- (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
- '(:efmt (lambda (m e) (concat m "x10^" e))))))
- (should
- (equal "2x10^3"
- (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
- '(:efmt (1 "%sx10^%s")))))
- (should
- (equal "2x10^3"
- (orgtbl-to-generic
- (org-table-to-lisp "| 2e3 |")
- '(:efmt (1 (lambda (m e) (format "%sx10^%s" m e)))))))
- (should
- (equal "2e3"
- (orgtbl-to-generic (org-table-to-lisp "| 2e3 |") '(:efmt nil))))
- ;; Test :skip parameter.
- (should
- (equal "cd"
- (orgtbl-to-generic
- (org-table-to-lisp "| \ | <c> |\n| a | b |\n|---+---|\n| c | d |")
- '(:skip 2))))
- ;; Test :skipcols parameter.
- (should
- (equal "a\nc"
- (orgtbl-to-generic
- (org-table-to-lisp "| a | b |\n| c | d |") '(:skipcols (2)))))
- (should
- (equal "a\nc"
- (orgtbl-to-generic
- (org-table-to-lisp
- "| / | <c> | <c> |\n| # | a | b |\n|---+---+---|\n| | c | d |")
- '(:skipcols (2)))))
- ;; Test :raw parameter.
- (when (featurep 'ox-latex)
- (should
- (string-match-p
- "/a/"
- (orgtbl-to-generic (org-table-to-lisp "| /a/ | b |")
- '(:backend latex :raw t)))))
- ;; Hooks are ignored.
- (should
- (equal
- "a\nb"
- (let* ((fun-list (list (lambda (_backend) (search-forward "a") (insert "hook"))))
- (org-export-before-parsing-hook fun-list)
- (org-export-before-processing-hook fun-list))
- (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
- '(:hline nil)))))
- ;; User-defined export filters are ignored.
- (should
- (equal
- "a\nb"
- (let ((org-export-filter-table-cell-functions
- (list (lambda (_c _b _i) "filter"))))
- (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
- '(:hline nil)))))
- ;; Macros, even if unknown, are returned as-is.
- (should
- (equal "{{{macro}}}"
- (orgtbl-to-generic (org-table-to-lisp "| {{{macro}}} |") nil))))
- (ert-deftest test-org-table/to-latex ()
- "Test `orgtbl-to-latex' specifications."
- (should
- (equal "\\begin{tabular}{l}\na\\\\\n\\end{tabular}"
- (orgtbl-to-latex (org-table-to-lisp "| a |") nil)))
- ;; Test :environment parameter.
- (should
- (equal "\\begin{tabularx}{l}\na\\\\\n\\end{tabularx}"
- (orgtbl-to-latex (org-table-to-lisp "| a |")
- '(:environment "tabularx"))))
- ;; Test :booktabs parameter.
- (should
- (string-match-p
- "\\toprule" (orgtbl-to-latex (org-table-to-lisp "| a |") '(:booktabs t))))
- ;; Handle LaTeX snippets.
- (should
- (equal "\\begin{tabular}{l}\n\\(x\\)\\\\\n\\end{tabular}"
- (orgtbl-to-latex (org-table-to-lisp "| $x$ |") nil)))
- ;; Test pseudo objects and :raw parameter.
- (should
- (string-match-p
- "\\$x\\$" (orgtbl-to-latex (org-table-to-lisp "| $x$ |") '(:raw t)))))
- (ert-deftest test-org-table/to-html ()
- "Test `orgtbl-to-html' specifications."
- (should
- (equal (orgtbl-to-html (org-table-to-lisp "| a |") nil)
- "<table border=\"2\" cellspacing=\"0\" cellpadding=\"6\" rules=\"groups\" frame=\"hsides\">
- <colgroup>
- <col class=\"org-left\" />
- </colgroup>
- <tbody>
- <tr>
- <td class=\"org-left\">a</td>
- </tr>
- </tbody>
- </table>"))
- ;; Test :attributes parameter.
- (should
- (string-match-p
- "<table>"
- (orgtbl-to-html (org-table-to-lisp "| a |") '(:attributes nil))))
- (should
- (string-match-p
- "<table border=\"2\">"
- (orgtbl-to-html (org-table-to-lisp "| a |") '(:attributes (:border "2"))))))
- (ert-deftest test-org-table/to-texinfo ()
- "Test `orgtbl-to-texinfo' specifications."
- (should
- (equal "@multitable {a}\n@item a\n@end multitable"
- (orgtbl-to-texinfo (org-table-to-lisp "| a |") nil)))
- ;; Test :columns parameter.
- (should
- (equal "@multitable @columnfractions .4 .6\n@item a\n@tab b\n@end multitable"
- (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
- '(:columns ".4 .6"))))
- (should
- (equal "@multitable @columnfractions .4 .6\n@item a\n@tab b\n@end multitable"
- (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
- '(:columns "@columnfractions .4 .6"))))
- (should
- (equal "@multitable {xxx} {xx}\n@item a\n@tab b\n@end multitable"
- (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
- '(:columns "{xxx} {xx}")))))
- (ert-deftest test-org-table/to-orgtbl ()
- "Test `orgtbl-to-orgtbl' specifications."
- (should
- (equal "| a | b |\n|---+---|\n| c | d |"
- (orgtbl-to-orgtbl
- (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |") nil))))
- (ert-deftest test-org-table/to-unicode ()
- "Test `orgtbl-to-unicode' specifications."
- (should
- (equal "━━━\n a \n━━━"
- (orgtbl-to-unicode (org-table-to-lisp "| a |") nil)))
- ;; Test :narrow parameter.
- (should
- (equal "━━━━\n => \n━━━━"
- (orgtbl-to-unicode (org-table-to-lisp "| <2> |\n| xxx |")
- '(:narrow t)))))
- (ert-deftest test-org-table/send-region ()
- "Test `orgtbl-send-table' specifications."
- ;; Error when not at a table.
- (should-error
- (org-test-with-temp-text "Paragraph"
- (orgtbl-send-table)))
- ;; Error when destination is missing.
- (should-error
- (org-test-with-temp-text "#+ORGTBL: SEND\n<point>| a |"
- (orgtbl-send-table)))
- ;; Error when transformation function is not specified.
- (should-error
- (org-test-with-temp-text "
- # BEGIN RECEIVE ORGTBL table
- # END RECEIVE ORGTBL table
- #+ORGTBL: SEND table
- <point>| a |"
- (orgtbl-send-table)))
- ;; Standard test.
- (should
- (equal "| a |\n|---|\n| b |\n"
- (org-test-with-temp-text "
- # BEGIN RECEIVE ORGTBL table
- # END RECEIVE ORGTBL table
- #+ORGTBL: SEND table orgtbl-to-orgtbl :hlines nil
- <point>| a |\n|---|\n| b |"
- (orgtbl-send-table)
- (goto-char (point-min))
- (buffer-substring-no-properties
- (search-forward "# BEGIN RECEIVE ORGTBL table\n")
- (progn (search-forward "# END RECEIVE ORGTBL table")
- (match-beginning 0))))))
- ;; Allow multiple receiver locations.
- (should
- (org-test-with-temp-text "
- # BEGIN RECEIVE ORGTBL table
- # END RECEIVE ORGTBL table
- #+ORGTBL: SEND table orgtbl-to-orgtbl :hlines nil
- <point>| a |
- # BEGIN RECEIVE ORGTBL table
- # END RECEIVE ORGTBL table"
- (orgtbl-send-table)
- (goto-char (point-min))
- (search-forward "| a |" nil t 3))))
- ;;; Align
- (ert-deftest test-org-table/align ()
- "Test `org-table-align' specifications."
- ;; Regular test.
- (should
- (equal "| a |\n"
- (org-test-with-temp-text "| a |"
- (org-table-align)
- (buffer-string))))
- ;; Preserve alignment.
- (should
- (equal " | a |\n"
- (org-test-with-temp-text " | a |"
- (org-table-align)
- (buffer-string))))
- ;; Handle horizontal lines.
- (should
- (equal "| 123 |\n|-----|\n"
- (org-test-with-temp-text "| 123 |\n|-|"
- (org-table-align)
- (buffer-string))))
- (should
- (equal "| a | b |\n|---+---|\n"
- (org-test-with-temp-text "| a | b |\n|-+-|"
- (org-table-align)
- (buffer-string))))
- ;; Handle empty fields.
- (should
- (equal "| a | bc |\n| bcd | |\n"
- (org-test-with-temp-text "| a | bc |\n| bcd | |"
- (org-table-align)
- (buffer-string))))
- (should
- (equal "| abc | bc |\n| | bcd |\n"
- (org-test-with-temp-text "| abc | bc |\n| | bcd |"
- (org-table-align)
- (buffer-string))))
- ;; Handle missing fields.
- (should
- (equal "| a | b |\n| c | |\n"
- (org-test-with-temp-text "| a | b |\n| c |"
- (org-table-align)
- (buffer-string))))
- (should
- (equal "| a | b |\n|---+---|\n"
- (org-test-with-temp-text "| a | b |\n|---|"
- (org-table-align)
- (buffer-string))))
- ;; Alignment is done to the right when the ratio of numbers in the
- ;; column is superior to `org-table-number-fraction'.
- (should
- (equal "| 1 |\n| 12 |\n| abc |"
- (org-test-with-temp-text "| 1 |\n| 12 |\n| abc |"
- (let ((org-table-number-fraction 0.5)) (org-table-align))
- (buffer-string))))
- (should
- (equal "| 1 |\n| ab |\n| abc |"
- (org-test-with-temp-text "| 1 |\n| ab |\n| abc |"
- (let ((org-table-number-fraction 0.5)) (org-table-align))
- (buffer-string))))
- ;; Obey to alignment cookies.
- (should
- (equal "| <r> |\n| ab |\n| abc |"
- (org-test-with-temp-text "| <r> |\n| ab |\n| abc |"
- (let ((org-table-number-fraction 0.5)) (org-table-align))
- (buffer-string))))
- (should
- (equal "| <l> |\n| 12 |\n| 123 |"
- (org-test-with-temp-text "| <l> |\n| 12 |\n| 123 |"
- (let ((org-table-number-fraction 0.5)) (org-table-align))
- (buffer-string))))
- (should
- (equal "| <c> |\n| 1 |\n| 123 |"
- (org-test-with-temp-text "| <c> |\n| 1 |\n| 123 |"
- (let ((org-table-number-fraction 0.5)) (org-table-align))
- (buffer-string))))
- ;; Handle gracefully tables with only horizontal rules.
- (should
- (org-test-with-temp-text "|-<point>--|"
- (org-table-align)
- t))
- (should
- (org-test-with-temp-text "|-<point>--|---------|\n|---|---|-----|"
- (org-table-align)
- t)))
- (ert-deftest test-org-table/align-buffer-tables ()
- "Align all tables when updating buffer."
- (let ((before "
- | a b |
- | c d |
- ")
- (after "
- | a b |
- | c d |
- "))
- (should (equal (org-test-with-temp-text before
- (org-table-recalculate-buffer-tables)
- (buffer-string))
- after))
- (should (equal (org-test-with-temp-text before
- (org-table-iterate-buffer-tables)
- (buffer-string))
- after))))
- ;;; Sorting
- (ert-deftest test-org-table/sort-lines ()
- "Test `org-table-sort-lines' specifications."
- ;; Sort numerically.
- (should
- (equal "| 1 | 2 |\n| 2 | 4 |\n| 5 | 3 |\n"
- (org-test-with-temp-text "| <point>1 | 2 |\n| 5 | 3 |\n| 2 | 4 |\n"
- (org-table-sort-lines nil ?n)
- (buffer-string))))
- (should
- (equal "| 5 | 3 |\n| 2 | 4 |\n| 1 | 2 |\n"
- (org-test-with-temp-text "| <point>1 | 2 |\n| 5 | 3 |\n| 2 | 4 |\n"
- (org-table-sort-lines nil ?N)
- (buffer-string))))
- ;; Sort alphabetically. Enforce the C locale for consistent results.
- (let ((original-string-collate-lessp (symbol-function 'string-collate-lessp)))
- (cl-letf (((symbol-function 'string-collate-lessp)
- (lambda (s1 s2 &optional _locale ignore-case)
- (funcall original-string-collate-lessp
- s1 s2 "C" ignore-case))))
- (should
- (equal "| a | x |\n| B | 4 |\n| c | 3 |\n"
- (org-test-with-temp-text "| <point>a | x |\n| c | 3 |\n| B | 4 |\n"
- (org-table-sort-lines nil ?a)
- (buffer-string))))
- (should
- (equal "| c | 3 |\n| B | 4 |\n| a | x |\n"
- (org-test-with-temp-text "| <point>a | x |\n| c | 3 |\n| B | 4 |\n"
- (org-table-sort-lines nil ?A)
- (buffer-string))))
- ;; Sort alphabetically with case.
- (should
- (equal "| C |\n| a |\n| b |\n"
- (org-test-with-temp-text "| <point>a |\n| C |\n| b |\n"
- (org-table-sort-lines t ?a)
- (buffer-string))))
- (should
- (equal "| C |\n| b |\n| a |\n"
- (org-test-with-temp-text "| <point>a |\n| C |\n| b |\n"
- (org-table-sort-lines nil ?A)
- (buffer-string))))))
- ;; Sort by time (timestamps)
- (should
- (equal
- "| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n| <2014-03-04 tue.> |\n"
- (org-test-with-temp-text
- "| <2014-03-04 tue.> |\n| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n"
- (org-table-sort-lines nil ?t)
- (buffer-string))))
- (should
- (equal
- "| <2014-03-04 tue.> |\n| <2012-03-29 thu.> |\n| <2008-08-08 sat.> |\n"
- (org-test-with-temp-text
- "| <2014-03-04 tue.> |\n| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n"
- (org-table-sort-lines nil ?T)
- (buffer-string))))
- ;; Sort by time (HH:MM values)
- (should
- (equal "| 1:00 |\n| 17:00 |\n| 114:00 |\n"
- (org-test-with-temp-text "| 114:00 |\n| 17:00 |\n| 1:00 |\n"
- (org-table-sort-lines nil ?t)
- (buffer-string))))
- (should
- (equal "| 114:00 |\n| 17:00 |\n| 1:00 |\n"
- (org-test-with-temp-text "| 114:00 |\n| 17:00 |\n| 1:00 |\n"
- (org-table-sort-lines nil ?T)
- (buffer-string))))
- ;; Sort by time (durations)
- (should
- (equal "| 1d 3:00 |\n| 28:00 |\n"
- (org-test-with-temp-text "| 28:00 |\n| 1d 3:00 |\n"
- (org-table-sort-lines nil ?t)
- (buffer-string))))
- ;; Sort with custom functions.
- (should
- (equal "| 22 |\n| 15 |\n| 18 |\n"
- (org-test-with-temp-text "| 15 |\n| 22 |\n| 18 |\n"
- (org-table-sort-lines nil ?f
- (lambda (s) (% (string-to-number s) 10))
- #'<)
- (buffer-string))))
- (should
- (equal "| 18 |\n| 15 |\n| 22 |\n"
- (org-test-with-temp-text "| 15 |\n| 22 |\n| 18 |\n"
- (org-table-sort-lines nil ?F
- (lambda (s) (% (string-to-number s) 10))
- #'<)
- (buffer-string))))
- ;; Sort according to current column.
- (should
- (equal "| 1 | 2 |\n| 7 | 3 |\n| 5 | 4 |\n"
- (org-test-with-temp-text "| 1 | <point>2 |\n| 5 | 4 |\n| 7 | 3 |\n"
- (org-table-sort-lines nil ?n)
- (buffer-string))))
- ;; Sort between horizontal separators if possible.
- (should
- (equal
- "| 9 | 8 |\n|---+---|\n| 5 | 3 |\n| 7 | 4 |\n|---+---|\n| 1 | 2 |\n"
- (org-test-with-temp-text
- "| 9 | 8 |\n|---+---|\n| <point>7 | 4 |\n| 5 | 3 |\n|---+---|\n| 1 | 2 |\n"
- (org-table-sort-lines nil ?n)
- (buffer-string)))))
- ;;; Formulas
- (ert-deftest test-org-table/eval-formula ()
- "Test `org-table-eval-formula' specifications."
- ;; Error when not on a table field.
- (should-error
- (org-test-with-temp-text "Text"
- (org-table-eval-formula)))
- (should-error
- (org-test-with-temp-text "| a |\n|---|<point>"
- (org-table-eval-formula)))
- (should-error
- (org-test-with-temp-text "| a |\n#+TBLFM:<point>"
- (org-table-eval-formula)))
- ;; Handle @<, @>, $< and $>.
- (should
- (equal "| 1 |\n| 1 |"
- (org-test-with-temp-text "| <point> |\n| 1 |"
- (org-table-eval-formula nil "@>" nil nil t)
- (buffer-string))))
- (should
- (equal "| 1 |\n| 1 |"
- (org-test-with-temp-text "| 1 |\n| <point> |"
- (org-table-eval-formula nil "@<" nil nil t)
- (buffer-string))))
- (should
- (equal "| 1 | 1 |"
- (org-test-with-temp-text "| <point> | 1 |"
- (org-table-eval-formula nil "$>" nil nil t)
- (buffer-string))))
- (should
- (equal "| 1 | 1 |"
- (org-test-with-temp-text "| 1 | <point> |"
- (org-table-eval-formula nil "$<" nil nil t)
- (buffer-string)))))
- (ert-deftest test-org-table/field-formula-outside-table ()
- "Test `org-table-formula-create-columns' variable."
- ;; Refuse to create column if variable is nil.
- (should-error
- (org-test-with-temp-text "
- | 2 |
- | 4 |
- | 8 |
- <point>#+TBLFM: @1$2=5"
- (let ((org-table-formula-create-columns nil))
- (org-table-calc-current-TBLFM))
- (buffer-string))
- :type (list 'error 'user-error))
- ;; If the variable is non-nil, field formulas and columns formulas
- ;; can create tables.
- (should
- (equal
- "
- | 2 | 5 |
- | 4 | |
- | 8 | |
- #+TBLFM: @1$2=5"
- (org-test-with-temp-text "
- | 2 |
- | 4 |
- | 8 |
- <point>#+TBLFM: @1$2=5"
- (let ((org-table-formula-create-columns t))
- (org-table-calc-current-TBLFM))
- (buffer-string))))
- (should
- (equal
- "
- | 2 | | 15 |
- | 4 | | 15 |
- | 8 | | 15 |
- #+TBLFM: $3=15"
- (org-test-with-temp-text "
- | 2 |
- | 4 |
- | 8 |
- <point>#+TBLFM: $3=15"
- (let ((org-table-formula-create-columns t))
- (org-table-calc-current-TBLFM))
- (buffer-string)))))
- (ert-deftest test-org-table/duration ()
- "Test durations in table formulas."
- ;; Durations in cells.
- (should
- (string-match "| 2:12 | 1:47 | 03:59:00 |"
- (org-test-with-temp-text "
- | 2:12 | 1:47 | |
- <point>#+TBLFM: @1$3=$1+$2;T"
- (org-table-calc-current-TBLFM)
- (buffer-string))))
- (should
- (string-match "| 2:12 | 1:47 | 03:59 |"
- (org-test-with-temp-text "
- | 2:12 | 1:47 | |
- <point>#+TBLFM: @1$3=$1+$2;U"
- (org-table-calc-current-TBLFM)
- (buffer-string))))
- (should
- (string-match "| 3:02:20 | -2:07:00 | 0.92 |"
- (org-test-with-temp-text "
- | 3:02:20 | -2:07:00 | |
- <point>#+TBLFM: @1$3=$1+$2;t"
- (org-table-calc-current-TBLFM)
- (buffer-string))))
- ;; Durations set through properties.
- (should
- (string-match "| 16:00:00 |"
- (org-test-with-temp-text "* H
- :PROPERTIES:
- :time_constant: 08:00:00
- :END:
- | |
- <point>#+TBLFM: $1=2*$PROP_time_constant;T"
- (org-table-calc-current-TBLFM)
- (buffer-string))))
- (should
- (string-match "| 16.00 |"
- (org-test-with-temp-text "* H
- :PROPERTIES:
- :time_constant: 08:00:00
- :END:
- | |
- <point>#+TBLFM: $1=2*$PROP_time_constant;t"
- (org-table-calc-current-TBLFM)
- (buffer-string)))))
- (ert-deftest test-org-table/end-on-hline ()
- "Test with a table ending on a hline."
- (should
- (equal
- (org-test-with-temp-text
- "
- | 1 | 2 | 3 |
- | 4 | 5 | 6 |
- | | | |
- |---+---+---|
- <point>#+TBLFM: @3$2..@3$>=vsum(@1..@2)"
- (org-table-calc-current-TBLFM)
- (buffer-string))
- "
- | 1 | 2 | 3 |
- | 4 | 5 | 6 |
- | | 7 | 9 |
- |---+---+---|
- #+TBLFM: @3$2..@3$>=vsum(@1..@2)")))
- (ert-deftest test-org-table/named-field ()
- "Test formula with a named field."
- (should
- (string-match-p
- "| +| +1 +|"
- (org-test-with-temp-text "
- | | |
- | ^ | name |
- <point>#+TBLFM: $name=1"
- (org-table-calc-current-TBLFM)
- (buffer-string))))
- (should
- (string-match-p
- "| +| +1 +|"
- (org-test-with-temp-text "
- | _ | name |
- | | |
- <point>#+TBLFM: $name=1"
- (org-table-calc-current-TBLFM)
- (buffer-string)))))
- (ert-deftest test-org-table/named-column ()
- "Test formula with a named field."
- (should
- (string-match-p
- "| +| +1 +| +1 +|"
- (org-test-with-temp-text "
- | ! | name | |
- | | 1 | |
- <point>#+TBLFM: @2$3=$name"
- (org-table-calc-current-TBLFM)
- (buffer-string)))))
- (ert-deftest test-org-table/formula-priority ()
- "Test field formula priority over column formula."
- ;; Field formulas bind stronger than column formulas.
- (should
- (equal
- "| 1 | 3 |\n| 2 | 99 |\n"
- (org-test-with-temp-text
- "| 1 | |\n| 2 | |\n<point>#+tblfm: $2=3*$1::@2$2=99"
- (org-table-calc-current-TBLFM)
- (buffer-substring-no-properties (point-min) (point)))))
- ;; When field formula is removed, table formulas is applied again.
- (should
- (equal
- "| 1 | 3 |\n| 2 | 6 |\n"
- (org-test-with-temp-text
- "| 1 | |\n| 2 | |\n#+tblfm: $2=3*$1<point>::@2$2=99"
- (org-table-calc-current-TBLFM)
- (delete-region (point) (line-end-position))
- (org-table-calc-current-TBLFM)
- (buffer-substring-no-properties (point-min) (line-beginning-position))))))
- (ert-deftest test-org-table/tab-indent ()
- "Test named fields with tab indentation."
- (should
- (string-match-p
- "| # | 111 |"
- (org-test-with-temp-text
- "
- | ! | sum | | a | b | c |
- |---+------+------+---+----+-----|
- | # | 1011 | 1000 | 1 | 10 | 100 |
- <point>#+TBLFM: $2=$a+$b+$c
- "
- (org-table-calc-current-TBLFM)
- (buffer-string)))))
- (ert-deftest test-org-table/first-rc ()
- "Test \"$<\" and \"@<\" constructs in formulas."
- (should
- (string-match-p
- "| 1 | 2 |"
- (org-test-with-temp-text
- "| | 2 |
- <point>#+TBLFM: $<=1"
- (org-table-calc-current-TBLFM)
- (buffer-string))))
- (should
- (string-match-p
- "| 2 |\n| 2 |"
- (org-test-with-temp-text
- "| 2 |\n| |
- <point>#+TBLFM: @2$1=@<"
- (org-table-calc-current-TBLFM)
- (buffer-string)))))
- (ert-deftest test-org-table/last-rc ()
- "Test \"$>\" and \"@>\" constructs in formulas."
- (should
- (string-match-p
- "| 2 | 1 |"
- (org-test-with-temp-text
- "| 2 | |\n<point>#+TBLFM: $>=1"
- (org-table-calc-current-TBLFM)
- (buffer-string))))
- (should
- (string-match-p
- "| 2 |\n| 2 |"
- (org-test-with-temp-text
- "| 2 |\n| |\n<point>#+TBLFM: @>$1=@<"
- (org-table-calc-current-TBLFM)
- (buffer-string)))))
- (ert-deftest test-org-table/time-stamps ()
- "Test time-stamps handling."
- ;; Standard test.
- (should
- (string-match-p
- "| 1 |"
- (org-test-with-temp-text
- "| <2016-07-07 Sun> | <2016-07-08 Fri> | |\n<point>#+TBLFM: $3=$2-$1"
- (org-table-calc-current-TBLFM)
- (buffer-string))))
- ;; Handle locale specific time-stamps.
- (should
- (string-match-p
- "| 1 |"
- (org-test-with-temp-text
- "| <2016-07-07 Do> | <2016-07-08 Fr> | |\n<point>#+TBLFM: $3=$2-$1"
- (org-table-calc-current-TBLFM)
- (buffer-string)))))
- (ert-deftest test-org-table/orgtbl-ascii-draw ()
- "Test `orgtbl-ascii-draw'."
- ;; First value: Make sure that an integer input value is converted to a
- ;; float before division. Further values: Show some float input value
- ;; ranges corresponding to the same bar width.
- (should
- (equal
- (org-test-with-temp-text
- "
- | Value | <l> |
- |----------+---------|
- | 19 | replace |
- |----------+---------|
- | -0.50001 | replace |
- | -0.49999 | replace |
- | 0.49999 | replace |
- | 0.50001 | replace |
- | 1.49999 | replace |
- | 22.50001 | replace |
- | 23.49999 | replace |
- | 23.50001 | replace |
- | 24.49999 | replace |
- | 24.50001 | replace |
- <point>#+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 24 3 \" 12345678\")"
- (org-table-calc-current-TBLFM)
- (buffer-string))
- "
- | Value | <l> |
- |----------+-----------|
- | 19 | 883 |
- |----------+-----------|
- | -0.50001 | too small |
- | -0.49999 | |
- | 0.49999 | |
- | 0.50001 | 1 |
- | 1.49999 | 1 |
- | 22.50001 | 887 |
- | 23.49999 | 887 |
- | 23.50001 | 888 |
- | 24.49999 | 888 |
- | 24.50001 | too large |
- #+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 24 3 \" 12345678\")"))
- ;; Draw bars with a bullet. The bullet does not count in the parameter
- ;; WIDTH of `orgtbl-ascii-draw'.
- (should
- (equal
- (org-test-with-temp-text
- "
- | -1 | replace |
- | 0 | replace |
- | 1 | replace |
- | 2 | replace |
- | 3 | replace |
- | 4 | replace |
- <point>#+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 3 3 \"$-\")"
- (org-table-calc-current-TBLFM)
- (buffer-string))
- "
- | -1 | too small |
- | 0 | $ |
- | 1 | -$ |
- | 2 | --$ |
- | 3 | ---$ |
- | 4 | too large |
- #+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 3 3 \"$-\")")))
- (ert-deftest test-org-table/single-rowgroup ()
- "Test column formula in a table with a single rowgroup."
- (should
- (equal
- "
- |---+---|
- | 1 | 0 |
- |---+---|
- #+TBLFM: $2=$1-1"
- (org-test-with-temp-text "
- |---+---|
- | 1 | |
- |---+---|
- <point>#+TBLFM: $2=$1-1"
- (org-table-calc-current-TBLFM)
- (buffer-string))))
- (should
- (equal
- "
- | 1 | 0 |
- #+TBLFM: $2=$1-1"
- (org-test-with-temp-text "
- | 1 | |
- <point>#+TBLFM: $2=$1-1"
- (org-table-calc-current-TBLFM)
- (buffer-string)))))
- ;;; Navigation
- (ert-deftest test-org-table/next-field ()
- "Test `org-table-next-field' specifications."
- ;; Regular test.
- (should
- (equal
- "b"
- (org-test-with-temp-text "| a<point> | b |"
- (org-table-next-field)
- (org-trim (org-table-get-field)))))
- ;; Create new rows as needed.
- (should
- (equal
- "| a |\n| |\n"
- (org-test-with-temp-text "| a<point> |"
- (org-table-next-field)
- (buffer-string))))
- ;; Jump over hlines, if `org-table-tab-jumps-over-hlines' is
- ;; non-nil.
- (should
- (equal
- "b"
- (org-test-with-temp-text "| a<point> |\n|---|\n| b |"
- (let ((org-table-tab-jumps-over-hlines t)) (org-table-next-field))
- (org-trim (org-table-get-field)))))
- ;; If `org-table-tab-jumps-over-hlines' is nil, however, create
- ;; a new row before the rule.
- (should
- (equal
- "| a |\n| |\n|---|\n| b |"
- (org-test-with-temp-text "| a<point> |\n|---|\n| b |"
- (let ((org-table-tab-jumps-over-hlines nil)) (org-table-next-field))
- (buffer-string)))))
- (ert-deftest test-org-table/previous-field ()
- "Test `org-table-previous-field' specifications."
- ;; Regular tests.
- (should
- (eq ?a
- (org-test-with-temp-text "| a | <point>b |"
- (org-table-previous-field)
- (char-after))))
- (should
- (eq ?a
- (org-test-with-temp-text "| a |\n| <point>b |"
- (org-table-previous-field)
- (char-after))))
- ;; Find previous field across horizontal rules.
- (should
- (eq ?a
- (org-test-with-temp-text "| a |\n|---|\n| <point>b |"
- (org-table-previous-field)
- (char-after))))
- ;; When called on a horizontal rule, find previous data field.
- (should
- (eq ?b
- (org-test-with-temp-text "| a | b |\n|---+-<point>--|"
- (org-table-previous-field)
- (char-after))))
- ;; Error when at first field. Make sure to preserve original
- ;; position.
- (should-error
- (org-test-with-temp-text "| <point> a|"
- (org-table-previous-field)))
- (should-error
- (org-test-with-temp-text "|---|\n| <point>a |"
- (org-table-previous-field)))
- (should
- (eq ?a
- (org-test-with-temp-text "|---|\n| <point>a |"
- (ignore-errors (org-table-previous-field))
- (char-after)))))
- ;;; Deleting columns
- (ert-deftest test-org-table/delete-column ()
- "Test `org-table-delete-column'."
- ;; Error when outside a table.
- (should-error
- (org-test-with-temp-text "Paragraph"
- (org-table-delete-column)))
- ;; Delete first column.
- (should
- (equal "| a |\n"
- (org-test-with-temp-text
- "| <point> | a |\n"
- (org-table-delete-column)
- (buffer-string))))
- ;; Delete column and check location of point.
- (should
- (= 2
- (org-test-with-temp-text
- "| a | <point>b | c |"
- (org-table-delete-column)
- (org-table-current-column))))
- ;; Delete column when at end of line and after a "|".
- (should
- (equal "| a |\n"
- (org-test-with-temp-text
- "| a | b |<point>\n"
- (org-table-delete-column)
- (buffer-string))))
- (should
- (equal "| a |\n"
- (org-test-with-temp-text
- "| a | b | <point>\n"
- (org-table-delete-column)
- (buffer-string))))
- ;; Delete two columns starting with the last column.
- (should
- (equal "| a |\n"
- (org-test-with-temp-text
- "| a | b | c<point> |"
- (org-table-delete-column)
- (org-table-delete-column)
- (buffer-string)))))
- ;;; Inserting rows, inserting columns
- (ert-deftest test-org-table/insert-column ()
- "Test `org-table-insert-column' specifications."
- ;; Error when outside a table.
- (should-error
- (org-test-with-temp-text "Paragraph"
- (org-table-insert-column)))
- ;; Insert new column after current one.
- (should
- (equal "| | a |\n"
- (org-test-with-temp-text "| a |"
- (org-table-insert-column)
- (buffer-string))))
- (should
- (equal "| | a | b |\n"
- (org-test-with-temp-text "| <point>a | b |"
- (org-table-insert-column)
- (buffer-string))))
- ;; Move point into the newly created column.
- (should
- (equal " | a |"
- (org-test-with-temp-text "| <point>a |"
- (org-table-insert-column)
- (buffer-substring-no-properties (point) (line-end-position)))))
- (should
- (equal " | a | b |"
- (org-test-with-temp-text "| <point>a | b |"
- (org-table-insert-column)
- (buffer-substring-no-properties (point) (line-end-position)))))
- ;; Handle missing vertical bar in the last column.
- (should
- (equal "| | a |\n"
- (org-test-with-temp-text "| a"
- (org-table-insert-column)
- (buffer-string))))
- (should
- (equal " | a |"
- (org-test-with-temp-text "| <point>a"
- (org-table-insert-column)
- (buffer-substring-no-properties (point) (line-end-position)))))
- ;; Handle column insertion when point is before first column.
- (should
- (equal " | | a |\n"
- (org-test-with-temp-text " | a |"
- (org-table-insert-column)
- (buffer-string))))
- (should
- (equal " | | a | b |\n"
- (org-test-with-temp-text " | a | b |"
- (org-table-insert-column)
- (buffer-string)))))
- (ert-deftest test-org-table/insert-column-with-formula ()
- "Test `org-table-insert-column' with a formula in place."
- (should
- (equal "| | 1 | 1 | 2 |
- #+TBLFM: $4=$2+$3"
- (org-test-with-temp-text
- "| 1<point> | 1 | 2 |
- #+TBLFM: $3=$1+$2"
- (org-table-insert-column)
- (buffer-substring-no-properties (point-min) (point-max))))))
- ;;; Moving single cells
- (ert-deftest test-org-table/move-cell-down ()
- "Test `org-table-move-cell-down' specifications."
- ;; Error out when cell cannot be moved due to not in table, in the
- ;; last row of the table, or is on a hline.
- (should-error
- (org-test-with-temp-text "not in\na table\n"
- (org-table-move-cell-down)))
- (should-error
- (org-test-with-temp-text "| a |"
- (org-table-move-cell-down)))
- (should-error
- (org-test-with-temp-text "| a |\n"
- (org-table-move-cell-down)))
- (should-error
- (org-test-with-temp-text "| a | <point>b |\n"
- (org-table-move-cell-down)))
- (should-error
- (org-test-with-temp-text "| a | b |\n| <point>c | d |\n"
- (org-table-move-cell-down)))
- (should-error
- (org-test-with-temp-text "| a | b |\n| c | <point>d |\n"
- (org-table-move-cell-down)))
- (should-error
- (org-test-with-temp-text "| <point>a |\n|---|\n"
- (org-table-move-cell-down)))
- (should-error
- (org-test-with-temp-text "|<point>---|\n| a |\n"
- (org-table-move-cell-down)))
- ;; Check for correct cell movement
- (should (equal (concat "| c | b |\n"
- "| a | d |\n"
- "| e | f |\n")
- (org-test-with-temp-text
- (concat "| <point>a | b |\n"
- "| c | d |\n"
- "| e | f |\n")
- (org-table-move-cell-down)
- (buffer-string))))
- (should (equal (concat "| a | d |\n"
- "| c | b |\n"
- "| e | f |\n")
- (org-test-with-temp-text
- (concat "| a | <point>b |\n"
- "| c | d |\n"
- "| e | f |\n")
- (org-table-move-cell-down)
- (buffer-string))))
- (should (equal (concat "| a | b |\n"
- "| e | d |\n"
- "| c | f |\n")
- (org-test-with-temp-text
- (concat "| a | b |\n"
- "| <point>c | d |\n"
- "| e | f |\n")
- (org-table-move-cell-down)
- (buffer-string))))
- (should (equal (concat "| a | d |\n"
- "| c | f |\n"
- "| e | b |\n")
- (org-test-with-temp-text
- (concat "| a |<point> b |\n"
- "| c | d |\n"
- "| e | f |\n")
- (org-table-move-cell-down)
- (org-table-move-cell-down)
- (buffer-string))))
- ;; Check for correct handling of hlines which should not change
- ;; position on single cell moves.
- (should (equal (concat "| c | b |\n"
- "|---+---|\n"
- "| a | d |\n"
- "| e | f |\n")
- (org-test-with-temp-text
- (concat "| <point>a | b |\n"
- "|---+---|\n"
- "| c | d |\n"
- "| e | f |\n")
- (org-table-move-cell-down)
- (buffer-string))))
- (should (equal (concat "| a | d |\n"
- "|---+---|\n"
- "| c | f |\n"
- "| e | b |\n")
- (org-test-with-temp-text
- (concat "| a | <point>b |\n"
- "|---+---|\n"
- "| c | d |\n"
- "| e | f |\n")
- (org-table-move-cell-down)
- (org-table-move-cell-down)
- (buffer-string))))
- (should (equal (concat "| a | b |\n"
- "|---+---|\n"
- "| c | f |\n"
- "| e | d |\n")
- (org-test-with-temp-text
- (concat "| a | b |\n"
- "|---+---|\n"
- "| c | <point>d |\n"
- "| e | f |\n")
- (org-table-move-cell-down)
- (buffer-string))))
- ;; Move single cell even without a final newline.
- (should (equal (concat "| a | d |\n"
- "|---+---|\n"
- "| c | f |\n"
- "| e | b |\n")
- (org-test-with-temp-text
- (concat "| a | <point>b |\n"
- "|---+---|\n"
- "| c | d |\n"
- "| e | f |")
- (org-table-move-cell-down)
- (org-table-move-cell-down)
- (buffer-string)))))
- (ert-deftest test-org-table/move-cell-up ()
- "Test `org-table-move-cell-up' specifications."
- ;; Error out when cell cannot be moved due to not in table, in the
- ;; last row of the table, or is on a hline.
- (should-error
- (org-test-with-temp-text "not in\na table\n"
- (org-table-move-cell-up)))
- (should-error
- (org-test-with-temp-text "| a |"
- (org-table-move-cell-up)))
- (should-error
- (org-test-with-temp-text "| a |\n"
- (org-table-move-cell-up)))
- (should-error
- (org-test-with-temp-text "| <point>a | b |\n"
- (org-table-move-cell-up)))
- (should-error
- (org-test-with-temp-text "| a | <point>b |\n| c | d |\n"
- (org-table-move-cell-up)))
- (should-error
- (org-test-with-temp-text "| <point>a |\n|---|\n"
- (org-table-move-cell-up)))
- (should-error
- (org-test-with-temp-text "|<point>---|\n| a |\n"
- (org-table-move-cell-up)))
- ;; Check for correct cell movement.
- (should (equal (concat "| c | b |\n"
- "| a | d |\n"
- "| e | f |\n")
- (org-test-with-temp-text
- (concat "| a | b |\n"
- "| <point>c | d |\n"
- "| e | f |\n")
- (org-table-move-cell-up)
- (buffer-string))))
- (should (equal (concat "| a | d |\n"
- "| c | b |\n"
- "| e | f |\n")
- (org-test-with-temp-text
- (concat "| a | b |\n"
- "| c | <point>d |\n"
- "| e | f |\n")
- (org-table-move-cell-up)
- (buffer-string))))
- (should (equal (concat "| a | b |\n"
- "| e | d |\n"
- "| c | f |\n")
- (org-test-with-temp-text
- (concat "| a | b |\n"
- "| c | d |\n"
- "| <point>e | f |\n")
- (org-table-move-cell-up)
- (buffer-string))))
- (should (equal (concat "| a | f |\n"
- "| c | b |\n"
- "| e | d |\n")
- (org-test-with-temp-text
- (concat "| a | b |\n"
- "| c | d |\n"
- "| e |<point> f |\n")
- (org-table-move-cell-up)
- (org-table-move-cell-up)
- (buffer-string))))
- ;; Check for correct handling of hlines which should not change
- ;; position on single cell moves.
- (should (equal (concat "| c | b |\n"
- "|---+---|\n"
- "| a | d |\n"
- "| e | f |\n")
- (org-test-with-temp-text
- (concat "| a | b |\n"
- "|---+---|\n"
- "| <point>c | d |\n"
- "| e | f |\n")
- (org-table-move-cell-up)
- (buffer-string))))
- (should (equal (concat "| a | f |\n"
- "|---+---|\n"
- "| c | b |\n"
- "| e | d |\n")
- (org-test-with-temp-text
- (concat "| a | b |\n"
- "|---+---|\n"
- "| c | d |\n"
- "| e | <point>f |\n")
- (org-table-move-cell-up)
- (org-table-move-cell-up)
- (buffer-string))))
- (should (equal (concat "| a | b |\n"
- "|---+---|\n"
- "| c | f |\n"
- "| e | d |\n")
- (org-test-with-temp-text
- (concat "| a | b |\n"
- "|---+---|\n"
- "| c | d |\n"
- "| e | <point>f |\n")
- (org-table-move-cell-up)
- (buffer-string))))
- ;; Move single cell even without a final newline.
- (should (equal (concat "| a | f |\n"
- "|---+---|\n"
- "| c | b |\n"
- "| e | d |\n")
- (org-test-with-temp-text
- (concat "| a | b |\n"
- "|---+---|\n"
- "| c | d |\n"
- "| e | <point>f |")
- (org-table-move-cell-up)
- (org-table-move-cell-up)
- (buffer-string)))))
- (ert-deftest test-org-table/move-cell-right ()
- "Test `org-table-move-cell-right' specifications."
- ;; Error out when cell cannot be moved due to not in table, in the
- ;; last col of the table, or is on a hline.
- (should-error
- (org-test-with-temp-text "not in\na table\n"
- (org-table-move-cell-right)))
- (should-error
- (org-test-with-temp-text "| a |"
- (org-table-move-cell-right)))
- (should-error
- (org-test-with-temp-text "| a |\n"
- (org-table-move-cell-right)))
- (should-error
- (org-test-with-temp-text "| <point>a |\n| b |\n"
- (org-table-move-cell-right)))
- (should-error
- (org-test-with-temp-text "| a | <point>b |\n| c | d |\n"
- (org-table-move-cell-right)))
- (should-error
- (org-test-with-temp-text "| <point>a |\n|---|\n"
- (org-table-move-cell-right)))
- (should-error
- (org-test-with-temp-text "|<point>---|\n| a |\n"
- (org-table-move-cell-right)))
- ;; Check for correct cell movement.
- (should (equal (concat "| b | a | c |\n"
- "| d | e | f |\n")
- (org-test-with-temp-text
- (concat "| <point>a | b | c |\n"
- "| d | e | f |\n")
- (org-table-move-cell-right)
- (buffer-string))))
- (should (equal (concat "| b | c | a |\n"
- "| d | e | f |\n")
- (org-test-with-temp-text
- (concat "| <point>a | b | c |\n"
- "| d | e | f |\n")
- (org-table-move-cell-right)
- (org-table-move-cell-right)
- (buffer-string))))
- (should (equal (concat "| a | b | c |\n"
- "| e | f | d |\n")
- (org-test-with-temp-text
- (concat "| a | b | c |\n"
- "| <point> d | e | f |\n")
- (org-table-move-cell-right)
- (org-table-move-cell-right)
- (buffer-string))))
- (should (equal (concat "| a | b | c |\n"
- "| d | f | e |\n")
- (org-test-with-temp-text
- (concat "| a | b | c |\n"
- "| d | <point>e | f |\n")
- (org-table-move-cell-right)
- (buffer-string))))
- (should (equal (concat "| a | b | c |\n"
- "|---+---+---|\n"
- "| e | f | d |\n")
- (org-test-with-temp-text
- (concat "| a | b | c |\n"
- "|---+---+---|\n"
- "| <point>d | e | f |\n")
- (org-table-move-cell-right)
- (org-table-move-cell-right)
- (buffer-string))))
- ;; Move single cell even without a final newline.
- (should (equal (concat "| a | b | c |\n"
- "|---+---+---|\n"
- "| e | d | f |\n")
- (org-test-with-temp-text
- (concat "| a | b | c |\n"
- "|---+---+---|\n"
- "| <point>d | e | f |")
- (org-table-move-cell-right)
- (buffer-string)))))
- (ert-deftest test-org-table/move-cell-left ()
- "Test `org-table-move-cell-left' specifications."
- ;; Error out when cell cannot be moved due to not in table, in the
- ;; last col of the table, or is on a hline.
- (should-error
- (org-test-with-temp-text "not in\na table\n"
- (org-table-move-cell-left)))
- (should-error
- (org-test-with-temp-text "| a |"
- (org-table-move-cell-left)))
- (should-error
- (org-test-with-temp-text "| a |\n"
- (org-table-move-cell-left)))
- (should-error
- (org-test-with-temp-text "| <point>a |\n| b |\n"
- (org-table-move-cell-left)))
- (should-error
- (org-test-with-temp-text "| <point>a | b |\n| c | d |\n"
- (org-table-move-cell-left)))
- (should-error
- (org-test-with-temp-text "| <point>a |\n|---|\n"
- (org-table-move-cell-left)))
- (should-error
- (org-test-with-temp-text "|<point>---|\n| a |\n"
- (org-table-move-cell-left)))
- ;; Check for correct cell movement.
- (should (equal (concat "| b | a | c |\n"
- "| d | e | f |\n")
- (org-test-with-temp-text
- (concat "| a | <point>b | c |\n"
- "| d | e | f |\n")
- (org-table-move-cell-left)
- (buffer-string))))
- (should (equal (concat "| c | a | b |\n"
- "| d | e | f |\n")
- (org-test-with-temp-text
- (concat "| a | b | <point>c |\n"
- "| d | e | f |\n")
- (org-table-move-cell-left)
- (org-table-move-cell-left)
- (buffer-string))))
- (should (equal (concat "| a | b | c |\n"
- "| f | d | e |\n")
- (org-test-with-temp-text
- (concat "| a | b | c |\n"
- "| d | e | <point>f |\n")
- (org-table-move-cell-left)
- (org-table-move-cell-left)
- (buffer-string))))
- (should (equal (concat "| a | b | c |\n"
- "| d | f | e |\n")
- (org-test-with-temp-text
- (concat "| a | b | c |\n"
- "| d | e | <point>f |\n")
- (org-table-move-cell-left)
- (buffer-string))))
- (should (equal (concat "| a | b | c |\n"
- "|---+---+---|\n"
- "| f | d | e |\n")
- (org-test-with-temp-text
- (concat "| a | b | c |\n"
- "|---+---+---|\n"
- "| d | e | <point>f |\n")
- (org-table-move-cell-left)
- (org-table-move-cell-left)
- (buffer-string))))
- ;; Move single cell even without a final newline.
- (should (equal (concat "| a | b | c |\n"
- "|---+---+---|\n"
- "| e | d | f |\n")
- (org-test-with-temp-text
- (concat "| a | b | c |\n"
- "|---+---+---|\n"
- "| d | <point>e | f |")
- (org-table-move-cell-left)
- (buffer-string)))))
- ;;; Moving rows, moving columns
- (ert-deftest test-org-table/move-row-down ()
- "Test `org-table-move-row-down' specifications."
- ;; Error out when row cannot be moved, e.g., it is the last row in
- ;; the table.
- (should-error
- (org-test-with-temp-text "| a |"
- (org-table-move-row-down)))
- (should-error
- (org-test-with-temp-text "| a |\n"
- (org-table-move-row-down)))
- (should-error
- (org-test-with-temp-text "| a |\n| <point>b |"
- (org-table-move-row-down)))
- ;; Move data lines.
- (should
- (equal "| b |\n| a |\n"
- (org-test-with-temp-text "| a |\n| b |\n"
- (org-table-move-row-down)
- (buffer-string))))
- (should
- (equal "|---|\n| a |\n"
- (org-test-with-temp-text "| a |\n|---|\n"
- (org-table-move-row-down)
- (buffer-string))))
- ;; Move hlines.
- (should
- (equal "| b |\n|---|\n"
- (org-test-with-temp-text "|---|\n| b |\n"
- (org-table-move-row-down)
- (buffer-string))))
- (should
- (equal "|---|\n|---|\n"
- (org-test-with-temp-text "|---|\n|---|\n"
- (org-table-move-row-down)
- (buffer-string))))
- ;; Move rows even without a final newline.
- (should
- (equal "| b |\n| a |\n"
- (org-test-with-temp-text "| a |\n| b |"
- (org-table-move-row-down)
- (buffer-string)))))
- (ert-deftest test-org-table/move-row-up ()
- "Test `org-table-move-row-up' specifications."
- ;; Error out when row cannot be moved, e.g., it is the first row in
- ;; the table.
- (should-error
- (org-test-with-temp-text "| a |"
- (org-table-move-row-up)))
- (should-error
- (org-test-with-temp-text "| a |\n"
- (org-table-move-row-up)))
- ;; Move data lines.
- (should
- (equal "| b |\n| a |\n"
- (org-test-with-temp-text "| a |\n| <point>b |\n"
- (org-table-move-row-up)
- (buffer-string))))
- (should
- (equal "| b |\n|---|\n"
- (org-test-with-temp-text "|---|\n| <point>b |\n"
- (org-table-move-row-up)
- (buffer-string))))
- ;; Move hlines.
- (should
- (equal "|---|\n| a |\n"
- (org-test-with-temp-text "| a |\n|<point>---|\n"
- (org-table-move-row-up)
- (buffer-string))))
- (should
- (equal "|---|\n|---|\n"
- (org-test-with-temp-text "|---|\n|<point>---|\n"
- (org-table-move-row-up)
- (buffer-string))))
- ;; Move rows even without a final newline.
- (should
- (equal "| b |\n| a |\n"
- (org-test-with-temp-text "| a |\n| <point>b |"
- (org-table-move-row-up)
- (buffer-string)))))
- ;;; Shrunk columns
- (ert-deftest test-org-table/toggle-column-width ()
- "Test `org-table-toggle-columns-width' specifications."
- ;; Error when not at a column.
- (should-error
- (org-test-with-temp-text "<point>a"
- (org-table-toggle-column-width)))
- ;; A shrunk column is overlaid with
- ;; `org-table-shrunk-column-indicator'.
- (should
- (equal org-table-shrunk-column-indicator
- (org-test-with-temp-text "| <point>a |"
- (org-table-toggle-column-width)
- (overlay-get (car (overlays-at (point))) 'display))))
- (should
- (equal org-table-shrunk-column-indicator
- (org-test-with-temp-text "| a |\n|-<point>--|"
- (org-table-toggle-column-width)
- (overlay-get (car (overlays-at (point))) 'display))))
- ;; Shrink every field in the same column.
- (should
- (equal org-table-shrunk-column-indicator
- (org-test-with-temp-text "| a |\n|-<point>--|"
- (org-table-toggle-column-width)
- (overlay-get (car (overlays-at (1+ (line-beginning-position 0))))
- 'display))))
- ;; When column is already shrunk, expand it, i.e., remove overlays.
- (should-not
- (org-test-with-temp-text "| <point>a |"
- (org-table-toggle-column-width)
- (org-table-toggle-column-width)
- (overlays-in (point-min) (point-max))))
- (should-not
- (org-test-with-temp-text "| a |\n| <point>b |"
- (org-table-toggle-column-width)
- (org-table-toggle-column-width)
- (overlays-in (point-min) (point-max))))
- ;; With a column width cookie, limit overlay to the specified number
- ;; of characters.
- (should
- (equal "| abc"
- (org-test-with-temp-text "| <3> |\n| <point>abcd |"
- (org-table-toggle-column-width)
- (buffer-substring (line-beginning-position)
- (overlay-start
- (car (overlays-in (line-beginning-position)
- (line-end-position))))))))
- (should
- (equal "| a "
- (org-test-with-temp-text "| <3> |\n| <point>a |"
- (org-table-toggle-column-width)
- (buffer-substring (line-beginning-position)
- (overlay-start
- (car (overlays-in (line-beginning-position)
- (line-end-position))))))))
- (should
- (equal (concat "----" org-table-shrunk-column-indicator)
- (org-test-with-temp-text "| <3> |\n|--<point>----|"
- (org-table-toggle-column-width)
- (overlay-get
- (car (overlays-in (line-beginning-position)
- (line-end-position)))
- 'display))))
- ;; Width only takes into account visible characters.
- (should
- (equal "| [[http"
- (org-test-with-temp-text "| <4> |\n| <point>[[http://orgmode.org]] |"
- (org-table-toggle-column-width)
- (buffer-substring (line-beginning-position)
- (overlay-start
- (car (overlays-in (line-beginning-position)
- (line-end-position))))))))
- ;; Before the first column or after the last one, ask for columns
- ;; ranges.
- (should
- (catch :exit
- (org-test-with-temp-text "| a |"
- (cl-letf (((symbol-function 'read-string)
- (lambda (&rest_) (throw :exit t))))
- (org-table-toggle-column-width)
- nil))))
- (should
- (catch :exit
- (org-test-with-temp-text "| a |<point>"
- (cl-letf (((symbol-function 'read-string)
- (lambda (&rest_) (throw :exit t))))
- (org-table-toggle-column-width)
- nil))))
- ;; When optional argument ARG is a string, toggle specified columns.
- (should
- (equal org-table-shrunk-column-indicator
- (org-test-with-temp-text "| <point>a | b |"
- (org-table-toggle-column-width "2")
- (overlay-get (car (overlays-at (- (point-max) 2))) 'display))))
- (should
- (equal '("b" "c")
- (org-test-with-temp-text "| a | b | c | d |"
- (org-table-toggle-column-width "2-3")
- (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
- (overlays-in (point-min) (point-max)))
- #'string-lessp))))
- (should
- (equal '("b" "c" "d")
- (org-test-with-temp-text "| a | b | c | d |"
- (org-table-toggle-column-width "2-")
- (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
- (overlays-in (point-min) (point-max)))
- #'string-lessp))))
- (should
- (equal '("a" "b")
- (org-test-with-temp-text "| a | b | c | d |"
- (org-table-toggle-column-width "-2")
- (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
- (overlays-in (point-min) (point-max)))
- #'string-lessp))))
- (should
- (equal '("a" "b" "c" "d")
- (org-test-with-temp-text "| a | b | c | d |"
- (org-table-toggle-column-width "-")
- (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
- (overlays-in (point-min) (point-max)))
- #'string-lessp))))
- (should
- (equal '("a" "d")
- (org-test-with-temp-text "| a | b | c | d |"
- (org-table-toggle-column-width "1-3")
- (org-table-toggle-column-width "2-4")
- (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
- (overlays-in (point-min) (point-max)))
- #'string-lessp))))
- ;; When ARG is (16), remove any column overlay.
- (should-not
- (org-test-with-temp-text "| <point>a |"
- (org-table-toggle-column-width)
- (org-table-toggle-column-width '(16))
- (overlays-in (point-min) (point-max))))
- (should-not
- (org-test-with-temp-text "| a | b | c | d |"
- (org-table-toggle-column-width "-")
- (org-table-toggle-column-width '(16))
- (overlays-in (point-min) (point-max)))))
- (ert-deftest test-org-table/shrunk-columns ()
- "Test behaviour of shrunk column."
- ;; Edition automatically expands a shrunk column.
- (should-not
- (org-test-with-temp-text "| <point>a |"
- (org-table-toggle-column-width)
- (insert "a")
- (overlays-in (point-min) (point-max))))
- ;; Other columns are not changed.
- (should
- (org-test-with-temp-text "| <point>a | b |"
- (org-table-toggle-column-width "-")
- (insert "a")
- (overlays-in (point-min) (point-max))))
- ;; Moving a shrunk column doesn't alter its state.
- (should
- (equal "a"
- (org-test-with-temp-text "| <point>a | b |"
- (org-table-toggle-column-width)
- (org-table-move-column-right)
- (overlay-get (car (overlays-at (point))) 'help-echo))))
- (should
- (equal "a"
- (org-test-with-temp-text "| <point>a |\n| b |"
- (org-table-toggle-column-width)
- (org-table-move-row-down)
- (overlay-get (car (overlays-at (point))) 'help-echo))))
- ;; State is preserved upon inserting a column.
- (should
- (equal '("a")
- (org-test-with-temp-text "| <point>a |"
- (org-table-toggle-column-width)
- (org-table-insert-column)
- (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
- (overlays-in (point-min) (point-max)))
- #'string-lessp))))
- ;; State is preserved upon deleting a column.
- (should
- (equal '("a" "c")
- (org-test-with-temp-text "| a | <point>b | c |"
- (org-table-toggle-column-width "-")
- (org-table-delete-column)
- (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
- (overlays-in (point-min) (point-max)))
- #'string-lessp))))
- ;; State is preserved upon deleting a row.
- (should
- (equal '("b1" "b2")
- (org-test-with-temp-text "| a1 | a2 |\n| b1 | b2 |"
- (org-table-toggle-column-width "-")
- (org-table-kill-row)
- (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
- (overlays-in (point-min) (point-max)))
- #'string-lessp))))
- (should
- (equal '("a1" "a2")
- (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
- (org-table-toggle-column-width "-")
- (org-table-kill-row)
- (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
- (overlays-in (point-min) (point-max)))
- #'string-lessp))))
- ;; State is preserved upon inserting a row or hline.
- (should
- (equal '("" "a1" "b1")
- (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
- (org-table-toggle-column-width)
- (org-table-insert-row)
- (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
- (overlays-in (point-min) (point-max)))
- #'string-lessp))))
- (should
- (equal '("a1" "b1")
- (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
- (org-table-toggle-column-width)
- (org-table-insert-hline)
- (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
- (overlays-in (point-min) (point-max)))
- #'string-lessp))))
- ;; State is preserved upon sorting a column for all the columns but
- ;; the one being sorted.
- (should
- (equal '("a2" "b2")
- (org-test-with-temp-text "| <point>a1 | a2 |\n| <point>b1 | b2 |"
- (org-table-toggle-column-width "-")
- (org-table-sort-lines nil ?A)
- (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
- (overlays-in (point-min) (point-max)))
- #'string-lessp))))
- ;; State is preserved upon replacing a field non-interactively.
- (should
- (equal '("a")
- (org-test-with-temp-text "| <point>a |"
- (org-table-toggle-column-width)
- (org-table-get-field nil "b")
- (mapcar (lambda (o) (overlay-get o 'help-echo))
- (overlays-in (point-min) (point-max))))))
- ;; Moving to next field doesn't change shrunk state.
- (should
- (equal "a"
- (org-test-with-temp-text "| <point>a | b |"
- (org-table-toggle-column-width)
- (org-table-next-field)
- (overlay-get (car (overlays-at (1+ (line-beginning-position))))
- 'help-echo))))
- (should
- (equal "b"
- (org-test-with-temp-text "| a | <point>b |"
- (org-table-toggle-column-width)
- (goto-char 2)
- (org-table-next-field)
- (overlay-get (car (overlays-at (point))) 'help-echo))))
- ;; Aligning table doesn't alter shrunk state.
- (should
- (equal "a"
- (org-test-with-temp-text "| <point>a | b |"
- (org-table-toggle-column-width)
- (org-table-align)
- (overlay-get (car (overlays-at (1+ (line-beginning-position))))
- 'help-echo))))
- (should
- (equal "b"
- (org-test-with-temp-text "|---+-----|\n| a | <point>b |"
- (org-table-toggle-column-width)
- (org-table-align)
- (overlay-get (car (overlays-at (point)))
- 'help-echo))))
- (should
- (equal
- '("b")
- (org-test-with-temp-text "|---+-----|\n| a | <point>b |"
- (org-table-toggle-column-width)
- (org-table-align)
- (mapcar (lambda (o) (overlay-get o 'help-echo))
- (overlays-in (line-beginning-position) (line-end-position))))))
- ;; Recalculating formulas doesn't change shrunk state.
- (should
- (equal "2"
- (org-test-with-temp-text "| 1 | <point>0 |\n#+TBLFM: $2=$1+1\n"
- (org-table-toggle-column-width)
- (org-table-recalculate)
- (overlay-get (car (overlays-at (point))) 'help-echo)))))
- ;;; Miscellaneous
- (ert-deftest test-org-table/current-column ()
- "Test `org-table-current-column' specifications."
- (should
- (= 1 (org-test-with-temp-text "| <point>a |"
- (org-table-current-column))))
- (should
- (= 1 (org-test-with-temp-text "|-<point>--|"
- (org-table-current-column))))
- (should
- (= 2 (org-test-with-temp-text "| 1 | <point>2 |"
- (org-table-current-column))))
- (should
- (= 2 (org-test-with-temp-text "|---+-<point>--|"
- (org-table-current-column)))))
- (ert-deftest test-org-table/get-field ()
- "Test `org-table-get-field' specifications."
- ;; Regular test.
- (should
- (equal " a "
- (org-test-with-temp-text "| <point>a |" (org-table-get-field))))
- ;; Get field in open last column.
- (should
- (equal " a "
- (org-test-with-temp-text "| <point>a " (org-table-get-field))))
- ;; Get empty field.
- (should
- (equal ""
- (org-test-with-temp-text "|<point>|" (org-table-get-field))))
- (should
- (equal " "
- (org-test-with-temp-text "| <point>|" (org-table-get-field))))
- ;; Outside the table, return the empty string.
- (should
- (equal ""
- (org-test-with-temp-text "<point>| a |" (org-table-get-field))))
- (should
- (equal ""
- (org-test-with-temp-text "| a |<point>" (org-table-get-field))))
- ;; With optional N argument, select a particular column in current
- ;; row.
- (should
- (equal " 3 "
- (org-test-with-temp-text "| 1 | 2 | 3 |" (org-table-get-field 3))))
- (should
- (equal " 4 "
- (org-test-with-temp-text "| 1 | 2 |\n<point>| 3 | 4 |"
- (org-table-get-field 2))))
- ;; REPLACE optional argument is used to replace selected field.
- (should
- (equal "| foo |"
- (org-test-with-temp-text "| <point>1 |"
- (org-table-get-field nil " foo ")
- (buffer-string))))
- (should
- (equal "| 1 | 2 | foo |"
- (org-test-with-temp-text "| 1 | 2 | 3 |"
- (org-table-get-field 3 " foo ")
- (buffer-string))))
- (should
- (equal " 4 "
- (org-test-with-temp-text "| 1 | 2 |\n<point>| 3 | 4 |"
- (org-table-get-field 2))))
- ;; An empty REPLACE string clears the field.
- (should
- (equal "| |"
- (org-test-with-temp-text "| <point>1 |"
- (org-table-get-field nil "")
- (buffer-string))))
- ;; When using REPLACE still return old value.
- (should
- (equal " 1 "
- (org-test-with-temp-text "| <point>1 |"
- (org-table-get-field nil " foo ")))))
- (provide 'test-org-table)
- ;;; test-org-table.el ends here
|