1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359536053615362536353645365536653675368536953705371537253735374537553765377537853795380538153825383538453855386538753885389539053915392539353945395539653975398539954005401540254035404540554065407540854095410541154125413541454155416541754185419542054215422542354245425542654275428542954305431543254335434543554365437543854395440544154425443544454455446544754485449545054515452545354545455545654575458545954605461546254635464546554665467546854695470547154725473547454755476547754785479548054815482548354845485548654875488548954905491549254935494549554965497549854995500550155025503550455055506550755085509551055115512551355145515551655175518551955205521552255235524552555265527552855295530553155325533553455355536553755385539554055415542554355445545554655475548554955505551555255535554555555565557555855595560556155625563556455655566556755685569557055715572557355745575557655775578557955805581558255835584558555865587558855895590559155925593559455955596559755985599560056015602560356045605560656075608560956105611561256135614561556165617561856195620562156225623562456255626562756285629563056315632563356345635563656375638563956405641564256435644564556465647564856495650565156525653565456555656565756585659566056615662566356645665566656675668566956705671567256735674567556765677567856795680568156825683568456855686568756885689569056915692569356945695569656975698569957005701570257035704570557065707570857095710571157125713571457155716571757185719572057215722572357245725572657275728572957305731573257335734573557365737573857395740574157425743574457455746574757485749575057515752575357545755575657575758575957605761576257635764576557665767576857695770577157725773577457755776577757785779578057815782578357845785578657875788578957905791579257935794579557965797579857995800580158025803580458055806580758085809581058115812581358145815581658175818581958205821582258235824582558265827582858295830583158325833583458355836583758385839584058415842584358445845584658475848584958505851585258535854585558565857585858595860586158625863586458655866586758685869587058715872587358745875587658775878587958805881588258835884588558865887588858895890589158925893589458955896589758985899590059015902590359045905590659075908590959105911591259135914591559165917591859195920592159225923592459255926592759285929593059315932593359345935593659375938593959405941594259435944594559465947594859495950595159525953595459555956595759585959596059615962596359645965596659675968596959705971597259735974597559765977597859795980598159825983598459855986598759885989599059915992599359945995599659975998599960006001600260036004600560066007600860096010601160126013601460156016601760186019602060216022602360246025602660276028602960306031603260336034603560366037603860396040604160426043604460456046604760486049605060516052605360546055605660576058605960606061606260636064606560666067606860696070607160726073607460756076607760786079608060816082608360846085608660876088608960906091609260936094609560966097609860996100610161026103610461056106610761086109611061116112611361146115611661176118611961206121612261236124612561266127612861296130613161326133613461356136613761386139614061416142614361446145614661476148614961506151615261536154615561566157615861596160616161626163616461656166616761686169617061716172617361746175617661776178617961806181618261836184618561866187618861896190619161926193619461956196619761986199620062016202620362046205620662076208620962106211621262136214621562166217621862196220622162226223622462256226622762286229623062316232623362346235623662376238623962406241624262436244624562466247624862496250625162526253625462556256625762586259626062616262626362646265626662676268626962706271627262736274627562766277627862796280628162826283628462856286628762886289629062916292629362946295629662976298629963006301630263036304630563066307630863096310631163126313631463156316631763186319632063216322632363246325632663276328632963306331633263336334633563366337633863396340634163426343634463456346634763486349635063516352635363546355635663576358635963606361636263636364636563666367636863696370637163726373637463756376637763786379638063816382638363846385638663876388638963906391639263936394639563966397639863996400640164026403640464056406640764086409641064116412641364146415641664176418641964206421642264236424642564266427642864296430643164326433643464356436643764386439644064416442644364446445644664476448644964506451645264536454645564566457645864596460646164626463646464656466646764686469647064716472647364746475647664776478647964806481648264836484648564866487648864896490649164926493649464956496649764986499650065016502650365046505650665076508650965106511651265136514651565166517651865196520652165226523652465256526652765286529653065316532653365346535653665376538653965406541654265436544654565466547654865496550655165526553655465556556655765586559656065616562656365646565656665676568656965706571657265736574657565766577657865796580658165826583658465856586658765886589659065916592659365946595659665976598659966006601660266036604660566066607660866096610661166126613661466156616661766186619662066216622662366246625662666276628662966306631663266336634663566366637663866396640664166426643664466456646664766486649665066516652665366546655665666576658665966606661666266636664666566666667666866696670667166726673667466756676667766786679668066816682668366846685668666876688668966906691669266936694669566966697669866996700670167026703670467056706670767086709671067116712671367146715671667176718671967206721672267236724672567266727672867296730673167326733673467356736673767386739674067416742674367446745674667476748674967506751675267536754675567566757675867596760676167626763676467656766676767686769677067716772677367746775677667776778677967806781678267836784678567866787678867896790679167926793679467956796679767986799680068016802680368046805680668076808680968106811681268136814681568166817681868196820682168226823682468256826682768286829683068316832683368346835683668376838683968406841684268436844684568466847684868496850685168526853685468556856685768586859686068616862686368646865686668676868686968706871687268736874687568766877687868796880688168826883688468856886688768886889689068916892689368946895689668976898689969006901690269036904690569066907690869096910691169126913691469156916691769186919692069216922692369246925692669276928692969306931693269336934693569366937693869396940694169426943694469456946694769486949695069516952695369546955695669576958695969606961696269636964696569666967696869696970697169726973697469756976697769786979698069816982698369846985698669876988698969906991699269936994699569966997699869997000700170027003700470057006700770087009701070117012701370147015701670177018701970207021702270237024702570267027702870297030703170327033703470357036703770387039704070417042704370447045704670477048704970507051705270537054705570567057705870597060706170627063706470657066706770687069707070717072707370747075707670777078707970807081708270837084708570867087708870897090709170927093709470957096709770987099710071017102710371047105710671077108710971107111711271137114711571167117711871197120712171227123712471257126712771287129713071317132713371347135713671377138713971407141714271437144714571467147714871497150715171527153715471557156715771587159716071617162716371647165716671677168716971707171717271737174717571767177717871797180718171827183718471857186718771887189719071917192719371947195719671977198719972007201720272037204720572067207720872097210721172127213721472157216721772187219722072217222722372247225722672277228722972307231723272337234723572367237723872397240724172427243724472457246724772487249725072517252725372547255725672577258725972607261726272637264726572667267726872697270727172727273727472757276727772787279728072817282728372847285728672877288728972907291729272937294729572967297729872997300730173027303730473057306730773087309731073117312731373147315731673177318731973207321732273237324732573267327732873297330733173327333733473357336733773387339734073417342734373447345734673477348734973507351735273537354735573567357735873597360736173627363736473657366736773687369737073717372737373747375737673777378737973807381738273837384738573867387738873897390739173927393739473957396739773987399740074017402740374047405740674077408740974107411741274137414741574167417741874197420742174227423742474257426742774287429743074317432743374347435743674377438743974407441744274437444744574467447744874497450745174527453745474557456745774587459746074617462746374647465746674677468746974707471747274737474747574767477747874797480748174827483748474857486748774887489749074917492749374947495749674977498749975007501750275037504750575067507750875097510751175127513751475157516751775187519752075217522752375247525752675277528752975307531753275337534753575367537753875397540754175427543754475457546754775487549755075517552755375547555755675577558755975607561756275637564756575667567756875697570757175727573757475757576757775787579758075817582758375847585758675877588758975907591759275937594759575967597759875997600760176027603760476057606760776087609761076117612761376147615761676177618761976207621762276237624762576267627762876297630763176327633763476357636763776387639764076417642764376447645764676477648764976507651765276537654765576567657765876597660766176627663766476657666766776687669767076717672767376747675767676777678767976807681768276837684768576867687768876897690769176927693769476957696769776987699770077017702770377047705770677077708770977107711771277137714771577167717771877197720772177227723772477257726772777287729773077317732773377347735773677377738773977407741774277437744774577467747774877497750775177527753775477557756775777587759776077617762776377647765776677677768776977707771777277737774777577767777777877797780778177827783778477857786778777887789779077917792779377947795779677977798779978007801780278037804780578067807780878097810781178127813781478157816781778187819782078217822782378247825782678277828782978307831783278337834783578367837783878397840784178427843784478457846784778487849785078517852785378547855785678577858785978607861786278637864786578667867786878697870787178727873787478757876787778787879788078817882788378847885788678877888788978907891789278937894789578967897789878997900790179027903790479057906790779087909791079117912791379147915791679177918791979207921792279237924792579267927792879297930793179327933793479357936793779387939794079417942794379447945794679477948794979507951795279537954795579567957795879597960796179627963796479657966796779687969797079717972797379747975797679777978797979807981798279837984798579867987798879897990799179927993799479957996799779987999800080018002800380048005800680078008800980108011801280138014801580168017801880198020802180228023802480258026802780288029803080318032803380348035803680378038803980408041804280438044804580468047804880498050805180528053805480558056805780588059806080618062806380648065806680678068806980708071807280738074807580768077807880798080808180828083808480858086808780888089809080918092809380948095809680978098809981008101810281038104810581068107810881098110811181128113811481158116811781188119812081218122812381248125812681278128812981308131813281338134813581368137813881398140814181428143814481458146814781488149815081518152815381548155815681578158815981608161816281638164816581668167816881698170817181728173817481758176817781788179818081818182818381848185818681878188818981908191819281938194819581968197819881998200820182028203820482058206820782088209821082118212821382148215821682178218821982208221822282238224822582268227822882298230823182328233823482358236823782388239824082418242824382448245824682478248824982508251825282538254825582568257825882598260826182628263826482658266826782688269827082718272827382748275827682778278827982808281828282838284828582868287828882898290829182928293829482958296829782988299830083018302830383048305830683078308830983108311831283138314831583168317831883198320832183228323832483258326832783288329833083318332833383348335833683378338833983408341834283438344834583468347834883498350835183528353835483558356835783588359836083618362836383648365836683678368836983708371837283738374837583768377837883798380838183828383838483858386838783888389839083918392839383948395839683978398839984008401840284038404840584068407840884098410841184128413841484158416841784188419842084218422842384248425842684278428842984308431843284338434843584368437843884398440844184428443844484458446844784488449845084518452845384548455845684578458845984608461846284638464846584668467846884698470847184728473847484758476847784788479848084818482848384848485848684878488848984908491849284938494849584968497849884998500850185028503850485058506850785088509851085118512851385148515851685178518851985208521852285238524852585268527852885298530853185328533853485358536853785388539854085418542854385448545854685478548854985508551855285538554855585568557855885598560856185628563856485658566856785688569857085718572857385748575857685778578857985808581858285838584858585868587858885898590859185928593859485958596859785988599860086018602860386048605860686078608860986108611861286138614861586168617861886198620862186228623862486258626862786288629863086318632863386348635863686378638863986408641864286438644864586468647864886498650865186528653865486558656865786588659866086618662866386648665866686678668866986708671867286738674867586768677867886798680868186828683868486858686868786888689869086918692869386948695869686978698869987008701870287038704870587068707870887098710871187128713871487158716871787188719872087218722872387248725872687278728872987308731873287338734873587368737873887398740874187428743874487458746874787488749875087518752875387548755875687578758875987608761876287638764876587668767876887698770877187728773877487758776877787788779878087818782878387848785878687878788878987908791879287938794879587968797879887998800880188028803880488058806880788088809881088118812881388148815881688178818881988208821882288238824882588268827882888298830883188328833883488358836883788388839884088418842884388448845884688478848884988508851885288538854885588568857885888598860886188628863886488658866886788688869887088718872887388748875887688778878887988808881888288838884888588868887888888898890889188928893889488958896889788988899890089018902890389048905890689078908890989108911891289138914891589168917891889198920892189228923892489258926892789288929893089318932893389348935893689378938893989408941894289438944894589468947894889498950895189528953895489558956895789588959896089618962896389648965896689678968896989708971897289738974897589768977897889798980898189828983898489858986898789888989899089918992899389948995899689978998899990009001900290039004900590069007900890099010901190129013901490159016901790189019902090219022902390249025902690279028902990309031903290339034903590369037903890399040904190429043904490459046904790489049905090519052905390549055905690579058905990609061906290639064906590669067906890699070907190729073907490759076907790789079908090819082908390849085908690879088908990909091909290939094909590969097909890999100910191029103910491059106910791089109911091119112911391149115911691179118911991209121912291239124912591269127912891299130913191329133913491359136913791389139914091419142914391449145914691479148914991509151915291539154915591569157915891599160916191629163916491659166916791689169917091719172917391749175917691779178917991809181918291839184918591869187918891899190919191929193919491959196919791989199920092019202920392049205920692079208920992109211921292139214921592169217921892199220922192229223922492259226922792289229923092319232923392349235923692379238923992409241924292439244924592469247924892499250925192529253925492559256925792589259926092619262926392649265926692679268926992709271927292739274927592769277927892799280928192829283928492859286928792889289929092919292929392949295929692979298929993009301930293039304930593069307930893099310931193129313931493159316931793189319932093219322932393249325932693279328932993309331933293339334933593369337933893399340934193429343934493459346934793489349935093519352935393549355935693579358935993609361936293639364936593669367936893699370937193729373937493759376937793789379938093819382938393849385938693879388938993909391939293939394939593969397939893999400940194029403940494059406940794089409941094119412941394149415941694179418941994209421942294239424942594269427942894299430943194329433943494359436943794389439944094419442944394449445944694479448944994509451945294539454945594569457945894599460946194629463946494659466946794689469947094719472947394749475947694779478947994809481948294839484948594869487948894899490949194929493949494959496949794989499950095019502950395049505950695079508950995109511951295139514951595169517951895199520952195229523952495259526952795289529953095319532953395349535953695379538953995409541954295439544954595469547954895499550955195529553955495559556955795589559956095619562956395649565956695679568956995709571957295739574957595769577957895799580958195829583958495859586958795889589959095919592959395949595959695979598959996009601960296039604960596069607960896099610961196129613961496159616961796189619962096219622962396249625962696279628962996309631963296339634963596369637963896399640964196429643964496459646964796489649965096519652965396549655965696579658965996609661966296639664966596669667966896699670967196729673967496759676967796789679968096819682968396849685968696879688968996909691969296939694969596969697969896999700970197029703970497059706970797089709971097119712971397149715971697179718971997209721972297239724972597269727972897299730973197329733973497359736973797389739974097419742974397449745974697479748974997509751975297539754975597569757975897599760976197629763976497659766976797689769977097719772977397749775977697779778977997809781978297839784978597869787978897899790979197929793979497959796979797989799980098019802980398049805980698079808980998109811981298139814981598169817981898199820982198229823982498259826982798289829983098319832983398349835983698379838983998409841984298439844984598469847984898499850985198529853985498559856985798589859986098619862986398649865986698679868986998709871987298739874987598769877987898799880988198829883988498859886988798889889989098919892989398949895989698979898989999009901990299039904990599069907990899099910991199129913991499159916991799189919992099219922992399249925992699279928992999309931993299339934993599369937993899399940994199429943994499459946994799489949995099519952995399549955995699579958995999609961996299639964996599669967996899699970997199729973997499759976997799789979998099819982998399849985998699879988998999909991999299939994999599969997999899991000010001100021000310004100051000610007100081000910010100111001210013100141001510016100171001810019100201002110022100231002410025100261002710028100291003010031100321003310034100351003610037100381003910040100411004210043100441004510046100471004810049100501005110052100531005410055100561005710058100591006010061100621006310064100651006610067100681006910070100711007210073100741007510076100771007810079100801008110082100831008410085100861008710088100891009010091100921009310094100951009610097100981009910100101011010210103101041010510106101071010810109101101011110112101131011410115101161011710118101191012010121101221012310124101251012610127101281012910130101311013210133101341013510136101371013810139101401014110142101431014410145101461014710148101491015010151101521015310154101551015610157101581015910160101611016210163101641016510166101671016810169101701017110172101731017410175101761017710178101791018010181101821018310184101851018610187101881018910190101911019210193101941019510196101971019810199102001020110202102031020410205102061020710208102091021010211102121021310214102151021610217102181021910220102211022210223102241022510226102271022810229102301023110232102331023410235102361023710238102391024010241102421024310244102451024610247102481024910250102511025210253102541025510256102571025810259102601026110262102631026410265102661026710268102691027010271102721027310274102751027610277102781027910280102811028210283102841028510286102871028810289102901029110292102931029410295102961029710298102991030010301103021030310304103051030610307103081030910310103111031210313103141031510316103171031810319103201032110322103231032410325103261032710328103291033010331103321033310334103351033610337103381033910340103411034210343103441034510346103471034810349103501035110352103531035410355103561035710358103591036010361103621036310364103651036610367103681036910370103711037210373103741037510376103771037810379103801038110382103831038410385103861038710388103891039010391103921039310394103951039610397103981039910400104011040210403104041040510406104071040810409104101041110412104131041410415104161041710418104191042010421104221042310424104251042610427104281042910430104311043210433104341043510436104371043810439104401044110442104431044410445104461044710448104491045010451104521045310454104551045610457104581045910460104611046210463104641046510466104671046810469104701047110472104731047410475104761047710478104791048010481104821048310484104851048610487104881048910490104911049210493104941049510496104971049810499105001050110502105031050410505105061050710508105091051010511105121051310514105151051610517105181051910520105211052210523105241052510526105271052810529105301053110532105331053410535105361053710538105391054010541105421054310544105451054610547105481054910550105511055210553105541055510556105571055810559105601056110562105631056410565105661056710568105691057010571105721057310574105751057610577105781057910580105811058210583105841058510586105871058810589105901059110592105931059410595105961059710598105991060010601106021060310604106051060610607106081060910610106111061210613106141061510616106171061810619106201062110622106231062410625106261062710628106291063010631106321063310634106351063610637106381063910640106411064210643106441064510646106471064810649106501065110652106531065410655106561065710658106591066010661106621066310664106651066610667106681066910670106711067210673106741067510676106771067810679106801068110682106831068410685106861068710688106891069010691106921069310694106951069610697106981069910700107011070210703107041070510706107071070810709107101071110712107131071410715107161071710718107191072010721107221072310724107251072610727107281072910730107311073210733107341073510736107371073810739107401074110742107431074410745107461074710748107491075010751107521075310754107551075610757107581075910760107611076210763107641076510766107671076810769107701077110772107731077410775107761077710778107791078010781107821078310784107851078610787107881078910790107911079210793107941079510796107971079810799108001080110802108031080410805108061080710808108091081010811108121081310814108151081610817108181081910820108211082210823108241082510826108271082810829108301083110832108331083410835108361083710838108391084010841108421084310844108451084610847108481084910850108511085210853108541085510856108571085810859108601086110862108631086410865108661086710868108691087010871108721087310874108751087610877108781087910880108811088210883108841088510886108871088810889108901089110892108931089410895108961089710898108991090010901109021090310904109051090610907109081090910910109111091210913109141091510916109171091810919109201092110922109231092410925109261092710928109291093010931109321093310934109351093610937109381093910940109411094210943109441094510946109471094810949109501095110952109531095410955109561095710958109591096010961109621096310964109651096610967109681096910970109711097210973109741097510976109771097810979109801098110982109831098410985109861098710988109891099010991109921099310994109951099610997109981099911000110011100211003110041100511006110071100811009110101101111012110131101411015110161101711018110191102011021110221102311024110251102611027110281102911030110311103211033110341103511036110371103811039110401104111042110431104411045110461104711048110491105011051110521105311054110551105611057110581105911060110611106211063110641106511066110671106811069110701107111072110731107411075110761107711078110791108011081110821108311084110851108611087110881108911090110911109211093110941109511096110971109811099111001110111102111031110411105111061110711108111091111011111111121111311114111151111611117111181111911120111211112211123111241112511126111271112811129111301113111132111331113411135111361113711138111391114011141111421114311144111451114611147111481114911150111511115211153111541115511156111571115811159111601116111162111631116411165111661116711168111691117011171111721117311174111751117611177111781117911180111811118211183111841118511186111871118811189111901119111192111931119411195111961119711198111991120011201112021120311204112051120611207112081120911210112111121211213112141121511216112171121811219112201122111222112231122411225112261122711228112291123011231112321123311234112351123611237112381123911240112411124211243112441124511246112471124811249112501125111252112531125411255112561125711258112591126011261112621126311264112651126611267112681126911270112711127211273112741127511276112771127811279112801128111282112831128411285112861128711288112891129011291112921129311294112951129611297112981129911300113011130211303113041130511306113071130811309113101131111312113131131411315113161131711318113191132011321113221132311324113251132611327113281132911330113311133211333113341133511336113371133811339113401134111342113431134411345113461134711348113491135011351113521135311354113551135611357113581135911360113611136211363113641136511366113671136811369113701137111372113731137411375113761137711378113791138011381113821138311384113851138611387113881138911390113911139211393113941139511396113971139811399114001140111402114031140411405114061140711408114091141011411114121141311414114151141611417114181141911420114211142211423114241142511426114271142811429114301143111432114331143411435114361143711438114391144011441114421144311444114451144611447114481144911450114511145211453114541145511456114571145811459114601146111462114631146411465114661146711468114691147011471114721147311474114751147611477114781147911480114811148211483114841148511486114871148811489114901149111492114931149411495114961149711498114991150011501115021150311504115051150611507115081150911510115111151211513115141151511516115171151811519115201152111522115231152411525115261152711528115291153011531115321153311534115351153611537115381153911540115411154211543115441154511546115471154811549115501155111552115531155411555115561155711558115591156011561115621156311564115651156611567115681156911570115711157211573115741157511576115771157811579115801158111582115831158411585115861158711588115891159011591115921159311594115951159611597115981159911600116011160211603116041160511606116071160811609116101161111612116131161411615116161161711618116191162011621116221162311624116251162611627116281162911630116311163211633116341163511636116371163811639116401164111642116431164411645116461164711648116491165011651116521165311654116551165611657116581165911660116611166211663116641166511666116671166811669116701167111672116731167411675116761167711678116791168011681116821168311684116851168611687116881168911690116911169211693116941169511696116971169811699117001170111702117031170411705117061170711708117091171011711117121171311714117151171611717117181171911720117211172211723117241172511726117271172811729117301173111732117331173411735117361173711738117391174011741117421174311744117451174611747117481174911750117511175211753117541175511756117571175811759117601176111762117631176411765117661176711768117691177011771117721177311774117751177611777117781177911780117811178211783117841178511786117871178811789117901179111792117931179411795117961179711798117991180011801118021180311804118051180611807118081180911810118111181211813118141181511816118171181811819118201182111822118231182411825118261182711828118291183011831118321183311834118351183611837118381183911840118411184211843118441184511846118471184811849118501185111852118531185411855118561185711858118591186011861118621186311864118651186611867118681186911870118711187211873118741187511876118771187811879118801188111882118831188411885118861188711888118891189011891118921189311894118951189611897118981189911900119011190211903119041190511906119071190811909119101191111912119131191411915119161191711918119191192011921119221192311924119251192611927119281192911930119311193211933119341193511936119371193811939119401194111942119431194411945119461194711948119491195011951119521195311954119551195611957119581195911960119611196211963119641196511966119671196811969119701197111972119731197411975119761197711978119791198011981119821198311984119851198611987119881198911990119911199211993119941199511996119971199811999120001200112002120031200412005120061200712008120091201012011120121201312014120151201612017120181201912020120211202212023120241202512026120271202812029120301203112032120331203412035120361203712038120391204012041120421204312044120451204612047120481204912050120511205212053120541205512056120571205812059120601206112062120631206412065120661206712068120691207012071120721207312074120751207612077120781207912080120811208212083120841208512086120871208812089120901209112092120931209412095120961209712098120991210012101121021210312104121051210612107121081210912110121111211212113121141211512116121171211812119121201212112122121231212412125121261212712128121291213012131121321213312134121351213612137121381213912140121411214212143121441214512146121471214812149121501215112152121531215412155121561215712158121591216012161121621216312164121651216612167121681216912170121711217212173121741217512176121771217812179121801218112182121831218412185121861218712188121891219012191121921219312194121951219612197121981219912200122011220212203122041220512206122071220812209122101221112212122131221412215122161221712218122191222012221122221222312224122251222612227122281222912230122311223212233122341223512236122371223812239122401224112242122431224412245122461224712248122491225012251122521225312254122551225612257122581225912260122611226212263122641226512266122671226812269122701227112272122731227412275122761227712278122791228012281122821228312284122851228612287122881228912290122911229212293122941229512296122971229812299123001230112302123031230412305123061230712308123091231012311123121231312314123151231612317123181231912320123211232212323123241232512326123271232812329123301233112332123331233412335123361233712338123391234012341123421234312344123451234612347123481234912350123511235212353123541235512356123571235812359123601236112362123631236412365123661236712368123691237012371123721237312374123751237612377123781237912380123811238212383123841238512386123871238812389123901239112392123931239412395123961239712398123991240012401124021240312404124051240612407124081240912410124111241212413124141241512416124171241812419124201242112422124231242412425124261242712428124291243012431124321243312434124351243612437124381243912440124411244212443124441244512446124471244812449124501245112452124531245412455124561245712458124591246012461124621246312464124651246612467124681246912470124711247212473124741247512476124771247812479124801248112482124831248412485124861248712488124891249012491124921249312494124951249612497124981249912500125011250212503125041250512506125071250812509125101251112512125131251412515125161251712518125191252012521125221252312524125251252612527125281252912530125311253212533125341253512536125371253812539125401254112542125431254412545125461254712548125491255012551125521255312554125551255612557125581255912560125611256212563125641256512566125671256812569125701257112572125731257412575125761257712578125791258012581125821258312584125851258612587125881258912590125911259212593125941259512596125971259812599126001260112602126031260412605126061260712608126091261012611126121261312614126151261612617126181261912620126211262212623126241262512626126271262812629126301263112632126331263412635126361263712638126391264012641126421264312644126451264612647126481264912650126511265212653126541265512656126571265812659126601266112662126631266412665126661266712668126691267012671126721267312674126751267612677126781267912680126811268212683126841268512686126871268812689126901269112692126931269412695126961269712698126991270012701127021270312704127051270612707127081270912710127111271212713127141271512716127171271812719127201272112722127231272412725127261272712728127291273012731127321273312734127351273612737127381273912740127411274212743127441274512746127471274812749127501275112752127531275412755127561275712758127591276012761127621276312764127651276612767127681276912770127711277212773127741277512776127771277812779127801278112782127831278412785127861278712788127891279012791127921279312794127951279612797127981279912800128011280212803128041280512806128071280812809128101281112812128131281412815128161281712818128191282012821128221282312824128251282612827128281282912830128311283212833128341283512836128371283812839128401284112842128431284412845128461284712848128491285012851128521285312854128551285612857128581285912860128611286212863128641286512866128671286812869128701287112872128731287412875128761287712878128791288012881128821288312884128851288612887128881288912890128911289212893128941289512896128971289812899129001290112902129031290412905129061290712908129091291012911129121291312914129151291612917129181291912920129211292212923129241292512926129271292812929129301293112932129331293412935129361293712938129391294012941129421294312944129451294612947129481294912950129511295212953129541295512956129571295812959129601296112962129631296412965129661296712968129691297012971129721297312974129751297612977129781297912980129811298212983129841298512986129871298812989129901299112992129931299412995129961299712998129991300013001130021300313004130051300613007130081300913010130111301213013130141301513016130171301813019130201302113022130231302413025130261302713028130291303013031130321303313034130351303613037130381303913040130411304213043130441304513046130471304813049130501305113052130531305413055130561305713058130591306013061130621306313064130651306613067130681306913070130711307213073130741307513076130771307813079130801308113082130831308413085130861308713088130891309013091130921309313094130951309613097130981309913100131011310213103131041310513106131071310813109131101311113112131131311413115131161311713118131191312013121131221312313124131251312613127131281312913130131311313213133131341313513136131371313813139131401314113142131431314413145131461314713148131491315013151131521315313154131551315613157131581315913160131611316213163131641316513166131671316813169131701317113172131731317413175131761317713178131791318013181131821318313184131851318613187131881318913190131911319213193131941319513196131971319813199132001320113202132031320413205132061320713208132091321013211132121321313214132151321613217132181321913220132211322213223132241322513226132271322813229132301323113232132331323413235132361323713238132391324013241132421324313244132451324613247132481324913250132511325213253132541325513256132571325813259132601326113262132631326413265132661326713268132691327013271132721327313274132751327613277132781327913280132811328213283132841328513286132871328813289132901329113292132931329413295132961329713298132991330013301133021330313304133051330613307133081330913310133111331213313133141331513316133171331813319133201332113322133231332413325133261332713328133291333013331133321333313334133351333613337133381333913340133411334213343133441334513346133471334813349133501335113352133531335413355133561335713358133591336013361133621336313364133651336613367133681336913370133711337213373133741337513376133771337813379133801338113382133831338413385133861338713388133891339013391133921339313394133951339613397133981339913400134011340213403134041340513406134071340813409134101341113412134131341413415134161341713418134191342013421134221342313424134251342613427134281342913430134311343213433134341343513436134371343813439134401344113442134431344413445134461344713448134491345013451134521345313454134551345613457134581345913460134611346213463134641346513466134671346813469134701347113472134731347413475134761347713478134791348013481134821348313484134851348613487134881348913490134911349213493134941349513496134971349813499135001350113502135031350413505135061350713508135091351013511135121351313514135151351613517135181351913520135211352213523135241352513526135271352813529135301353113532135331353413535135361353713538135391354013541135421354313544135451354613547135481354913550135511355213553135541355513556135571355813559135601356113562135631356413565135661356713568135691357013571135721357313574135751357613577135781357913580135811358213583135841358513586135871358813589135901359113592135931359413595135961359713598135991360013601136021360313604136051360613607136081360913610136111361213613136141361513616136171361813619136201362113622136231362413625136261362713628136291363013631136321363313634136351363613637136381363913640136411364213643136441364513646136471364813649136501365113652136531365413655136561365713658136591366013661136621366313664136651366613667136681366913670136711367213673136741367513676136771367813679136801368113682136831368413685136861368713688136891369013691136921369313694136951369613697136981369913700137011370213703137041370513706137071370813709137101371113712137131371413715137161371713718137191372013721137221372313724137251372613727137281372913730137311373213733137341373513736137371373813739137401374113742137431374413745137461374713748137491375013751137521375313754137551375613757137581375913760137611376213763137641376513766137671376813769137701377113772137731377413775137761377713778137791378013781137821378313784137851378613787137881378913790137911379213793137941379513796137971379813799138001380113802138031380413805138061380713808138091381013811138121381313814138151381613817138181381913820138211382213823138241382513826138271382813829138301383113832138331383413835138361383713838138391384013841138421384313844138451384613847138481384913850138511385213853138541385513856138571385813859138601386113862138631386413865138661386713868138691387013871138721387313874138751387613877138781387913880138811388213883138841388513886138871388813889138901389113892138931389413895138961389713898138991390013901139021390313904139051390613907139081390913910139111391213913139141391513916139171391813919139201392113922139231392413925139261392713928139291393013931139321393313934139351393613937139381393913940139411394213943139441394513946139471394813949139501395113952139531395413955139561395713958139591396013961139621396313964139651396613967139681396913970139711397213973139741397513976139771397813979139801398113982139831398413985139861398713988139891399013991139921399313994139951399613997139981399914000140011400214003140041400514006140071400814009140101401114012140131401414015140161401714018140191402014021140221402314024140251402614027140281402914030140311403214033140341403514036140371403814039140401404114042140431404414045140461404714048140491405014051140521405314054140551405614057140581405914060140611406214063140641406514066140671406814069140701407114072140731407414075140761407714078140791408014081140821408314084140851408614087140881408914090140911409214093140941409514096140971409814099141001410114102141031410414105141061410714108141091411014111141121411314114141151411614117141181411914120141211412214123141241412514126141271412814129141301413114132141331413414135141361413714138141391414014141141421414314144141451414614147141481414914150141511415214153141541415514156141571415814159141601416114162141631416414165141661416714168141691417014171141721417314174141751417614177141781417914180141811418214183141841418514186141871418814189141901419114192141931419414195141961419714198141991420014201142021420314204142051420614207142081420914210142111421214213142141421514216142171421814219142201422114222142231422414225142261422714228142291423014231142321423314234142351423614237142381423914240142411424214243142441424514246142471424814249142501425114252142531425414255142561425714258142591426014261142621426314264142651426614267142681426914270142711427214273142741427514276142771427814279142801428114282142831428414285142861428714288142891429014291142921429314294142951429614297142981429914300143011430214303143041430514306143071430814309143101431114312143131431414315143161431714318143191432014321143221432314324143251432614327143281432914330143311433214333143341433514336143371433814339143401434114342143431434414345143461434714348143491435014351143521435314354143551435614357143581435914360143611436214363143641436514366143671436814369143701437114372143731437414375143761437714378143791438014381143821438314384143851438614387143881438914390143911439214393143941439514396143971439814399144001440114402144031440414405144061440714408144091441014411144121441314414144151441614417144181441914420144211442214423144241442514426144271442814429144301443114432144331443414435144361443714438144391444014441144421444314444144451444614447144481444914450144511445214453144541445514456144571445814459144601446114462144631446414465144661446714468144691447014471144721447314474144751447614477144781447914480144811448214483144841448514486144871448814489144901449114492144931449414495144961449714498144991450014501145021450314504145051450614507145081450914510145111451214513145141451514516145171451814519145201452114522145231452414525145261452714528145291453014531145321453314534145351453614537145381453914540145411454214543145441454514546145471454814549145501455114552145531455414555145561455714558145591456014561145621456314564145651456614567145681456914570145711457214573145741457514576145771457814579145801458114582145831458414585145861458714588145891459014591145921459314594145951459614597145981459914600146011460214603146041460514606146071460814609146101461114612146131461414615146161461714618146191462014621146221462314624146251462614627146281462914630146311463214633146341463514636146371463814639146401464114642146431464414645146461464714648146491465014651146521465314654146551465614657146581465914660146611466214663146641466514666146671466814669146701467114672146731467414675146761467714678146791468014681146821468314684146851468614687146881468914690146911469214693146941469514696146971469814699147001470114702147031470414705147061470714708147091471014711147121471314714147151471614717147181471914720147211472214723147241472514726147271472814729147301473114732147331473414735147361473714738147391474014741147421474314744147451474614747147481474914750147511475214753147541475514756147571475814759147601476114762147631476414765147661476714768147691477014771147721477314774147751477614777147781477914780147811478214783147841478514786147871478814789147901479114792147931479414795147961479714798147991480014801148021480314804148051480614807148081480914810148111481214813148141481514816148171481814819148201482114822148231482414825148261482714828148291483014831148321483314834148351483614837148381483914840148411484214843148441484514846148471484814849148501485114852148531485414855148561485714858148591486014861148621486314864148651486614867148681486914870148711487214873148741487514876148771487814879148801488114882148831488414885148861488714888148891489014891148921489314894148951489614897148981489914900149011490214903149041490514906149071490814909149101491114912149131491414915149161491714918149191492014921149221492314924149251492614927149281492914930149311493214933149341493514936149371493814939149401494114942149431494414945149461494714948149491495014951149521495314954149551495614957149581495914960149611496214963149641496514966149671496814969149701497114972149731497414975149761497714978149791498014981149821498314984149851498614987149881498914990149911499214993149941499514996149971499814999150001500115002150031500415005150061500715008150091501015011150121501315014150151501615017150181501915020150211502215023150241502515026150271502815029150301503115032150331503415035150361503715038150391504015041150421504315044150451504615047150481504915050150511505215053150541505515056150571505815059150601506115062150631506415065150661506715068150691507015071150721507315074150751507615077150781507915080150811508215083150841508515086150871508815089150901509115092150931509415095150961509715098150991510015101151021510315104151051510615107151081510915110151111511215113151141511515116151171511815119151201512115122151231512415125151261512715128151291513015131151321513315134151351513615137151381513915140151411514215143151441514515146151471514815149151501515115152151531515415155151561515715158151591516015161151621516315164151651516615167151681516915170151711517215173151741517515176151771517815179151801518115182151831518415185151861518715188151891519015191151921519315194151951519615197151981519915200152011520215203152041520515206152071520815209152101521115212152131521415215152161521715218152191522015221152221522315224152251522615227152281522915230152311523215233152341523515236152371523815239152401524115242152431524415245152461524715248152491525015251152521525315254152551525615257152581525915260152611526215263152641526515266152671526815269152701527115272152731527415275152761527715278152791528015281152821528315284152851528615287152881528915290152911529215293152941529515296152971529815299153001530115302153031530415305153061530715308153091531015311153121531315314153151531615317153181531915320153211532215323153241532515326153271532815329153301533115332153331533415335153361533715338153391534015341153421534315344153451534615347153481534915350153511535215353153541535515356153571535815359153601536115362153631536415365153661536715368153691537015371153721537315374153751537615377153781537915380153811538215383153841538515386153871538815389153901539115392153931539415395153961539715398153991540015401154021540315404154051540615407154081540915410154111541215413154141541515416154171541815419154201542115422154231542415425154261542715428154291543015431154321543315434154351543615437154381543915440154411544215443154441544515446154471544815449154501545115452154531545415455154561545715458154591546015461154621546315464154651546615467154681546915470154711547215473154741547515476154771547815479154801548115482154831548415485154861548715488154891549015491154921549315494154951549615497154981549915500155011550215503155041550515506155071550815509155101551115512155131551415515155161551715518155191552015521155221552315524155251552615527155281552915530155311553215533155341553515536155371553815539155401554115542155431554415545155461554715548155491555015551155521555315554155551555615557155581555915560155611556215563155641556515566155671556815569155701557115572155731557415575155761557715578155791558015581155821558315584155851558615587155881558915590155911559215593155941559515596155971559815599156001560115602156031560415605156061560715608156091561015611156121561315614156151561615617156181561915620156211562215623156241562515626156271562815629156301563115632156331563415635156361563715638156391564015641156421564315644156451564615647156481564915650156511565215653156541565515656156571565815659156601566115662156631566415665156661566715668156691567015671156721567315674156751567615677156781567915680156811568215683156841568515686156871568815689156901569115692156931569415695156961569715698156991570015701157021570315704157051570615707157081570915710157111571215713157141571515716157171571815719157201572115722157231572415725157261572715728157291573015731157321573315734157351573615737157381573915740157411574215743157441574515746157471574815749157501575115752157531575415755157561575715758157591576015761157621576315764157651576615767157681576915770157711577215773157741577515776157771577815779157801578115782157831578415785157861578715788157891579015791157921579315794157951579615797157981579915800158011580215803158041580515806158071580815809158101581115812158131581415815158161581715818158191582015821158221582315824158251582615827158281582915830158311583215833158341583515836158371583815839158401584115842158431584415845158461584715848158491585015851158521585315854158551585615857158581585915860158611586215863158641586515866158671586815869158701587115872158731587415875158761587715878158791588015881158821588315884158851588615887158881588915890158911589215893158941589515896158971589815899159001590115902159031590415905159061590715908159091591015911159121591315914159151591615917159181591915920159211592215923159241592515926159271592815929159301593115932159331593415935159361593715938159391594015941159421594315944159451594615947159481594915950159511595215953159541595515956159571595815959159601596115962159631596415965159661596715968159691597015971159721597315974159751597615977159781597915980159811598215983159841598515986159871598815989159901599115992159931599415995159961599715998159991600016001160021600316004160051600616007160081600916010160111601216013160141601516016160171601816019160201602116022160231602416025160261602716028160291603016031160321603316034160351603616037160381603916040160411604216043160441604516046160471604816049160501605116052160531605416055160561605716058160591606016061160621606316064160651606616067160681606916070160711607216073160741607516076160771607816079160801608116082160831608416085160861608716088160891609016091160921609316094160951609616097160981609916100161011610216103161041610516106161071610816109161101611116112161131611416115161161611716118161191612016121161221612316124161251612616127161281612916130161311613216133161341613516136161371613816139161401614116142161431614416145161461614716148161491615016151161521615316154161551615616157161581615916160161611616216163161641616516166161671616816169161701617116172161731617416175161761617716178161791618016181161821618316184161851618616187161881618916190161911619216193161941619516196161971619816199162001620116202162031620416205162061620716208162091621016211162121621316214162151621616217162181621916220162211622216223162241622516226162271622816229162301623116232162331623416235162361623716238162391624016241162421624316244162451624616247162481624916250162511625216253162541625516256162571625816259162601626116262162631626416265162661626716268162691627016271162721627316274162751627616277162781627916280162811628216283162841628516286162871628816289162901629116292162931629416295162961629716298162991630016301163021630316304163051630616307163081630916310163111631216313163141631516316163171631816319163201632116322163231632416325163261632716328163291633016331163321633316334163351633616337163381633916340163411634216343163441634516346163471634816349163501635116352163531635416355163561635716358163591636016361163621636316364163651636616367163681636916370163711637216373163741637516376163771637816379163801638116382163831638416385163861638716388163891639016391163921639316394163951639616397163981639916400164011640216403164041640516406164071640816409164101641116412164131641416415164161641716418164191642016421164221642316424164251642616427164281642916430164311643216433164341643516436164371643816439164401644116442164431644416445164461644716448164491645016451164521645316454164551645616457164581645916460164611646216463164641646516466164671646816469164701647116472164731647416475164761647716478164791648016481164821648316484164851648616487164881648916490164911649216493164941649516496164971649816499165001650116502165031650416505165061650716508165091651016511165121651316514165151651616517165181651916520165211652216523165241652516526165271652816529165301653116532165331653416535165361653716538165391654016541165421654316544165451654616547165481654916550165511655216553165541655516556165571655816559165601656116562165631656416565165661656716568165691657016571165721657316574165751657616577165781657916580165811658216583165841658516586165871658816589165901659116592165931659416595165961659716598165991660016601166021660316604166051660616607166081660916610166111661216613166141661516616166171661816619166201662116622166231662416625166261662716628166291663016631166321663316634166351663616637166381663916640166411664216643166441664516646166471664816649166501665116652166531665416655166561665716658166591666016661166621666316664166651666616667166681666916670166711667216673166741667516676166771667816679166801668116682166831668416685166861668716688166891669016691166921669316694166951669616697166981669916700167011670216703167041670516706167071670816709167101671116712167131671416715167161671716718167191672016721167221672316724167251672616727167281672916730167311673216733167341673516736167371673816739167401674116742167431674416745167461674716748167491675016751167521675316754167551675616757167581675916760167611676216763167641676516766167671676816769167701677116772167731677416775167761677716778167791678016781167821678316784167851678616787167881678916790167911679216793167941679516796167971679816799168001680116802168031680416805168061680716808168091681016811168121681316814168151681616817168181681916820168211682216823168241682516826168271682816829168301683116832168331683416835168361683716838168391684016841168421684316844168451684616847168481684916850168511685216853168541685516856168571685816859168601686116862168631686416865168661686716868168691687016871168721687316874168751687616877168781687916880168811688216883168841688516886168871688816889168901689116892168931689416895168961689716898168991690016901169021690316904169051690616907169081690916910169111691216913169141691516916169171691816919169201692116922169231692416925169261692716928169291693016931169321693316934169351693616937169381693916940169411694216943169441694516946169471694816949169501695116952169531695416955169561695716958169591696016961169621696316964169651696616967169681696916970169711697216973169741697516976169771697816979169801698116982169831698416985169861698716988169891699016991169921699316994169951699616997169981699917000170011700217003170041700517006170071700817009170101701117012170131701417015170161701717018170191702017021170221702317024170251702617027170281702917030170311703217033170341703517036170371703817039170401704117042170431704417045170461704717048170491705017051170521705317054170551705617057170581705917060170611706217063170641706517066170671706817069170701707117072170731707417075170761707717078170791708017081170821708317084170851708617087170881708917090170911709217093170941709517096170971709817099171001710117102171031710417105171061710717108171091711017111171121711317114171151711617117171181711917120171211712217123171241712517126171271712817129171301713117132171331713417135171361713717138171391714017141171421714317144171451714617147171481714917150171511715217153171541715517156171571715817159171601716117162171631716417165171661716717168171691717017171171721717317174171751717617177171781717917180171811718217183171841718517186171871718817189171901719117192171931719417195171961719717198171991720017201172021720317204172051720617207172081720917210172111721217213172141721517216172171721817219172201722117222172231722417225172261722717228172291723017231172321723317234172351723617237172381723917240172411724217243172441724517246172471724817249172501725117252172531725417255172561725717258172591726017261172621726317264172651726617267172681726917270172711727217273172741727517276172771727817279172801728117282172831728417285172861728717288172891729017291172921729317294172951729617297172981729917300173011730217303173041730517306173071730817309173101731117312173131731417315173161731717318173191732017321173221732317324173251732617327173281732917330173311733217333173341733517336173371733817339173401734117342173431734417345173461734717348173491735017351173521735317354173551735617357173581735917360173611736217363173641736517366173671736817369173701737117372173731737417375173761737717378173791738017381173821738317384173851738617387173881738917390173911739217393173941739517396173971739817399174001740117402174031740417405174061740717408174091741017411174121741317414174151741617417174181741917420174211742217423174241742517426174271742817429174301743117432174331743417435174361743717438174391744017441174421744317444174451744617447174481744917450174511745217453174541745517456174571745817459174601746117462174631746417465174661746717468174691747017471174721747317474174751747617477174781747917480174811748217483174841748517486174871748817489174901749117492174931749417495174961749717498174991750017501175021750317504175051750617507175081750917510175111751217513175141751517516175171751817519175201752117522175231752417525175261752717528175291753017531175321753317534175351753617537175381753917540175411754217543175441754517546175471754817549175501755117552175531755417555175561755717558175591756017561175621756317564175651756617567175681756917570175711757217573175741757517576175771757817579175801758117582175831758417585175861758717588175891759017591175921759317594175951759617597175981759917600176011760217603176041760517606176071760817609176101761117612176131761417615176161761717618176191762017621176221762317624176251762617627176281762917630176311763217633176341763517636176371763817639176401764117642176431764417645176461764717648176491765017651176521765317654176551765617657176581765917660176611766217663176641766517666176671766817669176701767117672176731767417675176761767717678176791768017681176821768317684176851768617687176881768917690176911769217693176941769517696176971769817699177001770117702177031770417705177061770717708177091771017711177121771317714177151771617717177181771917720177211772217723177241772517726177271772817729177301773117732177331773417735177361773717738177391774017741177421774317744177451774617747177481774917750177511775217753177541775517756177571775817759177601776117762177631776417765177661776717768177691777017771177721777317774177751777617777177781777917780177811778217783177841778517786177871778817789177901779117792177931779417795177961779717798177991780017801178021780317804178051780617807178081780917810178111781217813178141781517816178171781817819178201782117822178231782417825178261782717828178291783017831178321783317834178351783617837178381783917840178411784217843178441784517846178471784817849178501785117852178531785417855178561785717858178591786017861178621786317864178651786617867178681786917870178711787217873178741787517876178771787817879178801788117882178831788417885178861788717888178891789017891178921789317894178951789617897178981789917900179011790217903179041790517906179071790817909179101791117912179131791417915179161791717918179191792017921179221792317924179251792617927179281792917930179311793217933179341793517936179371793817939179401794117942179431794417945179461794717948179491795017951179521795317954179551795617957179581795917960179611796217963179641796517966179671796817969179701797117972179731797417975179761797717978179791798017981179821798317984179851798617987179881798917990179911799217993179941799517996179971799817999180001800118002180031800418005180061800718008180091801018011180121801318014180151801618017180181801918020180211802218023180241802518026180271802818029180301803118032180331803418035180361803718038180391804018041180421804318044180451804618047180481804918050180511805218053180541805518056180571805818059180601806118062180631806418065180661806718068180691807018071180721807318074180751807618077180781807918080180811808218083180841808518086180871808818089180901809118092180931809418095180961809718098180991810018101181021810318104181051810618107181081810918110181111811218113181141811518116181171811818119181201812118122181231812418125181261812718128181291813018131181321813318134181351813618137181381813918140181411814218143181441814518146181471814818149181501815118152181531815418155181561815718158181591816018161181621816318164181651816618167181681816918170181711817218173181741817518176181771817818179181801818118182181831818418185181861818718188181891819018191181921819318194181951819618197181981819918200182011820218203182041820518206182071820818209182101821118212182131821418215182161821718218182191822018221182221822318224182251822618227182281822918230182311823218233182341823518236182371823818239182401824118242182431824418245182461824718248182491825018251182521825318254182551825618257182581825918260182611826218263182641826518266182671826818269182701827118272182731827418275182761827718278182791828018281182821828318284182851828618287182881828918290182911829218293182941829518296182971829818299183001830118302183031830418305183061830718308183091831018311183121831318314183151831618317183181831918320183211832218323183241832518326183271832818329183301833118332183331833418335183361833718338183391834018341183421834318344183451834618347183481834918350183511835218353183541835518356183571835818359183601836118362183631836418365183661836718368183691837018371183721837318374183751837618377183781837918380183811838218383183841838518386183871838818389183901839118392183931839418395183961839718398183991840018401184021840318404184051840618407184081840918410184111841218413184141841518416184171841818419184201842118422184231842418425184261842718428184291843018431184321843318434184351843618437184381843918440184411844218443184441844518446184471844818449184501845118452184531845418455184561845718458184591846018461184621846318464184651846618467184681846918470184711847218473184741847518476184771847818479184801848118482184831848418485184861848718488184891849018491184921849318494184951849618497184981849918500185011850218503185041850518506185071850818509185101851118512185131851418515185161851718518185191852018521185221852318524185251852618527185281852918530185311853218533185341853518536185371853818539185401854118542185431854418545185461854718548185491855018551185521855318554185551855618557185581855918560185611856218563185641856518566185671856818569185701857118572185731857418575185761857718578185791858018581185821858318584185851858618587185881858918590185911859218593185941859518596185971859818599186001860118602186031860418605186061860718608186091861018611186121861318614186151861618617186181861918620186211862218623186241862518626186271862818629186301863118632186331863418635186361863718638186391864018641186421864318644186451864618647186481864918650186511865218653186541865518656186571865818659186601866118662186631866418665186661866718668186691867018671186721867318674186751867618677186781867918680186811868218683186841868518686186871868818689186901869118692186931869418695186961869718698186991870018701187021870318704187051870618707187081870918710187111871218713187141871518716187171871818719187201872118722187231872418725187261872718728187291873018731187321873318734187351873618737187381873918740187411874218743187441874518746187471874818749187501875118752187531875418755187561875718758187591876018761187621876318764187651876618767187681876918770187711877218773187741877518776187771877818779187801878118782187831878418785187861878718788187891879018791187921879318794187951879618797187981879918800188011880218803188041880518806188071880818809188101881118812188131881418815188161881718818188191882018821188221882318824188251882618827188281882918830188311883218833188341883518836188371883818839188401884118842188431884418845188461884718848188491885018851188521885318854188551885618857188581885918860188611886218863188641886518866188671886818869188701887118872188731887418875188761887718878188791888018881188821888318884188851888618887188881888918890188911889218893188941889518896188971889818899189001890118902189031890418905189061890718908189091891018911189121891318914189151891618917189181891918920189211892218923189241892518926189271892818929189301893118932189331893418935189361893718938189391894018941189421894318944189451894618947189481894918950189511895218953189541895518956189571895818959189601896118962189631896418965189661896718968189691897018971189721897318974189751897618977189781897918980189811898218983189841898518986189871898818989189901899118992189931899418995189961899718998189991900019001190021900319004190051900619007190081900919010190111901219013190141901519016190171901819019190201902119022190231902419025190261902719028190291903019031190321903319034190351903619037190381903919040190411904219043190441904519046190471904819049190501905119052190531905419055190561905719058190591906019061190621906319064190651906619067190681906919070190711907219073190741907519076190771907819079190801908119082190831908419085190861908719088190891909019091190921909319094190951909619097190981909919100191011910219103191041910519106191071910819109191101911119112191131911419115191161911719118191191912019121191221912319124191251912619127191281912919130191311913219133191341913519136191371913819139191401914119142191431914419145191461914719148191491915019151191521915319154191551915619157191581915919160191611916219163191641916519166191671916819169191701917119172191731917419175191761917719178191791918019181191821918319184191851918619187191881918919190191911919219193191941919519196191971919819199192001920119202192031920419205192061920719208192091921019211192121921319214192151921619217192181921919220192211922219223192241922519226192271922819229192301923119232192331923419235192361923719238192391924019241192421924319244192451924619247192481924919250192511925219253192541925519256192571925819259192601926119262192631926419265192661926719268192691927019271192721927319274192751927619277192781927919280192811928219283192841928519286192871928819289192901929119292192931929419295192961929719298192991930019301193021930319304193051930619307193081930919310193111931219313193141931519316193171931819319193201932119322193231932419325193261932719328193291933019331193321933319334193351933619337193381933919340193411934219343193441934519346193471934819349193501935119352193531935419355193561935719358193591936019361193621936319364193651936619367193681936919370193711937219373193741937519376193771937819379193801938119382193831938419385193861938719388193891939019391193921939319394193951939619397193981939919400194011940219403194041940519406194071940819409194101941119412194131941419415194161941719418194191942019421194221942319424194251942619427194281942919430194311943219433194341943519436194371943819439194401944119442194431944419445194461944719448194491945019451194521945319454194551945619457194581945919460194611946219463194641946519466194671946819469194701947119472194731947419475194761947719478194791948019481194821948319484194851948619487194881948919490194911949219493194941949519496194971949819499195001950119502195031950419505195061950719508195091951019511195121951319514195151951619517195181951919520195211952219523195241952519526195271952819529195301953119532195331953419535195361953719538195391954019541195421954319544195451954619547195481954919550195511955219553195541955519556195571955819559195601956119562195631956419565195661956719568195691957019571195721957319574195751957619577195781957919580195811958219583195841958519586195871958819589195901959119592195931959419595195961959719598195991960019601196021960319604196051960619607196081960919610196111961219613196141961519616196171961819619196201962119622196231962419625196261962719628196291963019631196321963319634196351963619637196381963919640196411964219643196441964519646196471964819649196501965119652196531965419655196561965719658196591966019661196621966319664196651966619667196681966919670196711967219673196741967519676196771967819679196801968119682196831968419685196861968719688196891969019691196921969319694196951969619697196981969919700197011970219703197041970519706197071970819709197101971119712197131971419715197161971719718197191972019721197221972319724197251972619727197281972919730197311973219733197341973519736197371973819739197401974119742197431974419745197461974719748197491975019751197521975319754197551975619757197581975919760197611976219763197641976519766197671976819769197701977119772197731977419775197761977719778197791978019781197821978319784197851978619787197881978919790197911979219793197941979519796197971979819799198001980119802198031980419805198061980719808198091981019811198121981319814198151981619817198181981919820198211982219823198241982519826198271982819829198301983119832198331983419835198361983719838198391984019841198421984319844198451984619847198481984919850198511985219853198541985519856198571985819859198601986119862198631986419865198661986719868198691987019871198721987319874198751987619877198781987919880198811988219883198841988519886198871988819889198901989119892198931989419895198961989719898198991990019901199021990319904199051990619907199081990919910199111991219913199141991519916199171991819919199201992119922199231992419925199261992719928199291993019931199321993319934199351993619937199381993919940199411994219943199441994519946199471994819949199501995119952199531995419955199561995719958199591996019961199621996319964199651996619967199681996919970199711997219973199741997519976199771997819979199801998119982199831998419985199861998719988199891999019991199921999319994199951999619997199981999920000200012000220003200042000520006200072000820009200102001120012200132001420015200162001720018200192002020021200222002320024200252002620027200282002920030200312003220033200342003520036200372003820039200402004120042200432004420045200462004720048200492005020051200522005320054200552005620057200582005920060200612006220063200642006520066200672006820069200702007120072200732007420075200762007720078200792008020081200822008320084200852008620087200882008920090200912009220093200942009520096200972009820099201002010120102201032010420105201062010720108201092011020111201122011320114201152011620117201182011920120201212012220123201242012520126201272012820129201302013120132201332013420135201362013720138201392014020141201422014320144201452014620147201482014920150201512015220153201542015520156201572015820159201602016120162201632016420165201662016720168201692017020171201722017320174201752017620177201782017920180201812018220183201842018520186201872018820189201902019120192201932019420195201962019720198201992020020201202022020320204202052020620207202082020920210202112021220213202142021520216202172021820219202202022120222202232022420225202262022720228202292023020231202322023320234202352023620237202382023920240202412024220243202442024520246202472024820249202502025120252202532025420255202562025720258202592026020261202622026320264202652026620267202682026920270202712027220273202742027520276202772027820279202802028120282202832028420285202862028720288202892029020291202922029320294202952029620297202982029920300203012030220303203042030520306203072030820309203102031120312203132031420315203162031720318203192032020321203222032320324203252032620327203282032920330203312033220333203342033520336203372033820339203402034120342203432034420345203462034720348203492035020351203522035320354203552035620357203582035920360203612036220363203642036520366203672036820369203702037120372203732037420375203762037720378203792038020381203822038320384203852038620387203882038920390203912039220393203942039520396203972039820399204002040120402204032040420405204062040720408204092041020411204122041320414204152041620417204182041920420204212042220423204242042520426204272042820429204302043120432204332043420435204362043720438204392044020441204422044320444204452044620447204482044920450204512045220453204542045520456204572045820459204602046120462204632046420465204662046720468204692047020471204722047320474204752047620477204782047920480204812048220483204842048520486204872048820489204902049120492204932049420495204962049720498204992050020501205022050320504205052050620507205082050920510205112051220513205142051520516205172051820519205202052120522205232052420525205262052720528205292053020531205322053320534205352053620537205382053920540205412054220543205442054520546205472054820549205502055120552205532055420555205562055720558205592056020561205622056320564205652056620567205682056920570205712057220573205742057520576205772057820579205802058120582205832058420585205862058720588205892059020591205922059320594205952059620597205982059920600206012060220603206042060520606206072060820609206102061120612206132061420615206162061720618206192062020621206222062320624206252062620627206282062920630206312063220633206342063520636206372063820639206402064120642206432064420645206462064720648206492065020651206522065320654206552065620657206582065920660206612066220663206642066520666206672066820669206702067120672206732067420675206762067720678206792068020681206822068320684206852068620687206882068920690206912069220693206942069520696206972069820699207002070120702207032070420705207062070720708207092071020711207122071320714207152071620717207182071920720207212072220723207242072520726207272072820729207302073120732207332073420735207362073720738207392074020741207422074320744207452074620747207482074920750207512075220753207542075520756207572075820759207602076120762207632076420765207662076720768207692077020771207722077320774207752077620777207782077920780207812078220783207842078520786207872078820789207902079120792207932079420795207962079720798207992080020801208022080320804208052080620807208082080920810208112081220813208142081520816208172081820819208202082120822208232082420825208262082720828208292083020831208322083320834208352083620837208382083920840208412084220843208442084520846208472084820849208502085120852208532085420855208562085720858208592086020861208622086320864208652086620867208682086920870208712087220873208742087520876208772087820879208802088120882208832088420885208862088720888208892089020891208922089320894208952089620897208982089920900209012090220903209042090520906209072090820909209102091120912209132091420915209162091720918209192092020921209222092320924209252092620927209282092920930209312093220933209342093520936209372093820939209402094120942209432094420945209462094720948209492095020951209522095320954209552095620957209582095920960209612096220963209642096520966209672096820969209702097120972209732097420975209762097720978209792098020981209822098320984209852098620987209882098920990209912099220993209942099520996209972099820999210002100121002210032100421005210062100721008210092101021011210122101321014210152101621017210182101921020210212102221023210242102521026210272102821029210302103121032210332103421035210362103721038210392104021041210422104321044210452104621047210482104921050210512105221053210542105521056210572105821059210602106121062210632106421065210662106721068210692107021071210722107321074210752107621077210782107921080210812108221083210842108521086210872108821089210902109121092210932109421095210962109721098210992110021101211022110321104211052110621107211082110921110211112111221113211142111521116211172111821119211202112121122211232112421125211262112721128211292113021131211322113321134211352113621137211382113921140211412114221143211442114521146211472114821149211502115121152211532115421155211562115721158211592116021161211622116321164211652116621167211682116921170211712117221173211742117521176211772117821179211802118121182211832118421185211862118721188211892119021191211922119321194211952119621197211982119921200212012120221203212042120521206212072120821209212102121121212212132121421215212162121721218212192122021221212222122321224212252122621227212282122921230212312123221233212342123521236212372123821239212402124121242212432124421245212462124721248212492125021251212522125321254212552125621257212582125921260212612126221263212642126521266212672126821269212702127121272212732127421275212762127721278212792128021281212822128321284212852128621287212882128921290212912129221293212942129521296212972129821299213002130121302213032130421305213062130721308213092131021311213122131321314213152131621317213182131921320213212132221323213242132521326213272132821329213302133121332213332133421335213362133721338213392134021341213422134321344213452134621347213482134921350213512135221353213542135521356213572135821359213602136121362213632136421365213662136721368213692137021371213722137321374213752137621377213782137921380213812138221383213842138521386213872138821389213902139121392213932139421395213962139721398213992140021401214022140321404214052140621407214082140921410214112141221413214142141521416214172141821419214202142121422214232142421425214262142721428214292143021431214322143321434214352143621437214382143921440214412144221443214442144521446214472144821449214502145121452214532145421455214562145721458214592146021461214622146321464214652146621467214682146921470214712147221473214742147521476214772147821479214802148121482214832148421485214862148721488214892149021491214922149321494214952149621497214982149921500215012150221503215042150521506215072150821509215102151121512215132151421515215162151721518215192152021521215222152321524215252152621527215282152921530215312153221533215342153521536215372153821539215402154121542215432154421545215462154721548215492155021551215522155321554215552155621557215582155921560215612156221563215642156521566215672156821569215702157121572215732157421575215762157721578215792158021581215822158321584215852158621587215882158921590215912159221593215942159521596215972159821599216002160121602216032160421605216062160721608216092161021611216122161321614216152161621617216182161921620216212162221623216242162521626216272162821629216302163121632216332163421635216362163721638216392164021641216422164321644216452164621647216482164921650216512165221653216542165521656216572165821659216602166121662216632166421665216662166721668216692167021671216722167321674216752167621677216782167921680216812168221683216842168521686216872168821689216902169121692216932169421695216962169721698216992170021701217022170321704217052170621707217082170921710217112171221713217142171521716217172171821719217202172121722217232172421725217262172721728217292173021731217322173321734217352173621737217382173921740217412174221743217442174521746217472174821749217502175121752217532175421755217562175721758217592176021761217622176321764217652176621767217682176921770217712177221773217742177521776217772177821779217802178121782217832178421785217862178721788217892179021791217922179321794217952179621797217982179921800218012180221803218042180521806218072180821809218102181121812218132181421815218162181721818218192182021821218222182321824218252182621827218282182921830218312183221833218342183521836218372183821839218402184121842218432184421845218462184721848218492185021851218522185321854218552185621857218582185921860218612186221863218642186521866218672186821869218702187121872218732187421875218762187721878218792188021881218822188321884218852188621887218882188921890218912189221893218942189521896218972189821899219002190121902219032190421905219062190721908219092191021911219122191321914219152191621917219182191921920219212192221923219242192521926219272192821929219302193121932219332193421935219362193721938219392194021941219422194321944219452194621947219482194921950219512195221953219542195521956219572195821959219602196121962219632196421965219662196721968219692197021971219722197321974219752197621977219782197921980219812198221983219842198521986219872198821989219902199121992219932199421995219962199721998219992200022001220022200322004220052200622007220082200922010220112201222013220142201522016220172201822019220202202122022220232202422025220262202722028220292203022031220322203322034220352203622037220382203922040220412204222043220442204522046220472204822049220502205122052220532205422055220562205722058220592206022061220622206322064220652206622067220682206922070220712207222073220742207522076220772207822079220802208122082220832208422085220862208722088220892209022091220922209322094220952209622097220982209922100221012210222103221042210522106221072210822109221102211122112221132211422115221162211722118221192212022121221222212322124221252212622127221282212922130221312213222133221342213522136221372213822139221402214122142221432214422145221462214722148221492215022151221522215322154221552215622157221582215922160221612216222163221642216522166221672216822169221702217122172221732217422175221762217722178221792218022181221822218322184221852218622187221882218922190221912219222193221942219522196221972219822199222002220122202222032220422205222062220722208222092221022211222122221322214222152221622217222182221922220222212222222223222242222522226222272222822229222302223122232222332223422235222362223722238222392224022241222422224322244222452224622247222482224922250222512225222253222542225522256222572225822259222602226122262222632226422265222662226722268222692227022271222722227322274222752227622277222782227922280222812228222283222842228522286222872228822289222902229122292222932229422295222962229722298222992230022301223022230322304223052230622307223082230922310223112231222313223142231522316223172231822319223202232122322223232232422325223262232722328223292233022331223322233322334223352233622337223382233922340223412234222343223442234522346223472234822349223502235122352223532235422355223562235722358223592236022361223622236322364223652236622367223682236922370223712237222373223742237522376223772237822379223802238122382223832238422385223862238722388223892239022391223922239322394223952239622397223982239922400224012240222403224042240522406224072240822409224102241122412224132241422415224162241722418224192242022421224222242322424224252242622427224282242922430224312243222433224342243522436224372243822439224402244122442224432244422445224462244722448224492245022451224522245322454224552245622457224582245922460224612246222463224642246522466224672246822469224702247122472224732247422475224762247722478224792248022481224822248322484224852248622487224882248922490224912249222493224942249522496224972249822499225002250122502225032250422505225062250722508225092251022511225122251322514225152251622517225182251922520225212252222523225242252522526225272252822529225302253122532225332253422535225362253722538225392254022541225422254322544225452254622547225482254922550225512255222553225542255522556225572255822559225602256122562225632256422565225662256722568225692257022571225722257322574225752257622577225782257922580225812258222583225842258522586225872258822589225902259122592225932259422595225962259722598225992260022601226022260322604226052260622607226082260922610226112261222613226142261522616226172261822619226202262122622226232262422625226262262722628226292263022631226322263322634226352263622637226382263922640226412264222643226442264522646226472264822649226502265122652226532265422655226562265722658226592266022661226622266322664226652266622667226682266922670226712267222673226742267522676226772267822679226802268122682226832268422685226862268722688226892269022691226922269322694226952269622697226982269922700227012270222703227042270522706227072270822709227102271122712227132271422715227162271722718227192272022721227222272322724227252272622727227282272922730227312273222733227342273522736227372273822739227402274122742227432274422745227462274722748227492275022751227522275322754227552275622757227582275922760227612276222763227642276522766227672276822769227702277122772227732277422775227762277722778227792278022781227822278322784227852278622787227882278922790227912279222793227942279522796227972279822799228002280122802228032280422805228062280722808228092281022811228122281322814228152281622817228182281922820228212282222823228242282522826228272282822829228302283122832228332283422835228362283722838228392284022841228422284322844228452284622847228482284922850228512285222853228542285522856228572285822859228602286122862228632286422865228662286722868228692287022871228722287322874228752287622877228782287922880228812288222883228842288522886228872288822889228902289122892228932289422895228962289722898228992290022901229022290322904229052290622907229082290922910229112291222913229142291522916229172291822919229202292122922229232292422925229262292722928229292293022931229322293322934229352293622937229382293922940229412294222943229442294522946229472294822949229502295122952229532295422955229562295722958229592296022961229622296322964229652296622967229682296922970229712297222973229742297522976229772297822979229802298122982229832298422985229862298722988229892299022991229922299322994229952299622997229982299923000230012300223003230042300523006230072300823009230102301123012230132301423015230162301723018230192302023021230222302323024230252302623027230282302923030230312303223033230342303523036230372303823039230402304123042230432304423045230462304723048230492305023051230522305323054230552305623057230582305923060230612306223063230642306523066230672306823069230702307123072230732307423075230762307723078230792308023081230822308323084230852308623087230882308923090230912309223093230942309523096230972309823099231002310123102231032310423105231062310723108231092311023111231122311323114231152311623117231182311923120231212312223123231242312523126231272312823129231302313123132231332313423135231362313723138231392314023141231422314323144231452314623147231482314923150231512315223153231542315523156231572315823159231602316123162231632316423165231662316723168231692317023171231722317323174231752317623177231782317923180231812318223183231842318523186231872318823189231902319123192231932319423195231962319723198231992320023201232022320323204232052320623207232082320923210232112321223213232142321523216232172321823219232202322123222232232322423225232262322723228232292323023231232322323323234232352323623237232382323923240232412324223243232442324523246232472324823249232502325123252232532325423255232562325723258232592326023261232622326323264232652326623267232682326923270232712327223273232742327523276232772327823279232802328123282232832328423285232862328723288232892329023291232922329323294232952329623297232982329923300233012330223303233042330523306233072330823309233102331123312233132331423315233162331723318233192332023321233222332323324233252332623327233282332923330233312333223333233342333523336233372333823339233402334123342233432334423345233462334723348233492335023351233522335323354233552335623357233582335923360233612336223363233642336523366233672336823369233702337123372233732337423375233762337723378233792338023381233822338323384233852338623387233882338923390233912339223393233942339523396233972339823399234002340123402234032340423405234062340723408234092341023411234122341323414234152341623417234182341923420234212342223423234242342523426234272342823429234302343123432234332343423435234362343723438234392344023441234422344323444234452344623447234482344923450234512345223453234542345523456234572345823459234602346123462234632346423465234662346723468234692347023471234722347323474234752347623477234782347923480234812348223483234842348523486234872348823489234902349123492234932349423495234962349723498234992350023501235022350323504235052350623507235082350923510235112351223513235142351523516235172351823519235202352123522235232352423525235262352723528235292353023531235322353323534235352353623537235382353923540235412354223543235442354523546235472354823549235502355123552235532355423555235562355723558235592356023561235622356323564235652356623567235682356923570235712357223573235742357523576235772357823579235802358123582235832358423585235862358723588235892359023591235922359323594235952359623597235982359923600236012360223603236042360523606236072360823609236102361123612236132361423615236162361723618236192362023621236222362323624236252362623627236282362923630236312363223633236342363523636236372363823639236402364123642236432364423645236462364723648236492365023651236522365323654236552365623657236582365923660236612366223663236642366523666236672366823669236702367123672236732367423675236762367723678236792368023681236822368323684236852368623687236882368923690236912369223693236942369523696236972369823699237002370123702237032370423705237062370723708237092371023711237122371323714237152371623717237182371923720237212372223723237242372523726237272372823729237302373123732237332373423735237362373723738237392374023741237422374323744237452374623747237482374923750237512375223753237542375523756237572375823759237602376123762237632376423765237662376723768237692377023771237722377323774237752377623777237782377923780237812378223783237842378523786237872378823789237902379123792237932379423795237962379723798237992380023801238022380323804238052380623807238082380923810238112381223813238142381523816238172381823819238202382123822238232382423825238262382723828238292383023831238322383323834238352383623837238382383923840238412384223843238442384523846238472384823849238502385123852238532385423855238562385723858238592386023861238622386323864238652386623867238682386923870238712387223873238742387523876238772387823879238802388123882238832388423885238862388723888238892389023891238922389323894238952389623897238982389923900239012390223903239042390523906239072390823909239102391123912239132391423915239162391723918239192392023921239222392323924239252392623927239282392923930239312393223933239342393523936239372393823939239402394123942239432394423945239462394723948239492395023951239522395323954239552395623957239582395923960239612396223963239642396523966239672396823969239702397123972239732397423975239762397723978239792398023981239822398323984239852398623987239882398923990239912399223993239942399523996239972399823999240002400124002240032400424005240062400724008240092401024011240122401324014240152401624017240182401924020240212402224023240242402524026240272402824029240302403124032240332403424035240362403724038240392404024041240422404324044240452404624047240482404924050240512405224053240542405524056240572405824059240602406124062240632406424065240662406724068240692407024071240722407324074240752407624077240782407924080240812408224083240842408524086240872408824089240902409124092240932409424095240962409724098240992410024101241022410324104241052410624107241082410924110241112411224113241142411524116241172411824119241202412124122241232412424125241262412724128241292413024131241322413324134241352413624137241382413924140241412414224143241442414524146241472414824149241502415124152241532415424155241562415724158241592416024161241622416324164241652416624167241682416924170241712417224173241742417524176241772417824179241802418124182241832418424185241862418724188241892419024191241922419324194241952419624197241982419924200242012420224203242042420524206242072420824209242102421124212242132421424215242162421724218242192422024221242222422324224242252422624227242282422924230242312423224233242342423524236242372423824239242402424124242242432424424245242462424724248242492425024251242522425324254242552425624257242582425924260242612426224263242642426524266242672426824269242702427124272242732427424275242762427724278242792428024281242822428324284242852428624287242882428924290242912429224293242942429524296242972429824299243002430124302243032430424305243062430724308243092431024311243122431324314243152431624317243182431924320243212432224323243242432524326243272432824329243302433124332243332433424335243362433724338243392434024341243422434324344243452434624347243482434924350243512435224353243542435524356243572435824359243602436124362243632436424365243662436724368243692437024371243722437324374243752437624377243782437924380243812438224383243842438524386243872438824389243902439124392243932439424395243962439724398243992440024401244022440324404244052440624407244082440924410244112441224413244142441524416244172441824419244202442124422244232442424425244262442724428244292443024431244322443324434244352443624437244382443924440244412444224443244442444524446244472444824449244502445124452244532445424455244562445724458244592446024461244622446324464244652446624467244682446924470244712447224473244742447524476244772447824479244802448124482244832448424485244862448724488244892449024491244922449324494244952449624497244982449924500245012450224503245042450524506245072450824509245102451124512245132451424515245162451724518245192452024521245222452324524245252452624527245282452924530245312453224533245342453524536245372453824539245402454124542245432454424545245462454724548245492455024551245522455324554245552455624557245582455924560245612456224563245642456524566245672456824569245702457124572245732457424575245762457724578245792458024581245822458324584245852458624587245882458924590245912459224593245942459524596245972459824599246002460124602246032460424605246062460724608246092461024611246122461324614246152461624617246182461924620246212462224623246242462524626246272462824629246302463124632246332463424635246362463724638246392464024641246422464324644246452464624647246482464924650246512465224653246542465524656246572465824659246602466124662246632466424665246662466724668246692467024671246722467324674246752467624677246782467924680246812468224683246842468524686246872468824689246902469124692246932469424695246962469724698246992470024701247022470324704247052470624707247082470924710247112471224713247142471524716247172471824719247202472124722247232472424725247262472724728247292473024731247322473324734247352473624737247382473924740247412474224743247442474524746247472474824749247502475124752247532475424755247562475724758247592476024761247622476324764247652476624767247682476924770247712477224773247742477524776247772477824779247802478124782247832478424785247862478724788247892479024791247922479324794247952479624797247982479924800248012480224803248042480524806248072480824809248102481124812248132481424815248162481724818248192482024821248222482324824248252482624827248282482924830248312483224833248342483524836248372483824839248402484124842248432484424845248462484724848248492485024851248522485324854248552485624857248582485924860248612486224863248642486524866248672486824869248702487124872248732487424875248762487724878248792488024881248822488324884248852488624887248882488924890248912489224893248942489524896248972489824899249002490124902249032490424905249062490724908249092491024911249122491324914249152491624917249182491924920249212492224923249242492524926249272492824929249302493124932249332493424935249362493724938249392494024941249422494324944249452494624947249482494924950249512495224953249542495524956249572495824959249602496124962249632496424965249662496724968249692497024971249722497324974249752497624977249782497924980249812498224983249842498524986249872498824989249902499124992249932499424995249962499724998249992500025001250022500325004250052500625007250082500925010250112501225013250142501525016250172501825019250202502125022250232502425025250262502725028250292503025031250322503325034250352503625037250382503925040250412504225043250442504525046250472504825049250502505125052250532505425055250562505725058250592506025061250622506325064250652506625067250682506925070250712507225073250742507525076250772507825079250802508125082250832508425085250862508725088250892509025091250922509325094250952509625097250982509925100251012510225103251042510525106251072510825109251102511125112251132511425115251162511725118251192512025121251222512325124251252512625127251282512925130251312513225133251342513525136251372513825139251402514125142251432514425145251462514725148251492515025151251522515325154251552515625157251582515925160 |
- ;;; org.el --- Outline-based notes management and organizer -*- lexical-binding: t; -*-
- ;; Carstens outline-mode for keeping track of everything.
- ;; Copyright (C) 2004-2017 Free Software Foundation, Inc.
- ;;
- ;; Author: Carsten Dominik <carsten at orgmode dot org>
- ;; Maintainer: Carsten Dominik <carsten at orgmode dot org>
- ;; Keywords: outlines, hypermedia, calendar, wp
- ;; Homepage: http://orgmode.org
- ;;
- ;; This file is part of GNU Emacs.
- ;;
- ;; GNU Emacs 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.
- ;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
- ;;
- ;;; Commentary:
- ;;
- ;; Org is a mode for keeping notes, maintaining ToDo lists, and doing
- ;; project planning with a fast and effective plain-text system.
- ;;
- ;; Org mode develops organizational tasks around NOTES files that
- ;; contain information about projects as plain text. Org mode is
- ;; implemented on top of outline-mode, which makes it possible to keep
- ;; the content of large files well structured. Visibility cycling and
- ;; structure editing help to work with the tree. Tables are easily
- ;; created with a built-in table editor. Org mode supports ToDo
- ;; items, deadlines, time stamps, and scheduling. It dynamically
- ;; compiles entries into an agenda that utilizes and smoothly
- ;; integrates much of the Emacs calendar and diary. Plain text
- ;; URL-like links connect to websites, emails, Usenet messages, BBDB
- ;; entries, and any files related to the projects. For printing and
- ;; sharing of notes, an Org file can be exported as a structured ASCII
- ;; file, as HTML, or (todo and agenda items only) as an iCalendar
- ;; file. It can also serve as a publishing tool for a set of linked
- ;; webpages.
- ;;
- ;; Installation and Activation
- ;; ---------------------------
- ;; See the corresponding sections in the manual at
- ;;
- ;; http://orgmode.org/org.html#Installation
- ;;
- ;; Documentation
- ;; -------------
- ;; The documentation of Org mode can be found in the TeXInfo file. The
- ;; distribution also contains a PDF version of it. At the homepage of
- ;; Org mode, you can read the same text online as HTML. There is also an
- ;; excellent reference card made by Philip Rooke. This card can be found
- ;; in the doc/ directory.
- ;;
- ;; A list of recent changes can be found at
- ;; http://orgmode.org/Changes.html
- ;;
- ;;; Code:
- (defvar org-inhibit-highlight-removal nil) ; dynamically scoped param
- (defvar-local org-table-formula-constants-local nil
- "Local version of `org-table-formula-constants'.")
- ;;;; Require other packages
- (require 'cl-lib)
- (eval-when-compile (require 'gnus-sum))
- (require 'calendar)
- (require 'find-func)
- (require 'format-spec)
- (or (eq this-command 'eval-buffer)
- (condition-case nil
- (load (concat (file-name-directory load-file-name)
- "org-loaddefs.el")
- nil t t t)
- (error
- (message "WARNING: No org-loaddefs.el file could be found from where org.el is loaded.")
- (sit-for 3)
- (message "You need to run \"make\" or \"make autoloads\" from Org lisp directory")
- (sit-for 3))))
- (require 'org-macs)
- (require 'org-compat)
- ;; `org-outline-regexp' ought to be a defconst but is let-bound in
- ;; some places -- e.g. see the macro `org-with-limited-levels'.
- ;;
- ;; In Org buffers, the value of `outline-regexp' is that of
- ;; `org-outline-regexp'. The only function still directly relying on
- ;; `outline-regexp' is `org-overview' so that `org-cycle' can do its
- ;; job when `orgstruct-mode' is active.
- (defvar org-outline-regexp "\\*+ "
- "Regexp to match Org headlines.")
- (defvar org-outline-regexp-bol "^\\*+ "
- "Regexp to match Org headlines.
- This is similar to `org-outline-regexp' but additionally makes
- sure that we are at the beginning of the line.")
- (defvar org-heading-regexp "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$"
- "Matches a headline, putting stars and text into groups.
- Stars are put in group 1 and the trimmed body in group 2.")
- (declare-function calendar-check-holidays "holidays" (date))
- (declare-function cdlatex-environment "ext:cdlatex" (environment item))
- (declare-function isearch-no-upper-case-p "isearch" (string regexp-flag))
- (declare-function org-add-archive-files "org-archive" (files))
- (declare-function org-agenda-entry-get-agenda-timestamp "org-agenda" (pom))
- (declare-function org-agenda-list "org-agenda" (&optional arg start-day span with-hour))
- (declare-function org-agenda-redo "org-agenda" (&optional all))
- (declare-function org-babel-do-in-edit-buffer "ob-core" (&rest body) t)
- (declare-function org-babel-tangle-file "ob-tangle" (file &optional target-file lang))
- (declare-function org-beamer-mode "ox-beamer" (&optional prefix) t)
- (declare-function org-clock-get-last-clock-out-time "org-clock" ())
- (declare-function org-clock-out "org-clock" (&optional switch-to-state fail-quietly at-time))
- (declare-function org-clock-remove-overlays "org-clock" (&optional beg end noremove))
- (declare-function org-clock-sum "org-clock" (&optional tstart tend headline-filter propname))
- (declare-function org-clock-sum-current-item "org-clock" (&optional tstart))
- (declare-function org-clock-timestamps-down "org-clock" (&optional n))
- (declare-function org-clock-timestamps-up "org-clock" (&optional n))
- (declare-function org-clock-update-time-maybe "org-clock" ())
- (declare-function org-clocktable-shift "org-clock" (dir n))
- (declare-function org-element-at-point "org-element" ())
- (declare-function org-element-cache-refresh "org-element" (pos))
- (declare-function org-element-cache-reset "org-element" (&optional all))
- (declare-function org-element-contents "org-element" (element))
- (declare-function org-element-context "org-element" (&optional element))
- (declare-function org-element-copy "org-element" (datum))
- (declare-function org-element-interpret-data "org-element" (data))
- (declare-function org-element-lineage "org-element" (blob &optional types with-self))
- (declare-function org-element-link-parser "org-element" ())
- (declare-function org-element-nested-p "org-element" (elem-a elem-b))
- (declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only))
- (declare-function org-element-property "org-element" (property element))
- (declare-function org-element-put-property "org-element" (element property value))
- (declare-function org-element-swap-A-B "org-element" (elem-a elem-b))
- (declare-function org-element-type "org-element" (element))
- (declare-function org-element-update-syntax "org-element" ())
- (declare-function org-id-find-id-file "org-id" (id))
- (declare-function org-id-get-create "org-id" (&optional force))
- (declare-function org-inlinetask-at-task-p "org-inlinetask" ())
- (declare-function org-inlinetask-outline-regexp "org-inlinetask" ())
- (declare-function org-inlinetask-toggle-visibility "org-inlinetask" ())
- (declare-function org-plot/gnuplot "org-plot" (&optional params))
- (declare-function org-table-align "org-table" ())
- (declare-function org-table-begin "org-table" (&optional table-type))
- (declare-function org-table-beginning-of-field "org-table" (&optional n))
- (declare-function org-table-blank-field "org-table" ())
- (declare-function org-table-calc-current-TBLFM "org-table" (&optional arg))
- (declare-function org-table-copy-region "org-table" (beg end &optional cut))
- (declare-function org-table-cut-region "org-table" (beg end))
- (declare-function org-table-edit-field "org-table" (arg))
- (declare-function org-table-end "org-table" (&optional table-type))
- (declare-function org-table-end-of-field "org-table" (&optional n))
- (declare-function org-table-insert-row "org-table" (&optional arg))
- (declare-function org-table-justify-field-maybe "org-table" (&optional new))
- (declare-function org-table-maybe-eval-formula "org-table" ())
- (declare-function org-table-maybe-recalculate-line "org-table" ())
- (declare-function org-table-next-row "org-table" ())
- (declare-function org-table-paste-rectangle "org-table" ())
- (declare-function org-table-recalculate "org-table" (&optional all noalign))
- (declare-function org-table-wrap-region "org-table" (arg))
- (declare-function org-tags-view "org-agenda" (&optional todo-only match))
- (declare-function orgtbl-ascii-plot "org-table" (&optional ask))
- (declare-function orgtbl-mode "org-table" (&optional arg))
- (declare-function org-export-get-backend "ox" (name))
- (declare-function org-export-get-environment "ox" (&optional backend subtreep ext-plist))
- (declare-function org-latex-make-preamble "ox-latex" (info &optional template snippet?))
- (defsubst org-uniquify (list)
- "Non-destructively remove duplicate elements from LIST."
- (let ((res (copy-sequence list))) (delete-dups res)))
- (defsubst org-get-at-bol (property)
- "Get text property PROPERTY at the beginning of line."
- (get-text-property (point-at-bol) property))
- (defsubst org-trim (s &optional keep-lead)
- "Remove whitespace at the beginning and the end of string S.
- When optional argument KEEP-LEAD is non-nil, removing blank lines
- at the beginning of the string does not affect leading indentation."
- (replace-regexp-in-string
- (if keep-lead "\\`\\([ \t]*\n\\)+" "\\`[ \t\n\r]+") ""
- (replace-regexp-in-string "[ \t\n\r]+\\'" "" s)))
- ;; load languages based on value of `org-babel-load-languages'
- (defvar org-babel-load-languages)
- ;;;###autoload
- (defun org-babel-do-load-languages (sym value)
- "Load the languages defined in `org-babel-load-languages'."
- (set-default sym value)
- (dolist (pair org-babel-load-languages)
- (let ((active (cdr pair)) (lang (symbol-name (car pair))))
- (if active
- (require (intern (concat "ob-" lang)))
- (funcall 'fmakunbound
- (intern (concat "org-babel-execute:" lang)))
- (funcall 'fmakunbound
- (intern (concat "org-babel-expand-body:" lang)))))))
- (declare-function org-babel-tangle-file "ob-tangle" (file &optional target-file lang))
- ;;;###autoload
- (defun org-babel-load-file (file &optional compile)
- "Load Emacs Lisp source code blocks in the Org FILE.
- This function exports the source code using `org-babel-tangle'
- and then loads the resulting file using `load-file'. With prefix
- arg (noninteractively: 2nd arg) COMPILE the tangled Emacs Lisp
- file to byte-code before it is loaded."
- (interactive "fFile to load: \nP")
- (let* ((age (lambda (file)
- (float-time
- (time-subtract (current-time)
- (nth 5 (or (file-attributes (file-truename file))
- (file-attributes file)))))))
- (base-name (file-name-sans-extension file))
- (exported-file (concat base-name ".el")))
- ;; tangle if the Org file is newer than the elisp file
- (unless (and (file-exists-p exported-file)
- (> (funcall age file) (funcall age exported-file)))
- ;; Tangle-file traversal returns reversed list of tangled files
- ;; and we want to evaluate the first target.
- (setq exported-file
- (car (last (org-babel-tangle-file file exported-file "emacs-lisp")))))
- (message "%s %s"
- (if compile
- (progn (byte-compile-file exported-file 'load)
- "Compiled and loaded")
- (progn (load-file exported-file) "Loaded"))
- exported-file)))
- (defcustom org-babel-load-languages '((emacs-lisp . t))
- "Languages which can be evaluated in Org buffers.
- This list can be used to load support for any of the languages
- below, note that each language will depend on a different set of
- system executables and/or Emacs modes. When a language is
- \"loaded\", then code blocks in that language can be evaluated
- with `org-babel-execute-src-block' bound by default to C-c
- C-c (note the `org-babel-no-eval-on-ctrl-c-ctrl-c' variable can
- be set to remove code block evaluation from the C-c C-c
- keybinding. By default only Emacs Lisp (which has no
- requirements) is loaded."
- :group 'org-babel
- :set 'org-babel-do-load-languages
- :version "24.1"
- :type '(alist :tag "Babel Languages"
- :key-type
- (choice
- (const :tag "Awk" awk)
- (const :tag "C" C)
- (const :tag "R" R)
- (const :tag "Asymptote" asymptote)
- (const :tag "Calc" calc)
- (const :tag "Clojure" clojure)
- (const :tag "CSS" css)
- (const :tag "Ditaa" ditaa)
- (const :tag "Dot" dot)
- (const :tag "Emacs Lisp" emacs-lisp)
- (const :tag "Forth" forth)
- (const :tag "Fortran" fortran)
- (const :tag "Gnuplot" gnuplot)
- (const :tag "Haskell" haskell)
- (const :tag "IO" io)
- (const :tag "J" J)
- (const :tag "Java" java)
- (const :tag "Javascript" js)
- (const :tag "LaTeX" latex)
- (const :tag "Ledger" ledger)
- (const :tag "Lilypond" lilypond)
- (const :tag "Lisp" lisp)
- (const :tag "Makefile" makefile)
- (const :tag "Maxima" maxima)
- (const :tag "Matlab" matlab)
- (const :tag "Mscgen" mscgen)
- (const :tag "Ocaml" ocaml)
- (const :tag "Octave" octave)
- (const :tag "Org" org)
- (const :tag "Perl" perl)
- (const :tag "Pico Lisp" picolisp)
- (const :tag "PlantUML" plantuml)
- (const :tag "Python" python)
- (const :tag "Ruby" ruby)
- (const :tag "Sass" sass)
- (const :tag "Scala" scala)
- (const :tag "Scheme" scheme)
- (const :tag "Screen" screen)
- (const :tag "Shell Script" shell)
- (const :tag "Shen" shen)
- (const :tag "Sql" sql)
- (const :tag "Sqlite" sqlite)
- (const :tag "Stan" stan)
- (const :tag "ebnf2ps" ebnf2ps))
- :value-type (boolean :tag "Activate" :value t)))
- ;;;; Customization variables
- (defcustom org-clone-delete-id nil
- "Remove ID property of clones of a subtree.
- When non-nil, clones of a subtree don't inherit the ID property.
- Otherwise they inherit the ID property with a new unique
- identifier."
- :type 'boolean
- :version "24.1"
- :group 'org-id)
- ;;; Version
- (org-check-version)
- ;;;###autoload
- (defun org-version (&optional here full message)
- "Show the Org version.
- Interactively, or when MESSAGE is non-nil, show it in echo area.
- With prefix argument, or when HERE is non-nil, insert it at point.
- In non-interactive uses, a reduced version string is output unless
- FULL is given."
- (interactive (list current-prefix-arg t (not current-prefix-arg)))
- (let ((org-dir (ignore-errors (org-find-library-dir "org")))
- (save-load-suffixes (when (boundp 'load-suffixes) load-suffixes))
- (load-suffixes (list ".el"))
- (org-install-dir
- (ignore-errors (org-find-library-dir "org-loaddefs"))))
- (unless (and (fboundp 'org-release) (fboundp 'org-git-version))
- (org-load-noerror-mustsuffix (concat org-dir "org-version")))
- (let* ((load-suffixes save-load-suffixes)
- (release (org-release))
- (git-version (org-git-version))
- (version (format "Org mode version %s (%s @ %s)"
- release
- git-version
- (if org-install-dir
- (if (string= org-dir org-install-dir)
- org-install-dir
- (concat "mixed installation! "
- org-install-dir
- " and "
- org-dir))
- "org-loaddefs.el can not be found!")))
- (version1 (if full version release)))
- (when here (insert version1))
- (when message (message "%s" version1))
- version1)))
- (defconst org-version (org-version))
- ;;; Syntax Constants
- ;;;; Block
- (defconst org-block-regexp
- "^[ \t]*#\\+begin_?\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_?\\1[ \t]*$"
- "Regular expression for hiding blocks.")
- (defconst org-dblock-start-re
- "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?"
- "Matches the start line of a dynamic block, with parameters.")
- (defconst org-dblock-end-re "^[ \t]*#\\+\\(?:END\\|end\\)\\([: \t\r\n]\\|$\\)"
- "Matches the end of a dynamic block.")
- ;;;; Clock and Planning
- (defconst org-clock-string "CLOCK:"
- "String used as prefix for timestamps clocking work hours on an item.")
- (defvar org-closed-string "CLOSED:"
- "String used as the prefix for timestamps logging closing a TODO entry.")
- (defvar org-deadline-string "DEADLINE:"
- "String to mark deadline entries.
- \\<org-mode-map>
- A deadline is this string, followed by a time stamp. It must be
- a word, terminated by a colon. You can insert a schedule keyword
- and a timestamp with `\\[org-deadline]'.")
- (defvar org-scheduled-string "SCHEDULED:"
- "String to mark scheduled TODO entries.
- \\<org-mode-map>
- A schedule is this string, followed by a time stamp. It must be
- a word, terminated by a colon. You can insert a schedule keyword
- and a timestamp with `\\[org-schedule]'.")
- (defconst org-ds-keyword-length
- (+ 2
- (apply #'max
- (mapcar #'length
- (list org-deadline-string org-scheduled-string
- org-clock-string org-closed-string))))
- "Maximum length of the DEADLINE and SCHEDULED keywords.")
- (defconst org-planning-line-re
- (concat "^[ \t]*"
- (regexp-opt
- (list org-closed-string org-deadline-string org-scheduled-string)
- t))
- "Matches a line with planning info.
- Matched keyword is in group 1.")
- (defconst org-clock-line-re
- (concat "^[ \t]*" org-clock-string)
- "Matches a line with clock info.")
- (defconst org-deadline-regexp (concat "\\<" org-deadline-string)
- "Matches the DEADLINE keyword.")
- (defconst org-deadline-time-regexp
- (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")
- "Matches the DEADLINE keyword together with a time stamp.")
- (defconst org-deadline-time-hour-regexp
- (concat "\\<" org-deadline-string
- " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\)>")
- "Matches the DEADLINE keyword together with a time-and-hour stamp.")
- (defconst org-deadline-line-regexp
- (concat "\\<\\(" org-deadline-string "\\).*")
- "Matches the DEADLINE keyword and the rest of the line.")
- (defconst org-scheduled-regexp (concat "\\<" org-scheduled-string)
- "Matches the SCHEDULED keyword.")
- (defconst org-scheduled-time-regexp
- (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")
- "Matches the SCHEDULED keyword together with a time stamp.")
- (defconst org-scheduled-time-hour-regexp
- (concat "\\<" org-scheduled-string
- " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\)>")
- "Matches the SCHEDULED keyword together with a time-and-hour stamp.")
- (defconst org-closed-time-regexp
- (concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]")
- "Matches the CLOSED keyword together with a time stamp.")
- (defconst org-keyword-time-regexp
- (concat "\\<"
- (regexp-opt
- (list org-scheduled-string org-deadline-string org-closed-string
- org-clock-string)
- t)
- " *[[<]\\([^]>]+\\)[]>]")
- "Matches any of the 4 keywords, together with the time stamp.")
- (defconst org-keyword-time-not-clock-regexp
- (concat
- "\\<"
- (regexp-opt
- (list org-scheduled-string org-deadline-string org-closed-string) t)
- " *[[<]\\([^]>]+\\)[]>]")
- "Matches any of the 3 keywords, together with the time stamp.")
- (defconst org-maybe-keyword-time-regexp
- (concat "\\(\\<"
- (regexp-opt
- (list org-scheduled-string org-deadline-string org-closed-string
- org-clock-string)
- t)
- "\\)?"
- " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?[]>]"
- "\\|"
- "<%%([^\r\n>]*>\\)")
- "Matches a timestamp, possibly preceded by a keyword.")
- (defconst org-all-time-keywords
- (mapcar (lambda (w) (substring w 0 -1))
- (list org-scheduled-string org-deadline-string
- org-clock-string org-closed-string))
- "List of time keywords.")
- ;;;; Drawer
- (defconst org-drawer-regexp "^[ \t]*:\\(\\(?:\\w\\|[-_]\\)+\\):[ \t]*$"
- "Matches first or last line of a hidden block.
- Group 1 contains drawer's name or \"END\".")
- (defconst org-property-start-re "^[ \t]*:PROPERTIES:[ \t]*$"
- "Regular expression matching the first line of a property drawer.")
- (defconst org-property-end-re "^[ \t]*:END:[ \t]*$"
- "Regular expression matching the last line of a property drawer.")
- (defconst org-clock-drawer-start-re "^[ \t]*:CLOCK:[ \t]*$"
- "Regular expression matching the first line of a clock drawer.")
- (defconst org-clock-drawer-end-re "^[ \t]*:END:[ \t]*$"
- "Regular expression matching the last line of a clock drawer.")
- (defconst org-property-drawer-re
- (concat "^[ \t]*:PROPERTIES:[ \t]*\n"
- "\\(?:[ \t]*:\\S-+:\\(?: .*\\)?[ \t]*\n\\)*?"
- "[ \t]*:END:[ \t]*$")
- "Matches an entire property drawer.")
- (defconst org-clock-drawer-re
- (concat "\\(" org-clock-drawer-start-re "\\)[^\000]*?\\("
- org-clock-drawer-end-re "\\)\n?")
- "Matches an entire clock drawer.")
- ;;;; Headline
- (defconst org-heading-keyword-regexp-format
- "^\\(\\*+\\)\\(?: +%s\\)\\(?: +\\(.*?\\)\\)?[ \t]*$"
- "Printf format for a regexp matching a headline with some keyword.
- This regexp will match the headline of any node which has the
- exact keyword that is put into the format. The keyword isn't in
- any group by default, but the stars and the body are.")
- (defconst org-heading-keyword-maybe-regexp-format
- "^\\(\\*+\\)\\(?: +%s\\)?\\(?: +\\(.*?\\)\\)?[ \t]*$"
- "Printf format for a regexp matching a headline, possibly with some keyword.
- This regexp can match any headline with the specified keyword, or
- without a keyword. The keyword isn't in any group by default,
- but the stars and the body are.")
- (defconst org-archive-tag "ARCHIVE"
- "The tag that marks a subtree as archived.
- An archived subtree does not open during visibility cycling, and does
- not contribute to the agenda listings.")
- (defconst org-comment-string "COMMENT"
- "Entries starting with this keyword will never be exported.
- \\<org-mode-map>
- An entry can be toggled between COMMENT and normal with
- `\\[org-toggle-comment]'.")
- ;;;; LaTeX Environments and Fragments
- (defconst org-latex-regexps
- '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t)
- ;; ("$" "\\([ \t(]\\|^\\)\\(\\(\\([$]\\)\\([^ \t\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \t\n,.$]\\)\\4\\)\\)\\([ \t.,?;:'\")]\\|$\\)" 2 nil)
- ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p
- ("$1" "\\([^$]\\|^\\)\\(\\$[^ \t\r\n,;.$]\\$\\)\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|\000\\|'\\|$\\)" 2 nil)
- ("$" "\\([^$]\\|^\\)\\(\\(\\$\\([^ \t\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \t\n,.$]\\)\\$\\)\\)\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|\000\\|'\\|$\\)" 2 nil)
- ("\\(" "\\\\([^\000]*?\\\\)" 0 nil)
- ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 nil)
- ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil))
- "Regular expressions for matching embedded LaTeX.")
- ;;;; Node Property
- (defconst org-effort-property "Effort"
- "The property that is being used to keep track of effort estimates.
- Effort estimates given in this property need to have the format H:MM.")
- ;;;; Table
- (defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)"
- "Detect an org-type or table-type table.")
- (defconst org-table-line-regexp "^[ \t]*|"
- "Detect an org-type table line.")
- (defconst org-table-dataline-regexp "^[ \t]*|[^-]"
- "Detect an org-type table line.")
- (defconst org-table-hline-regexp "^[ \t]*|-"
- "Detect an org-type table hline.")
- (defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]"
- "Detect a table-type table hline.")
- (defconst org-table-any-border-regexp "^[ \t]*[^|+ \t]"
- "Detect the first line outside a table when searching from within it.
- This works for both table types.")
- (defconst org-TBLFM-regexp "^[ \t]*#\\+TBLFM: "
- "Detect a #+TBLFM line.")
- ;;;; Timestamp
- (defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)>"
- "Regular expression for fast time stamp matching.")
- (defconst org-ts-regexp-inactive
- "\\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)\\]"
- "Regular expression for fast inactive time stamp matching.")
- (defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?\\)[]>]"
- "Regular expression for fast time stamp matching.")
- (defconst org-ts-regexp0
- "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\( +[^]+0-9>\r\n -]+\\)?\\( +\\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
- "Regular expression matching time strings for analysis.
- This one does not require the space after the date, so it can be used
- on a string that terminates immediately after the date.")
- (defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
- "Regular expression matching time strings for analysis.")
- (defconst org-ts-regexp2 (concat "<" org-ts-regexp1 "[^>\n]\\{0,16\\}>")
- "Regular expression matching time stamps, with groups.")
- (defconst org-ts-regexp3 (concat "[[<]" org-ts-regexp1 "[^]>\n]\\{0,16\\}[]>]")
- "Regular expression matching time stamps (also [..]), with groups.")
- (defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp)
- "Regular expression matching a time stamp range.")
- (defconst org-tr-regexp-both
- (concat org-ts-regexp-both "--?-?" org-ts-regexp-both)
- "Regular expression matching a time stamp range.")
- (defconst org-tsr-regexp (concat org-ts-regexp "\\(--?-?"
- org-ts-regexp "\\)?")
- "Regular expression matching a time stamp or time stamp range.")
- (defconst org-tsr-regexp-both
- (concat org-ts-regexp-both "\\(--?-?"
- org-ts-regexp-both "\\)?")
- "Regular expression matching a time stamp or time stamp range.
- The time stamps may be either active or inactive.")
- (defconst org-repeat-re
- "<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*?\\([.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)"
- "Regular expression for specifying repeated events.
- After a match, group 1 contains the repeat expression.")
- (defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>")
- "Formats for `format-time-string' which are used for time stamps.")
- ;;; The custom variables
- (defgroup org nil
- "Outline-based notes management and organizer."
- :tag "Org"
- :group 'outlines
- :group 'calendar)
- (defcustom org-mode-hook nil
- "Mode hook for Org mode, run after the mode was turned on."
- :group 'org
- :type 'hook)
- (defcustom org-load-hook nil
- "Hook that is run after org.el has been loaded."
- :group 'org
- :type 'hook)
- (defcustom org-log-buffer-setup-hook nil
- "Hook that is run after an Org log buffer is created."
- :group 'org
- :version "24.1"
- :type 'hook)
- (defvar org-modules) ; defined below
- (defvar org-modules-loaded nil
- "Have the modules been loaded already?")
- (defun org-load-modules-maybe (&optional force)
- "Load all extensions listed in `org-modules'."
- (when (or force (not org-modules-loaded))
- (dolist (ext org-modules)
- (condition-case nil (require ext)
- (error (message "Problems while trying to load feature `%s'" ext))))
- (setq org-modules-loaded t)))
- (defun org-set-modules (var value)
- "Set VAR to VALUE and call `org-load-modules-maybe' with the force flag."
- (set var value)
- (when (featurep 'org)
- (org-load-modules-maybe 'force)
- (org-element-cache-reset 'all)))
- (defcustom org-modules '(org-w3m org-bbdb org-bibtex org-docview org-gnus org-info org-irc org-mhe org-rmail)
- "Modules that should always be loaded together with org.el.
- If a description starts with <C>, the file is not part of Emacs
- and loading it will require that you have downloaded and properly
- installed the Org mode distribution.
- You can also use this system to load external packages (i.e. neither Org
- core modules, nor modules from the CONTRIB directory). Just add symbols
- to the end of the list. If the package is called org-xyz.el, then you need
- to add the symbol `xyz', and the package must have a call to:
- (provide \\='org-xyz)
- For export specific modules, see also `org-export-backends'."
- :group 'org
- :set 'org-set-modules
- :version "24.4"
- :package-version '(Org . "8.0")
- :type
- '(set :greedy t
- (const :tag " bbdb: Links to BBDB entries" org-bbdb)
- (const :tag " bibtex: Links to BibTeX entries" org-bibtex)
- (const :tag " crypt: Encryption of subtrees" org-crypt)
- (const :tag " ctags: Access to Emacs tags with links" org-ctags)
- (const :tag " docview: Links to doc-view buffers" org-docview)
- (const :tag " eww: Store link to url of eww" org-eww)
- (const :tag " gnus: Links to GNUS folders/messages" org-gnus)
- (const :tag " habit: Track your consistency with habits" org-habit)
- (const :tag " id: Global IDs for identifying entries" org-id)
- (const :tag " info: Links to Info nodes" org-info)
- (const :tag " inlinetask: Tasks independent of outline hierarchy" org-inlinetask)
- (const :tag " irc: Links to IRC/ERC chat sessions" org-irc)
- (const :tag " mhe: Links to MHE folders/messages" org-mhe)
- (const :tag " mouse: Additional mouse support" org-mouse)
- (const :tag " protocol: Intercept calls from emacsclient" org-protocol)
- (const :tag " rmail: Links to RMAIL folders/messages" org-rmail)
- (const :tag " w3m: Special cut/paste from w3m to Org mode." org-w3m)
- (const :tag "C annotate-file: Annotate a file with org syntax" org-annotate-file)
- (const :tag "C bookmark: Org links to bookmarks" org-bookmark)
- (const :tag "C bullets: Add overlays to headlines stars" org-bullets)
- (const :tag "C checklist: Extra functions for checklists in repeated tasks" org-checklist)
- (const :tag "C choose: Use TODO keywords to mark decisions states" org-choose)
- (const :tag "C collector: Collect properties into tables" org-collector)
- (const :tag "C depend: TODO dependencies for Org mode\n\t\t\t(PARTIALLY OBSOLETE, see built-in dependency support))" org-depend)
- (const :tag "C drill: Flashcards and spaced repetition for Org mode" org-drill)
- (const :tag "C elisp-symbol: Org links to emacs-lisp symbols" org-elisp-symbol)
- (const :tag "C eshell Support for links to working directories in eshell" org-eshell)
- (const :tag "C eval-light: Evaluate inbuffer-code on demand" org-eval-light)
- (const :tag "C eval: Include command output as text" org-eval)
- (const :tag "C expiry: Expiry mechanism for Org entries" org-expiry)
- (const :tag "C favtable: Lookup table of favorite references and links" org-favtable)
- (const :tag "C git-link: Provide org links to specific file version" org-git-link)
- (const :tag "C interactive-query: Interactive modification of tags query\n\t\t\t(PARTIALLY OBSOLETE, see secondary filtering)" org-interactive-query)
- (const :tag "C invoice: Help manage client invoices in Org mode" org-invoice)
- (const :tag "C learn: SuperMemo's incremental learning algorithm" org-learn)
- (const :tag "C mac-iCal Imports events from iCal.app to the Emacs diary" org-mac-iCal)
- (const :tag "C mac-link: Grab links and url from various mac Applications" org-mac-link)
- (const :tag "C mairix: Hook mairix search into Org for different MUAs" org-mairix)
- (const :tag "C man: Support for links to manpages in Org mode" org-man)
- (const :tag "C mew: Links to Mew folders/messages" org-mew)
- (const :tag "C mtags: Support for muse-like tags" org-mtags)
- (const :tag "C notmuch: Provide org links to notmuch searches or messages" org-notmuch)
- (const :tag "C panel: Simple routines for us with bad memory" org-panel)
- (const :tag "C registry: A registry for Org links" org-registry)
- (const :tag "C screen: Visit screen sessions through Org links" org-screen)
- (const :tag "C secretary: Team management with org-mode" org-secretary)
- (const :tag "C sqlinsert: Convert Org tables to SQL insertions" orgtbl-sqlinsert)
- (const :tag "C toc: Table of contents for Org buffer" org-toc)
- (const :tag "C track: Keep up with Org mode development" org-track)
- (const :tag "C velocity Something like Notational Velocity for Org" org-velocity)
- (const :tag "C vm: Links to VM folders/messages" org-vm)
- (const :tag "C wikinodes: CamelCase wiki-like links" org-wikinodes)
- (const :tag "C wl: Links to Wanderlust folders/messages" org-wl)
- (repeat :tag "External packages" :inline t (symbol :tag "Package"))))
- (defvar org-export-registered-backends) ; From ox.el.
- (declare-function org-export-derived-backend-p "ox" (backend &rest backends))
- (declare-function org-export-backend-name "ox" (backend) t)
- (defcustom org-export-backends '(ascii html icalendar latex odt)
- "List of export back-ends that should be always available.
- If a description starts with <C>, the file is not part of Emacs
- and loading it will require that you have downloaded and properly
- installed the Org mode distribution.
- Unlike to `org-modules', libraries in this list will not be
- loaded along with Org, but only once the export framework is
- needed.
- This variable needs to be set before org.el is loaded. If you
- need to make a change while Emacs is running, use the customize
- interface or run the following code, where VAL stands for the new
- value of the variable, after updating it:
- (progn
- (setq org-export-registered-backends
- (cl-remove-if-not
- (lambda (backend)
- (let ((name (org-export-backend-name backend)))
- (or (memq name val)
- (catch \\='parentp
- (dolist (b val)
- (and (org-export-derived-backend-p b name)
- (throw \\='parentp t)))))))
- org-export-registered-backends))
- (let ((new-list (mapcar #\\='org-export-backend-name
- org-export-registered-backends)))
- (dolist (backend val)
- (cond
- ((not (load (format \"ox-%s\" backend) t t))
- (message \"Problems while trying to load export back-end \\=`%s\\='\"
- backend))
- ((not (memq backend new-list)) (push backend new-list))))
- (set-default \\='org-export-backends new-list)))
- Adding a back-end to this list will also pull the back-end it
- depends on, if any."
- :group 'org
- :group 'org-export
- :version "26.1"
- :package-version '(Org . "9.0")
- :initialize 'custom-initialize-set
- :set (lambda (var val)
- (if (not (featurep 'ox)) (set-default var val)
- ;; Any back-end not required anymore (not present in VAL and not
- ;; a parent of any back-end in the new value) is removed from the
- ;; list of registered back-ends.
- (setq org-export-registered-backends
- (cl-remove-if-not
- (lambda (backend)
- (let ((name (org-export-backend-name backend)))
- (or (memq name val)
- (catch 'parentp
- (dolist (b val)
- (and (org-export-derived-backend-p b name)
- (throw 'parentp t)))))))
- org-export-registered-backends))
- ;; Now build NEW-LIST of both new back-ends and required
- ;; parents.
- (let ((new-list (mapcar #'org-export-backend-name
- org-export-registered-backends)))
- (dolist (backend val)
- (cond
- ((not (load (format "ox-%s" backend) t t))
- (message "Problems while trying to load export back-end `%s'"
- backend))
- ((not (memq backend new-list)) (push backend new-list))))
- ;; Set VAR to that list with fixed dependencies.
- (set-default var new-list))))
- :type '(set :greedy t
- (const :tag " ascii Export buffer to ASCII format" ascii)
- (const :tag " beamer Export buffer to Beamer presentation" beamer)
- (const :tag " html Export buffer to HTML format" html)
- (const :tag " icalendar Export buffer to iCalendar format" icalendar)
- (const :tag " latex Export buffer to LaTeX format" latex)
- (const :tag " man Export buffer to MAN format" man)
- (const :tag " md Export buffer to Markdown format" md)
- (const :tag " odt Export buffer to ODT format" odt)
- (const :tag " org Export buffer to Org format" org)
- (const :tag " texinfo Export buffer to Texinfo format" texinfo)
- (const :tag "C confluence Export buffer to Confluence Wiki format" confluence)
- (const :tag "C deck Export buffer to deck.js presentations" deck)
- (const :tag "C freemind Export buffer to Freemind mindmap format" freemind)
- (const :tag "C groff Export buffer to Groff format" groff)
- (const :tag "C koma-letter Export buffer to KOMA Scrlttrl2 format" koma-letter)
- (const :tag "C RSS 2.0 Export buffer to RSS 2.0 format" rss)
- (const :tag "C s5 Export buffer to s5 presentations" s5)
- (const :tag "C taskjuggler Export buffer to TaskJuggler format" taskjuggler)))
- (eval-after-load 'ox
- '(dolist (backend org-export-backends)
- (condition-case nil (require (intern (format "ox-%s" backend)))
- (error (message "Problems while trying to load export back-end `%s'"
- backend)))))
- (defcustom org-support-shift-select nil
- "Non-nil means make shift-cursor commands select text when possible.
- \\<org-mode-map>\
- In Emacs 23, when `shift-select-mode' is on, shifted cursor keys
- start selecting a region, or enlarge regions started in this way.
- In Org mode, in special contexts, these same keys are used for
- other purposes, important enough to compete with shift selection.
- Org tries to balance these needs by supporting `shift-select-mode'
- outside these special contexts, under control of this variable.
- The default of this variable is nil, to avoid confusing behavior. Shifted
- cursor keys will then execute Org commands in the following contexts:
- - on a headline, changing TODO state (left/right) and priority (up/down)
- - on a time stamp, changing the time
- - in a plain list item, changing the bullet type
- - in a property definition line, switching between allowed values
- - in the BEGIN line of a clock table (changing the time block).
- Outside these contexts, the commands will throw an error.
- When this variable is t and the cursor is not in a special
- context, Org mode will support shift-selection for making and
- enlarging regions. To make this more effective, the bullet
- cycling will no longer happen anywhere in an item line, but only
- if the cursor is exactly on the bullet.
- If you set this variable to the symbol `always', then the keys
- will not be special in headlines, property lines, and item lines,
- to make shift selection work there as well. If this is what you
- want, you can use the following alternative commands:
- `\\[org-todo]' and `\\[org-priority]' \
- to change TODO state and priority,
- `\\[universal-argument] \\[universal-argument] \\[org-todo]' \
- can be used to switch TODO sets,
- `\\[org-ctrl-c-minus]' to cycle item bullet types,
- and properties can be edited by hand or in column view.
- However, when the cursor is on a timestamp, shift-cursor commands
- will still edit the time stamp - this is just too good to give up."
- :group 'org
- :type '(choice
- (const :tag "Never" nil)
- (const :tag "When outside special context" t)
- (const :tag "Everywhere except timestamps" always)))
- (defcustom org-loop-over-headlines-in-active-region nil
- "Shall some commands act upon headlines in the active region?
- When set to t, some commands will be performed in all headlines
- within the active region.
- When set to `start-level', some commands will be performed in all
- headlines within the active region, provided that these headlines
- are of the same level than the first one.
- When set to a string, those commands will be performed on the
- matching headlines within the active region. Such string must be
- a tags/property/todo match as it is used in the agenda tags view.
- The list of commands is: `org-schedule', `org-deadline',
- `org-todo', `org-archive-subtree', `org-archive-set-tag' and
- `org-archive-to-archive-sibling'. The archiving commands skip
- already archived entries."
- :type '(choice (const :tag "Don't loop" nil)
- (const :tag "All headlines in active region" t)
- (const :tag "In active region, headlines at the same level than the first one" start-level)
- (string :tag "Tags/Property/Todo matcher"))
- :version "24.1"
- :group 'org-todo
- :group 'org-archive)
- (defgroup org-startup nil
- "Options concerning startup of Org mode."
- :tag "Org Startup"
- :group 'org)
- (defcustom org-startup-folded t
- "Non-nil means entering Org mode will switch to OVERVIEW.
- This can also be configured on a per-file basis by adding one of
- the following lines anywhere in the buffer:
- #+STARTUP: fold (or `overview', this is equivalent)
- #+STARTUP: nofold (or `showall', this is equivalent)
- #+STARTUP: content
- #+STARTUP: showeverything
- Set `org-agenda-inhibit-startup' to a non-nil value if you want
- to ignore this option when Org opens agenda files for the first
- time."
- :group 'org-startup
- :type '(choice
- (const :tag "nofold: show all" nil)
- (const :tag "fold: overview" t)
- (const :tag "content: all headlines" content)
- (const :tag "show everything, even drawers" showeverything)))
- (defcustom org-startup-truncated t
- "Non-nil means entering Org mode will set `truncate-lines'.
- This is useful since some lines containing links can be very long and
- uninteresting. Also tables look terrible when wrapped.
- The variable `org-startup-truncated' allows to configure
- truncation for Org mode different to the other modes that use the
- variable `truncate-lines' and as a shortcut instead of putting
- the variable `truncate-lines' into the `org-mode-hook'. If one
- wants to configure truncation for Org mode not statically but
- dynamically e. g. in a hook like `ediff-prepare-buffer-hook' then
- the variable `truncate-lines' has to be used because in such a
- case it is too late to set the variable `org-startup-truncated'."
- :group 'org-startup
- :type 'boolean)
- (defcustom org-startup-indented nil
- "Non-nil means turn on `org-indent-mode' on startup.
- This can also be configured on a per-file basis by adding one of
- the following lines anywhere in the buffer:
- #+STARTUP: indent
- #+STARTUP: noindent"
- :group 'org-structure
- :type '(choice
- (const :tag "Not" nil)
- (const :tag "Globally (slow on startup in large files)" t)))
- (defcustom org-use-sub-superscripts t
- "Non-nil means interpret \"_\" and \"^\" for display.
- If you want to control how Org exports those characters, see
- `org-export-with-sub-superscripts'. `org-use-sub-superscripts'
- used to be an alias for `org-export-with-sub-superscripts' in
- Org <8.0, it is not anymore.
- When this option is turned on, you can use TeX-like syntax for
- sub- and superscripts within the buffer. Several characters after
- \"_\" or \"^\" will be considered as a single item - so grouping
- with {} is normally not needed. For example, the following things
- will be parsed as single sub- or superscripts:
- 10^24 or 10^tau several digits will be considered 1 item.
- 10^-12 or 10^-tau a leading sign with digits or a word
- x^2-y^3 will be read as x^2 - y^3, because items are
- terminated by almost any nonword/nondigit char.
- x_{i^2} or x^(2-i) braces or parenthesis do grouping.
- Still, ambiguity is possible. So when in doubt, use {} to enclose
- the sub/superscript. If you set this variable to the symbol `{}',
- the braces are *required* in order to trigger interpretations as
- sub/superscript. This can be helpful in documents that need \"_\"
- frequently in plain text."
- :group 'org-startup
- :version "24.4"
- :package-version '(Org . "8.0")
- :type '(choice
- (const :tag "Always interpret" t)
- (const :tag "Only with braces" {})
- (const :tag "Never interpret" nil)))
- (defcustom org-startup-with-beamer-mode nil
- "Non-nil means turn on `org-beamer-mode' on startup.
- This can also be configured on a per-file basis by adding one of
- the following lines anywhere in the buffer:
- #+STARTUP: beamer"
- :group 'org-startup
- :version "24.1"
- :type 'boolean)
- (defcustom org-startup-align-all-tables nil
- "Non-nil means align all tables when visiting a file.
- This is useful when the column width in tables is forced with <N> cookies
- in table fields. Such tables will look correct only after the first re-align.
- This can also be configured on a per-file basis by adding one of
- the following lines anywhere in the buffer:
- #+STARTUP: align
- #+STARTUP: noalign"
- :group 'org-startup
- :type 'boolean)
- (defcustom org-startup-with-inline-images nil
- "Non-nil means show inline images when loading a new Org file.
- This can also be configured on a per-file basis by adding one of
- the following lines anywhere in the buffer:
- #+STARTUP: inlineimages
- #+STARTUP: noinlineimages"
- :group 'org-startup
- :version "24.1"
- :type 'boolean)
- (defcustom org-startup-with-latex-preview nil
- "Non-nil means preview LaTeX fragments when loading a new Org file.
- This can also be configured on a per-file basis by adding one of
- the following lines anywhere in the buffer:
- #+STARTUP: latexpreview
- #+STARTUP: nolatexpreview"
- :group 'org-startup
- :version "24.4"
- :package-version '(Org . "8.0")
- :type 'boolean)
- (defcustom org-insert-mode-line-in-empty-file nil
- "Non-nil means insert the first line setting Org mode in empty files.
- When the function `org-mode' is called interactively in an empty file, this
- normally means that the file name does not automatically trigger Org mode.
- To ensure that the file will always be in Org mode in the future, a
- line enforcing Org mode will be inserted into the buffer, if this option
- has been set."
- :group 'org-startup
- :type 'boolean)
- (defcustom org-replace-disputed-keys nil
- "Non-nil means use alternative key bindings for some keys.
- Org mode uses S-<cursor> keys for changing timestamps and priorities.
- These keys are also used by other packages like shift-selection-mode'
- \(built into Emacs 23), `CUA-mode' or `windmove.el'.
- If you want to use Org mode together with one of these other modes,
- or more generally if you would like to move some Org mode commands to
- other keys, set this variable and configure the keys with the variable
- `org-disputed-keys'.
- This option is only relevant at load-time of Org mode, and must be set
- *before* org.el is loaded. Changing it requires a restart of Emacs to
- become effective."
- :group 'org-startup
- :type 'boolean)
- (defcustom org-use-extra-keys nil
- "Non-nil means use extra key sequence definitions for certain commands.
- This happens automatically if `window-system' is nil. This
- variable lets you do the same manually. You must set it before
- loading Org."
- :group 'org-startup
- :type 'boolean)
- (defvaralias 'org-CUA-compatible 'org-replace-disputed-keys)
- (defcustom org-disputed-keys
- '(([(shift up)] . [(meta p)])
- ([(shift down)] . [(meta n)])
- ([(shift left)] . [(meta -)])
- ([(shift right)] . [(meta +)])
- ([(control shift right)] . [(meta shift +)])
- ([(control shift left)] . [(meta shift -)]))
- "Keys for which Org mode and other modes compete.
- This is an alist, cars are the default keys, second element specifies
- the alternative to use when `org-replace-disputed-keys' is t.
- Keys can be specified in any syntax supported by `define-key'.
- The value of this option takes effect only at Org mode startup,
- therefore you'll have to restart Emacs to apply it after changing."
- :group 'org-startup
- :type 'alist)
- (defun org-key (key)
- "Select key according to `org-replace-disputed-keys' and `org-disputed-keys'.
- Or return the original if not disputed."
- (when org-replace-disputed-keys
- (let* ((nkey (key-description key))
- (x (cl-find-if (lambda (x) (equal (key-description (car x)) nkey))
- org-disputed-keys)))
- (setq key (if x (cdr x) key))))
- key)
- (defun org-defkey (keymap key def)
- "Define a key, possibly translated, as returned by `org-key'."
- (define-key keymap (org-key key) def))
- (defcustom org-ellipsis nil
- "The ellipsis to use in the Org mode outline.
- When nil, just use the standard three dots. When a non-empty string,
- use that string instead.
- The change affects only Org mode (which will then use its own display table).
- Changing this requires executing `\\[org-mode]' in a buffer to become
- effective."
- :group 'org-startup
- :type '(choice (const :tag "Default" nil)
- (string :tag "String" :value "...#"))
- :safe (lambda (v) (and (string-or-null-p v) (not (equal "" v)))))
- (defvar org-display-table nil
- "The display table for Org mode, in case `org-ellipsis' is non-nil.")
- (defgroup org-keywords nil
- "Keywords in Org mode."
- :tag "Org Keywords"
- :group 'org)
- (defcustom org-closed-keep-when-no-todo nil
- "Remove CLOSED: time-stamp when switching back to a non-todo state?"
- :group 'org-todo
- :group 'org-keywords
- :version "24.4"
- :package-version '(Org . "8.0")
- :type 'boolean)
- (defgroup org-structure nil
- "Options concerning the general structure of Org files."
- :tag "Org Structure"
- :group 'org)
- (defgroup org-reveal-location nil
- "Options about how to make context of a location visible."
- :tag "Org Reveal Location"
- :group 'org-structure)
- (defcustom org-show-context-detail '((agenda . local)
- (bookmark-jump . lineage)
- (isearch . lineage)
- (default . ancestors))
- "Alist between context and visibility span when revealing a location.
- \\<org-mode-map>Some actions may move point into invisible
- locations. As a consequence, Org always expose a neighborhood
- around point. How much is shown depends on the initial action,
- or context. Valid contexts are
- agenda when exposing an entry from the agenda
- org-goto when using the command `org-goto' (`\\[org-goto]')
- occur-tree when using the command `org-occur' (`\\[org-sparse-tree] /')
- tags-tree when constructing a sparse tree based on tags matches
- link-search when exposing search matches associated with a link
- mark-goto when exposing the jump goal of a mark
- bookmark-jump when exposing a bookmark location
- isearch when exiting from an incremental search
- default default for all contexts not set explicitly
- Allowed visibility spans are
- minimal show current headline; if point is not on headline,
- also show entry
- local show current headline, entry and next headline
- ancestors show current headline and its direct ancestors; if
- point is not on headline, also show entry
- lineage show current headline, its direct ancestors and all
- their children; if point is not on headline, also show
- entry and first child
- tree show current headline, its direct ancestors and all
- their children; if point is not on headline, also show
- entry and all children
- canonical show current headline, its direct ancestors along with
- their entries and children; if point is not located on
- the headline, also show current entry and all children
- As special cases, a nil or t value means show all contexts in
- `minimal' or `canonical' view, respectively.
- Some views can make displayed information very compact, but also
- make it harder to edit the location of the match. In such
- a case, use the command `org-reveal' (`\\[org-reveal]') to show
- more context."
- :group 'org-reveal-location
- :version "26.1"
- :package-version '(Org . "9.0")
- :type '(choice
- (const :tag "Canonical" t)
- (const :tag "Minimal" nil)
- (repeat :greedy t :tag "Individual contexts"
- (cons
- (choice :tag "Context"
- (const agenda)
- (const org-goto)
- (const occur-tree)
- (const tags-tree)
- (const link-search)
- (const mark-goto)
- (const bookmark-jump)
- (const isearch)
- (const default))
- (choice :tag "Detail level"
- (const minimal)
- (const local)
- (const ancestors)
- (const lineage)
- (const tree)
- (const canonical))))))
- (defcustom org-indirect-buffer-display 'other-window
- "How should indirect tree buffers be displayed?
- This applies to indirect buffers created with the commands
- `org-tree-to-indirect-buffer' and `org-agenda-tree-to-indirect-buffer'.
- Valid values are:
- current-window Display in the current window
- other-window Just display in another window.
- dedicated-frame Create one new frame, and re-use it each time.
- new-frame Make a new frame each time. Note that in this case
- previously-made indirect buffers are kept, and you need to
- kill these buffers yourself."
- :group 'org-structure
- :group 'org-agenda-windows
- :type '(choice
- (const :tag "In current window" current-window)
- (const :tag "In current frame, other window" other-window)
- (const :tag "Each time a new frame" new-frame)
- (const :tag "One dedicated frame" dedicated-frame)))
- (defcustom org-use-speed-commands nil
- "Non-nil means activate single letter commands at beginning of a headline.
- This may also be a function to test for appropriate locations where speed
- commands should be active.
- For example, to activate speed commands when the point is on any
- star at the beginning of the headline, you can do this:
- (setq org-use-speed-commands
- (lambda () (and (looking-at org-outline-regexp) (looking-back \"^\\**\"))))"
- :group 'org-structure
- :type '(choice
- (const :tag "Never" nil)
- (const :tag "At beginning of headline stars" t)
- (function)))
- (defcustom org-speed-commands-user nil
- "Alist of additional speed commands.
- This list will be checked before `org-speed-commands-default'
- when the variable `org-use-speed-commands' is non-nil
- and when the cursor is at the beginning of a headline.
- The car if each entry is a string with a single letter, which must
- be assigned to `self-insert-command' in the global map.
- The cdr is either a command to be called interactively, a function
- to be called, or a form to be evaluated.
- An entry that is just a list with a single string will be interpreted
- as a descriptive headline that will be added when listing the speed
- commands in the Help buffer using the `?' speed command."
- :group 'org-structure
- :type '(repeat :value ("k" . ignore)
- (choice :value ("k" . ignore)
- (list :tag "Descriptive Headline" (string :tag "Headline"))
- (cons :tag "Letter and Command"
- (string :tag "Command letter")
- (choice
- (function)
- (sexp))))))
- (defcustom org-bookmark-names-plist
- '(:last-capture "org-capture-last-stored"
- :last-refile "org-refile-last-stored"
- :last-capture-marker "org-capture-last-stored-marker")
- "Names for bookmarks automatically set by some Org commands.
- This can provide strings as names for a number of bookmarks Org sets
- automatically. The following keys are currently implemented:
- :last-capture
- :last-capture-marker
- :last-refile
- When a key does not show up in the property list, the corresponding bookmark
- is not set."
- :group 'org-structure
- :type 'plist)
- (defgroup org-cycle nil
- "Options concerning visibility cycling in Org mode."
- :tag "Org Cycle"
- :group 'org-structure)
- (defcustom org-cycle-skip-children-state-if-no-children t
- "Non-nil means skip CHILDREN state in entries that don't have any."
- :group 'org-cycle
- :type 'boolean)
- (defcustom org-cycle-max-level nil
- "Maximum level which should still be subject to visibility cycling.
- Levels higher than this will, for cycling, be treated as text, not a headline.
- When `org-odd-levels-only' is set, a value of N in this variable actually
- means 2N-1 stars as the limiting headline.
- When nil, cycle all levels.
- Note that the limiting level of cycling is also influenced by
- `org-inlinetask-min-level'. When `org-cycle-max-level' is not set but
- `org-inlinetask-min-level' is, cycling will be limited to levels one less
- than its value."
- :group 'org-cycle
- :type '(choice
- (const :tag "No limit" nil)
- (integer :tag "Maximum level")))
- (defcustom org-hide-block-startup nil
- "Non-nil means entering Org mode will fold all blocks.
- This can also be set in on a per-file basis with
- #+STARTUP: hideblocks
- #+STARTUP: showblocks"
- :group 'org-startup
- :group 'org-cycle
- :type 'boolean)
- (defcustom org-cycle-global-at-bob nil
- "Cycle globally if cursor is at beginning of buffer and not at a headline.
- This makes it possible to do global cycling without having to use `S-TAB'
- or `\\[universal-argument] TAB'. For this special case to work, the first \
- line of the buffer
- must not be a headline -- it may be empty or some other text.
- When used in this way, `org-cycle-hook' is disabled temporarily to make
- sure the cursor stays at the beginning of the buffer.
- When this option is nil, don't do anything special at the beginning of
- the buffer."
- :group 'org-cycle
- :type 'boolean)
- (defcustom org-cycle-level-after-item/entry-creation t
- "Non-nil means cycle entry level or item indentation in new empty entries.
- When the cursor is at the end of an empty headline, i.e., with only stars
- and maybe a TODO keyword, TAB will then switch the entry to become a child,
- and then all possible ancestor states, before returning to the original state.
- This makes data entry extremely fast: M-RET to create a new headline,
- on TAB to make it a child, two or more tabs to make it a (grand-)uncle.
- When the cursor is at the end of an empty plain list item, one TAB will
- make it a subitem, two or more tabs will back up to make this an item
- higher up in the item hierarchy."
- :group 'org-cycle
- :type 'boolean)
- (defcustom org-cycle-emulate-tab t
- "Where should `org-cycle' emulate TAB.
- nil Never
- white Only in completely white lines
- whitestart Only at the beginning of lines, before the first non-white char
- t Everywhere except in headlines
- exc-hl-bol Everywhere except at the start of a headline
- If TAB is used in a place where it does not emulate TAB, the current subtree
- visibility is cycled."
- :group 'org-cycle
- :type '(choice (const :tag "Never" nil)
- (const :tag "Only in completely white lines" white)
- (const :tag "Before first char in a line" whitestart)
- (const :tag "Everywhere except in headlines" t)
- (const :tag "Everywhere except at bol in headlines" exc-hl-bol)))
- (defcustom org-cycle-separator-lines 2
- "Number of empty lines needed to keep an empty line between collapsed trees.
- If you leave an empty line between the end of a subtree and the following
- headline, this empty line is hidden when the subtree is folded.
- Org mode will leave (exactly) one empty line visible if the number of
- empty lines is equal or larger to the number given in this variable.
- So the default 2 means at least 2 empty lines after the end of a subtree
- are needed to produce free space between a collapsed subtree and the
- following headline.
- If the number is negative, and the number of empty lines is at least -N,
- all empty lines are shown.
- Special case: when 0, never leave empty lines in collapsed view."
- :group 'org-cycle
- :type 'integer)
- (put 'org-cycle-separator-lines 'safe-local-variable 'integerp)
- (defcustom org-pre-cycle-hook nil
- "Hook that is run before visibility cycling is happening.
- The function(s) in this hook must accept a single argument which indicates
- the new state that will be set right after running this hook. The
- argument is a symbol. Before a global state change, it can have the values
- `overview', `content', or `all'. Before a local state change, it can have
- the values `folded', `children', or `subtree'."
- :group 'org-cycle
- :type 'hook)
- (defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees
- org-cycle-hide-drawers
- org-cycle-show-empty-lines
- org-optimize-window-after-visibility-change)
- "Hook that is run after `org-cycle' has changed the buffer visibility.
- The function(s) in this hook must accept a single argument which indicates
- the new state that was set by the most recent `org-cycle' command. The
- argument is a symbol. After a global state change, it can have the values
- `overview', `contents', or `all'. After a local state change, it can have
- the values `folded', `children', or `subtree'."
- :group 'org-cycle
- :type 'hook
- :version "26.1"
- :package-version '(Org . "8.3"))
- (defgroup org-edit-structure nil
- "Options concerning structure editing in Org mode."
- :tag "Org Edit Structure"
- :group 'org-structure)
- (defcustom org-odd-levels-only nil
- "Non-nil means skip even levels and only use odd levels for the outline.
- This has the effect that two stars are being added/taken away in
- promotion/demotion commands. It also influences how levels are
- handled by the exporters.
- Changing it requires restart of `font-lock-mode' to become effective
- for fontification also in regions already fontified.
- You may also set this on a per-file basis by adding one of the following
- lines to the buffer:
- #+STARTUP: odd
- #+STARTUP: oddeven"
- :group 'org-edit-structure
- :group 'org-appearance
- :type 'boolean)
- (defcustom org-adapt-indentation t
- "Non-nil means adapt indentation to outline node level.
- When this variable is set, Org assumes that you write outlines by
- indenting text in each node to align with the headline (after the
- stars). The following issues are influenced by this variable:
- - The indentation is increased by one space in a demotion
- command, and decreased by one in a promotion command. However,
- in the latter case, if shifting some line in the entry body
- would alter document structure (e.g., insert a new headline),
- indentation is not changed at all.
- - Property drawers and planning information is inserted indented
- when this variable is set. When nil, they will not be indented.
- - TAB indents a line relative to current level. The lines below
- a headline will be indented when this variable is set.
- Note that this is all about true indentation, by adding and
- removing space characters. See also `org-indent.el' which does
- level-dependent indentation in a virtual way, i.e. at display
- time in Emacs."
- :group 'org-edit-structure
- :type 'boolean)
- (defcustom org-special-ctrl-a/e nil
- "Non-nil means `C-a' and `C-e' behave specially in headlines and items.
- When t, `C-a' will bring back the cursor to the beginning of the
- headline text, i.e. after the stars and after a possible TODO
- keyword. In an item, this will be the position after bullet and
- check-box, if any. When the cursor is already at that position,
- another `C-a' will bring it to the beginning of the line.
- `C-e' will jump to the end of the headline, ignoring the presence
- of tags in the headline. A second `C-e' will then jump to the
- true end of the line, after any tags. This also means that, when
- this variable is non-nil, `C-e' also will never jump beyond the
- end of the heading of a folded section, i.e. not after the
- ellipses.
- When set to the symbol `reversed', the first `C-a' or `C-e' works
- normally, going to the true line boundary first. Only a directly
- following, identical keypress will bring the cursor to the
- special positions.
- This may also be a cons cell where the behavior for `C-a' and
- `C-e' is set separately."
- :group 'org-edit-structure
- :type '(choice
- (const :tag "off" nil)
- (const :tag "on: after stars/bullet and before tags first" t)
- (const :tag "reversed: true line boundary first" reversed)
- (cons :tag "Set C-a and C-e separately"
- (choice :tag "Special C-a"
- (const :tag "off" nil)
- (const :tag "on: after stars/bullet first" t)
- (const :tag "reversed: before stars/bullet first" reversed))
- (choice :tag "Special C-e"
- (const :tag "off" nil)
- (const :tag "on: before tags first" t)
- (const :tag "reversed: after tags first" reversed)))))
- (defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e)
- (defcustom org-special-ctrl-k nil
- "Non-nil means `C-k' will behave specially in headlines.
- When nil, `C-k' will call the default `kill-line' command.
- When t, the following will happen while the cursor is in the headline:
- - When the cursor is at the beginning of a headline, kill the entire
- line and possible the folded subtree below the line.
- - When in the middle of the headline text, kill the headline up to the tags.
- - When after the headline text, kill the tags."
- :group 'org-edit-structure
- :type 'boolean)
- (defcustom org-ctrl-k-protect-subtree nil
- "Non-nil means, do not delete a hidden subtree with C-k.
- When set to the symbol `error', simply throw an error when C-k is
- used to kill (part-of) a headline that has hidden text behind it.
- Any other non-nil value will result in a query to the user, if it is
- OK to kill that hidden subtree. When nil, kill without remorse."
- :group 'org-edit-structure
- :version "24.1"
- :type '(choice
- (const :tag "Do not protect hidden subtrees" nil)
- (const :tag "Protect hidden subtrees with a security query" t)
- (const :tag "Never kill a hidden subtree with C-k" error)))
- (defcustom org-special-ctrl-o t
- "Non-nil means, make `C-o' insert a row in tables."
- :group 'org-edit-structure
- :type 'boolean)
- (defcustom org-catch-invisible-edits nil
- "Check if in invisible region before inserting or deleting a character.
- Valid values are:
- nil Do not check, so just do invisible edits.
- error Throw an error and do nothing.
- show Make point visible, and do the requested edit.
- show-and-error Make point visible, then throw an error and abort the edit.
- smart Make point visible, and do insertion/deletion if it is
- adjacent to visible text and the change feels predictable.
- Never delete a previously invisible character or add in the
- middle or right after an invisible region. Basically, this
- allows insertion and backward-delete right before ellipses.
- FIXME: maybe in this case we should not even show?"
- :group 'org-edit-structure
- :version "24.1"
- :type '(choice
- (const :tag "Do not check" nil)
- (const :tag "Throw error when trying to edit" error)
- (const :tag "Unhide, but do not do the edit" show-and-error)
- (const :tag "Show invisible part and do the edit" show)
- (const :tag "Be smart and do the right thing" smart)))
- (defcustom org-yank-folded-subtrees t
- "Non-nil means when yanking subtrees, fold them.
- If the kill is a single subtree, or a sequence of subtrees, i.e. if
- it starts with a heading and all other headings in it are either children
- or siblings, then fold all the subtrees. However, do this only if no
- text after the yank would be swallowed into a folded tree by this action."
- :group 'org-edit-structure
- :type 'boolean)
- (defcustom org-yank-adjusted-subtrees nil
- "Non-nil means when yanking subtrees, adjust the level.
- With this setting, `org-paste-subtree' is used to insert the subtree, see
- this function for details."
- :group 'org-edit-structure
- :type 'boolean)
- (defcustom org-M-RET-may-split-line '((default . t))
- "Non-nil means M-RET will split the line at the cursor position.
- When nil, it will go to the end of the line before making a
- new line.
- You may also set this option in a different way for different
- contexts. Valid contexts are:
- headline when creating a new headline
- item when creating a new item
- table in a table field
- default the value to be used for all contexts not explicitly
- customized"
- :group 'org-structure
- :group 'org-table
- :type '(choice
- (const :tag "Always" t)
- (const :tag "Never" nil)
- (repeat :greedy t :tag "Individual contexts"
- (cons
- (choice :tag "Context"
- (const headline)
- (const item)
- (const table)
- (const default))
- (boolean)))))
- (defcustom org-insert-heading-respect-content nil
- "Non-nil means insert new headings after the current subtree.
- \\<org-mode-map>
- When nil, the new heading is created directly after the current line.
- The commands `\\[org-insert-heading-respect-content]' and \
- `\\[org-insert-todo-heading-respect-content]' turn this variable on
- for the duration of the command."
- :group 'org-structure
- :type 'boolean)
- (defcustom org-blank-before-new-entry '((heading . auto)
- (plain-list-item . auto))
- "Should `org-insert-heading' leave a blank line before new heading/item?
- The value is an alist, with `heading' and `plain-list-item' as CAR,
- and a boolean flag as CDR. The cdr may also be the symbol `auto', in
- which case Org will look at the surrounding headings/items and try to
- make an intelligent decision whether to insert a blank line or not."
- :group 'org-edit-structure
- :type '(list
- (cons (const heading)
- (choice (const :tag "Never" nil)
- (const :tag "Always" t)
- (const :tag "Auto" auto)))
- (cons (const plain-list-item)
- (choice (const :tag "Never" nil)
- (const :tag "Always" t)
- (const :tag "Auto" auto)))))
- (defcustom org-insert-heading-hook nil
- "Hook being run after inserting a new heading."
- :group 'org-edit-structure
- :type 'hook)
- (defcustom org-enable-fixed-width-editor t
- "Non-nil means lines starting with \":\" are treated as fixed-width.
- This currently only means they are never auto-wrapped.
- When nil, such lines will be treated like ordinary lines."
- :group 'org-edit-structure
- :type 'boolean)
- (defcustom org-goto-auto-isearch t
- "Non-nil means typing characters in `org-goto' starts incremental search.
- When nil, you can use these keybindings to navigate the buffer:
- q Quit the org-goto interface
- n Go to the next visible heading
- p Go to the previous visible heading
- f Go one heading forward on same level
- b Go one heading backward on same level
- u Go one heading up"
- :group 'org-edit-structure
- :type 'boolean)
- (defgroup org-sparse-trees nil
- "Options concerning sparse trees in Org mode."
- :tag "Org Sparse Trees"
- :group 'org-structure)
- (defcustom org-highlight-sparse-tree-matches t
- "Non-nil means highlight all matches that define a sparse tree.
- The highlights will automatically disappear the next time the buffer is
- changed by an edit command."
- :group 'org-sparse-trees
- :type 'boolean)
- (defcustom org-remove-highlights-with-change t
- "Non-nil means any change to the buffer will remove temporary highlights.
- \\<org-mode-map>\
- Such highlights are created by `org-occur' and `org-clock-display'.
- When nil, `\\[org-ctrl-c-ctrl-c]' needs to be used \
- to get rid of the highlights.
- The highlights created by `org-toggle-latex-fragment' always need
- `\\[org-toggle-latex-fragment]' to be removed."
- :group 'org-sparse-trees
- :group 'org-time
- :type 'boolean)
- (defcustom org-occur-case-fold-search t
- "Non-nil means `org-occur' should be case-insensitive.
- If set to `smart' the search will be case-insensitive only if it
- doesn't specify any upper case character."
- :group 'org-sparse-trees
- :version "26.1"
- :type '(choice
- (const :tag "Case-sensitive" nil)
- (const :tag "Case-insensitive" t)
- (const :tag "Case-insensitive for lower case searches only" 'smart)))
- (defcustom org-occur-hook '(org-first-headline-recenter)
- "Hook that is run after `org-occur' has constructed a sparse tree.
- This can be used to recenter the window to show as much of the structure
- as possible."
- :group 'org-sparse-trees
- :type 'hook)
- (defgroup org-imenu-and-speedbar nil
- "Options concerning imenu and speedbar in Org mode."
- :tag "Org Imenu and Speedbar"
- :group 'org-structure)
- (defcustom org-imenu-depth 2
- "The maximum level for Imenu access to Org headlines.
- This also applied for speedbar access."
- :group 'org-imenu-and-speedbar
- :type 'integer)
- (defgroup org-table nil
- "Options concerning tables in Org mode."
- :tag "Org Table"
- :group 'org)
- (defcustom org-enable-table-editor 'optimized
- "Non-nil means lines starting with \"|\" are handled by the table editor.
- When nil, such lines will be treated like ordinary lines.
- When equal to the symbol `optimized', the table editor will be optimized to
- do the following:
- - Automatic overwrite mode in front of whitespace in table fields.
- This makes the structure of the table stay in tact as long as the edited
- field does not exceed the column width.
- - Minimize the number of realigns. Normally, the table is aligned each time
- TAB or RET are pressed to move to another field. With optimization this
- happens only if changes to a field might have changed the column width.
- Optimization requires replacing the functions `self-insert-command',
- `delete-char', and `backward-delete-char' in Org buffers, with a
- slight (in fact: unnoticeable) speed impact for normal typing. Org is very
- good at guessing when a re-align will be necessary, but you can always
- force one with `\\[org-ctrl-c-ctrl-c]'.
- If you would like to use the optimized version in Org mode, but the
- un-optimized version in OrgTbl-mode, see the variable `orgtbl-optimized'.
- This variable can be used to turn on and off the table editor during a session,
- but in order to toggle optimization, a restart is required.
- See also the variable `org-table-auto-blank-field'."
- :group 'org-table
- :type '(choice
- (const :tag "off" nil)
- (const :tag "on" t)
- (const :tag "on, optimized" optimized)))
- (defcustom org-self-insert-cluster-for-undo nil
- "Non-nil means cluster self-insert commands for undo when possible.
- If this is set, then, like in the Emacs command loop, 20 consecutive
- characters will be undone together.
- This is configurable, because there is some impact on typing performance."
- :group 'org-table
- :type 'boolean)
- (defcustom org-table-tab-recognizes-table.el t
- "Non-nil means TAB will automatically notice a table.el table.
- When it sees such a table, it moves point into it and - if necessary -
- calls `table-recognize-table'."
- :group 'org-table-editing
- :type 'boolean)
- (defgroup org-link nil
- "Options concerning links in Org mode."
- :tag "Org Link"
- :group 'org)
- (defvar-local org-link-abbrev-alist-local nil
- "Buffer-local version of `org-link-abbrev-alist', which see.
- The value of this is taken from the #+LINK lines.")
- (defcustom org-link-parameters
- '(("doi" :follow org--open-doi-link)
- ("elisp" :follow org--open-elisp-link)
- ("file" :complete org-file-complete-link)
- ("ftp" :follow (lambda (path) (browse-url (concat "ftp:" path))))
- ("help" :follow org--open-help-link)
- ("http" :follow (lambda (path) (browse-url (concat "http:" path))))
- ("https" :follow (lambda (path) (browse-url (concat "https:" path))))
- ("mailto" :follow (lambda (path) (browse-url (concat "mailto:" path))))
- ("message" :follow (lambda (path) (browse-url (concat "message:" path))))
- ("news" :follow (lambda (path) (browse-url (concat "news:" path))))
- ("shell" :follow org--open-shell-link))
- "An alist of properties that defines all the links in Org mode.
- The key in each association is a string of the link type.
- Subsequent optional elements make up a p-list of link properties.
- :follow - A function that takes the link path as an argument.
- :export - A function that takes the link path, description and
- export-backend as arguments.
- :store - A function responsible for storing the link. See the
- function `org-store-link-functions'.
- :complete - A function that inserts a link with completion. The
- function takes one optional prefix arg.
- :face - A face for the link, or a function that returns a face.
- The function takes one argument which is the link path. The
- default face is `org-link'.
- :mouse-face - The mouse-face. The default is `highlight'.
- :display - `full' will not fold the link in descriptive
- display. Default is `org-link'.
- :help-echo - A string or function that takes (window object position)
- as arguments and returns a string.
- :keymap - A keymap that is active on the link. The default is
- `org-mouse-map'.
- :htmlize-link - A function for the htmlize-link. Defaults
- to (list :uri \"type:path\")
- :activate-func - A function to run at the end of font-lock
- activation. The function must accept (link-start link-end path bracketp)
- as arguments."
- :group 'org-link
- :type '(alist :tag "Link display parameters"
- :value-type plist))
- (defun org-link-get-parameter (type key)
- "Get TYPE link property for KEY.
- TYPE is a string and KEY is a plist keyword."
- (plist-get
- (cdr (assoc type org-link-parameters))
- key))
- (defun org-link-set-parameters (type &rest parameters)
- "Set link TYPE properties to PARAMETERS.
- PARAMETERS should be :key val pairs."
- (let ((data (assoc type org-link-parameters)))
- (if data (setcdr data (org-combine-plists (cdr data) parameters))
- (push (cons type parameters) org-link-parameters)
- (org-make-link-regexps)
- (org-element-update-syntax))))
- (defun org-link-types ()
- "Return a list of known link types."
- (mapcar #'car org-link-parameters))
- (defcustom org-link-abbrev-alist nil
- "Alist of link abbreviations.
- The car of each element is a string, to be replaced at the start of a link.
- The cdrs are replacement values, like (\"linkkey\" . REPLACE). Abbreviated
- links in Org buffers can have an optional tag after a double colon, e.g.,
- [[linkkey:tag][description]]
- The `linkkey' must be a single word, starting with a letter, followed
- by letters, numbers, `-' or `_'.
- If REPLACE is a string, the tag will simply be appended to create the link.
- If the string contains \"%s\", the tag will be inserted there. If the string
- contains \"%h\", it will cause a url-encoded version of the tag to be inserted
- at that point (see the function `url-hexify-string'). If the string contains
- the specifier \"%(my-function)\", then the custom function `my-function' will
- be invoked: this function takes the tag as its only argument and must return
- a string.
- REPLACE may also be a function that will be called with the tag as the
- only argument to create the link, which should be returned as a string.
- See the manual for examples."
- :group 'org-link
- :type '(repeat
- (cons
- (string :tag "Protocol")
- (choice
- (string :tag "Format")
- (function)))))
- (defcustom org-descriptive-links t
- "Non-nil means Org will display descriptive links.
- E.g. [[http://orgmode.org][Org website]] will be displayed as
- \"Org Website\", hiding the link itself and just displaying its
- description. When set to nil, Org will display the full links
- literally.
- You can interactively set the value of this variable by calling
- `org-toggle-link-display' or from the menu Org>Hyperlinks menu."
- :group 'org-link
- :type 'boolean)
- (defcustom org-link-file-path-type 'adaptive
- "How the path name in file links should be stored.
- Valid values are:
- relative Relative to the current directory, i.e. the directory of the file
- into which the link is being inserted.
- absolute Absolute path, if possible with ~ for home directory.
- noabbrev Absolute path, no abbreviation of home directory.
- adaptive Use relative path for files in the current directory and sub-
- directories of it. For other files, use an absolute path."
- :group 'org-link
- :type '(choice
- (const relative)
- (const absolute)
- (const noabbrev)
- (const adaptive)))
- (defvaralias 'org-activate-links 'org-highlight-links)
- (defcustom org-highlight-links '(bracket angle plain radio tag date footnote)
- "Types of links that should be highlighted in Org files.
- This is a list of symbols, each one of them leading to the
- highlighting of a certain link type.
- You can still open links that are not highlighted.
- In principle, it does not hurt to turn on highlighting for all
- link types. There may be a small gain when turning off unused
- link types. The types are:
- bracket The recommended [[link][description]] or [[link]] links with hiding.
- angle Links in angular brackets that may contain whitespace like
- <bbdb:Carsten Dominik>.
- plain Plain links in normal text, no whitespace, like http://google.com.
- radio Text that is matched by a radio target, see manual for details.
- tag Tag settings in a headline (link to tag search).
- date Time stamps (link to calendar).
- footnote Footnote labels.
- If you set this variable during an Emacs session, use `org-mode-restart'
- in the Org buffer so that the change takes effect."
- :group 'org-link
- :group 'org-appearance
- :type '(set :greedy t
- (const :tag "Double bracket links" bracket)
- (const :tag "Angular bracket links" angle)
- (const :tag "Plain text links" plain)
- (const :tag "Radio target matches" radio)
- (const :tag "Tags" tag)
- (const :tag "Timestamps" date)
- (const :tag "Footnotes" footnote)))
- (defcustom org-make-link-description-function nil
- "Function to use for generating link descriptions from links.
- When nil, the link location will be used. This function must take
- two parameters: the first one is the link, the second one is the
- description generated by `org-insert-link'. The function should
- return the description to use."
- :group 'org-link
- :type '(choice (const nil) (function)))
- (defgroup org-link-store nil
- "Options concerning storing links in Org mode."
- :tag "Org Store Link"
- :group 'org-link)
- (defcustom org-url-hexify-p t
- "When non-nil, hexify URL when creating a link."
- :type 'boolean
- :version "24.3"
- :group 'org-link-store)
- (defcustom org-email-link-description-format "Email %c: %.30s"
- "Format of the description part of a link to an email or usenet message.
- The following %-escapes will be replaced by corresponding information:
- %F full \"From\" field
- %f name, taken from \"From\" field, address if no name
- %T full \"To\" field
- %t first name in \"To\" field, address if no name
- %c correspondent. Usually \"from NAME\", but if you sent it yourself, it
- will be \"to NAME\". See also the variable `org-from-is-user-regexp'.
- %s subject
- %d date
- %m message-id.
- You may use normal field width specification between the % and the letter.
- This is for example useful to limit the length of the subject.
- Examples: \"%f on: %.30s\", \"Email from %f\", \"Email %c\""
- :group 'org-link-store
- :type 'string)
- (defcustom org-from-is-user-regexp
- (let (r1 r2)
- (when (and user-mail-address (not (string= user-mail-address "")))
- (setq r1 (concat "\\<" (regexp-quote user-mail-address) "\\>")))
- (when (and user-full-name (not (string= user-full-name "")))
- (setq r2 (concat "\\<" (regexp-quote user-full-name) "\\>")))
- (if (and r1 r2) (concat r1 "\\|" r2) (or r1 r2)))
- "Regexp matched against the \"From:\" header of an email or usenet message.
- It should match if the message is from the user him/herself."
- :group 'org-link-store
- :type 'regexp)
- (defcustom org-context-in-file-links t
- "Non-nil means file links from `org-store-link' contain context.
- \\<org-mode-map>
- A search string will be added to the file name with :: as separator
- and used to find the context when the link is activated by the command
- `org-open-at-point'. When this option is t, the entire active region
- will be placed in the search string of the file link. If set to a
- positive integer, only the first n lines of context will be stored.
- Using a prefix arg to the command `org-store-link' (`\\[universal-argument] \
- \\[org-store-link]')
- negates this setting for the duration of the command."
- :group 'org-link-store
- :type '(choice boolean integer))
- (defcustom org-keep-stored-link-after-insertion nil
- "Non-nil means keep link in list for entire session.
- \\<org-mode-map>
- The command `org-store-link' adds a link pointing to the current
- location to an internal list. These links accumulate during a session.
- The command `org-insert-link' can be used to insert links into any
- Org file (offering completion for all stored links).
- When this option is nil, every link which has been inserted once using
- `\\[org-insert-link]' will be removed from the list, to make completing the \
- unused
- links more efficient."
- :group 'org-link-store
- :type 'boolean)
- (defgroup org-link-follow nil
- "Options concerning following links in Org mode."
- :tag "Org Follow Link"
- :group 'org-link)
- (defcustom org-link-translation-function nil
- "Function to translate links with different syntax to Org syntax.
- This can be used to translate links created for example by the Planner
- or emacs-wiki packages to Org syntax.
- The function must accept two parameters, a TYPE containing the link
- protocol name like \"rmail\" or \"gnus\" as a string, and the linked path,
- which is everything after the link protocol. It should return a cons
- with possibly modified values of type and path.
- Org contains a function for this, so if you set this variable to
- `org-translate-link-from-planner', you should be able follow many
- links created by planner."
- :group 'org-link-follow
- :type '(choice (const nil) (function)))
- (defcustom org-follow-link-hook nil
- "Hook that is run after a link has been followed."
- :group 'org-link-follow
- :type 'hook)
- (defcustom org-tab-follows-link nil
- "Non-nil means on links TAB will follow the link.
- Needs to be set before org.el is loaded.
- This really should not be used, it does not make sense, and the
- implementation is bad."
- :group 'org-link-follow
- :type 'boolean)
- (defcustom org-return-follows-link nil
- "Non-nil means on links RET will follow the link.
- In tables, the special behavior of RET has precedence."
- :group 'org-link-follow
- :type 'boolean)
- (defcustom org-mouse-1-follows-link
- (if (boundp 'mouse-1-click-follows-link) mouse-1-click-follows-link t)
- "Non-nil means mouse-1 on a link will follow the link.
- A longer mouse click will still set point. Needs to be set
- before org.el is loaded."
- :group 'org-link-follow
- :version "24.4"
- :package-version '(Org . "8.3")
- :type '(choice
- (const :tag "A double click follows the link" double)
- (const :tag "Unconditionally follow the link with mouse-1" t)
- (integer :tag "mouse-1 click does not follow the link if longer than N ms" 450)))
- (defcustom org-mark-ring-length 4
- "Number of different positions to be recorded in the ring.
- Changing this requires a restart of Emacs to work correctly."
- :group 'org-link-follow
- :type 'integer)
- (defcustom org-link-search-must-match-exact-headline 'query-to-create
- "Non-nil means internal fuzzy links can only match headlines.
- When nil, the a fuzzy link may point to a target or a named
- construct in the document. When set to the special value
- `query-to-create', offer to create a new headline when none
- matched.
- Spaces and statistics cookies are ignored during heading searches."
- :group 'org-link-follow
- :version "24.1"
- :type '(choice
- (const :tag "Use fuzzy text search" nil)
- (const :tag "Match only exact headline" t)
- (const :tag "Match exact headline or query to create it"
- query-to-create))
- :safe #'symbolp)
- (defcustom org-link-frame-setup
- '((vm . vm-visit-folder-other-frame)
- (vm-imap . vm-visit-imap-folder-other-frame)
- (gnus . org-gnus-no-new-news)
- (file . find-file-other-window)
- (wl . wl-other-frame))
- "Setup the frame configuration for following links.
- When following a link with Emacs, it may often be useful to display
- this link in another window or frame. This variable can be used to
- set this up for the different types of links.
- For VM, use any of
- `vm-visit-folder'
- `vm-visit-folder-other-window'
- `vm-visit-folder-other-frame'
- For Gnus, use any of
- `gnus'
- `gnus-other-frame'
- `org-gnus-no-new-news'
- For FILE, use any of
- `find-file'
- `find-file-other-window'
- `find-file-other-frame'
- For Wanderlust use any of
- `wl'
- `wl-other-frame'
- For the calendar, use the variable `calendar-setup'.
- For BBDB, it is currently only possible to display the matches in
- another window."
- :group 'org-link-follow
- :type '(list
- (cons (const vm)
- (choice
- (const vm-visit-folder)
- (const vm-visit-folder-other-window)
- (const vm-visit-folder-other-frame)))
- (cons (const vm-imap)
- (choice
- (const vm-visit-imap-folder)
- (const vm-visit-imap-folder-other-window)
- (const vm-visit-imap-folder-other-frame)))
- (cons (const gnus)
- (choice
- (const gnus)
- (const gnus-other-frame)
- (const org-gnus-no-new-news)))
- (cons (const file)
- (choice
- (const find-file)
- (const find-file-other-window)
- (const find-file-other-frame)))
- (cons (const wl)
- (choice
- (const wl)
- (const wl-other-frame)))))
- (defcustom org-display-internal-link-with-indirect-buffer nil
- "Non-nil means use indirect buffer to display infile links.
- Activating internal links (from one location in a file to another location
- in the same file) normally just jumps to the location. When the link is
- activated with a `\\[universal-argument]' prefix (or with mouse-3), the link \
- is displayed in
- another window. When this option is set, the other window actually displays
- an indirect buffer clone of the current buffer, to avoid any visibility
- changes to the current buffer."
- :group 'org-link-follow
- :type 'boolean)
- (defcustom org-open-non-existing-files nil
- "Non-nil means `org-open-file' will open non-existing files.
- When nil, an error will be generated.
- This variable applies only to external applications because they
- might choke on non-existing files. If the link is to a file that
- will be opened in Emacs, the variable is ignored."
- :group 'org-link-follow
- :type 'boolean)
- (defcustom org-open-directory-means-index-dot-org nil
- "Non-nil means a link to a directory really means to index.org.
- When nil, following a directory link will run dired or open a finder/explorer
- window on that directory."
- :group 'org-link-follow
- :type 'boolean)
- (defcustom org-confirm-shell-link-function 'yes-or-no-p
- "Non-nil means ask for confirmation before executing shell links.
- Shell links can be dangerous: just think about a link
- [[shell:rm -rf ~/*][Google Search]]
- This link would show up in your Org document as \"Google Search\",
- but really it would remove your entire home directory.
- Therefore we advise against setting this variable to nil.
- Just change it to `y-or-n-p' if you want to confirm with a
- single keystroke rather than having to type \"yes\"."
- :group 'org-link-follow
- :type '(choice
- (const :tag "with yes-or-no (safer)" yes-or-no-p)
- (const :tag "with y-or-n (faster)" y-or-n-p)
- (const :tag "no confirmation (dangerous)" nil)))
- (put 'org-confirm-shell-link-function
- 'safe-local-variable
- (lambda (x) (member x '(yes-or-no-p y-or-n-p))))
- (defcustom org-confirm-shell-link-not-regexp ""
- "A regexp to skip confirmation for shell links."
- :group 'org-link-follow
- :version "24.1"
- :type 'regexp)
- (defcustom org-confirm-elisp-link-function 'yes-or-no-p
- "Non-nil means ask for confirmation before executing Emacs Lisp links.
- Elisp links can be dangerous: just think about a link
- [[elisp:(shell-command \"rm -rf ~/*\")][Google Search]]
- This link would show up in your Org document as \"Google Search\",
- but really it would remove your entire home directory.
- Therefore we advise against setting this variable to nil.
- Just change it to `y-or-n-p' if you want to confirm with a
- single keystroke rather than having to type \"yes\"."
- :group 'org-link-follow
- :type '(choice
- (const :tag "with yes-or-no (safer)" yes-or-no-p)
- (const :tag "with y-or-n (faster)" y-or-n-p)
- (const :tag "no confirmation (dangerous)" nil)))
- (put 'org-confirm-shell-link-function
- 'safe-local-variable
- (lambda (x) (member x '(yes-or-no-p y-or-n-p))))
- (defcustom org-confirm-elisp-link-not-regexp ""
- "A regexp to skip confirmation for Elisp links."
- :group 'org-link-follow
- :version "24.1"
- :type 'regexp)
- (defconst org-file-apps-defaults-gnu
- '((remote . emacs)
- (system . mailcap)
- (t . mailcap))
- "Default file applications on a UNIX or GNU/Linux system.
- See `org-file-apps'.")
- (defconst org-file-apps-defaults-macosx
- '((remote . emacs)
- (system . "open %s")
- ("ps.gz" . "gv %s")
- ("eps.gz" . "gv %s")
- ("dvi" . "xdvi %s")
- ("fig" . "xfig %s")
- (t . "open %s"))
- "Default file applications on a macOS system.
- The system \"open\" is known as a default, but we use X11 applications
- for some files for which the OS does not have a good default.
- See `org-file-apps'.")
- (defconst org-file-apps-defaults-windowsnt
- (list '(remote . emacs)
- (cons 'system (lambda (file _path)
- (with-no-warnings (w32-shell-execute "open" file))))
- (cons t (lambda (file _path)
- (with-no-warnings (w32-shell-execute "open" file)))))
- "Default file applications on a Windows NT system.
- The system \"open\" is used for most files.
- See `org-file-apps'.")
- (defcustom org-file-apps
- '((auto-mode . emacs)
- ("\\.mm\\'" . default)
- ("\\.x?html?\\'" . default)
- ("\\.pdf\\'" . default))
- "External applications for opening `file:path' items in a document.
- \\<org-mode-map>\
- Org mode uses system defaults for different file types, but
- you can use this variable to set the application for a given file
- extension. The entries in this list are cons cells where the car identifies
- files and the cdr the corresponding command.
- Possible values for the file identifier are:
- \"string\" A string as a file identifier can be interpreted in different
- ways, depending on its contents:
- - Alphanumeric characters only:
- Match links with this file extension.
- Example: (\"pdf\" . \"evince %s\")
- to open PDFs with evince.
- - Regular expression: Match links where the
- filename matches the regexp. If you want to
- use groups here, use shy groups.
- Example: (\"\\\\.x?html\\\\\\='\" . \"firefox %s\")
- (\"\\\\(?:xhtml\\\\|html\\\\)\\\\\\='\" . \"firefox %s\")
- to open *.html and *.xhtml with firefox.
- - Regular expression which contains (non-shy) groups:
- Match links where the whole link, including \"::\", and
- anything after that, matches the regexp.
- In a custom command string, %1, %2, etc. are replaced with
- the parts of the link that were matched by the groups.
- For backwards compatibility, if a command string is given
- that does not use any of the group matches, this case is
- handled identically to the second one (i.e. match against
- file name only).
- In a custom function, you can access the group matches with
- (match-string n link).
- Example: (\"\\\\.pdf::\\\\(\\\\d+\\\\)\\\\\\='\" . \
- \"evince -p %1 %s\")
- to open [[file:document.pdf::5]] with evince at page 5.
- `directory' Matches a directory
- `remote' Matches a remote file, accessible through tramp or efs.
- Remote files most likely should be visited through Emacs
- because external applications cannot handle such paths.
- `auto-mode' Matches files that are matched by any entry in `auto-mode-alist',
- so all files Emacs knows how to handle. Using this with
- command `emacs' will open most files in Emacs. Beware that this
- will also open html files inside Emacs, unless you add
- (\"html\" . default) to the list as well.
- `system' The system command to open files, like `open' on Windows
- and macOS, and mailcap under GNU/Linux. This is the command
- that will be selected if you call `org-open-at-point' with a
- double prefix argument (`\\[universal-argument] \
- \\[universal-argument] \\[org-open-at-point]').
- t Default for files not matched by any of the other options.
- Possible values for the command are:
- `emacs' The file will be visited by the current Emacs process.
- `default' Use the default application for this file type, which is the
- association for t in the list, most likely in the system-specific
- part. This can be used to overrule an unwanted setting in the
- system-specific variable.
- `system' Use the system command for opening files, like \"open\".
- This command is specified by the entry whose car is `system'.
- Most likely, the system-specific version of this variable
- does define this command, but you can overrule/replace it
- here.
- `mailcap' Use command specified in the mailcaps.
- string A command to be executed by a shell; %s will be replaced
- by the path to the file.
- function A Lisp function, which will be called with two arguments:
- the file path and the original link string, without the
- \"file:\" prefix.
- For more examples, see the system specific constants
- `org-file-apps-defaults-macosx'
- `org-file-apps-defaults-windowsnt'
- `org-file-apps-defaults-gnu'."
- :group 'org-link-follow
- :type '(repeat
- (cons (choice :value ""
- (string :tag "Extension")
- (const :tag "System command to open files" system)
- (const :tag "Default for unrecognized files" t)
- (const :tag "Remote file" remote)
- (const :tag "Links to a directory" directory)
- (const :tag "Any files that have Emacs modes"
- auto-mode))
- (choice :value ""
- (const :tag "Visit with Emacs" emacs)
- (const :tag "Use default" default)
- (const :tag "Use the system command" system)
- (string :tag "Command")
- (function :tag "Function")))))
- (defcustom org-doi-server-url "http://dx.doi.org/"
- "The URL of the DOI server."
- :type 'string
- :version "24.3"
- :group 'org-link-follow)
- (defgroup org-refile nil
- "Options concerning refiling entries in Org mode."
- :tag "Org Refile"
- :group 'org)
- (defcustom org-directory "~/org"
- "Directory with Org files.
- This is just a default location to look for Org files. There is no need
- at all to put your files into this directory. It is used in the
- following situations:
- 1. When a capture template specifies a target file that is not an
- absolute path. The path will then be interpreted relative to
- `org-directory'
- 2. When the value of variable `org-agenda-files' is a single file, any
- relative paths in this file will be taken as relative to
- `org-directory'."
- :group 'org-refile
- :group 'org-capture
- :type 'directory)
- (defcustom org-default-notes-file (convert-standard-filename "~/.notes")
- "Default target for storing notes.
- Used as a fall back file for org-capture.el, for templates that
- do not specify a target file."
- :group 'org-refile
- :group 'org-capture
- :type 'file)
- (defcustom org-goto-interface 'outline
- "The default interface to be used for `org-goto'.
- Allowed values are:
- outline The interface shows an outline of the relevant file
- and the correct heading is found by moving through
- the outline or by searching with incremental search.
- outline-path-completion Headlines in the current buffer are offered via
- completion. This is the interface also used by
- the refile command."
- :group 'org-refile
- :type '(choice
- (const :tag "Outline" outline)
- (const :tag "Outline-path-completion" outline-path-completion)))
- (defcustom org-goto-max-level 5
- "Maximum target level when running `org-goto' with refile interface."
- :group 'org-refile
- :type 'integer)
- (defcustom org-reverse-note-order nil
- "Non-nil means store new notes at the beginning of a file or entry.
- When nil, new notes will be filed to the end of a file or entry.
- This can also be a list with cons cells of regular expressions that
- are matched against file names, and values."
- :group 'org-capture
- :group 'org-refile
- :type '(choice
- (const :tag "Reverse always" t)
- (const :tag "Reverse never" nil)
- (repeat :tag "By file name regexp"
- (cons regexp boolean))))
- (defcustom org-log-refile nil
- "Information to record when a task is refiled.
- Possible values are:
- nil Don't add anything
- time Add a time stamp to the task
- note Prompt for a note and add it with template `org-log-note-headings'
- This option can also be set with on a per-file-basis with
- #+STARTUP: nologrefile
- #+STARTUP: logrefile
- #+STARTUP: lognoterefile
- You can have local logging settings for a subtree by setting the LOGGING
- property to one or more of these keywords.
- When bulk-refiling from the agenda, the value `note' is forbidden and
- will temporarily be changed to `time'."
- :group 'org-refile
- :group 'org-progress
- :version "24.1"
- :type '(choice
- (const :tag "No logging" nil)
- (const :tag "Record timestamp" time)
- (const :tag "Record timestamp with note." note)))
- (defcustom org-refile-targets nil
- "Targets for refiling entries with `\\[org-refile]'.
- This is a list of cons cells. Each cell contains:
- - a specification of the files to be considered, either a list of files,
- or a symbol whose function or variable value will be used to retrieve
- a file name or a list of file names. If you use `org-agenda-files' for
- that, all agenda files will be scanned for targets. Nil means consider
- headings in the current buffer.
- - A specification of how to find candidate refile targets. This may be
- any of:
- - a cons cell (:tag . \"TAG\") to identify refile targets by a tag.
- This tag has to be present in all target headlines, inheritance will
- not be considered.
- - a cons cell (:todo . \"KEYWORD\") to identify refile targets by
- todo keyword.
- - a cons cell (:regexp . \"REGEXP\") with a regular expression matching
- headlines that are refiling targets.
- - a cons cell (:level . N). Any headline of level N is considered a target.
- Note that, when `org-odd-levels-only' is set, level corresponds to
- order in hierarchy, not to the number of stars.
- - a cons cell (:maxlevel . N). Any headline with level <= N is a target.
- Note that, when `org-odd-levels-only' is set, level corresponds to
- order in hierarchy, not to the number of stars.
- Each element of this list generates a set of possible targets.
- The union of these sets is presented (with completion) to
- the user by `org-refile'.
- You can set the variable `org-refile-target-verify-function' to a function
- to verify each headline found by the simple criteria above.
- When this variable is nil, all top-level headlines in the current buffer
- are used, equivalent to the value `((nil . (:level . 1))'."
- :group 'org-refile
- :type '(repeat
- (cons
- (choice :value org-agenda-files
- (const :tag "All agenda files" org-agenda-files)
- (const :tag "Current buffer" nil)
- (function) (variable) (file))
- (choice :tag "Identify target headline by"
- (cons :tag "Specific tag" (const :value :tag) (string))
- (cons :tag "TODO keyword" (const :value :todo) (string))
- (cons :tag "Regular expression" (const :value :regexp) (regexp))
- (cons :tag "Level number" (const :value :level) (integer))
- (cons :tag "Max Level number" (const :value :maxlevel) (integer))))))
- (defcustom org-refile-target-verify-function nil
- "Function to verify if the headline at point should be a refile target.
- The function will be called without arguments, with point at the
- beginning of the headline. It should return t and leave point
- where it is if the headline is a valid target for refiling.
- If the target should not be selected, the function must return nil.
- In addition to this, it may move point to a place from where the search
- should be continued. For example, the function may decide that the entire
- subtree of the current entry should be excluded and move point to the end
- of the subtree."
- :group 'org-refile
- :type '(choice
- (const nil)
- (function)))
- (defcustom org-refile-use-cache nil
- "Non-nil means cache refile targets to speed up the process.
- \\<org-mode-map>\
- The cache for a particular file will be updated automatically when
- the buffer has been killed, or when any of the marker used for flagging
- refile targets no longer points at a live buffer.
- If you have added new entries to a buffer that might themselves be targets,
- you need to clear the cache manually by pressing `C-0 \\[org-refile]' or,
- if you find that easier, \
- `\\[universal-argument] \\[universal-argument] \\[universal-argument] \
- \\[org-refile]'."
- :group 'org-refile
- :version "24.1"
- :type 'boolean)
- (defcustom org-refile-use-outline-path nil
- "Non-nil means provide refile targets as paths.
- So a level 3 headline will be available as level1/level2/level3.
- When the value is `file', also include the file name (without directory)
- into the path. In this case, you can also stop the completion after
- the file name, to get entries inserted as top level in the file.
- When `full-file-path', include the full file path."
- :group 'org-refile
- :type '(choice
- (const :tag "Not" nil)
- (const :tag "Yes" t)
- (const :tag "Start with file name" file)
- (const :tag "Start with full file path" full-file-path)))
- (defcustom org-outline-path-complete-in-steps t
- "Non-nil means complete the outline path in hierarchical steps.
- When Org uses the refile interface to select an outline path (see
- `org-refile-use-outline-path'), the completion of the path can be
- done in a single go, or it can be done in steps down the headline
- hierarchy. Going in steps is probably the best if you do not use
- a special completion package like `ido' or `icicles'. However,
- when using these packages, going in one step can be very fast,
- while still showing the whole path to the entry."
- :group 'org-refile
- :type 'boolean)
- (defcustom org-refile-allow-creating-parent-nodes nil
- "Non-nil means allow the creation of new nodes as refile targets.
- New nodes are then created by adding \"/new node name\" to the completion
- of an existing node. When the value of this variable is `confirm',
- new node creation must be confirmed by the user (recommended).
- When nil, the completion must match an existing entry.
- Note that, if the new heading is not seen by the criteria
- listed in `org-refile-targets', multiple instances of the same
- heading would be created by trying again to file under the new
- heading."
- :group 'org-refile
- :type '(choice
- (const :tag "Never" nil)
- (const :tag "Always" t)
- (const :tag "Prompt for confirmation" confirm)))
- (defcustom org-refile-active-region-within-subtree nil
- "Non-nil means also refile active region within a subtree.
- By default `org-refile' doesn't allow refiling regions if they
- don't contain a set of subtrees, but it might be convenient to
- do so sometimes: in that case, the first line of the region is
- converted to a headline before refiling."
- :group 'org-refile
- :version "24.1"
- :type 'boolean)
- (defgroup org-todo nil
- "Options concerning TODO items in Org mode."
- :tag "Org TODO"
- :group 'org)
- (defgroup org-progress nil
- "Options concerning Progress logging in Org mode."
- :tag "Org Progress"
- :group 'org-time)
- (defvar org-todo-interpretation-widgets
- '((:tag "Sequence (cycling hits every state)" sequence)
- (:tag "Type (cycling directly to DONE)" type))
- "The available interpretation symbols for customizing `org-todo-keywords'.
- Interested libraries should add to this list.")
- (defcustom org-todo-keywords '((sequence "TODO" "DONE"))
- "List of TODO entry keyword sequences and their interpretation.
- \\<org-mode-map>This is a list of sequences.
- Each sequence starts with a symbol, either `sequence' or `type',
- indicating if the keywords should be interpreted as a sequence of
- action steps, or as different types of TODO items. The first
- keywords are states requiring action - these states will select a headline
- for inclusion into the global TODO list Org produces. If one of the
- \"keywords\" is the vertical bar, \"|\", the remaining keywords
- signify that no further action is necessary. If \"|\" is not found,
- the last keyword is treated as the only DONE state of the sequence.
- The command `\\[org-todo]' cycles an entry through these states, and one
- additional state where no keyword is present. For details about this
- cycling, see the manual.
- TODO keywords and interpretation can also be set on a per-file basis with
- the special #+SEQ_TODO and #+TYP_TODO lines.
- Each keyword can optionally specify a character for fast state selection
- \(in combination with the variable `org-use-fast-todo-selection')
- and specifiers for state change logging, using the same syntax that
- is used in the \"#+TODO:\" lines. For example, \"WAIT(w)\" says that
- the WAIT state can be selected with the \"w\" key. \"WAIT(w!)\"
- indicates to record a time stamp each time this state is selected.
- Each keyword may also specify if a timestamp or a note should be
- recorded when entering or leaving the state, by adding additional
- characters in the parenthesis after the keyword. This looks like this:
- \"WAIT(w@/!)\". \"@\" means to add a note (with time), \"!\" means to
- record only the time of the state change. With X and Y being either
- \"@\" or \"!\", \"X/Y\" means use X when entering the state, and use
- Y when leaving the state if and only if the *target* state does not
- define X. You may omit any of the fast-selection key or X or /Y,
- so WAIT(w@), WAIT(w/@) and WAIT(@/@) are all valid.
- For backward compatibility, this variable may also be just a list
- of keywords. In this case the interpretation (sequence or type) will be
- taken from the (otherwise obsolete) variable `org-todo-interpretation'."
- :group 'org-todo
- :group 'org-keywords
- :type '(choice
- (repeat :tag "Old syntax, just keywords"
- (string :tag "Keyword"))
- (repeat :tag "New syntax"
- (cons
- (choice
- :tag "Interpretation"
- ;;Quick and dirty way to see
- ;;`org-todo-interpretations'. This takes the
- ;;place of item arguments
- :convert-widget
- (lambda (widget)
- (widget-put widget
- :args (mapcar
- (lambda (x)
- (widget-convert
- (cons 'const x)))
- org-todo-interpretation-widgets))
- widget))
- (repeat
- (string :tag "Keyword"))))))
- (defvar-local org-todo-keywords-1 nil
- "All TODO and DONE keywords active in a buffer.")
- (defvar org-todo-keywords-for-agenda nil)
- (defvar org-done-keywords-for-agenda nil)
- (defvar org-todo-keyword-alist-for-agenda nil)
- (defvar org-tag-alist-for-agenda nil
- "Alist of all tags from all agenda files.")
- (defvar org-tag-groups-alist-for-agenda nil
- "Alist of all groups tags from all current agenda files.")
- (defvar-local org-tag-groups-alist nil)
- (defvar org-agenda-contributing-files nil)
- (defvar-local org-current-tag-alist nil
- "Alist of all tag groups in current buffer.
- This variable takes into consideration `org-tag-alist',
- `org-tag-persistent-alist' and TAGS keywords in the buffer.")
- (defvar-local org-not-done-keywords nil)
- (defvar-local org-done-keywords nil)
- (defvar-local org-todo-heads nil)
- (defvar-local org-todo-sets nil)
- (defvar-local org-todo-log-states nil)
- (defvar-local org-todo-kwd-alist nil)
- (defvar-local org-todo-key-alist nil)
- (defvar-local org-todo-key-trigger nil)
- (defcustom org-todo-interpretation 'sequence
- "Controls how TODO keywords are interpreted.
- This variable is in principle obsolete and is only used for
- backward compatibility, if the interpretation of todo keywords is
- not given already in `org-todo-keywords'. See that variable for
- more information."
- :group 'org-todo
- :group 'org-keywords
- :type '(choice (const sequence)
- (const type)))
- (defcustom org-use-fast-todo-selection t
- "\\<org-mode-map>\
- Non-nil means use the fast todo selection scheme with `\\[org-todo]'.
- This variable describes if and under what circumstances the cycling
- mechanism for TODO keywords will be replaced by a single-key, direct
- selection scheme.
- When nil, fast selection is never used.
- When the symbol `prefix', it will be used when `org-todo' is called
- with a prefix argument, i.e. `\\[universal-argument] \\[org-todo]' \
- in an Org buffer, and
- `\\[universal-argument] t' in an agenda buffer.
- When t, fast selection is used by default. In this case, the prefix
- argument forces cycling instead.
- In all cases, the special interface is only used if access keys have
- actually been assigned by the user, i.e. if keywords in the configuration
- are followed by a letter in parenthesis, like TODO(t)."
- :group 'org-todo
- :type '(choice
- (const :tag "Never" nil)
- (const :tag "By default" t)
- (const :tag "Only with C-u C-c C-t" prefix)))
- (defcustom org-provide-todo-statistics t
- "Non-nil means update todo statistics after insert and toggle.
- ALL-HEADLINES means update todo statistics by including headlines
- with no TODO keyword as well, counting them as not done.
- A list of TODO keywords means the same, but skip keywords that are
- not in this list.
- When set to a list of two lists, the first list contains keywords
- to consider as TODO keywords, the second list contains keywords
- to consider as DONE keywords.
- When this is set, todo statistics is updated in the parent of the
- current entry each time a todo state is changed."
- :group 'org-todo
- :type '(choice
- (const :tag "Yes, only for TODO entries" t)
- (const :tag "Yes, including all entries" all-headlines)
- (repeat :tag "Yes, for TODOs in this list"
- (string :tag "TODO keyword"))
- (list :tag "Yes, for TODOs and DONEs in these lists"
- (repeat (string :tag "TODO keyword"))
- (repeat (string :tag "DONE keyword")))
- (other :tag "No TODO statistics" nil)))
- (defcustom org-hierarchical-todo-statistics t
- "Non-nil means TODO statistics covers just direct children.
- When nil, all entries in the subtree are considered.
- This has only an effect if `org-provide-todo-statistics' is set.
- To set this to nil for only a single subtree, use a COOKIE_DATA
- property and include the word \"recursive\" into the value."
- :group 'org-todo
- :type 'boolean)
- (defcustom org-after-todo-state-change-hook nil
- "Hook which is run after the state of a TODO item was changed.
- The new state (a string with a TODO keyword, or nil) is available in the
- Lisp variable `org-state'."
- :group 'org-todo
- :type 'hook)
- (defvar org-blocker-hook nil
- "Hook for functions that are allowed to block a state change.
- Functions in this hook should not modify the buffer.
- Each function gets as its single argument a property list,
- see `org-trigger-hook' for more information about this list.
- If any of the functions in this hook returns nil, the state change
- is blocked.")
- (defvar org-trigger-hook nil
- "Hook for functions that are triggered by a state change.
- Each function gets as its single argument a property list with at
- least the following elements:
- (:type type-of-change :position pos-at-entry-start
- :from old-state :to new-state)
- Depending on the type, more properties may be present.
- This mechanism is currently implemented for:
- TODO state changes
- ------------------
- :type todo-state-change
- :from previous state (keyword as a string), or nil, or a symbol
- `todo' or `done', to indicate the general type of state.
- :to new state, like in :from")
- (defcustom org-enforce-todo-dependencies nil
- "Non-nil means undone TODO entries will block switching the parent to DONE.
- Also, if a parent has an :ORDERED: property, switching an entry to DONE will
- be blocked if any prior sibling is not yet done.
- Finally, if the parent is blocked because of ordered siblings of its own,
- the child will also be blocked."
- :set (lambda (var val)
- (set var val)
- (if val
- (add-hook 'org-blocker-hook
- 'org-block-todo-from-children-or-siblings-or-parent)
- (remove-hook 'org-blocker-hook
- 'org-block-todo-from-children-or-siblings-or-parent)))
- :group 'org-todo
- :type 'boolean)
- (defcustom org-enforce-todo-checkbox-dependencies nil
- "Non-nil means unchecked boxes will block switching the parent to DONE.
- When this is nil, checkboxes have no influence on switching TODO states.
- When non-nil, you first need to check off all check boxes before the TODO
- entry can be switched to DONE.
- This variable needs to be set before org.el is loaded, and you need to
- restart Emacs after a change to make the change effective. The only way
- to change is while Emacs is running is through the customize interface."
- :set (lambda (var val)
- (set var val)
- (if val
- (add-hook 'org-blocker-hook
- 'org-block-todo-from-checkboxes)
- (remove-hook 'org-blocker-hook
- 'org-block-todo-from-checkboxes)))
- :group 'org-todo
- :type 'boolean)
- (defcustom org-treat-insert-todo-heading-as-state-change nil
- "Non-nil means inserting a TODO heading is treated as state change.
- So when the command `\\[org-insert-todo-heading]' is used, state change
- logging will apply if appropriate. When nil, the new TODO item will
- be inserted directly, and no logging will take place."
- :group 'org-todo
- :type 'boolean)
- (defcustom org-treat-S-cursor-todo-selection-as-state-change t
- "Non-nil means switching TODO states with S-cursor counts as state change.
- This is the default behavior. However, setting this to nil allows a
- convenient way to select a TODO state and bypass any logging associated
- with that."
- :group 'org-todo
- :type 'boolean)
- (defcustom org-todo-state-tags-triggers nil
- "Tag changes that should be triggered by TODO state changes.
- This is a list. Each entry is
- (state-change (tag . flag) .......)
- State-change can be a string with a state, and empty string to indicate the
- state that has no TODO keyword, or it can be one of the symbols `todo'
- or `done', meaning any not-done or done state, respectively."
- :group 'org-todo
- :group 'org-tags
- :type '(repeat
- (cons (choice :tag "When changing to"
- (const :tag "Not-done state" todo)
- (const :tag "Done state" done)
- (string :tag "State"))
- (repeat
- (cons :tag "Tag action"
- (string :tag "Tag")
- (choice (const :tag "Add" t) (const :tag "Remove" nil)))))))
- (defcustom org-log-done nil
- "Information to record when a task moves to the DONE state.
- Possible values are:
- nil Don't add anything, just change the keyword
- time Add a time stamp to the task
- note Prompt for a note and add it with template `org-log-note-headings'
- This option can also be set with on a per-file-basis with
- #+STARTUP: nologdone
- #+STARTUP: logdone
- #+STARTUP: lognotedone
- You can have local logging settings for a subtree by setting the LOGGING
- property to one or more of these keywords."
- :group 'org-todo
- :group 'org-progress
- :type '(choice
- (const :tag "No logging" nil)
- (const :tag "Record CLOSED timestamp" time)
- (const :tag "Record CLOSED timestamp with note." note)))
- ;; Normalize old uses of org-log-done.
- (cond
- ((eq org-log-done t) (setq org-log-done 'time))
- ((and (listp org-log-done) (memq 'done org-log-done))
- (setq org-log-done 'note)))
- (defcustom org-log-reschedule nil
- "Information to record when the scheduling date of a tasks is modified.
- Possible values are:
- nil Don't add anything, just change the date
- time Add a time stamp to the task
- note Prompt for a note and add it with template `org-log-note-headings'
- This option can also be set with on a per-file-basis with
- #+STARTUP: nologreschedule
- #+STARTUP: logreschedule
- #+STARTUP: lognotereschedule"
- :group 'org-todo
- :group 'org-progress
- :type '(choice
- (const :tag "No logging" nil)
- (const :tag "Record timestamp" time)
- (const :tag "Record timestamp with note." note)))
- (defcustom org-log-redeadline nil
- "Information to record when the deadline date of a tasks is modified.
- Possible values are:
- nil Don't add anything, just change the date
- time Add a time stamp to the task
- note Prompt for a note and add it with template `org-log-note-headings'
- This option can also be set with on a per-file-basis with
- #+STARTUP: nologredeadline
- #+STARTUP: logredeadline
- #+STARTUP: lognoteredeadline
- You can have local logging settings for a subtree by setting the LOGGING
- property to one or more of these keywords."
- :group 'org-todo
- :group 'org-progress
- :type '(choice
- (const :tag "No logging" nil)
- (const :tag "Record timestamp" time)
- (const :tag "Record timestamp with note." note)))
- (defcustom org-log-note-clock-out nil
- "Non-nil means record a note when clocking out of an item.
- This can also be configured on a per-file basis by adding one of
- the following lines anywhere in the buffer:
- #+STARTUP: lognoteclock-out
- #+STARTUP: nolognoteclock-out"
- :group 'org-todo
- :group 'org-progress
- :type 'boolean)
- (defcustom org-log-done-with-time t
- "Non-nil means the CLOSED time stamp will contain date and time.
- When nil, only the date will be recorded."
- :group 'org-progress
- :type 'boolean)
- (defcustom org-log-note-headings
- '((done . "CLOSING NOTE %t")
- (state . "State %-12s from %-12S %t")
- (note . "Note taken on %t")
- (reschedule . "Rescheduled from %S on %t")
- (delschedule . "Not scheduled, was %S on %t")
- (redeadline . "New deadline from %S on %t")
- (deldeadline . "Removed deadline, was %S on %t")
- (refile . "Refiled on %t")
- (clock-out . ""))
- "Headings for notes added to entries.
- The value is an alist, with the car being a symbol indicating the
- note context, and the cdr is the heading to be used. The heading
- may also be the empty string. The following placeholders can be
- used:
- %t a time stamp.
- %T an active time stamp instead the default inactive one
- %d a short-format time stamp.
- %D an active short-format time stamp.
- %s the new TODO state or time stamp (inactive), in double quotes.
- %S the old TODO state or time stamp (inactive), in double quotes.
- %u the user name.
- %U full user name.
- In fact, it is not a good idea to change the `state' entry,
- because Agenda Log mode depends on the format of these entries."
- :group 'org-todo
- :group 'org-progress
- :type '(list :greedy t
- (cons (const :tag "Heading when closing an item" done) string)
- (cons (const :tag
- "Heading when changing todo state (todo sequence only)"
- state) string)
- (cons (const :tag "Heading when just taking a note" note) string)
- (cons (const :tag "Heading when rescheduling" reschedule) string)
- (cons (const :tag "Heading when an item is no longer scheduled" delschedule) string)
- (cons (const :tag "Heading when changing deadline" redeadline) string)
- (cons (const :tag "Heading when deleting a deadline" deldeadline) string)
- (cons (const :tag "Heading when refiling" refile) string)
- (cons (const :tag "Heading when clocking out" clock-out) string)))
- (unless (assq 'note org-log-note-headings)
- (push '(note . "%t") org-log-note-headings))
- (defcustom org-log-into-drawer nil
- "Non-nil means insert state change notes and time stamps into a drawer.
- When nil, state changes notes will be inserted after the headline and
- any scheduling and clock lines, but not inside a drawer.
- The value of this variable should be the name of the drawer to use.
- LOGBOOK is proposed as the default drawer for this purpose, you can
- also set this to a string to define the drawer of your choice.
- A value of t is also allowed, representing \"LOGBOOK\".
- A value of t or nil can also be set with on a per-file-basis with
- #+STARTUP: logdrawer
- #+STARTUP: nologdrawer
- If this variable is set, `org-log-state-notes-insert-after-drawers'
- will be ignored.
- You can set the property LOG_INTO_DRAWER to overrule this setting for
- a subtree.
- Do not check directly this variable in a Lisp program. Call
- function `org-log-into-drawer' instead."
- :group 'org-todo
- :group 'org-progress
- :type '(choice
- (const :tag "Not into a drawer" nil)
- (const :tag "LOGBOOK" t)
- (string :tag "Other")))
- (defvaralias 'org-log-state-notes-into-drawer 'org-log-into-drawer)
- (defun org-log-into-drawer ()
- "Name of the log drawer, as a string, or nil.
- This is the value of `org-log-into-drawer'. However, if the
- current entry has or inherits a LOG_INTO_DRAWER property, it will
- be used instead of the default value."
- (let ((p (org-entry-get nil "LOG_INTO_DRAWER" 'inherit t)))
- (cond ((equal p "nil") nil)
- ((equal p "t") "LOGBOOK")
- ((stringp p) p)
- (p "LOGBOOK")
- ((stringp org-log-into-drawer) org-log-into-drawer)
- (org-log-into-drawer "LOGBOOK"))))
- (defcustom org-log-state-notes-insert-after-drawers nil
- "Non-nil means insert state change notes after any drawers in entry.
- Only the drawers that *immediately* follow the headline and the
- deadline/scheduled line are skipped.
- When nil, insert notes right after the heading and perhaps the line
- with deadline/scheduling if present.
- This variable will have no effect if `org-log-into-drawer' is
- set."
- :group 'org-todo
- :group 'org-progress
- :type 'boolean)
- (defcustom org-log-states-order-reversed t
- "Non-nil means the latest state note will be directly after heading.
- When nil, the state change notes will be ordered according to time.
- This option can also be set with on a per-file-basis with
- #+STARTUP: logstatesreversed
- #+STARTUP: nologstatesreversed"
- :group 'org-todo
- :group 'org-progress
- :type 'boolean)
- (defcustom org-todo-repeat-to-state nil
- "The TODO state to which a repeater should return the repeating task.
- By default this is the first task in a TODO sequence, or the previous state
- in a TODO_TYP set. But you can specify another task here.
- alternatively, set the :REPEAT_TO_STATE: property of the entry."
- :group 'org-todo
- :version "24.1"
- :type '(choice (const :tag "Head of sequence" nil)
- (string :tag "Specific state")))
- (defcustom org-log-repeat 'time
- "Non-nil means record moving through the DONE state when triggering repeat.
- An auto-repeating task is immediately switched back to TODO when
- marked DONE. If you are not logging state changes (by adding \"@\"
- or \"!\" to the TODO keyword definition), or set `org-log-done' to
- record a closing note, there will be no record of the task moving
- through DONE. This variable forces taking a note anyway.
- nil Don't force a record
- time Record a time stamp
- note Prompt for a note and add it with template `org-log-note-headings'
- This option can also be set with on a per-file-basis with
- #+STARTUP: nologrepeat
- #+STARTUP: logrepeat
- #+STARTUP: lognoterepeat
- You can have local logging settings for a subtree by setting the LOGGING
- property to one or more of these keywords."
- :group 'org-todo
- :group 'org-progress
- :type '(choice
- (const :tag "Don't force a record" nil)
- (const :tag "Force recording the DONE state" time)
- (const :tag "Force recording a note with the DONE state" note)))
- (defgroup org-priorities nil
- "Priorities in Org mode."
- :tag "Org Priorities"
- :group 'org-todo)
- (defcustom org-enable-priority-commands t
- "Non-nil means priority commands are active.
- When nil, these commands will be disabled, so that you never accidentally
- set a priority."
- :group 'org-priorities
- :type 'boolean)
- (defcustom org-highest-priority ?A
- "The highest priority of TODO items. A character like ?A, ?B etc.
- Must have a smaller ASCII number than `org-lowest-priority'."
- :group 'org-priorities
- :type 'character)
- (defcustom org-lowest-priority ?C
- "The lowest priority of TODO items. A character like ?A, ?B etc.
- Must have a larger ASCII number than `org-highest-priority'."
- :group 'org-priorities
- :type 'character)
- (defcustom org-default-priority ?B
- "The default priority of TODO items.
- This is the priority an item gets if no explicit priority is given.
- When starting to cycle on an empty priority the first step in the cycle
- depends on `org-priority-start-cycle-with-default'. The resulting first
- step priority must not exceed the range from `org-highest-priority' to
- `org-lowest-priority' which means that `org-default-priority' has to be
- in this range exclusive or inclusive the range boundaries. Else the
- first step refuses to set the default and the second will fall back
- to (depending on the command used) the highest or lowest priority."
- :group 'org-priorities
- :type 'character)
- (defcustom org-priority-start-cycle-with-default t
- "Non-nil means start with default priority when starting to cycle.
- When this is nil, the first step in the cycle will be (depending on the
- command used) one higher or lower than the default priority.
- See also `org-default-priority'."
- :group 'org-priorities
- :type 'boolean)
- (defcustom org-get-priority-function nil
- "Function to extract the priority from a string.
- The string is normally the headline. If this is nil Org computes the
- priority from the priority cookie like [#A] in the headline. It returns
- an integer, increasing by 1000 for each priority level.
- The user can set a different function here, which should take a string
- as an argument and return the numeric priority."
- :group 'org-priorities
- :version "24.1"
- :type '(choice
- (const nil)
- (function)))
- (defgroup org-time nil
- "Options concerning time stamps and deadlines in Org mode."
- :tag "Org Time"
- :group 'org)
- (defcustom org-time-stamp-rounding-minutes '(0 5)
- "Number of minutes to round time stamps to.
- \\<org-mode-map>\
- These are two values, the first applies when first creating a time stamp.
- The second applies when changing it with the commands `S-up' and `S-down'.
- When changing the time stamp, this means that it will change in steps
- of N minutes, as given by the second value.
- When a setting is 0 or 1, insert the time unmodified. Useful rounding
- numbers should be factors of 60, so for example 5, 10, 15.
- When this is larger than 1, you can still force an exact time stamp by using
- a double prefix argument to a time stamp command like \
- `\\[org-time-stamp]' or `\\[org-time-stamp-inactive],
- and by using a prefix arg to `S-up/down' to specify the exact number
- of minutes to shift."
- :group 'org-time
- :get (lambda (var) ; Make sure both elements are there
- (if (integerp (default-value var))
- (list (default-value var) 5)
- (default-value var)))
- :type '(list
- (integer :tag "when inserting times")
- (integer :tag "when modifying times")))
- ;; Normalize old customizations of this variable.
- (when (integerp org-time-stamp-rounding-minutes)
- (setq org-time-stamp-rounding-minutes
- (list org-time-stamp-rounding-minutes
- org-time-stamp-rounding-minutes)))
- (defcustom org-display-custom-times nil
- "Non-nil means overlay custom formats over all time stamps.
- The formats are defined through the variable `org-time-stamp-custom-formats'.
- To turn this on on a per-file basis, insert anywhere in the file:
- #+STARTUP: customtime"
- :group 'org-time
- :set 'set-default
- :type 'sexp)
- (make-variable-buffer-local 'org-display-custom-times)
- (defcustom org-time-stamp-custom-formats
- '("<%m/%d/%y %a>" . "<%m/%d/%y %a %H:%M>") ; american
- "Custom formats for time stamps. See `format-time-string' for the syntax.
- These are overlaid over the default ISO format if the variable
- `org-display-custom-times' is set. Time like %H:%M should be at the
- end of the second format. The custom formats are also honored by export
- commands, if custom time display is turned on at the time of export."
- :group 'org-time
- :type 'sexp)
- (defun org-time-stamp-format (&optional long inactive)
- "Get the right format for a time string."
- (let ((f (if long (cdr org-time-stamp-formats)
- (car org-time-stamp-formats))))
- (if inactive
- (concat "[" (substring f 1 -1) "]")
- f)))
- (defcustom org-time-clocksum-format
- '(:days "%dd " :hours "%d" :require-hours t :minutes ":%02d" :require-minutes t)
- "The format string used when creating CLOCKSUM lines.
- This is also used when Org mode generates a time duration.
- The value can be a single format string containing two
- %-sequences, which will be filled with the number of hours and
- minutes in that order.
- Alternatively, the value can be a plist associating any of the
- keys :years, :months, :weeks, :days, :hours or :minutes with
- format strings. The time duration is formatted using only the
- time components that are needed and concatenating the results.
- If a time unit in absent, it falls back to the next smallest
- unit.
- The keys :require-years, :require-months, :require-days,
- :require-weeks, :require-hours, :require-minutes are also
- meaningful. A non-nil value for these keys indicates that the
- corresponding time component should always be included, even if
- its value is 0.
- For example,
- (:days \"%dd\" :hours \"%d\" :require-hours t :minutes \":%02d\"
- :require-minutes t)
- means durations longer than a day will be expressed in days,
- hours and minutes, and durations less than a day will always be
- expressed in hours and minutes (even for durations less than an
- hour).
- The value
- (:days \"%dd\" :minutes \"%dm\")
- means durations longer than a day will be expressed in days and
- minutes, and durations less than a day will be expressed entirely
- in minutes (even for durations longer than an hour)."
- :group 'org-time
- :group 'org-clock
- :version "24.4"
- :package-version '(Org . "8.0")
- :type '(choice (string :tag "Format string")
- (set :tag "Plist"
- (group :inline t (const :tag "Years" :years)
- (string :tag "Format string"))
- (group :inline t
- (const :tag "Always show years" :require-years)
- (const t))
- (group :inline t (const :tag "Months" :months)
- (string :tag "Format string"))
- (group :inline t
- (const :tag "Always show months" :require-months)
- (const t))
- (group :inline t (const :tag "Weeks" :weeks)
- (string :tag "Format string"))
- (group :inline t
- (const :tag "Always show weeks" :require-weeks)
- (const t))
- (group :inline t (const :tag "Days" :days)
- (string :tag "Format string"))
- (group :inline t
- (const :tag "Always show days" :require-days)
- (const t))
- (group :inline t (const :tag "Hours" :hours)
- (string :tag "Format string"))
- (group :inline t
- (const :tag "Always show hours" :require-hours)
- (const t))
- (group :inline t (const :tag "Minutes" :minutes)
- (string :tag "Format string"))
- (group :inline t
- (const :tag "Always show minutes" :require-minutes)
- (const t)))))
- (defcustom org-time-clocksum-use-fractional nil
- "When non-nil, `\\[org-clock-display]' uses fractional times.
- See `org-time-clocksum-format' for more on time clock formats."
- :group 'org-time
- :group 'org-clock
- :version "24.3"
- :type 'boolean)
- (defcustom org-time-clocksum-use-effort-durations nil
- "When non-nil, `\\[org-clock-display]' uses effort durations.
- E.g. by default, one day is considered to be a 8 hours effort,
- so a task that has been clocked for 16 hours will be displayed
- as during 2 days in the clock display or in the clocktable.
- See `org-effort-durations' on how to set effort durations
- and `org-time-clocksum-format' for more on time clock formats."
- :group 'org-time
- :group 'org-clock
- :version "24.4"
- :package-version '(Org . "8.0")
- :type 'boolean)
- (defcustom org-time-clocksum-fractional-format "%.2f"
- "The format string used when creating CLOCKSUM lines,
- or when Org mode generates a time duration, if
- `org-time-clocksum-use-fractional' is enabled.
- The value can be a single format string containing one
- %-sequence, which will be filled with the number of hours as
- a float.
- Alternatively, the value can be a plist associating any of the
- keys :years, :months, :weeks, :days, :hours or :minutes with
- a format string. The time duration is formatted using the
- largest time unit which gives a non-zero integer part. If all
- specified formats have zero integer part, the smallest time unit
- is used."
- :group 'org-time
- :type '(choice (string :tag "Format string")
- (set (group :inline t (const :tag "Years" :years)
- (string :tag "Format string"))
- (group :inline t (const :tag "Months" :months)
- (string :tag "Format string"))
- (group :inline t (const :tag "Weeks" :weeks)
- (string :tag "Format string"))
- (group :inline t (const :tag "Days" :days)
- (string :tag "Format string"))
- (group :inline t (const :tag "Hours" :hours)
- (string :tag "Format string"))
- (group :inline t (const :tag "Minutes" :minutes)
- (string :tag "Format string")))))
- (defcustom org-deadline-warning-days 14
- "Number of days before expiration during which a deadline becomes active.
- This variable governs the display in sparse trees and in the agenda.
- When 0 or negative, it means use this number (the absolute value of it)
- even if a deadline has a different individual lead time specified.
- Custom commands can set this variable in the options section."
- :group 'org-time
- :group 'org-agenda-daily/weekly
- :type 'integer)
- (defcustom org-scheduled-delay-days 0
- "Number of days before a scheduled item becomes active.
- This variable governs the display in sparse trees and in the agenda.
- The default value (i.e. 0) means: don't delay scheduled item.
- When negative, it means use this number (the absolute value of it)
- even if a scheduled item has a different individual delay time
- specified.
- Custom commands can set this variable in the options section."
- :group 'org-time
- :group 'org-agenda-daily/weekly
- :version "24.4"
- :package-version '(Org . "8.0")
- :type 'integer)
- (defcustom org-read-date-prefer-future t
- "Non-nil means assume future for incomplete date input from user.
- This affects the following situations:
- 1. The user gives a month but not a year.
- For example, if it is April and you enter \"feb 2\", this will be read
- as Feb 2, *next* year. \"May 5\", however, will be this year.
- 2. The user gives a day, but no month.
- For example, if today is the 15th, and you enter \"3\", Org will read
- this as the third of *next* month. However, if you enter \"17\",
- it will be considered as *this* month.
- If you set this variable to the symbol `time', then also the following
- will work:
- 3. If the user gives a time.
- If the time is before now, it will be interpreted as tomorrow.
- Currently none of this works for ISO week specifications.
- When this option is nil, the current day, month and year will always be
- used as defaults.
- See also `org-agenda-jump-prefer-future'."
- :group 'org-time
- :type '(choice
- (const :tag "Never" nil)
- (const :tag "Check month and day" t)
- (const :tag "Check month, day, and time" time)))
- (defcustom org-agenda-jump-prefer-future 'org-read-date-prefer-future
- "Should the agenda jump command prefer the future for incomplete dates?
- The default is to do the same as configured in `org-read-date-prefer-future'.
- But you can also set a deviating value here.
- This may t or nil, or the symbol `org-read-date-prefer-future'."
- :group 'org-agenda
- :group 'org-time
- :version "24.1"
- :type '(choice
- (const :tag "Use org-read-date-prefer-future"
- org-read-date-prefer-future)
- (const :tag "Never" nil)
- (const :tag "Always" t)))
- (defcustom org-read-date-force-compatible-dates t
- "Should date/time prompt force dates that are guaranteed to work in Emacs?
- Depending on the system Emacs is running on, certain dates cannot
- be represented with the type used internally to represent time.
- Dates between 1970-1-1 and 2038-1-1 can always be represented
- correctly. Some systems allow for earlier dates, some for later,
- some for both. One way to find out it to insert any date into an
- Org buffer, putting the cursor on the year and hitting S-up and
- S-down to test the range.
- When this variable is set to t, the date/time prompt will not let
- you specify dates outside the 1970-2037 range, so it is certain that
- these dates will work in whatever version of Emacs you are
- running, and also that you can move a file from one Emacs implementation
- to another. WHenever Org is forcing the year for you, it will display
- a message and beep.
- When this variable is nil, Org will check if the date is
- representable in the specific Emacs implementation you are using.
- If not, it will force a year, usually the current year, and beep
- to remind you. Currently this setting is not recommended because
- the likelihood that you will open your Org files in an Emacs that
- has limited date range is not negligible.
- A workaround for this problem is to use diary sexp dates for time
- stamps outside of this range."
- :group 'org-time
- :version "24.1"
- :type 'boolean)
- (defcustom org-read-date-display-live t
- "Non-nil means display current interpretation of date prompt live.
- This display will be in an overlay, in the minibuffer."
- :group 'org-time
- :type 'boolean)
- (defcustom org-read-date-popup-calendar t
- "Non-nil means pop up a calendar when prompting for a date.
- In the calendar, the date can be selected with mouse-1. However, the
- minibuffer will also be active, and you can simply enter the date as well.
- When nil, only the minibuffer will be available."
- :group 'org-time
- :type 'boolean)
- (defvaralias 'org-popup-calendar-for-date-prompt
- 'org-read-date-popup-calendar)
- (defcustom org-extend-today-until 0
- "The hour when your day really ends. Must be an integer.
- This has influence for the following applications:
- - When switching the agenda to \"today\". It it is still earlier than
- the time given here, the day recognized as TODAY is actually yesterday.
- - When a date is read from the user and it is still before the time given
- here, the current date and time will be assumed to be yesterday, 23:59.
- Also, timestamps inserted in capture templates follow this rule.
- IMPORTANT: This is a feature whose implementation is and likely will
- remain incomplete. Really, it is only here because past midnight seems to
- be the favorite working time of John Wiegley :-)"
- :group 'org-time
- :type 'integer)
- (defcustom org-use-effective-time nil
- "If non-nil, consider `org-extend-today-until' when creating timestamps.
- For example, if `org-extend-today-until' is 8, and it's 4am, then the
- \"effective time\" of any timestamps between midnight and 8am will be
- 23:59 of the previous day."
- :group 'org-time
- :version "24.1"
- :type 'boolean)
- (defcustom org-use-last-clock-out-time-as-effective-time nil
- "When non-nil, use the last clock out time for `org-todo'.
- Note that this option has precedence over the combined use of
- `org-use-effective-time' and `org-extend-today-until'."
- :group 'org-time
- :version "24.4"
- :package-version '(Org . "8.0")
- :type 'boolean)
- (defcustom org-edit-timestamp-down-means-later nil
- "Non-nil means S-down will increase the time in a time stamp.
- When nil, S-up will increase."
- :group 'org-time
- :type 'boolean)
- (defcustom org-calendar-follow-timestamp-change t
- "Non-nil means make the calendar window follow timestamp changes.
- When a timestamp is modified and the calendar window is visible, it will be
- moved to the new date."
- :group 'org-time
- :type 'boolean)
- (defgroup org-tags nil
- "Options concerning tags in Org mode."
- :tag "Org Tags"
- :group 'org)
- (defcustom org-tag-alist nil
- "Default tags available in Org files.
- The value of this variable is an alist. Associations either:
- (TAG)
- (TAG . SELECT)
- (SPECIAL)
- where TAG is a tag as a string, SELECT is character, used to
- select that tag through the fast tag selection interface, and
- SPECIAL is one of the following keywords: `:startgroup',
- `:startgrouptag', `:grouptags', `:engroup', `:endgrouptag' or
- `:newline'. These keywords are used to define a hierarchy of
- tags. See manual for details.
- When this variable is nil, Org mode bases tag input on what is
- already in the buffer. The value can be overridden locally by
- using a TAGS keyword, e.g.,
- #+TAGS: tag1 tag2
- See also `org-tag-persistent-alist' to sidestep this behavior."
- :group 'org-tags
- :type '(repeat
- (choice
- (cons (string :tag "Tag name")
- (character :tag "Access char"))
- (const :tag "Start radio group" (:startgroup))
- (const :tag "Start tag group, non distinct" (:startgrouptag))
- (const :tag "Group tags delimiter" (:grouptags))
- (const :tag "End radio group" (:endgroup))
- (const :tag "End tag group, non distinct" (:endgrouptag))
- (const :tag "New line" (:newline)))))
- (defcustom org-tag-persistent-alist nil
- "Tags always available in Org files.
- The value of this variable is an alist. Associations either:
- (TAG)
- (TAG . SELECT)
- (SPECIAL)
- where TAG is a tag as a string, SELECT is a character, used to
- select that tag through the fast tag selection interface, and
- SPECIAL is one of the following keywords: `:startgroup',
- `:startgrouptag', `:grouptags', `:engroup', `:endgrouptag' or
- `:newline'. These keywords are used to define a hierarchy of
- tags. See manual for details.
- Unlike to `org-tag-alist', tags defined in this variable do not
- depend on a local TAGS keyword. Instead, to disable these tags
- on a per-file basis, insert anywhere in the file:
- #+STARTUP: noptag"
- :group 'org-tags
- :type '(repeat
- (choice
- (cons (string :tag "Tag name")
- (character :tag "Access char"))
- (const :tag "Start radio group" (:startgroup))
- (const :tag "Start tag group, non distinct" (:startgrouptag))
- (const :tag "Group tags delimiter" (:grouptags))
- (const :tag "End radio group" (:endgroup))
- (const :tag "End tag group, non distinct" (:endgrouptag))
- (const :tag "New line" (:newline)))))
- (defcustom org-complete-tags-always-offer-all-agenda-tags nil
- "If non-nil, always offer completion for all tags of all agenda files.
- Instead of customizing this variable directly, you might want to
- set it locally for capture buffers, because there no list of
- tags in that file can be created dynamically (there are none).
- (add-hook \\='org-capture-mode-hook
- (lambda ()
- (setq-local org-complete-tags-always-offer-all-agenda-tags t)))"
- :group 'org-tags
- :version "24.1"
- :type 'boolean)
- (defvar org-file-tags nil
- "List of tags that can be inherited by all entries in the file.
- The tags will be inherited if the variable `org-use-tag-inheritance'
- says they should be.
- This variable is populated from #+FILETAGS lines.")
- (defcustom org-use-fast-tag-selection 'auto
- "Non-nil means use fast tag selection scheme.
- This is a special interface to select and deselect tags with single keys.
- When nil, fast selection is never used.
- When the symbol `auto', fast selection is used if and only if selection
- characters for tags have been configured, either through the variable
- `org-tag-alist' or through a #+TAGS line in the buffer.
- When t, fast selection is always used and selection keys are assigned
- automatically if necessary."
- :group 'org-tags
- :type '(choice
- (const :tag "Always" t)
- (const :tag "Never" nil)
- (const :tag "When selection characters are configured" auto)))
- (defcustom org-fast-tag-selection-single-key nil
- "Non-nil means fast tag selection exits after first change.
- When nil, you have to press RET to exit it.
- During fast tag selection, you can toggle this flag with `C-c'.
- This variable can also have the value `expert'. In this case, the window
- displaying the tags menu is not even shown, until you press C-c again."
- :group 'org-tags
- :type '(choice
- (const :tag "No" nil)
- (const :tag "Yes" t)
- (const :tag "Expert" expert)))
- (defvar org-fast-tag-selection-include-todo nil
- "Non-nil means fast tags selection interface will also offer TODO states.
- This is an undocumented feature, you should not rely on it.")
- (defcustom org-tags-column -77
- "The column to which tags should be indented in a headline.
- If this number is positive, it specifies the column. If it is negative,
- it means that the tags should be flushright to that column. For example,
- -80 works well for a normal 80 character screen.
- When 0, place tags directly after headline text, with only one space in
- between."
- :group 'org-tags
- :type 'integer)
- (defcustom org-auto-align-tags t
- "Non-nil keeps tags aligned when modifying headlines.
- Some operations (i.e. demoting) change the length of a headline and
- therefore shift the tags around. With this option turned on, after
- each such operation the tags are again aligned to `org-tags-column'."
- :group 'org-tags
- :type 'boolean)
- (defcustom org-use-tag-inheritance t
- "Non-nil means tags in levels apply also for sublevels.
- When nil, only the tags directly given in a specific line apply there.
- This may also be a list of tags that should be inherited, or a regexp that
- matches tags that should be inherited. Additional control is possible
- with the variable `org-tags-exclude-from-inheritance' which gives an
- explicit list of tags to be excluded from inheritance, even if the value of
- `org-use-tag-inheritance' would select it for inheritance.
- If this option is t, a match early-on in a tree can lead to a large
- number of matches in the subtree when constructing the agenda or creating
- a sparse tree. If you only want to see the first match in a tree during
- a search, check out the variable `org-tags-match-list-sublevels'."
- :group 'org-tags
- :type '(choice
- (const :tag "Not" nil)
- (const :tag "Always" t)
- (repeat :tag "Specific tags" (string :tag "Tag"))
- (regexp :tag "Tags matched by regexp")))
- (defcustom org-tags-exclude-from-inheritance nil
- "List of tags that should never be inherited.
- This is a way to exclude a few tags from inheritance. For way to do
- the opposite, to actively allow inheritance for selected tags,
- see the variable `org-use-tag-inheritance'."
- :group 'org-tags
- :type '(repeat (string :tag "Tag")))
- (defun org-tag-inherit-p (tag)
- "Check if TAG is one that should be inherited."
- (cond
- ((member tag org-tags-exclude-from-inheritance) nil)
- ((eq org-use-tag-inheritance t) t)
- ((not org-use-tag-inheritance) nil)
- ((stringp org-use-tag-inheritance)
- (string-match org-use-tag-inheritance tag))
- ((listp org-use-tag-inheritance)
- (member tag org-use-tag-inheritance))
- (t (error "Invalid setting of `org-use-tag-inheritance'"))))
- (defcustom org-tags-match-list-sublevels t
- "Non-nil means list also sublevels of headlines matching a search.
- This variable applies to tags/property searches, and also to stuck
- projects because this search is based on a tags match as well.
- When set to the symbol `indented', sublevels are indented with
- leading dots.
- Because of tag inheritance (see variable `org-use-tag-inheritance'),
- the sublevels of a headline matching a tag search often also match
- the same search. Listing all of them can create very long lists.
- Setting this variable to nil causes subtrees of a match to be skipped.
- This variable is semi-obsolete and probably should always be true. It
- is better to limit inheritance to certain tags using the variables
- `org-use-tag-inheritance' and `org-tags-exclude-from-inheritance'."
- :group 'org-tags
- :type '(choice
- (const :tag "No, don't list them" nil)
- (const :tag "Yes, do list them" t)
- (const :tag "List them, indented with leading dots" indented)))
- (defcustom org-tags-sort-function nil
- "When set, tags are sorted using this function as a comparator."
- :group 'org-tags
- :type '(choice
- (const :tag "No sorting" nil)
- (const :tag "Alphabetical" string<)
- (const :tag "Reverse alphabetical" string>)
- (function :tag "Custom function" nil)))
- (defvar org-tags-history nil
- "History of minibuffer reads for tags.")
- (defvar org-last-tags-completion-table nil
- "The last used completion table for tags.")
- (defvar org-after-tags-change-hook nil
- "Hook that is run after the tags in a line have changed.")
- (defgroup org-properties nil
- "Options concerning properties in Org mode."
- :tag "Org Properties"
- :group 'org)
- (defcustom org-property-format "%-10s %s"
- "How property key/value pairs should be formatted by `indent-line'.
- When `indent-line' hits a property definition, it will format the line
- according to this format, mainly to make sure that the values are
- lined-up with respect to each other."
- :group 'org-properties
- :type 'string)
- (defcustom org-properties-postprocess-alist nil
- "Alist of properties and functions to adjust inserted values.
- Elements of this alist must be of the form
- ([string] [function])
- where [string] must be a property name and [function] must be a
- lambda expression: this lambda expression must take one argument,
- the value to adjust, and return the new value as a string.
- For example, this element will allow the property \"Remaining\"
- to be updated wrt the relation between the \"Effort\" property
- and the clock summary:
- ((\"Remaining\" (lambda(value)
- (let ((clocksum (org-clock-sum-current-item))
- (effort (org-duration-string-to-minutes
- (org-entry-get (point) \"Effort\"))))
- (org-minutes-to-clocksum-string (- effort clocksum))))))"
- :group 'org-properties
- :version "24.1"
- :type '(alist :key-type (string :tag "Property")
- :value-type (function :tag "Function")))
- (defcustom org-use-property-inheritance nil
- "Non-nil means properties apply also for sublevels.
- This setting is chiefly used during property searches. Turning it on can
- cause significant overhead when doing a search, which is why it is not
- on by default.
- When nil, only the properties directly given in the current entry count.
- When t, every property is inherited. The value may also be a list of
- properties that should have inheritance, or a regular expression matching
- properties that should be inherited.
- However, note that some special properties use inheritance under special
- circumstances (not in searches). Examples are CATEGORY, ARCHIVE, COLUMNS,
- and the properties ending in \"_ALL\" when they are used as descriptor
- for valid values of a property.
- Note for programmers:
- When querying an entry with `org-entry-get', you can control if inheritance
- should be used. By default, `org-entry-get' looks only at the local
- properties. You can request inheritance by setting the inherit argument
- to t (to force inheritance) or to `selective' (to respect the setting
- in this variable)."
- :group 'org-properties
- :type '(choice
- (const :tag "Not" nil)
- (const :tag "Always" t)
- (repeat :tag "Specific properties" (string :tag "Property"))
- (regexp :tag "Properties matched by regexp")))
- (defun org-property-inherit-p (property)
- "Return a non-nil value if PROPERTY should be inherited."
- (cond
- ((eq org-use-property-inheritance t) t)
- ((not org-use-property-inheritance) nil)
- ((stringp org-use-property-inheritance)
- (string-match org-use-property-inheritance property))
- ((listp org-use-property-inheritance)
- (member-ignore-case property org-use-property-inheritance))
- (t (error "Invalid setting of `org-use-property-inheritance'"))))
- (defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS"
- "The default column format, if no other format has been defined.
- This variable can be set on the per-file basis by inserting a line
- #+COLUMNS: %25ITEM ....."
- :group 'org-properties
- :type 'string)
- (defcustom org-columns-ellipses ".."
- "The ellipses to be used when a field in column view is truncated.
- When this is the empty string, as many characters as possible are shown,
- but then there will be no visual indication that the field has been truncated.
- When this is a string of length N, the last N characters of a truncated
- field are replaced by this string. If the column is narrower than the
- ellipses string, only part of the ellipses string will be shown."
- :group 'org-properties
- :type 'string)
- (defconst org-global-properties-fixed
- '(("VISIBILITY_ALL" . "folded children content all")
- ("CLOCK_MODELINE_TOTAL_ALL" . "current today repeat all auto"))
- "List of property/value pairs that can be inherited by any entry.
- These are fixed values, for the preset properties. The user variable
- that can be used to add to this list is `org-global-properties'.
- The entries in this list are cons cells where the car is a property
- name and cdr is a string with the value. If the value represents
- multiple items like an \"_ALL\" property, separate the items by
- spaces.")
- (defcustom org-global-properties nil
- "List of property/value pairs that can be inherited by any entry.
- This list will be combined with the constant `org-global-properties-fixed'.
- The entries in this list are cons cells where the car is a property
- name and cdr is a string with the value.
- You can set buffer-local values for the same purpose in the variable
- `org-file-properties' this by adding lines like
- #+PROPERTY: NAME VALUE"
- :group 'org-properties
- :type '(repeat
- (cons (string :tag "Property")
- (string :tag "Value"))))
- (defvar-local org-file-properties nil
- "List of property/value pairs that can be inherited by any entry.
- Valid for the current buffer.
- This variable is populated from #+PROPERTY lines.")
- (defgroup org-agenda nil
- "Options concerning agenda views in Org mode."
- :tag "Org Agenda"
- :group 'org)
- (defvar-local org-category nil
- "Variable used by org files to set a category for agenda display.
- Such files should use a file variable to set it, for example
- # -*- mode: org; org-category: \"ELisp\"
- or contain a special line
- #+CATEGORY: ELisp
- If the file does not specify a category, then file's base name
- is used instead.")
- (put 'org-category 'safe-local-variable (lambda (x) (or (symbolp x) (stringp x))))
- (defcustom org-agenda-files nil
- "The files to be used for agenda display.
- If an entry is a directory, all files in that directory that are matched
- by `org-agenda-file-regexp' will be part of the file list.
- If the value of the variable is not a list but a single file name, then
- the list of agenda files is actually stored and maintained in that file,
- one agenda file per line. In this file paths can be given relative to
- `org-directory'. Tilde expansion and environment variable substitution
- are also made.
- Entries may be added to this list with `\\[org-agenda-file-to-front]'
- and removed with `\\[org-remove-file]'."
- :group 'org-agenda
- :type '(choice
- (repeat :tag "List of files and directories" file)
- (file :tag "Store list in a file\n" :value "~/.agenda_files")))
- (defcustom org-agenda-file-regexp "\\`[^.].*\\.org\\'"
- "Regular expression to match files for `org-agenda-files'.
- If any element in the list in that variable contains a directory instead
- of a normal file, all files in that directory that are matched by this
- regular expression will be included."
- :group 'org-agenda
- :type 'regexp)
- (defcustom org-agenda-text-search-extra-files nil
- "List of extra files to be searched by text search commands.
- These files will be searched in addition to the agenda files by the
- commands `org-search-view' (`\\[org-agenda] s') \
- and `org-occur-in-agenda-files'.
- Note that these files will only be searched for text search commands,
- not for the other agenda views like todo lists, tag searches or the weekly
- agenda. This variable is intended to list notes and possibly archive files
- that should also be searched by these two commands.
- In fact, if the first element in the list is the symbol `agenda-archives',
- then all archive files of all agenda files will be added to the search
- scope."
- :group 'org-agenda
- :type '(set :greedy t
- (const :tag "Agenda Archives" agenda-archives)
- (repeat :inline t (file))))
- (defvaralias 'org-agenda-multi-occur-extra-files
- 'org-agenda-text-search-extra-files)
- (defcustom org-agenda-skip-unavailable-files nil
- "Non-nil means to just skip non-reachable files in `org-agenda-files'.
- A nil value means to remove them, after a query, from the list."
- :group 'org-agenda
- :type 'boolean)
- (defcustom org-calendar-to-agenda-key [?c]
- "The key to be installed in `calendar-mode-map' for switching to the agenda.
- The command `org-calendar-goto-agenda' will be bound to this key. The
- default is the character `c' because then `c' can be used to switch back and
- forth between agenda and calendar."
- :group 'org-agenda
- :type 'sexp)
- (defcustom org-calendar-insert-diary-entry-key [?i]
- "The key to be installed in `calendar-mode-map' for adding diary entries.
- This option is irrelevant until `org-agenda-diary-file' has been configured
- to point to an Org file. When that is the case, the command
- `org-agenda-diary-entry' will be bound to the key given here, by default
- `i'. In the calendar, `i' normally adds entries to `diary-file'. So
- if you want to continue doing this, you need to change this to a different
- key."
- :group 'org-agenda
- :type 'sexp)
- (defcustom org-agenda-diary-file 'diary-file
- "File to which to add new entries with the `i' key in agenda and calendar.
- When this is the symbol `diary-file', the functionality in the Emacs
- calendar will be used to add entries to the `diary-file'. But when this
- points to a file, `org-agenda-diary-entry' will be used instead."
- :group 'org-agenda
- :type '(choice
- (const :tag "The standard Emacs diary file" diary-file)
- (file :tag "Special Org file diary entries")))
- (eval-after-load "calendar"
- '(progn
- (org-defkey calendar-mode-map org-calendar-to-agenda-key
- 'org-calendar-goto-agenda)
- (add-hook 'calendar-mode-hook
- (lambda ()
- (unless (eq org-agenda-diary-file 'diary-file)
- (define-key calendar-mode-map
- org-calendar-insert-diary-entry-key
- 'org-agenda-diary-entry))))))
- (defgroup org-latex nil
- "Options for embedding LaTeX code into Org mode."
- :tag "Org LaTeX"
- :group 'org)
- (defcustom org-format-latex-options
- '(:foreground default :background default :scale 1.0
- :html-foreground "Black" :html-background "Transparent"
- :html-scale 1.0 :matchers ("begin" "$1" "$" "$$" "\\(" "\\["))
- "Options for creating images from LaTeX fragments.
- This is a property list with the following properties:
- :foreground the foreground color for images embedded in Emacs, e.g. \"Black\".
- `default' means use the foreground of the default face.
- `auto' means use the foreground from the text face.
- :background the background color, or \"Transparent\".
- `default' means use the background of the default face.
- `auto' means use the background from the text face.
- :scale a scaling factor for the size of the images, to get more pixels
- :html-foreground, :html-background, :html-scale
- the same numbers for HTML export.
- :matchers a list indicating which matchers should be used to
- find LaTeX fragments. Valid members of this list are:
- \"begin\" find environments
- \"$1\" find single characters surrounded by $.$
- \"$\" find math expressions surrounded by $...$
- \"$$\" find math expressions surrounded by $$....$$
- \"\\(\" find math expressions surrounded by \\(...\\)
- \"\\=\\[\" find math expressions surrounded by \\=\\[...\\]"
- :group 'org-latex
- :type 'plist)
- (defcustom org-format-latex-signal-error t
- "Non-nil means signal an error when image creation of LaTeX snippets fails.
- When nil, just push out a message."
- :group 'org-latex
- :version "24.1"
- :type 'boolean)
- (defcustom org-latex-to-mathml-jar-file nil
- "Value of\"%j\" in `org-latex-to-mathml-convert-command'.
- Use this to specify additional executable file say a jar file.
- When using MathToWeb as the converter, specify the full-path to
- your mathtoweb.jar file."
- :group 'org-latex
- :version "24.1"
- :type '(choice
- (const :tag "None" nil)
- (file :tag "JAR file" :must-match t)))
- (defcustom org-latex-to-mathml-convert-command nil
- "Command to convert LaTeX fragments to MathML.
- Replace format-specifiers in the command as noted below and use
- `shell-command' to convert LaTeX to MathML.
- %j: Executable file in fully expanded form as specified by
- `org-latex-to-mathml-jar-file'.
- %I: Input LaTeX file in fully expanded form.
- %i: The latex fragment to be converted.
- %o: Output MathML file.
- This command is used by `org-create-math-formula'.
- When using MathToWeb as the converter, set this option to
- \"java -jar %j -unicode -force -df %o %I\".
- When using LaTeXML set this option to
- \"latexmlmath \"%i\" --presentationmathml=%o\"."
- :group 'org-latex
- :version "24.1"
- :type '(choice
- (const :tag "None" nil)
- (string :tag "\nShell command")))
- (defcustom org-preview-latex-default-process 'dvipng
- "The default process to convert LaTeX fragments to image files.
- All available processes and theirs documents can be found in
- `org-preview-latex-process-alist', which see."
- :group 'org-latex
- :version "26.1"
- :package-version '(Org . "9.0")
- :type 'symbol)
- (defcustom org-preview-latex-process-alist
- '((dvipng
- :programs ("latex" "dvipng")
- :description "dvi > png"
- :message "you need to install the programs: latex and dvipng."
- :image-input-type "dvi"
- :image-output-type "png"
- :image-size-adjust (1.0 . 1.0)
- :latex-compiler ("latex -interaction nonstopmode -output-directory %o %f")
- :image-converter ("dvipng -fg %F -bg %B -D %D -T tight -o %O %f"))
- (dvisvgm
- :programs ("latex" "dvisvgm")
- :description "dvi > svg"
- :message "you need to install the programs: latex and dvisvgm."
- :use-xcolor t
- :image-input-type "dvi"
- :image-output-type "svg"
- :image-size-adjust (1.7 . 1.5)
- :latex-compiler ("latex -interaction nonstopmode -output-directory %o %f")
- :image-converter ("dvisvgm %f -n -b min -c %S -o %O"))
- (imagemagick
- :programs ("latex" "convert")
- :description "pdf > png"
- :message "you need to install the programs: latex and imagemagick."
- :use-xcolor t
- :image-input-type "pdf"
- :image-output-type "png"
- :image-size-adjust (1.0 . 1.0)
- :latex-compiler ("pdflatex -interaction nonstopmode -output-directory %o %f")
- :image-converter
- ("convert -density %D -trim -antialias %f -quality 100 %O")))
- "Definitions of external processes for LaTeX previewing.
- Org mode can use some external commands to generate TeX snippet's images for
- previewing or inserting into HTML files, e.g., \"dvipng\". This variable tells
- `org-create-formula-image' how to call them.
- The value is an alist with the pattern (NAME . PROPERTIES). NAME is a symbol.
- PROPERTIES accepts the following attributes:
- :programs list of strings, required programs.
- :description string, describe the process.
- :message string, message it when required programs cannot be found.
- :image-input-type string, input file type of image converter (e.g., \"dvi\").
- :image-output-type string, output file type of image converter (e.g., \"png\").
- :use-xcolor boolean, when non-nil, LaTeX \"xcolor\" macro is used to
- deal with background and foreground color of image.
- Otherwise, dvipng style background and foreground color
- format are generated. You may then refer to them in
- command options with \"%F\" and \"%B\".
- :image-size-adjust cons of numbers, the car element is used to adjust LaTeX
- image size showed in buffer and the cdr element is for
- HTML file. This option is only useful for process
- developers, users should use variable
- `org-format-latex-options' instead.
- :post-clean list of strings, files matched are to be cleaned up once
- the image is generated. When nil, the files with \".dvi\",
- \".xdv\", \".pdf\", \".tex\", \".aux\", \".log\", \".svg\",
- \".png\", \".jpg\", \".jpeg\" or \".out\" extension will
- be cleaned up.
- :latex-header list of strings, the LaTeX header of the snippet file.
- When nil, the fallback value is used instead, which is
- controlled by `org-format-latex-header',
- `org-latex-default-packages-alist' and
- `org-latex-packages-alist', which see.
- :latex-compiler list of LaTeX commands, as strings. Each of them is given
- to the shell. Place-holders \"%t\", \"%b\" and \"%o\" are
- replaced with values defined below.
- :image-converter list of image converter commands strings. Each of them is
- given to the shell and supports any of the following
- place-holders defined below.
- Place-holders used by `:image-converter' and `:latex-compiler':
- %f input file name
- %b base name of input file
- %o base directory of input file
- %O absolute output file name
- Place-holders only used by `:image-converter':
- %F foreground of image
- %B background of image
- %D dpi, which is used to adjust image size by some processing commands.
- %S the image size scale ratio, which is used to adjust image size by some
- processing commands."
- :group 'org-latex
- :version "26.1"
- :package-version '(Org . "9.0")
- :type '(alist :tag "LaTeX to image backends"
- :value-type (plist)))
- (defcustom org-preview-latex-image-directory "ltximg/"
- "Path to store latex preview images.
- A relative path here creates many directories relative to the
- processed org files paths. An absolute path puts all preview
- images at the same place."
- :group 'org-latex
- :version "26.1"
- :package-version '(Org . "9.0")
- :type 'string)
- (defun org-format-latex-mathml-available-p ()
- "Return t if `org-latex-to-mathml-convert-command' is usable."
- (save-match-data
- (when (and (boundp 'org-latex-to-mathml-convert-command)
- org-latex-to-mathml-convert-command)
- (let ((executable (car (split-string
- org-latex-to-mathml-convert-command))))
- (when (executable-find executable)
- (if (string-match
- "%j" org-latex-to-mathml-convert-command)
- (file-readable-p org-latex-to-mathml-jar-file)
- t))))))
- (defcustom org-format-latex-header "\\documentclass{article}
- \\usepackage[usenames]{color}
- \[PACKAGES]
- \[DEFAULT-PACKAGES]
- \\pagestyle{empty} % do not remove
- % The settings below are copied from fullpage.sty
- \\setlength{\\textwidth}{\\paperwidth}
- \\addtolength{\\textwidth}{-3cm}
- \\setlength{\\oddsidemargin}{1.5cm}
- \\addtolength{\\oddsidemargin}{-2.54cm}
- \\setlength{\\evensidemargin}{\\oddsidemargin}
- \\setlength{\\textheight}{\\paperheight}
- \\addtolength{\\textheight}{-\\headheight}
- \\addtolength{\\textheight}{-\\headsep}
- \\addtolength{\\textheight}{-\\footskip}
- \\addtolength{\\textheight}{-3cm}
- \\setlength{\\topmargin}{1.5cm}
- \\addtolength{\\topmargin}{-2.54cm}"
- "The document header used for processing LaTeX fragments.
- It is imperative that this header make sure that no page number
- appears on the page. The package defined in the variables
- `org-latex-default-packages-alist' and `org-latex-packages-alist'
- will either replace the placeholder \"[PACKAGES]\" in this
- header, or they will be appended."
- :group 'org-latex
- :type 'string)
- (defun org-set-packages-alist (var val)
- "Set the packages alist and make sure it has 3 elements per entry."
- (set var (mapcar (lambda (x)
- (if (and (consp x) (= (length x) 2))
- (list (car x) (nth 1 x) t)
- x))
- val)))
- (defun org-get-packages-alist (var)
- "Get the packages alist and make sure it has 3 elements per entry."
- (mapcar (lambda (x)
- (if (and (consp x) (= (length x) 2))
- (list (car x) (nth 1 x) t)
- x))
- (default-value var)))
- (defcustom org-latex-default-packages-alist
- '(("AUTO" "inputenc" t ("pdflatex"))
- ("T1" "fontenc" t ("pdflatex"))
- ("" "graphicx" t)
- ("" "grffile" t)
- ("" "longtable" nil)
- ("" "wrapfig" nil)
- ("" "rotating" nil)
- ("normalem" "ulem" t)
- ("" "amsmath" t)
- ("" "textcomp" t)
- ("" "amssymb" t)
- ("" "capt-of" nil)
- ("" "hyperref" nil))
- "Alist of default packages to be inserted in the header.
- Change this only if one of the packages here causes an
- incompatibility with another package you are using.
- The packages in this list are needed by one part or another of
- Org mode to function properly:
- - inputenc, fontenc: for basic font and character selection
- - graphicx: for including images
- - grffile: allow periods and spaces in graphics file names
- - longtable: For multipage tables
- - wrapfig: for figure placement
- - rotating: for sideways figures and tables
- - ulem: for underline and strike-through
- - amsmath: for subscript and superscript and math environments
- - textcomp, amssymb: for various symbols used
- for interpreting the entities in `org-entities'. You can skip
- some of these packages if you don't use any of their symbols.
- - capt-of: for captions outside of floats
- - hyperref: for cross references
- Therefore you should not modify this variable unless you know
- what you are doing. The one reason to change it anyway is that
- you might be loading some other package that conflicts with one
- of the default packages. Each element is either a cell or
- a string.
- A cell is of the format
- (\"options\" \"package\" SNIPPET-FLAG COMPILERS)
- If SNIPPET-FLAG is non-nil, the package also needs to be included
- when compiling LaTeX snippets into images for inclusion into
- non-LaTeX output. COMPILERS is a list of compilers that should
- include the package, see `org-latex-compiler'. If the document
- compiler is not in the list, and the list is non-nil, the package
- will not be inserted in the final document.
- A string will be inserted as-is in the header of the document."
- :group 'org-latex
- :group 'org-export-latex
- :set 'org-set-packages-alist
- :get 'org-get-packages-alist
- :version "26.1"
- :package-version '(Org . "8.3")
- :type '(repeat
- (choice
- (list :tag "options/package pair"
- (string :tag "options")
- (string :tag "package")
- (boolean :tag "Snippet"))
- (string :tag "A line of LaTeX"))))
- (defcustom org-latex-packages-alist nil
- "Alist of packages to be inserted in every LaTeX header.
- These will be inserted after `org-latex-default-packages-alist'.
- Each element is either a cell or a string.
- A cell is of the format:
- (\"options\" \"package\" SNIPPET-FLAG)
- SNIPPET-FLAG, when non-nil, indicates that this package is also
- needed when turning LaTeX snippets into images for inclusion into
- non-LaTeX output.
- A string will be inserted as-is in the header of the document.
- Make sure that you only list packages here which:
- - you want in every file;
- - do not conflict with the setup in `org-format-latex-header';
- - do not conflict with the default packages in
- `org-latex-default-packages-alist'."
- :group 'org-latex
- :group 'org-export-latex
- :set 'org-set-packages-alist
- :get 'org-get-packages-alist
- :type '(repeat
- (choice
- (list :tag "options/package pair"
- (string :tag "options")
- (string :tag "package")
- (boolean :tag "Snippet"))
- (string :tag "A line of LaTeX"))))
- (defgroup org-appearance nil
- "Settings for Org mode appearance."
- :tag "Org Appearance"
- :group 'org)
- (defcustom org-level-color-stars-only nil
- "Non-nil means fontify only the stars in each headline.
- When nil, the entire headline is fontified.
- Changing it requires restart of `font-lock-mode' to become effective
- also in regions already fontified."
- :group 'org-appearance
- :type 'boolean)
- (defcustom org-hide-leading-stars nil
- "Non-nil means hide the first N-1 stars in a headline.
- This works by using the face `org-hide' for these stars. This
- face is white for a light background, and black for a dark
- background. You may have to customize the face `org-hide' to
- make this work.
- Changing it requires restart of `font-lock-mode' to become effective
- also in regions already fontified.
- You may also set this on a per-file basis by adding one of the following
- lines to the buffer:
- #+STARTUP: hidestars
- #+STARTUP: showstars"
- :group 'org-appearance
- :type 'boolean)
- (defcustom org-hidden-keywords nil
- "List of symbols corresponding to keywords to be hidden the org buffer.
- For example, a value \\='(title) for this list will make the document's title
- appear in the buffer without the initial #+TITLE: keyword."
- :group 'org-appearance
- :version "24.1"
- :type '(set (const :tag "#+AUTHOR" author)
- (const :tag "#+DATE" date)
- (const :tag "#+EMAIL" email)
- (const :tag "#+TITLE" title)))
- (defcustom org-custom-properties nil
- "List of properties (as strings) with a special meaning.
- The default use of these custom properties is to let the user
- hide them with `org-toggle-custom-properties-visibility'."
- :group 'org-properties
- :group 'org-appearance
- :version "24.3"
- :type '(repeat (string :tag "Property Name")))
- (defcustom org-fontify-done-headline nil
- "Non-nil means change the face of a headline if it is marked DONE.
- Normally, only the TODO/DONE keyword indicates the state of a headline.
- When this is non-nil, the headline after the keyword is set to the
- `org-headline-done' as an additional indication."
- :group 'org-appearance
- :type 'boolean)
- (defcustom org-fontify-emphasized-text t
- "Non-nil means fontify *bold*, /italic/ and _underlined_ text.
- Changing this variable requires a restart of Emacs to take effect."
- :group 'org-appearance
- :type 'boolean)
- (defcustom org-fontify-whole-heading-line nil
- "Non-nil means fontify the whole line for headings.
- This is useful when setting a background color for the
- org-level-* faces."
- :group 'org-appearance
- :type 'boolean)
- (defcustom org-highlight-latex-and-related nil
- "Non-nil means highlight LaTeX related syntax in the buffer.
- When non nil, the value should be a list containing any of the
- following symbols:
- `latex' Highlight LaTeX snippets and environments.
- `script' Highlight subscript and superscript.
- `entities' Highlight entities."
- :group 'org-appearance
- :version "24.4"
- :package-version '(Org . "8.0")
- :type '(choice
- (const :tag "No highlighting" nil)
- (set :greedy t :tag "Highlight"
- (const :tag "LaTeX snippets and environments" latex)
- (const :tag "Subscript and superscript" script)
- (const :tag "Entities" entities))))
- (defcustom org-hide-emphasis-markers nil
- "Non-nil mean font-lock should hide the emphasis marker characters."
- :group 'org-appearance
- :type 'boolean)
- (defcustom org-hide-macro-markers nil
- "Non-nil mean font-lock should hide the brackets marking macro calls."
- :group 'org-appearance
- :type 'boolean)
- (defcustom org-pretty-entities nil
- "Non-nil means show entities as UTF8 characters.
- When nil, the \\name form remains in the buffer."
- :group 'org-appearance
- :version "24.1"
- :type 'boolean)
- (defcustom org-pretty-entities-include-sub-superscripts t
- "Non-nil means, pretty entity display includes formatting sub/superscripts."
- :group 'org-appearance
- :version "24.1"
- :type 'boolean)
- (defvar org-emph-re nil
- "Regular expression for matching emphasis.
- After a match, the match groups contain these elements:
- 0 The match of the full regular expression, including the characters
- before and after the proper match
- 1 The character before the proper match, or empty at beginning of line
- 2 The proper match, including the leading and trailing markers
- 3 The leading marker like * or /, indicating the type of highlighting
- 4 The text between the emphasis markers, not including the markers
- 5 The character after the match, empty at the end of a line")
- (defvar org-verbatim-re nil
- "Regular expression for matching verbatim text.")
- (defvar org-emphasis-regexp-components) ; defined just below
- (defvar org-emphasis-alist) ; defined just below
- (defun org-set-emph-re (var val)
- "Set variable and compute the emphasis regular expression."
- (set var val)
- (when (and (boundp 'org-emphasis-alist)
- (boundp 'org-emphasis-regexp-components)
- org-emphasis-alist org-emphasis-regexp-components)
- (let* ((e org-emphasis-regexp-components)
- (pre (car e))
- (post (nth 1 e))
- (border (nth 2 e))
- (body (nth 3 e))
- (nl (nth 4 e))
- (body1 (concat body "*?"))
- (markers (mapconcat 'car org-emphasis-alist ""))
- (vmarkers (mapconcat
- (lambda (x) (if (eq (nth 2 x) 'verbatim) (car x) ""))
- org-emphasis-alist "")))
- ;; make sure special characters appear at the right position in the class
- (if (string-match "\\^" markers)
- (setq markers (concat (replace-match "" t t markers) "^")))
- (if (string-match "-" markers)
- (setq markers (concat (replace-match "" t t markers) "-")))
- (if (string-match "\\^" vmarkers)
- (setq vmarkers (concat (replace-match "" t t vmarkers) "^")))
- (if (string-match "-" vmarkers)
- (setq vmarkers (concat (replace-match "" t t vmarkers) "-")))
- (if (> nl 0)
- (setq body1 (concat body1 "\\(?:\n" body "*?\\)\\{0,"
- (int-to-string nl) "\\}")))
- ;; Make the regexp
- (setq org-emph-re
- (concat "\\([" pre "]\\|^\\)"
- "\\("
- "\\([" markers "]\\)"
- "\\("
- "[^" border "]\\|"
- "[^" border "]"
- body1
- "[^" border "]"
- "\\)"
- "\\3\\)"
- "\\([" post "]\\|$\\)"))
- (setq org-verbatim-re
- (concat "\\([" pre "]\\|^\\)"
- "\\("
- "\\([" vmarkers "]\\)"
- "\\("
- "[^" border "]\\|"
- "[^" border "]"
- body1
- "[^" border "]"
- "\\)"
- "\\3\\)"
- "\\([" post "]\\|$\\)")))))
- ;; This used to be a defcustom (Org <8.0) but allowing the users to
- ;; set this option proved cumbersome. See this message/thread:
- ;; http://article.gmane.org/gmane.emacs.orgmode/68681
- (defvar org-emphasis-regexp-components
- '(" \t('\"{" "- \t.,:!?;'\")}\\[" " \t\r\n" "." 1)
- "Components used to build the regular expression for emphasis.
- This is a list with five entries. Terminology: In an emphasis string
- like \" *strong word* \", we call the initial space PREMATCH, the final
- space POSTMATCH, the stars MARKERS, \"s\" and \"d\" are BORDER characters
- and \"trong wor\" is the body. The different components in this variable
- specify what is allowed/forbidden in each part:
- pre Chars allowed as prematch. Beginning of line will be allowed too.
- post Chars allowed as postmatch. End of line will be allowed too.
- border The chars *forbidden* as border characters.
- body-regexp A regexp like \".\" to match a body character. Don't use
- non-shy groups here, and don't allow newline here.
- newline The maximum number of newlines allowed in an emphasis exp.
- You need to reload Org or to restart Emacs after customizing this.")
- (defcustom org-emphasis-alist
- '(("*" bold)
- ("/" italic)
- ("_" underline)
- ("=" org-verbatim verbatim)
- ("~" org-code verbatim)
- ("+" (:strike-through t)))
- "Alist of characters and faces to emphasize text.
- Text starting and ending with a special character will be emphasized,
- for example *bold*, _underlined_ and /italic/. This variable sets the
- marker characters and the face to be used by font-lock for highlighting
- in Org buffers.
- You need to reload Org or to restart Emacs after customizing this."
- :group 'org-appearance
- :set 'org-set-emph-re
- :version "24.4"
- :package-version '(Org . "8.0")
- :type '(repeat
- (list
- (string :tag "Marker character")
- (choice
- (face :tag "Font-lock-face")
- (plist :tag "Face property list"))
- (option (const verbatim)))))
- (defvar org-protecting-blocks '("src" "example" "export")
- "Blocks that contain text that is quoted, i.e. not processed as Org syntax.
- This is needed for font-lock setup.")
- ;;; Functions and variables from their packages
- ;; Declared here to avoid compiler warnings
- (defvar mark-active)
- ;; Various packages
- (declare-function calc-eval "calc" (str &optional separator &rest args))
- (declare-function calendar-forward-day "cal-move" (arg))
- (declare-function calendar-goto-date "cal-move" (date))
- (declare-function calendar-goto-today "cal-move" ())
- (declare-function calendar-iso-from-absolute "cal-iso" (date))
- (declare-function calendar-iso-to-absolute "cal-iso" (date))
- (declare-function cdlatex-compute-tables "ext:cdlatex" ())
- (declare-function cdlatex-tab "ext:cdlatex" ())
- (declare-function dired-get-filename
- "dired"
- (&optional localp no-error-if-not-filep))
- (declare-function iswitchb-read-buffer
- "iswitchb"
- (prompt &optional
- default require-match _predicate start matches-set))
- (declare-function org-agenda-change-all-lines
- "org-agenda"
- (newhead hdmarker &optional fixface just-this))
- (declare-function org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item
- "org-agenda"
- (&optional end))
- (declare-function org-agenda-copy-local-variable "org-agenda" (var))
- (declare-function org-agenda-format-item
- "org-agenda"
- (extra txt &optional level category tags dotime
- remove-re habitp))
- (declare-function org-agenda-maybe-redo "org-agenda" ())
- (declare-function org-agenda-new-marker "org-agenda" (&optional pos))
- (declare-function org-agenda-save-markers-for-cut-and-paste
- "org-agenda"
- (beg end))
- (declare-function org-agenda-set-restriction-lock "org-agenda" (&optional type))
- (declare-function org-agenda-skip "org-agenda" ())
- (declare-function org-attach-reveal "org-attach" (&optional if-exists))
- (declare-function org-gnus-follow-link "org-gnus" (&optional group article))
- (declare-function org-indent-mode "org-indent" (&optional arg))
- (declare-function org-inlinetask-goto-beginning "org-inlinetask" ())
- (declare-function org-inlinetask-goto-end "org-inlinetask" ())
- (declare-function org-inlinetask-in-task-p "org-inlinetask" ())
- (declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
- (declare-function orgtbl-send-table "org-table" (&optional maybe))
- (declare-function parse-time-string "parse-time" (string))
- (declare-function speedbar-line-directory "speedbar" (&optional depth))
- (defvar align-mode-rules-list)
- (defvar calc-embedded-close-formula)
- (defvar calc-embedded-open-formula)
- (defvar calc-embedded-open-mode)
- (defvar font-lock-unfontify-region-function)
- (defvar iswitchb-temp-buflist)
- (defvar org-agenda-tags-todo-honor-ignore-options)
- (defvar remember-data-file)
- (defvar texmathp-why)
- ;;;###autoload
- (defun turn-on-orgtbl ()
- "Unconditionally turn on `orgtbl-mode'."
- (require 'org-table)
- (orgtbl-mode 1))
- (defun org-at-table-p (&optional table-type)
- "Non-nil if the cursor is inside an Org table.
- If TABLE-TYPE is non-nil, also check for table.el-type tables.
- If `org-enable-table-editor' is nil, return nil unconditionally."
- (and
- org-enable-table-editor
- (save-excursion
- (beginning-of-line)
- (looking-at-p (if table-type "[ \t]*[|+]" "[ \t]*|")))
- (or (not (derived-mode-p 'org-mode))
- (let ((e (org-element-lineage (org-element-at-point) '(table) t)))
- (and e (or table-type (eq (org-element-property :type e) 'org)))))))
- (defun org-at-table.el-p ()
- "Non-nil when point is at a table.el table."
- (and (save-excursion (beginning-of-line) (looking-at "[ \t]*[|+]"))
- (let ((element (org-element-at-point)))
- (and (eq (org-element-type element) 'table)
- (eq (org-element-property :type element) 'table.el)))))
- (defun org-at-table-hline-p ()
- "Non-nil when point is inside a hline in a table.
- Assume point is already in a table. If `org-enable-table-editor'
- is nil, return nil unconditionally."
- (and org-enable-table-editor
- (save-excursion
- (beginning-of-line)
- (looking-at org-table-hline-regexp))))
- (defun org-table-map-tables (function &optional quietly)
- "Apply FUNCTION to the start of all tables in the buffer."
- (org-with-wide-buffer
- (goto-char (point-min))
- (while (re-search-forward org-table-any-line-regexp nil t)
- (unless quietly
- (message "Mapping tables: %d%%"
- (floor (* 100.0 (point)) (buffer-size))))
- (beginning-of-line 1)
- (when (and (looking-at org-table-line-regexp)
- ;; Exclude tables in src/example/verbatim/clocktable blocks
- (not (org-in-block-p '("src" "example" "verbatim" "clocktable"))))
- (save-excursion (funcall function))
- (or (looking-at org-table-line-regexp)
- (forward-char 1)))
- (re-search-forward org-table-any-border-regexp nil 1)))
- (unless quietly (message "Mapping tables: done")))
- (declare-function org-clock-save-markers-for-cut-and-paste "org-clock" (beg end))
- (declare-function org-clock-update-mode-line "org-clock" ())
- (declare-function org-resolve-clocks "org-clock"
- (&optional also-non-dangling-p prompt last-valid))
- (defun org-at-TBLFM-p (&optional pos)
- "Non-nil when point (or POS) is in #+TBLFM line."
- (save-excursion
- (goto-char (or pos (point)))
- (beginning-of-line)
- (and (let ((case-fold-search t)) (looking-at org-TBLFM-regexp))
- (eq (org-element-type (org-element-at-point)) 'table))))
- (defvar org-clock-start-time)
- (defvar org-clock-marker (make-marker)
- "Marker recording the last clock-in.")
- (defvar org-clock-hd-marker (make-marker)
- "Marker recording the last clock-in, but the headline position.")
- (defvar org-clock-heading ""
- "The heading of the current clock entry.")
- (defun org-clock-is-active ()
- "Return the buffer where the clock is currently running.
- Return nil if no clock is running."
- (marker-buffer org-clock-marker))
- (defun org-check-running-clock ()
- "Check if the current buffer contains the running clock.
- If yes, offer to stop it and to save the buffer with the changes."
- (when (and (equal (marker-buffer org-clock-marker) (current-buffer))
- (y-or-n-p (format "Clock-out in buffer %s before killing it? "
- (buffer-name))))
- (org-clock-out)
- (when (y-or-n-p "Save changed buffer?")
- (save-buffer))))
- (defun org-clocktable-try-shift (dir n)
- "Check if this line starts a clock table, if yes, shift the time block."
- (when (org-match-line "^[ \t]*#\\+BEGIN:[ \t]+clocktable\\>")
- (org-clocktable-shift dir n)))
- ;;;###autoload
- (defun org-clock-persistence-insinuate ()
- "Set up hooks for clock persistence."
- (require 'org-clock)
- (add-hook 'org-mode-hook 'org-clock-load)
- (add-hook 'kill-emacs-hook 'org-clock-save))
- (defgroup org-archive nil
- "Options concerning archiving in Org mode."
- :tag "Org Archive"
- :group 'org-structure)
- (defcustom org-archive-location "%s_archive::"
- "The location where subtrees should be archived.
- The value of this variable is a string, consisting of two parts,
- separated by a double-colon. The first part is a filename and
- the second part is a headline.
- When the filename is omitted, archiving happens in the same file.
- %s in the filename will be replaced by the current file
- name (without the directory part). Archiving to a different file
- is useful to keep archived entries from contributing to the
- Org Agenda.
- The archived entries will be filed as subtrees of the specified
- headline. When the headline is omitted, the subtrees are simply
- filed away at the end of the file, as top-level entries. Also in
- the heading you can use %s to represent the file name, this can be
- useful when using the same archive for a number of different files.
- Here are a few examples:
- \"%s_archive::\"
- If the current file is Projects.org, archive in file
- Projects.org_archive, as top-level trees. This is the default.
- \"::* Archived Tasks\"
- Archive in the current file, under the top-level headline
- \"* Archived Tasks\".
- \"~/org/archive.org::\"
- Archive in file ~/org/archive.org (absolute path), as top-level trees.
- \"~/org/archive.org::* From %s\"
- Archive in file ~/org/archive.org (absolute path), under headlines
- \"From FILENAME\" where file name is the current file name.
- \"~/org/datetree.org::datetree/* Finished Tasks\"
- The \"datetree/\" string is special, signifying to archive
- items to the datetree. Items are placed in either the CLOSED
- date of the item, or the current date if there is no CLOSED date.
- The heading will be a subentry to the current date. There doesn't
- need to be a heading, but there always needs to be a slash after
- datetree. For example, to store archived items directly in the
- datetree, use \"~/org/datetree.org::datetree/\".
- \"basement::** Finished Tasks\"
- Archive in file ./basement (relative path), as level 3 trees
- below the level 2 heading \"** Finished Tasks\".
- You may set this option on a per-file basis by adding to the buffer a
- line like
- #+ARCHIVE: basement::** Finished Tasks
- You may also define it locally for a subtree by setting an ARCHIVE property
- in the entry. If such a property is found in an entry, or anywhere up
- the hierarchy, it will be used."
- :group 'org-archive
- :type 'string)
- (defcustom org-agenda-skip-archived-trees t
- "Non-nil means the agenda will skip any items located in archived trees.
- An archived tree is a tree marked with the tag ARCHIVE. The use of this
- variable is no longer recommended, you should leave it at the value t.
- Instead, use the key `v' to cycle the archives-mode in the agenda."
- :group 'org-archive
- :group 'org-agenda-skip
- :type 'boolean)
- (defcustom org-columns-skip-archived-trees t
- "Non-nil means ignore archived trees when creating column view."
- :group 'org-archive
- :group 'org-properties
- :type 'boolean)
- (defcustom org-cycle-open-archived-trees nil
- "Non-nil means `org-cycle' will open archived trees.
- An archived tree is a tree marked with the tag ARCHIVE.
- When nil, archived trees will stay folded. You can still open them with
- normal outline commands like `show-all', but not with the cycling commands."
- :group 'org-archive
- :group 'org-cycle
- :type 'boolean)
- (defcustom org-sparse-tree-open-archived-trees nil
- "Non-nil means sparse tree construction shows matches in archived trees.
- When nil, matches in these trees are highlighted, but the trees are kept in
- collapsed state."
- :group 'org-archive
- :group 'org-sparse-trees
- :type 'boolean)
- (defcustom org-sparse-tree-default-date-type nil
- "The default date type when building a sparse tree.
- When this is nil, a date is a scheduled or a deadline timestamp.
- Otherwise, these types are allowed:
- all: all timestamps
- active: only active timestamps (<...>)
- inactive: only inactive timestamps ([...])
- scheduled: only scheduled timestamps
- deadline: only deadline timestamps"
- :type '(choice (const :tag "Scheduled or deadline" nil)
- (const :tag "All timestamps" all)
- (const :tag "Only active timestamps" active)
- (const :tag "Only inactive timestamps" inactive)
- (const :tag "Only scheduled timestamps" scheduled)
- (const :tag "Only deadline timestamps" deadline)
- (const :tag "Only closed timestamps" closed))
- :version "26.1"
- :package-version '(Org . "8.3")
- :group 'org-sparse-trees)
- (defun org-cycle-hide-archived-subtrees (state)
- "Re-hide all archived subtrees after a visibility state change.
- STATE should be one of the symbols listed in the docstring of
- `org-cycle-hook'."
- (when (and (not org-cycle-open-archived-trees)
- (not (memq state '(overview folded))))
- (save-excursion
- (let* ((globalp (memq state '(contents all)))
- (beg (if globalp (point-min) (point)))
- (end (if globalp (point-max) (org-end-of-subtree t))))
- (org-hide-archived-subtrees beg end)
- (goto-char beg)
- (when (looking-at-p (concat ".*:" org-archive-tag ":"))
- (message "%s" (substitute-command-keys
- "Subtree is archived and stays closed. Use \
- `\\[org-force-cycle-archived]' to cycle it anyway.")))))))
- (defun org-force-cycle-archived ()
- "Cycle subtree even if it is archived."
- (interactive)
- (setq this-command 'org-cycle)
- (let ((org-cycle-open-archived-trees t))
- (call-interactively 'org-cycle)))
- (defun org-hide-archived-subtrees (beg end)
- "Re-hide all archived subtrees after a visibility state change."
- (org-with-wide-buffer
- (let ((case-fold-search nil)
- (re (concat org-outline-regexp-bol ".*:" org-archive-tag ":")))
- (goto-char beg)
- ;; Include headline point is currently on.
- (beginning-of-line)
- (while (and (< (point) end) (re-search-forward re end t))
- (when (member org-archive-tag (org-get-tags))
- (org-flag-subtree t)
- (org-end-of-subtree t))))))
- (declare-function outline-end-of-heading "outline" ())
- (declare-function outline-flag-region "outline" (from to flag))
- (defun org-flag-subtree (flag)
- (save-excursion
- (org-back-to-heading t)
- (outline-end-of-heading)
- (outline-flag-region (point)
- (progn (org-end-of-subtree t) (point))
- flag)))
- (defalias 'org-advertized-archive-subtree 'org-archive-subtree)
- ;; Declare Column View Code
- (declare-function org-columns-get-format-and-top-level "org-colview" ())
- (declare-function org-columns-compute "org-colview" (property))
- ;; Declare ID code
- (declare-function org-id-store-link "org-id")
- (declare-function org-id-locations-load "org-id")
- (declare-function org-id-locations-save "org-id")
- (defvar org-id-track-globally)
- ;;; Variables for pre-computed regular expressions, all buffer local
- (defvar-local org-todo-regexp nil
- "Matches any of the TODO state keywords.
- Since TODO keywords are case-sensitive, `case-fold-search' is
- expected to be bound to nil when matching against this regexp.")
- (defvar-local org-not-done-regexp nil
- "Matches any of the TODO state keywords except the last one.
- Since TODO keywords are case-sensitive, `case-fold-search' is
- expected to be bound to nil when matching against this regexp.")
- (defvar-local org-not-done-heading-regexp nil
- "Matches a TODO headline that is not done.
- Since TODO keywords are case-sensitive, `case-fold-search' is
- expected to be bound to nil when matching against this regexp.")
- (defvar-local org-todo-line-regexp nil
- "Matches a headline and puts TODO state into group 2 if present.
- Since TODO keywords are case-sensitive, `case-fold-search' is
- expected to be bound to nil when matching against this regexp.")
- (defvar-local org-complex-heading-regexp nil
- "Matches a headline and puts everything into groups:
- group 1: Stars
- group 2: The TODO keyword, maybe
- group 3: Priority cookie
- group 4: True headline
- group 5: Tags
- Since TODO keywords are case-sensitive, `case-fold-search' is
- expected to be bound to nil when matching against this regexp.")
- (defvar-local org-complex-heading-regexp-format nil
- "Printf format to make regexp to match an exact headline.
- This regexp will match the headline of any node which has the
- exact headline text that is put into the format, but may have any
- TODO state, priority and tags.")
- (defvar-local org-todo-line-tags-regexp nil
- "Matches a headline and puts TODO state into group 2 if present.
- Also put tags into group 4 if tags are present.")
- (defconst org-plain-time-of-day-regexp
- (concat
- "\\(\\<[012]?[0-9]"
- "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)"
- "\\(--?"
- "\\(\\<[012]?[0-9]"
- "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)"
- "\\)?")
- "Regular expression to match a plain time or time range.
- Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following
- groups carry important information:
- 0 the full match
- 1 the first time, range or not
- 8 the second time, if it is a range.")
- (defconst org-plain-time-extension-regexp
- (concat
- "\\(\\<[012]?[0-9]"
- "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)"
- "\\+\\([0-9]+\\)\\(:\\([0-5][0-9]\\)\\)?")
- "Regular expression to match a time range like 13:30+2:10 = 13:30-15:40.
- Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following
- groups carry important information:
- 0 the full match
- 7 hours of duration
- 9 minutes of duration")
- (defconst org-stamp-time-of-day-regexp
- (concat
- "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} +\\sw+ +\\)"
- "\\([012][0-9]:[0-5][0-9]\\(-\\([012][0-9]:[0-5][0-9]\\)\\)?[^\n\r>]*?\\)>"
- "\\(--?"
- "<\\1\\([012][0-9]:[0-5][0-9]\\)>\\)?")
- "Regular expression to match a timestamp time or time range.
- After a match, the following groups carry important information:
- 0 the full match
- 1 date plus weekday, for back referencing to make sure both times are on the same day
- 2 the first time, range or not
- 4 the second time, if it is a range.")
- (defconst org-startup-options
- '(("fold" org-startup-folded t)
- ("overview" org-startup-folded t)
- ("nofold" org-startup-folded nil)
- ("showall" org-startup-folded nil)
- ("showeverything" org-startup-folded showeverything)
- ("content" org-startup-folded content)
- ("indent" org-startup-indented t)
- ("noindent" org-startup-indented nil)
- ("hidestars" org-hide-leading-stars t)
- ("showstars" org-hide-leading-stars nil)
- ("odd" org-odd-levels-only t)
- ("oddeven" org-odd-levels-only nil)
- ("align" org-startup-align-all-tables t)
- ("noalign" org-startup-align-all-tables nil)
- ("inlineimages" org-startup-with-inline-images t)
- ("noinlineimages" org-startup-with-inline-images nil)
- ("latexpreview" org-startup-with-latex-preview t)
- ("nolatexpreview" org-startup-with-latex-preview nil)
- ("customtime" org-display-custom-times t)
- ("logdone" org-log-done time)
- ("lognotedone" org-log-done note)
- ("nologdone" org-log-done nil)
- ("lognoteclock-out" org-log-note-clock-out t)
- ("nolognoteclock-out" org-log-note-clock-out nil)
- ("logrepeat" org-log-repeat state)
- ("lognoterepeat" org-log-repeat note)
- ("logdrawer" org-log-into-drawer t)
- ("nologdrawer" org-log-into-drawer nil)
- ("logstatesreversed" org-log-states-order-reversed t)
- ("nologstatesreversed" org-log-states-order-reversed nil)
- ("nologrepeat" org-log-repeat nil)
- ("logreschedule" org-log-reschedule time)
- ("lognotereschedule" org-log-reschedule note)
- ("nologreschedule" org-log-reschedule nil)
- ("logredeadline" org-log-redeadline time)
- ("lognoteredeadline" org-log-redeadline note)
- ("nologredeadline" org-log-redeadline nil)
- ("logrefile" org-log-refile time)
- ("lognoterefile" org-log-refile note)
- ("nologrefile" org-log-refile nil)
- ("fninline" org-footnote-define-inline t)
- ("nofninline" org-footnote-define-inline nil)
- ("fnlocal" org-footnote-section nil)
- ("fnauto" org-footnote-auto-label t)
- ("fnprompt" org-footnote-auto-label nil)
- ("fnconfirm" org-footnote-auto-label confirm)
- ("fnplain" org-footnote-auto-label plain)
- ("fnadjust" org-footnote-auto-adjust t)
- ("nofnadjust" org-footnote-auto-adjust nil)
- ("constcgs" constants-unit-system cgs)
- ("constSI" constants-unit-system SI)
- ("noptag" org-tag-persistent-alist nil)
- ("hideblocks" org-hide-block-startup t)
- ("nohideblocks" org-hide-block-startup nil)
- ("beamer" org-startup-with-beamer-mode t)
- ("entitiespretty" org-pretty-entities t)
- ("entitiesplain" org-pretty-entities nil))
- "Variable associated with STARTUP options for org-mode.
- Each element is a list of three items: the startup options (as written
- in the #+STARTUP line), the corresponding variable, and the value to set
- this variable to if the option is found. An optional forth element PUSH
- means to push this value onto the list in the variable.")
- (defcustom org-group-tags t
- "When non-nil (the default), use group tags.
- This can be turned on/off through `org-toggle-tags-groups'."
- :group 'org-tags
- :group 'org-startup
- :type 'boolean)
- (defvar org-inhibit-startup nil) ; Dynamically-scoped param.
- (defun org-toggle-tags-groups ()
- "Toggle support for group tags.
- Support for group tags is controlled by the option
- `org-group-tags', which is non-nil by default."
- (interactive)
- (setq org-group-tags (not org-group-tags))
- (cond ((and (derived-mode-p 'org-agenda-mode)
- org-group-tags)
- (org-agenda-redo))
- ((derived-mode-p 'org-mode)
- (let ((org-inhibit-startup t)) (org-mode))))
- (message "Groups tags support has been turned %s"
- (if org-group-tags "on" "off")))
- (defun org-set-regexps-and-options (&optional tags-only)
- "Precompute regular expressions used in the current buffer.
- When optional argument TAGS-ONLY is non-nil, only compute tags
- related expressions."
- (when (derived-mode-p 'org-mode)
- (let ((alist (org--setup-collect-keywords
- (org-make-options-regexp
- (append '("FILETAGS" "TAGS" "SETUPFILE")
- (and (not tags-only)
- '("ARCHIVE" "CATEGORY" "COLUMNS" "CONSTANTS"
- "LINK" "OPTIONS" "PRIORITIES" "PROPERTY"
- "SEQ_TODO" "STARTUP" "TODO" "TYP_TODO")))))))
- ;; Startup options. Get this early since it does change
- ;; behavior for other options (e.g., tags).
- (let ((startup (cdr (assq 'startup alist))))
- (dolist (option startup)
- (let ((entry (assoc-string option org-startup-options t)))
- (when entry
- (let ((var (nth 1 entry))
- (val (nth 2 entry)))
- (if (not (nth 3 entry)) (set (make-local-variable var) val)
- (unless (listp (symbol-value var))
- (set (make-local-variable var) nil))
- (add-to-list var val)))))))
- (setq-local org-file-tags
- (mapcar #'org-add-prop-inherited
- (cdr (assq 'filetags alist))))
- (setq org-current-tag-alist
- (append org-tag-persistent-alist
- (let ((tags (cdr (assq 'tags alist))))
- (if tags (org-tag-string-to-alist tags)
- org-tag-alist))))
- (setq org-tag-groups-alist
- (org-tag-alist-to-groups org-current-tag-alist))
- (unless tags-only
- ;; File properties.
- (setq-local org-file-properties (cdr (assq 'property alist)))
- ;; Archive location.
- (let ((archive (cdr (assq 'archive alist))))
- (when archive (setq-local org-archive-location archive)))
- ;; Category.
- (let ((cat (org-string-nw-p (cdr (assq 'category alist)))))
- (when cat
- (setq-local org-category (intern cat))
- (setq-local org-file-properties
- (org--update-property-plist
- "CATEGORY" cat org-file-properties))))
- ;; Columns.
- (let ((column (cdr (assq 'columns alist))))
- (when column (setq-local org-columns-default-format column)))
- ;; Constants.
- (setq org-table-formula-constants-local (cdr (assq 'constants alist)))
- ;; Link abbreviations.
- (let ((links (cdr (assq 'link alist))))
- (when links (setq org-link-abbrev-alist-local (nreverse links))))
- ;; Priorities.
- (let ((priorities (cdr (assq 'priorities alist))))
- (when priorities
- (setq-local org-highest-priority (nth 0 priorities))
- (setq-local org-lowest-priority (nth 1 priorities))
- (setq-local org-default-priority (nth 2 priorities))))
- ;; Scripts.
- (let ((scripts (assq 'scripts alist)))
- (when scripts
- (setq-local org-use-sub-superscripts (cdr scripts))))
- ;; TODO keywords.
- (setq-local org-todo-kwd-alist nil)
- (setq-local org-todo-key-alist nil)
- (setq-local org-todo-key-trigger nil)
- (setq-local org-todo-keywords-1 nil)
- (setq-local org-done-keywords nil)
- (setq-local org-todo-heads nil)
- (setq-local org-todo-sets nil)
- (setq-local org-todo-log-states nil)
- (let ((todo-sequences
- (or (nreverse (cdr (assq 'todo alist)))
- (let ((d (default-value 'org-todo-keywords)))
- (if (not (stringp (car d))) d
- ;; XXX: Backward compatibility code.
- (list (cons org-todo-interpretation d)))))))
- (dolist (sequence todo-sequences)
- (let* ((sequence (or (run-hook-with-args-until-success
- 'org-todo-setup-filter-hook sequence)
- sequence))
- (sequence-type (car sequence))
- (keywords (cdr sequence))
- (sep (member "|" keywords))
- names alist)
- (dolist (k (remove "|" keywords))
- (unless (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$"
- k)
- (error "Invalid TODO keyword %s" k))
- (let ((name (match-string 1 k))
- (key (match-string 2 k))
- (log (org-extract-log-state-settings k)))
- (push name names)
- (push (cons name (and key (string-to-char key))) alist)
- (when log (push log org-todo-log-states))))
- (let* ((names (nreverse names))
- (done (if sep (org-remove-keyword-keys (cdr sep))
- (last names)))
- (head (car names))
- (tail (list sequence-type head (car done) (org-last done))))
- (add-to-list 'org-todo-heads head 'append)
- (push names org-todo-sets)
- (setq org-done-keywords (append org-done-keywords done nil))
- (setq org-todo-keywords-1 (append org-todo-keywords-1 names nil))
- (setq org-todo-key-alist
- (append org-todo-key-alist
- (and alist
- (append '((:startgroup))
- (nreverse alist)
- '((:endgroup))))))
- (dolist (k names) (push (cons k tail) org-todo-kwd-alist))))))
- (setq org-todo-sets (nreverse org-todo-sets)
- org-todo-kwd-alist (nreverse org-todo-kwd-alist)
- org-todo-key-trigger (delq nil (mapcar #'cdr org-todo-key-alist))
- org-todo-key-alist (org-assign-fast-keys org-todo-key-alist))
- ;; Compute the regular expressions and other local variables.
- ;; Using `org-outline-regexp-bol' would complicate them much,
- ;; because of the fixed white space at the end of that string.
- (unless org-done-keywords
- (setq org-done-keywords
- (and org-todo-keywords-1 (last org-todo-keywords-1))))
- (setq org-not-done-keywords
- (org-delete-all org-done-keywords
- (copy-sequence org-todo-keywords-1))
- org-todo-regexp (regexp-opt org-todo-keywords-1 t)
- org-not-done-regexp (regexp-opt org-not-done-keywords t)
- org-not-done-heading-regexp
- (format org-heading-keyword-regexp-format org-not-done-regexp)
- org-todo-line-regexp
- (format org-heading-keyword-maybe-regexp-format org-todo-regexp)
- org-complex-heading-regexp
- (concat "^\\(\\*+\\)"
- "\\(?: +" org-todo-regexp "\\)?"
- "\\(?: +\\(\\[#.\\]\\)\\)?"
- "\\(?: +\\(.*?\\)\\)??"
- "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?"
- "[ \t]*$")
- org-complex-heading-regexp-format
- (concat "^\\(\\*+\\)"
- "\\(?: +" org-todo-regexp "\\)?"
- "\\(?: +\\(\\[#.\\]\\)\\)?"
- "\\(?: +"
- ;; Stats cookies can be stuck to body.
- "\\(?:\\[[0-9%%/]+\\] *\\)*"
- "\\(%s\\)"
- "\\(?: *\\[[0-9%%/]+\\]\\)*"
- "\\)"
- "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?"
- "[ \t]*$")
- org-todo-line-tags-regexp
- (concat "^\\(\\*+\\)"
- "\\(?: +" org-todo-regexp "\\)?"
- "\\(?: +\\(.*?\\)\\)??"
- "\\(?:[ \t]+\\(:[[:alnum:]:_@#%]+:\\)\\)?"
- "[ \t]*$"))
- (org-compute-latex-and-related-regexp)))))
- (defun org--setup-collect-keywords (regexp &optional files alist)
- "Return setup keywords values as an alist.
- REGEXP matches a subset of setup keywords. FILES is a list of
- file names already visited. It is used to avoid circular setup
- files. ALIST, when non-nil, is the alist computed so far.
- Return value contains the following keys: `archive', `category',
- `columns', `constants', `filetags', `link', `priorities',
- `property', `scripts', `startup', `tags' and `todo'."
- (org-with-wide-buffer
- (goto-char (point-min))
- (let ((case-fold-search t))
- (while (re-search-forward regexp nil t)
- (let ((element (org-element-at-point)))
- (when (eq (org-element-type element) 'keyword)
- (let ((key (org-element-property :key element))
- (value (org-element-property :value element)))
- (cond
- ((equal key "ARCHIVE")
- (when (org-string-nw-p value)
- (push (cons 'archive value) alist)))
- ((equal key "CATEGORY") (push (cons 'category value) alist))
- ((equal key "COLUMNS") (push (cons 'columns value) alist))
- ((equal key "CONSTANTS")
- (let* ((constants (assq 'constants alist))
- (store (cdr constants)))
- (dolist (pair (org-split-string value))
- (when (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)"
- pair)
- (let* ((name (match-string 1 pair))
- (value (match-string 2 pair))
- (old (assoc name store)))
- (if old (setcdr old value)
- (push (cons name value) store)))))
- (if constants (setcdr constants store)
- (push (cons 'constants store) alist))))
- ((equal key "FILETAGS")
- (when (org-string-nw-p value)
- (let ((old (assq 'filetags alist))
- (new (apply #'nconc
- (mapcar (lambda (x) (org-split-string x ":"))
- (org-split-string value)))))
- (if old (setcdr old (append new (cdr old)))
- (push (cons 'filetags new) alist)))))
- ((equal key "LINK")
- (when (string-match "\\`\\(\\S-+\\)[ \t]+\\(.+\\)" value)
- (let ((links (assq 'link alist))
- (pair (cons (match-string-no-properties 1 value)
- (match-string-no-properties 2 value))))
- (if links (push pair (cdr links))
- (push (list 'link pair) alist)))))
- ((equal key "OPTIONS")
- (when (and (org-string-nw-p value)
- (string-match "\\^:\\(t\\|nil\\|{}\\)" value))
- (push (cons 'scripts (read (match-string 1 value))) alist)))
- ((equal key "PRIORITIES")
- (push (cons 'priorities
- (let ((prio (org-split-string value)))
- (if (< (length prio) 3) '(?A ?C ?B)
- (mapcar #'string-to-char prio))))
- alist))
- ((equal key "PROPERTY")
- (when (string-match "\\(\\S-+\\)[ \t]+\\(.*\\)" value)
- (let* ((property (assq 'property alist))
- (value (org--update-property-plist
- (match-string-no-properties 1 value)
- (match-string-no-properties 2 value)
- (cdr property))))
- (if property (setcdr property value)
- (push (cons 'property value) alist)))))
- ((equal key "STARTUP")
- (let ((startup (assq 'startup alist)))
- (if startup
- (setcdr startup
- (append (cdr startup) (org-split-string value)))
- (push (cons 'startup (org-split-string value)) alist))))
- ((equal key "TAGS")
- (let ((tag-cell (assq 'tags alist)))
- (if tag-cell
- (setcdr tag-cell (concat (cdr tag-cell) "\n" value))
- (push (cons 'tags value) alist))))
- ((member key '("TODO" "SEQ_TODO" "TYP_TODO"))
- (let ((todo (assq 'todo alist))
- (value (cons (if (equal key "TYP_TODO") 'type 'sequence)
- (org-split-string value))))
- (if todo (push value (cdr todo))
- (push (list 'todo value) alist))))
- ((equal key "SETUPFILE")
- (unless buffer-read-only ; Do not check in Gnus messages.
- (let ((f (and (org-string-nw-p value)
- (expand-file-name
- (org-unbracket-string "\"" "\"" value)))))
- (when (and f (file-readable-p f) (not (member f files)))
- (with-temp-buffer
- (setq default-directory (file-name-directory f))
- (insert-file-contents f)
- (setq alist
- ;; Fake Org mode to benefit from cache
- ;; without recurring needlessly.
- (let ((major-mode 'org-mode))
- (org--setup-collect-keywords
- regexp (cons f files) alist)))))))))))))))
- alist)
- (defun org-tag-string-to-alist (s)
- "Return tag alist associated to string S.
- S is a value for TAGS keyword or produced with
- `org-tag-alist-to-string'. Return value is an alist suitable for
- `org-tag-alist' or `org-tag-persistent-alist'."
- (let ((lines (mapcar #'split-string (split-string s "\n" t)))
- (tag-re (concat "\\`\\([[:alnum:]_@#%]+"
- "\\|{.+?}\\)" ; regular expression
- "\\(?:(\\(.\\))\\)?\\'"))
- alist group-flag)
- (dolist (tokens lines (cdr (nreverse alist)))
- (push '(:newline) alist)
- (while tokens
- (let ((token (pop tokens)))
- (pcase token
- ("{"
- (push '(:startgroup) alist)
- (when (equal (nth 1 tokens) ":") (setq group-flag t)))
- ("}"
- (push '(:endgroup) alist)
- (setq group-flag nil))
- ("["
- (push '(:startgrouptag) alist)
- (when (equal (nth 1 tokens) ":") (setq group-flag t)))
- ("]"
- (push '(:endgrouptag) alist)
- (setq group-flag nil))
- (":"
- (push '(:grouptags) alist))
- ((guard (string-match tag-re token))
- (let ((tag (match-string 1 token))
- (key (and (match-beginning 2)
- (string-to-char (match-string 2 token)))))
- ;; Push all tags in groups, no matter if they already
- ;; appear somewhere else in the list.
- (when (or group-flag (not (assoc tag alist)))
- (push (cons tag key) alist))))))))))
- (defun org-tag-alist-to-string (alist &optional skip-key)
- "Return tag string associated to ALIST.
- ALIST is an alist, as defined in `org-tag-alist' or
- `org-tag-persistent-alist', or produced with
- `org-tag-string-to-alist'.
- Return value is a string suitable as a value for \"TAGS\"
- keyword.
- When optional argument SKIP-KEY is non-nil, skip selection keys
- next to tags."
- (mapconcat (lambda (token)
- (pcase token
- (`(:startgroup) "{")
- (`(:endgroup) "}")
- (`(:startgrouptag) "[")
- (`(:endgrouptag) "]")
- (`(:grouptags) ":")
- (`(:newline) "\\n")
- ((and
- (guard (not skip-key))
- `(,(and tag (pred stringp)) . ,(and key (pred characterp))))
- (format "%s(%c)" tag key))
- (`(,(and tag (pred stringp)) . ,_) tag)
- (_ (user-error "Invalid tag token: %S" token))))
- alist
- " "))
- (defun org-tag-alist-to-groups (alist)
- "Return group alist from tag ALIST.
- ALIST is an alist, as defined in `org-tag-alist' or
- `org-tag-persistent-alist', or produced with
- `org-tag-string-to-alist'. Return value is an alist following
- the pattern (GROUP-TAG TAGS) where GROUP-TAG is the tag, as
- a string, summarizing TAGS, as a list of strings."
- (let (groups group-status current-group)
- (dolist (token alist (nreverse groups))
- (pcase token
- (`(,(or :startgroup :startgrouptag)) (setq group-status t))
- (`(,(or :endgroup :endgrouptag))
- (when (eq group-status 'append)
- (push (nreverse current-group) groups))
- (setq group-status nil))
- (`(:grouptags) (setq group-status 'append))
- ((and `(,tag . ,_) (guard group-status))
- (if (eq group-status 'append) (push tag current-group)
- (setq current-group (list tag))))
- (_ nil)))))
- (defun org-file-contents (file &optional noerror)
- "Return the contents of FILE, as a string."
- (if (and file (file-readable-p file))
- (with-temp-buffer
- (insert-file-contents file)
- (buffer-string))
- (funcall (if noerror 'message 'error)
- "Cannot read file \"%s\"%s"
- file
- (let ((from (buffer-file-name (buffer-base-buffer))))
- (if from (concat " (referenced in file \"" from "\")") "")))))
- (defun org-extract-log-state-settings (x)
- "Extract the log state setting from a TODO keyword string.
- This will extract info from a string like \"WAIT(w@/!)\"."
- (when (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?\\([!@]\\)?\\(?:/\\([!@]\\)\\)?)\\)?$" x)
- (let ((kw (match-string 1 x))
- (log1 (and (match-end 3) (match-string 3 x)))
- (log2 (and (match-end 4) (match-string 4 x))))
- (and (or log1 log2)
- (list kw
- (and log1 (if (equal log1 "!") 'time 'note))
- (and log2 (if (equal log2 "!") 'time 'note)))))))
- (defun org-remove-keyword-keys (list)
- "Remove a pair of parenthesis at the end of each string in LIST."
- (mapcar (lambda (x)
- (if (string-match "(.*)$" x)
- (substring x 0 (match-beginning 0))
- x))
- list))
- (defun org-assign-fast-keys (alist)
- "Assign fast keys to a keyword-key alist.
- Respect keys that are already there."
- (let (new e (alt ?0))
- (while (setq e (pop alist))
- (if (or (memq (car e) '(:newline :grouptags :endgroup :startgroup))
- (cdr e)) ;; Key already assigned.
- (push e new)
- (let ((clist (string-to-list (downcase (car e))))
- (used (append new alist)))
- (when (= (car clist) ?@)
- (pop clist))
- (while (and clist (rassoc (car clist) used))
- (pop clist))
- (unless clist
- (while (rassoc alt used)
- (cl-incf alt)))
- (push (cons (car e) (or (car clist) alt)) new))))
- (nreverse new)))
- ;;; Some variables used in various places
- (defvar org-window-configuration nil
- "Used in various places to store a window configuration.")
- (defvar org-selected-window nil
- "Used in various places to store a window configuration.")
- (defvar org-finish-function nil
- "Function to be called when `C-c C-c' is used.
- This is for getting out of special buffers like capture.")
- (defvar org-last-state)
- ;; Defined somewhere in this file, but used before definition.
- (defvar org-entities) ;; defined in org-entities.el
- (defvar org-struct-menu)
- (defvar org-org-menu)
- (defvar org-tbl-menu)
- ;;;; Define the Org mode
- ;; We use a before-change function to check if a table might need
- ;; an update.
- (defvar org-table-may-need-update t
- "Indicates that a table might need an update.
- This variable is set by `org-before-change-function'.
- `org-table-align' sets it back to nil.")
- (defun org-before-change-function (_beg _end)
- "Every change indicates that a table might need an update."
- (setq org-table-may-need-update t))
- (defvar org-mode-map)
- (defvar org-inhibit-startup-visibility-stuff nil) ; Dynamically-scoped param.
- (defvar org-agenda-keep-modes nil) ; Dynamically-scoped param.
- (defvar org-inhibit-logging nil) ; Dynamically-scoped param.
- (defvar org-inhibit-blocking nil) ; Dynamically-scoped param.
- (defvar org-table-buffer-is-an nil)
- (defvar bidi-paragraph-direction)
- (defvar buffer-face-mode-face)
- (require 'outline)
- ;; Other stuff we need.
- (require 'time-date)
- (unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time))
- (require 'easymenu)
- (autoload 'easy-menu-add "easymenu")
- (require 'overlay)
- ;; (require 'org-macs) moved higher up in the file before it is first used
- (require 'org-entities)
- ;; (require 'org-compat) moved higher up in the file before it is first used
- (require 'org-faces)
- (require 'org-list)
- (require 'org-pcomplete)
- (require 'org-src)
- (require 'org-footnote)
- (require 'org-macro)
- ;; babel
- (require 'ob)
- ;;;###autoload
- (define-derived-mode org-mode outline-mode "Org"
- "Outline-based notes management and organizer, alias
- \"Carsten's outline-mode for keeping track of everything.\"
- Org mode develops organizational tasks around a NOTES file which
- contains information about projects as plain text. Org mode is
- implemented on top of Outline mode, which is ideal to keep the content
- of large files well structured. It supports ToDo items, deadlines and
- time stamps, which magically appear in the diary listing of the Emacs
- calendar. Tables are easily created with a built-in table editor.
- Plain text URL-like links connect to websites, emails (VM), Usenet
- messages (Gnus), BBDB entries, and any files related to the project.
- For printing and sharing of notes, an Org file (or a part of it)
- can be exported as a structured ASCII or HTML file.
- The following commands are available:
- \\{org-mode-map}"
- ;; Get rid of Outline menus, they are not needed
- ;; Need to do this here because define-derived-mode sets up
- ;; the keymap so late. Still, it is a waste to call this each time
- ;; we switch another buffer into Org mode.
- (define-key org-mode-map [menu-bar headings] 'undefined)
- (define-key org-mode-map [menu-bar hide] 'undefined)
- (define-key org-mode-map [menu-bar show] 'undefined)
- (org-load-modules-maybe)
- (org-install-agenda-files-menu)
- (when org-descriptive-links (add-to-invisibility-spec '(org-link)))
- (add-to-invisibility-spec '(org-cwidth))
- (add-to-invisibility-spec '(org-hide-block . t))
- (setq-local outline-regexp org-outline-regexp)
- (setq-local outline-level 'org-outline-level)
- (setq bidi-paragraph-direction 'left-to-right)
- (when (and (stringp org-ellipsis) (not (equal "" org-ellipsis)))
- (unless org-display-table
- (setq org-display-table (make-display-table)))
- (set-display-table-slot
- org-display-table 4
- (vconcat (mapcar (lambda (c) (make-glyph-code c 'org-ellipsis))
- org-ellipsis)))
- (setq buffer-display-table org-display-table))
- (org-set-regexps-and-options)
- (org-set-font-lock-defaults)
- (when (and org-tag-faces (not org-tags-special-faces-re))
- ;; tag faces set outside customize.... force initialization.
- (org-set-tag-faces 'org-tag-faces org-tag-faces))
- ;; Calc embedded
- (setq-local calc-embedded-open-mode "# ")
- ;; Modify a few syntax entries
- (modify-syntax-entry ?@ "w")
- (modify-syntax-entry ?\" "\"")
- (modify-syntax-entry ?\\ "_")
- (modify-syntax-entry ?~ "_")
- (setq-local font-lock-unfontify-region-function 'org-unfontify-region)
- ;; Activate before-change-function
- (setq-local org-table-may-need-update t)
- (add-hook 'before-change-functions 'org-before-change-function nil 'local)
- ;; Check for running clock before killing a buffer
- (add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local)
- ;; Initialize macros templates.
- (org-macro-initialize-templates)
- ;; Initialize radio targets.
- (org-update-radio-target-regexp)
- ;; Indentation.
- (setq-local indent-line-function 'org-indent-line)
- (setq-local indent-region-function 'org-indent-region)
- ;; Filling and auto-filling.
- (org-setup-filling)
- ;; Comments.
- (org-setup-comments-handling)
- ;; Initialize cache.
- (org-element-cache-reset)
- ;; Beginning/end of defun
- (setq-local beginning-of-defun-function 'org-backward-element)
- (setq-local end-of-defun-function
- (lambda ()
- (if (not (org-at-heading-p))
- (org-forward-element)
- (org-forward-element)
- (forward-char -1))))
- ;; Next error for sparse trees
- (setq-local next-error-function 'org-occur-next-match)
- ;; Make sure dependence stuff works reliably, even for users who set it
- ;; too late :-(
- (if org-enforce-todo-dependencies
- (add-hook 'org-blocker-hook
- 'org-block-todo-from-children-or-siblings-or-parent)
- (remove-hook 'org-blocker-hook
- 'org-block-todo-from-children-or-siblings-or-parent))
- (if org-enforce-todo-checkbox-dependencies
- (add-hook 'org-blocker-hook
- 'org-block-todo-from-checkboxes)
- (remove-hook 'org-blocker-hook
- 'org-block-todo-from-checkboxes))
- ;; Align options lines
- (setq-local
- align-mode-rules-list
- '((org-in-buffer-settings
- (regexp . "^[ \t]*#\\+[A-Z_]+:\\(\\s-*\\)\\S-+")
- (modes . '(org-mode)))))
- ;; Imenu
- (setq-local imenu-create-index-function 'org-imenu-get-tree)
- ;; Make isearch reveal context
- (setq-local outline-isearch-open-invisible-function
- (lambda (&rest _) (org-show-context 'isearch)))
- ;; Setup the pcomplete hooks
- (setq-local pcomplete-command-completion-function 'org-pcomplete-initial)
- (setq-local pcomplete-command-name-function 'org-command-at-point)
- (setq-local pcomplete-default-completion-function 'ignore)
- (setq-local pcomplete-parse-arguments-function 'org-parse-arguments)
- (setq-local pcomplete-termination-string "")
- (setq-local buffer-face-mode-face 'org-default)
- ;; If empty file that did not turn on Org mode automatically, make
- ;; it to.
- (when (and org-insert-mode-line-in-empty-file
- (called-interactively-p 'any)
- (= (point-min) (point-max)))
- (insert "# -*- mode: org -*-\n\n"))
- (unless org-inhibit-startup
- (org-unmodified
- (when org-startup-with-beamer-mode (org-beamer-mode))
- (when org-startup-align-all-tables
- (org-table-map-tables #'org-table-align t))
- (when org-startup-with-inline-images (org-display-inline-images))
- (when org-startup-with-latex-preview (org-toggle-latex-fragment '(16)))
- (unless org-inhibit-startup-visibility-stuff (org-set-startup-visibility))
- (when org-startup-truncated (setq truncate-lines t))
- (when org-startup-indented (require 'org-indent) (org-indent-mode 1))
- (org-refresh-effort-properties)))
- ;; Try to set `org-hide' face correctly.
- (let ((foreground (org-find-invisible-foreground)))
- (when foreground
- (set-face-foreground 'org-hide foreground))))
- ;; Update `customize-package-emacs-version-alist'
- (add-to-list 'customize-package-emacs-version-alist
- '(Org ("6.21b" . "23.1") ("6.33x" . "23.2")
- ("7.8.11" . "24.1") ("7.9.4" . "24.3")
- ("8.2.6" . "24.4") ("8.2.10" . "24.5")
- ("9.0" . "26.1")))
- (defvar org-mode-transpose-word-syntax-table
- (let ((st (make-syntax-table text-mode-syntax-table)))
- (dolist (c org-emphasis-alist st)
- (modify-syntax-entry (string-to-char (car c)) "w p" st))))
- (when (fboundp 'abbrev-table-put)
- (abbrev-table-put org-mode-abbrev-table
- :parents (list text-mode-abbrev-table)))
- (defun org-find-invisible-foreground ()
- (let ((candidates (remove
- "unspecified-bg"
- (nconc
- (list (face-background 'default)
- (face-background 'org-default))
- (mapcar
- (lambda (alist)
- (when (boundp alist)
- (cdr (assq 'background-color (symbol-value alist)))))
- '(default-frame-alist initial-frame-alist window-system-default-frame-alist))
- (list (face-foreground 'org-hide))))))
- (car (remove nil candidates))))
- (defun org-current-time (&optional rounding-minutes past)
- "Current time, possibly rounded to ROUNDING-MINUTES.
- When ROUNDING-MINUTES is not an integer, fall back on the car of
- `org-time-stamp-rounding-minutes'. When PAST is non-nil, ensure
- the rounding returns a past time."
- (let ((r (or (and (integerp rounding-minutes) rounding-minutes)
- (car org-time-stamp-rounding-minutes)))
- (time (decode-time)) res)
- (if (< r 1)
- (current-time)
- (setq res
- (apply 'encode-time
- (append (list 0 (* r (floor (+ .5 (/ (float (nth 1 time)) r)))))
- (nthcdr 2 time))))
- (if (and past (< (float-time (time-subtract (current-time) res)) 0))
- (seconds-to-time (- (float-time res) (* r 60)))
- res))))
- (defun org-today ()
- "Return today date, considering `org-extend-today-until'."
- (time-to-days
- (time-subtract (current-time)
- (list 0 (* 3600 org-extend-today-until) 0))))
- ;;;; Font-Lock stuff, including the activators
- (defvar org-mouse-map (make-sparse-keymap))
- (org-defkey org-mouse-map [mouse-2] 'org-open-at-mouse)
- (org-defkey org-mouse-map [mouse-3] 'org-find-file-at-mouse)
- (when org-mouse-1-follows-link
- (org-defkey org-mouse-map [follow-link] 'mouse-face))
- (when org-tab-follows-link
- (org-defkey org-mouse-map [(tab)] 'org-open-at-point)
- (org-defkey org-mouse-map "\C-i" 'org-open-at-point))
- (require 'font-lock)
- (defconst org-non-link-chars "]\t\n\r<>")
- (defvar org-link-types-re nil
- "Matches a link that has a url-like prefix like \"http:\"")
- (defvar org-link-re-with-space nil
- "Matches a link with spaces, optional angular brackets around it.")
- (defvar org-link-re-with-space2 nil
- "Matches a link with spaces, optional angular brackets around it.")
- (defvar org-link-re-with-space3 nil
- "Matches a link with spaces, only for internal part in bracket links.")
- (defvar org-angle-link-re nil
- "Matches link with angular brackets, spaces are allowed.")
- (defvar org-plain-link-re nil
- "Matches plain link, without spaces.")
- (defvar org-bracket-link-regexp nil
- "Matches a link in double brackets.")
- (defvar org-bracket-link-analytic-regexp nil
- "Regular expression used to analyze links.
- Here is what the match groups contain after a match:
- 1: http:
- 2: http
- 3: path
- 4: [desc]
- 5: desc")
- (defvar org-bracket-link-analytic-regexp++ nil
- "Like `org-bracket-link-analytic-regexp', but include coderef internal type.")
- (defvar org-any-link-re nil
- "Regular expression matching any link.")
- (defconst org-match-sexp-depth 3
- "Number of stacked braces for sub/superscript matching.")
- (defun org-create-multibrace-regexp (left right n)
- "Create a regular expression which will match a balanced sexp.
- Opening delimiter is LEFT, and closing delimiter is RIGHT, both given
- as single character strings.
- The regexp returned will match the entire expression including the
- delimiters. It will also define a single group which contains the
- match except for the outermost delimiters. The maximum depth of
- stacked delimiters is N. Escaping delimiters is not possible."
- (let* ((nothing (concat "[^" left right "]*?"))
- (or "\\|")
- (re nothing)
- (next (concat "\\(?:" nothing left nothing right "\\)+" nothing)))
- (while (> n 1)
- (setq n (1- n)
- re (concat re or next)
- next (concat "\\(?:" nothing left next right "\\)+" nothing)))
- (concat left "\\(" re "\\)" right)))
- (defconst org-match-substring-regexp
- (concat
- "\\(\\S-\\)\\([_^]\\)\\("
- "\\(?:" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)"
- "\\|"
- "\\(?:" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)"
- "\\|"
- "\\(?:\\*\\|[+-]?[[:alnum:].,\\]*[[:alnum:]]\\)\\)")
- "The regular expression matching a sub- or superscript.")
- (defconst org-match-substring-with-braces-regexp
- (concat
- "\\(\\S-\\)\\([_^]\\)"
- "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)")
- "The regular expression matching a sub- or superscript, forcing braces.")
- (defun org-make-link-regexps ()
- "Update the link regular expressions.
- This should be called after the variable `org-link-parameters' has changed."
- (let ((types-re (regexp-opt (org-link-types) t)))
- (setq org-link-types-re
- (concat "\\`" types-re ":")
- org-link-re-with-space
- (concat "<?" types-re ":"
- "\\([^" org-non-link-chars " ]"
- "[^" org-non-link-chars "]*"
- "[^" org-non-link-chars " ]\\)>?")
- org-link-re-with-space2
- (concat "<?" types-re ":"
- "\\([^" org-non-link-chars " ]"
- "[^\t\n\r]*"
- "[^" org-non-link-chars " ]\\)>?")
- org-link-re-with-space3
- (concat "<?" types-re ":"
- "\\([^" org-non-link-chars " ]"
- "[^\t\n\r]*\\)")
- org-angle-link-re
- (format "<%s:\\([^>\n]*\\(?:\n[ \t]*[^> \t\n][^>\n]*\\)*\\)>"
- types-re)
- org-plain-link-re
- (concat
- "\\<" types-re ":"
- "\\([^][ \t\n()<>]+\\(?:([[:word:]0-9_]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)")
- ;; "\\([^]\t\n\r<>() ]+[^]\t\n\r<>,.;() ]\\)")
- org-bracket-link-regexp
- "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]"
- org-bracket-link-analytic-regexp
- (concat
- "\\[\\["
- "\\(" types-re ":\\)?"
- "\\([^]]+\\)"
- "\\]"
- "\\(\\[" "\\([^]]+\\)" "\\]\\)?"
- "\\]")
- org-bracket-link-analytic-regexp++
- (concat
- "\\[\\["
- "\\(" (regexp-opt (cons "coderef" (org-link-types)) t) ":\\)?"
- "\\([^]]+\\)"
- "\\]"
- "\\(\\[" "\\([^]]+\\)" "\\]\\)?"
- "\\]")
- org-any-link-re
- (concat "\\(" org-bracket-link-regexp "\\)\\|\\("
- org-angle-link-re "\\)\\|\\("
- org-plain-link-re "\\)"))))
- (org-make-link-regexps)
- (defvar org-emph-face nil)
- (defun org-do-emphasis-faces (limit)
- "Run through the buffer and emphasize strings."
- (let (rtn a)
- (while (and (not rtn) (re-search-forward org-emph-re limit t))
- (let* ((border (char-after (match-beginning 3)))
- (bre (regexp-quote (char-to-string border))))
- (when (and (not (= border (char-after (match-beginning 4))))
- (not (string-match-p (concat bre ".*" bre)
- (replace-regexp-in-string
- "\n" " "
- (substring (match-string 2) 1 -1)))))
- (setq rtn t)
- (setq a (assoc (match-string 3) org-emphasis-alist))
- (font-lock-prepend-text-property (match-beginning 2) (match-end 2)
- 'face
- (nth 1 a))
- (and (nth 2 a)
- (org-remove-flyspell-overlays-in
- (match-beginning 0) (match-end 0)))
- (add-text-properties (match-beginning 2) (match-end 2)
- '(font-lock-multiline t org-emphasis t))
- (when org-hide-emphasis-markers
- (add-text-properties (match-end 4) (match-beginning 5)
- '(invisible org-link))
- (add-text-properties (match-beginning 3) (match-end 3)
- '(invisible org-link)))))
- (goto-char (1+ (match-beginning 0))))
- rtn))
- (defun org-emphasize (&optional char)
- "Insert or change an emphasis, i.e. a font like bold or italic.
- If there is an active region, change that region to a new emphasis.
- If there is no region, just insert the marker characters and position
- the cursor between them.
- CHAR should be the marker character. If it is a space, it means to
- remove the emphasis of the selected region.
- If CHAR is not given (for example in an interactive call) it will be
- prompted for."
- (interactive)
- (let ((erc org-emphasis-regexp-components)
- (string "") beg end move s)
- (if (org-region-active-p)
- (setq beg (region-beginning)
- end (region-end)
- string (buffer-substring beg end))
- (setq move t))
- (unless char
- (message "Emphasis marker or tag: [%s]"
- (mapconcat #'car org-emphasis-alist ""))
- (setq char (read-char-exclusive)))
- (if (equal char ?\s)
- (setq s ""
- move nil)
- (unless (assoc (char-to-string char) org-emphasis-alist)
- (user-error "No such emphasis marker: \"%c\"" char))
- (setq s (char-to-string char)))
- (while (and (> (length string) 1)
- (equal (substring string 0 1) (substring string -1))
- (assoc (substring string 0 1) org-emphasis-alist))
- (setq string (substring string 1 -1)))
- (setq string (concat s string s))
- (when beg (delete-region beg end))
- (unless (or (bolp)
- (string-match (concat "[" (nth 0 erc) "\n]")
- (char-to-string (char-before (point)))))
- (insert " "))
- (unless (or (eobp)
- (string-match (concat "[" (nth 1 erc) "\n]")
- (char-to-string (char-after (point)))))
- (insert " ") (backward-char 1))
- (insert string)
- (and move (backward-char 1))))
- (defconst org-nonsticky-props
- '(mouse-face highlight keymap invisible intangible help-echo org-linked-text htmlize-link))
- (defsubst org-rear-nonsticky-at (pos)
- (add-text-properties (1- pos) pos (list 'rear-nonsticky org-nonsticky-props)))
- (defun org-activate-links (limit)
- "Add link properties to links.
- This includes angle, plain, and bracket links."
- (catch :exit
- (while (re-search-forward org-any-link-re limit t)
- (let* ((start (match-beginning 0))
- (end (match-end 0))
- (style (cond ((eq ?< (char-after start)) 'angle)
- ((eq ?\[ (char-after (1+ start))) 'bracket)
- (t 'plain))))
- (when (and (memq style org-highlight-links)
- ;; Do not confuse plain links with tags.
- (not (and (eq style 'plain)
- (let ((face (get-text-property
- (max (1- start) (point-min)) 'face)))
- (if (consp face) (memq 'org-tag face)
- (eq 'org-tag face))))))
- (let* ((link-object (save-excursion
- (goto-char start)
- (save-match-data (org-element-link-parser))))
- (link (org-element-property :raw-link link-object))
- (type (org-element-property :type link-object))
- (path (org-element-property :path link-object))
- (properties ;for link's visible part
- (list
- 'face (pcase (org-link-get-parameter type :face)
- ((and (pred functionp) face) (funcall face path))
- ((and (pred facep) face) face)
- ((and (pred consp) face) face) ;anonymous
- (_ 'org-link))
- 'mouse-face (or (org-link-get-parameter type :mouse-face)
- 'highlight)
- 'keymap (or (org-link-get-parameter type :keymap)
- org-mouse-map)
- 'help-echo (pcase (org-link-get-parameter type :help-echo)
- ((and (pred stringp) echo) echo)
- ((and (pred functionp) echo) echo)
- (_ (concat "LINK: " link)))
- 'htmlize-link (pcase (org-link-get-parameter type
- :htmlize-link)
- ((and (pred functionp) f) (funcall f))
- (_ `(:uri ,link)))
- 'font-lock-multiline t)))
- (org-remove-flyspell-overlays-in start end)
- (org-rear-nonsticky-at end)
- (if (not (eq 'bracket style))
- (add-text-properties start end properties)
- ;; Handle invisible parts in bracket links.
- (remove-text-properties start end '(invisible nil))
- (let ((hidden
- (append `(invisible
- ,(or (org-link-get-parameter type :display)
- 'org-link))
- properties))
- (visible-start (or (match-beginning 4) (match-beginning 2)))
- (visible-end (or (match-end 4) (match-end 2))))
- (add-text-properties start visible-start hidden)
- (add-text-properties visible-start visible-end properties)
- (add-text-properties visible-end end hidden)
- (org-rear-nonsticky-at visible-start)
- (org-rear-nonsticky-at visible-end)))
- (let ((f (org-link-get-parameter type :activate-func)))
- (when (functionp f)
- (funcall f start end path (eq style 'bracket))))
- (throw :exit t))))) ;signal success
- nil))
- (defun org-activate-code (limit)
- (when (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t)
- (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
- (remove-text-properties (match-beginning 0) (match-end 0)
- '(display t invisible t intangible t))
- t))
- (defcustom org-src-fontify-natively t
- "When non-nil, fontify code in code blocks.
- See also the `org-block' face."
- :type 'boolean
- :version "24.4"
- :package-version '(Org . "8.3")
- :group 'org-appearance
- :group 'org-babel)
- (defcustom org-allow-promoting-top-level-subtree nil
- "When non-nil, allow promoting a top level subtree.
- The leading star of the top level headline will be replaced
- by a #."
- :type 'boolean
- :version "24.1"
- :group 'org-appearance)
- (defun org-fontify-meta-lines-and-blocks (limit)
- (condition-case nil
- (org-fontify-meta-lines-and-blocks-1 limit)
- (error (message "org-mode fontification error in %S at %d"
- (current-buffer)
- (line-number-at-pos)))))
- (defun org-fontify-meta-lines-and-blocks-1 (limit)
- "Fontify #+ lines and blocks."
- (let ((case-fold-search t))
- (when (re-search-forward
- "^\\([ \t]*#\\(\\(\\+[a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)"
- limit t)
- (let ((beg (match-beginning 0))
- (block-start (match-end 0))
- (block-end nil)
- (lang (match-string 7))
- (beg1 (line-beginning-position 2))
- (dc1 (downcase (match-string 2)))
- (dc3 (downcase (match-string 3)))
- end end1 quoting block-type)
- (cond
- ((and (match-end 4) (equal dc3 "+begin"))
- ;; Truly a block
- (setq block-type (downcase (match-string 5))
- quoting (member block-type org-protecting-blocks))
- (when (re-search-forward
- (concat "^[ \t]*#\\+end" (match-string 4) "\\>.*")
- nil t) ;; on purpose, we look further than LIMIT
- (setq end (min (point-max) (match-end 0))
- end1 (min (point-max) (1- (match-beginning 0))))
- (setq block-end (match-beginning 0))
- (when quoting
- (org-remove-flyspell-overlays-in beg1 end1)
- (remove-text-properties beg end
- '(display t invisible t intangible t)))
- (add-text-properties
- beg end '(font-lock-fontified t font-lock-multiline t))
- (add-text-properties beg beg1 '(face org-meta-line))
- (org-remove-flyspell-overlays-in beg beg1)
- (add-text-properties ; For end_src
- end1 (min (point-max) (1+ end)) '(face org-meta-line))
- (org-remove-flyspell-overlays-in end1 end)
- (cond
- ((and lang (not (string= lang "")) org-src-fontify-natively)
- (org-src-font-lock-fontify-block lang block-start block-end)
- (add-text-properties beg1 block-end '(src-block t)))
- (quoting
- (add-text-properties beg1 (min (point-max) (1+ end1))
- (list 'face
- (list :inherit
- (let ((face-name
- (intern (format "org-block-%s" lang))))
- (append (and (facep face-name) (list face-name))
- '(org-block))))))) ; end of source block
- ((not org-fontify-quote-and-verse-blocks))
- ((string= block-type "quote")
- (add-face-text-property
- beg1 (min (point-max) (1+ end1)) 'org-quote t))
- ((string= block-type "verse")
- (add-face-text-property
- beg1 (min (point-max) (1+ end1)) 'org-verse t)))
- (add-text-properties beg beg1 '(face org-block-begin-line))
- (add-text-properties (min (point-max) (1+ end)) (min (point-max) (1+ end1))
- '(face org-block-end-line))
- t))
- ((member dc1 '("+title:" "+author:" "+email:" "+date:"))
- (org-remove-flyspell-overlays-in
- (match-beginning 0)
- (if (equal "+title:" dc1) (match-end 2) (match-end 0)))
- (add-text-properties
- beg (match-end 3)
- (if (member (intern (substring dc1 1 -1)) org-hidden-keywords)
- '(font-lock-fontified t invisible t)
- '(font-lock-fontified t face org-document-info-keyword)))
- (add-text-properties
- (match-beginning 6) (min (point-max) (1+ (match-end 6)))
- (if (string-equal dc1 "+title:")
- '(font-lock-fontified t face org-document-title)
- '(font-lock-fontified t face org-document-info))))
- ((string-prefix-p "+caption" dc1)
- (org-remove-flyspell-overlays-in (match-end 2) (match-end 0))
- (remove-text-properties (match-beginning 0) (match-end 0)
- '(display t invisible t intangible t))
- ;; Handle short captions.
- (save-excursion
- (beginning-of-line)
- (looking-at "\\([ \t]*#\\+caption\\(?:\\[.*\\]\\)?:\\)[ \t]*"))
- (add-text-properties (line-beginning-position) (match-end 1)
- '(font-lock-fontified t face org-meta-line))
- (add-text-properties (match-end 0) (line-end-position)
- '(font-lock-fontified t face org-block))
- t)
- ((member dc3 '(" " ""))
- (org-remove-flyspell-overlays-in beg (match-end 0))
- (add-text-properties
- beg (match-end 0)
- '(font-lock-fontified t face font-lock-comment-face)))
- (t ;; just any other in-buffer setting, but not indented
- (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
- (remove-text-properties (match-beginning 0) (match-end 0)
- '(display t invisible t intangible t))
- (add-text-properties beg (match-end 0)
- '(font-lock-fontified t face org-meta-line))
- t))))))
- (defun org-fontify-drawers (limit)
- "Fontify drawers."
- (when (re-search-forward org-drawer-regexp limit t)
- (add-text-properties
- (match-beginning 0) (match-end 0)
- '(font-lock-fontified t face org-special-keyword))
- (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
- t))
- (defun org-fontify-macros (limit)
- "Fontify macros."
- (when (re-search-forward "\\({{{\\).+?\\(}}}\\)" limit t)
- (add-text-properties
- (match-beginning 0) (match-end 0)
- '(font-lock-fontified t face org-macro))
- (when org-hide-macro-markers
- (add-text-properties (match-end 2) (match-beginning 2)
- '(invisible t))
- (add-text-properties (match-beginning 1) (match-end 1)
- '(invisible t)))
- (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
- t))
- (defun org-activate-footnote-links (limit)
- "Add text properties for footnotes."
- (let ((fn (org-footnote-next-reference-or-definition limit)))
- (when fn
- (let* ((beg (nth 1 fn))
- (end (nth 2 fn))
- (label (car fn))
- (referencep (/= (line-beginning-position) beg)))
- (when (and referencep (nth 3 fn))
- (save-excursion
- (goto-char beg)
- (search-forward (or label "fn:"))
- (org-remove-flyspell-overlays-in beg (match-end 0))))
- (add-text-properties beg end
- (list 'mouse-face 'highlight
- 'keymap org-mouse-map
- 'help-echo
- (if referencep "Footnote reference"
- "Footnote definition")
- 'font-lock-fontified t
- 'font-lock-multiline t
- 'face 'org-footnote))))))
- (defun org-activate-dates (limit)
- "Add text properties for dates."
- (when (and (re-search-forward org-tsr-regexp-both limit t)
- (not (equal (char-before (match-beginning 0)) 91)))
- (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
- (add-text-properties (match-beginning 0) (match-end 0)
- (list 'mouse-face 'highlight
- 'keymap org-mouse-map))
- (org-rear-nonsticky-at (match-end 0))
- (when org-display-custom-times
- ;; If it's a date range, activate custom time for second date.
- (when (match-end 3)
- (org-display-custom-time (match-beginning 3) (match-end 3)))
- (org-display-custom-time (match-beginning 1) (match-end 1)))
- t))
- (defvar-local org-target-link-regexp nil
- "Regular expression matching radio targets in plain text.")
- (defconst org-target-regexp (let ((border "[^<>\n\r \t]"))
- (format "<<\\(%s\\|%s[^<>\n\r]*%s\\)>>"
- border border border))
- "Regular expression matching a link target.")
- (defconst org-radio-target-regexp (format "<%s>" org-target-regexp)
- "Regular expression matching a radio target.")
- (defconst org-any-target-regexp
- (format "%s\\|%s" org-radio-target-regexp org-target-regexp)
- "Regular expression matching any target.")
- (defun org-activate-target-links (limit)
- "Add text properties for target matches."
- (when org-target-link-regexp
- (let ((case-fold-search t))
- (when (re-search-forward org-target-link-regexp limit t)
- (org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1))
- (add-text-properties (match-beginning 1) (match-end 1)
- (list 'mouse-face 'highlight
- 'keymap org-mouse-map
- 'help-echo "Radio target link"
- 'org-linked-text t))
- (org-rear-nonsticky-at (match-end 1))
- t))))
- (defun org-update-radio-target-regexp ()
- "Find all radio targets in this file and update the regular expression.
- Also refresh fontification if needed."
- (interactive)
- (let ((old-regexp org-target-link-regexp)
- (before-re "\\(?:^\\|[^[:alnum:]]\\)\\(")
- (after-re "\\)\\(?:$\\|[^[:alnum:]]\\)")
- (targets
- (org-with-wide-buffer
- (goto-char (point-min))
- (let (rtn)
- (while (re-search-forward org-radio-target-regexp nil t)
- ;; Make sure point is really within the object.
- (backward-char)
- (let ((obj (org-element-context)))
- (when (eq (org-element-type obj) 'radio-target)
- (cl-pushnew (org-element-property :value obj) rtn
- :test #'equal))))
- rtn))))
- (setq org-target-link-regexp
- (and targets
- (concat before-re
- (mapconcat
- (lambda (x)
- (replace-regexp-in-string
- " +" "\\s-+" (regexp-quote x) t t))
- targets
- "\\|")
- after-re)))
- (unless (equal old-regexp org-target-link-regexp)
- ;; Clean-up cache.
- (let ((regexp (cond ((not old-regexp) org-target-link-regexp)
- ((not org-target-link-regexp) old-regexp)
- (t
- (concat before-re
- (mapconcat
- (lambda (re)
- (substring re (length before-re)
- (- (length after-re))))
- (list old-regexp org-target-link-regexp)
- "\\|")
- after-re)))))
- (org-with-wide-buffer
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (org-element-cache-refresh (match-beginning 1)))))
- ;; Re fontify buffer.
- (when (memq 'radio org-highlight-links)
- (org-restart-font-lock)))))
- (defun org-hide-wide-columns (limit)
- (let (s e)
- (setq s (text-property-any (point) (or limit (point-max))
- 'org-cwidth t))
- (when s
- (setq e (next-single-property-change s 'org-cwidth))
- (add-text-properties s e '(invisible org-cwidth))
- (goto-char e)
- t)))
- (defvar org-latex-and-related-regexp nil
- "Regular expression for highlighting LaTeX, entities and sub/superscript.")
- (defun org-compute-latex-and-related-regexp ()
- "Compute regular expression for LaTeX, entities and sub/superscript.
- Result depends on variable `org-highlight-latex-and-related'."
- (setq-local
- org-latex-and-related-regexp
- (let* ((re-sub
- (cond ((not (memq 'script org-highlight-latex-and-related)) nil)
- ((eq org-use-sub-superscripts '{})
- (list org-match-substring-with-braces-regexp))
- (org-use-sub-superscripts (list org-match-substring-regexp))))
- (re-latex
- (when (memq 'latex org-highlight-latex-and-related)
- (let ((matchers (plist-get org-format-latex-options :matchers)))
- (delq nil
- (mapcar (lambda (x)
- (and (member (car x) matchers) (nth 1 x)))
- org-latex-regexps)))))
- (re-entities
- (when (memq 'entities org-highlight-latex-and-related)
- (list "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)"))))
- (mapconcat 'identity (append re-latex re-entities re-sub) "\\|"))))
- (defun org-do-latex-and-related (limit)
- "Highlight LaTeX snippets and environments, entities and sub/superscript.
- LIMIT bounds the search for syntax to highlight. Stop at first
- highlighted object, if any. Return t if some highlighting was
- done, nil otherwise."
- (when (org-string-nw-p org-latex-and-related-regexp)
- (catch 'found
- (while (re-search-forward org-latex-and-related-regexp limit t)
- (unless
- (cl-some
- (lambda (f)
- (memq f '(org-code org-verbatim underline org-special-keyword)))
- (save-excursion
- (goto-char (1+ (match-beginning 0)))
- (face-at-point nil t)))
- (let ((offset (if (memq (char-after (1+ (match-beginning 0)))
- '(?_ ?^))
- 1
- 0)))
- (font-lock-prepend-text-property
- (+ offset (match-beginning 0)) (match-end 0)
- 'face 'org-latex-and-related)
- (add-text-properties (+ offset (match-beginning 0)) (match-end 0)
- '(font-lock-multiline t)))
- (throw 'found t)))
- nil)))
- (defun org-restart-font-lock ()
- "Restart `font-lock-mode', to force refontification."
- (when (and (boundp 'font-lock-mode) font-lock-mode)
- (font-lock-mode -1)
- (font-lock-mode 1)))
- (defun org-activate-tags (limit)
- (when (re-search-forward
- "^\\*+.*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" limit t)
- (org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1))
- (add-text-properties (match-beginning 1) (match-end 1)
- (list 'mouse-face 'highlight
- 'keymap org-mouse-map))
- (org-rear-nonsticky-at (match-end 1))
- t))
- (defun org-outline-level ()
- "Compute the outline level of the heading at point.
- If this is called at a normal headline, the level is the number
- of stars. Use `org-reduced-level' to remove the effect of
- `org-odd-levels'. Unlike to `org-current-level', this function
- takes into consideration inlinetasks."
- (org-with-wide-buffer
- (end-of-line)
- (if (re-search-backward org-outline-regexp-bol nil t)
- (1- (- (match-end 0) (match-beginning 0)))
- 0)))
- (defvar org-font-lock-keywords nil)
- (defsubst org-re-property (property &optional literal allow-null value)
- "Return a regexp matching a PROPERTY line.
- When optional argument LITERAL is non-nil, do not quote PROPERTY.
- This is useful when PROPERTY is a regexp. When ALLOW-NULL is
- non-nil, match properties even without a value.
- Match group 3 is set to the value when it exists. If there is no
- value and ALLOW-NULL is non-nil, it is set to the empty string.
- With optional argument VALUE, match only property lines with
- that value; in this case, ALLOW-NULL is ignored. VALUE is quoted
- unless LITERAL is non-nil."
- (concat
- "^\\(?4:[ \t]*\\)"
- (format "\\(?1::\\(?2:%s\\):\\)"
- (if literal property (regexp-quote property)))
- (cond (value
- (format "[ \t]+\\(?3:%s\\)\\(?5:[ \t]*\\)$"
- (if literal value (regexp-quote value))))
- (allow-null
- "\\(?:\\(?3:$\\)\\|[ \t]+\\(?3:.*?\\)\\)\\(?5:[ \t]*\\)$")
- (t
- "[ \t]+\\(?3:[^ \r\t\n]+.*?\\)\\(?5:[ \t]*\\)$"))))
- (defconst org-property-re
- (org-re-property "\\S-+" 'literal t)
- "Regular expression matching a property line.
- There are four matching groups:
- 1: :PROPKEY: including the leading and trailing colon,
- 2: PROPKEY without the leading and trailing colon,
- 3: PROPVAL without leading or trailing spaces,
- 4: the indentation of the current line,
- 5: trailing whitespace.")
- (defvar org-font-lock-hook nil
- "Functions to be called for special font lock stuff.")
- (defvar org-font-lock-extra-keywords nil) ;Dynamically scoped.
- (defvar org-font-lock-set-keywords-hook nil
- "Functions that can manipulate `org-font-lock-extra-keywords'.
- This is called after `org-font-lock-extra-keywords' is defined, but before
- it is installed to be used by font lock. This can be useful if something
- needs to be inserted at a specific position in the font-lock sequence.")
- (defun org-font-lock-hook (limit)
- "Run `org-font-lock-hook' within LIMIT."
- (run-hook-with-args 'org-font-lock-hook limit))
- (defun org-set-font-lock-defaults ()
- "Set font lock defaults for the current buffer."
- (let* ((em org-fontify-emphasized-text)
- (lk org-highlight-links)
- (org-font-lock-extra-keywords
- (list
- ;; Call the hook
- '(org-font-lock-hook)
- ;; Headlines
- `(,(if org-fontify-whole-heading-line
- "^\\(\\**\\)\\(\\* \\)\\(.*\n?\\)"
- "^\\(\\**\\)\\(\\* \\)\\(.*\\)")
- (1 (org-get-level-face 1))
- (2 (org-get-level-face 2))
- (3 (org-get-level-face 3)))
- ;; Table lines
- '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
- (1 'org-table t))
- ;; Table internals
- '("^[ \t]*|\\(?:.*?|\\)? *\\(:?=[^|\n]*\\)" (1 'org-formula t))
- '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t))
- '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t))
- '("| *\\(<[lrc]?[0-9]*>\\)" (1 'org-formula t))
- ;; Drawers
- '(org-fontify-drawers)
- ;; Properties
- (list org-property-re
- '(1 'org-special-keyword t)
- '(3 'org-property-value t))
- ;; Link related fontification.
- '(org-activate-links)
- (when (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend)))
- (when (memq 'radio lk) '(org-activate-target-links (1 'org-link t)))
- (when (memq 'date lk) '(org-activate-dates (0 'org-date t)))
- (when (memq 'footnote lk) '(org-activate-footnote-links))
- ;; Targets.
- (list org-any-target-regexp '(0 'org-target t))
- ;; Diary sexps.
- '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t))
- ;; Macro
- '(org-fontify-macros)
- '(org-hide-wide-columns (0 nil append))
- ;; TODO keyword
- (list (format org-heading-keyword-regexp-format
- org-todo-regexp)
- '(2 (org-get-todo-face 2) t))
- ;; DONE
- (if org-fontify-done-headline
- (list (format org-heading-keyword-regexp-format
- (concat
- "\\(?:"
- (mapconcat 'regexp-quote org-done-keywords "\\|")
- "\\)"))
- '(2 'org-headline-done t))
- nil)
- ;; Priorities
- '(org-font-lock-add-priority-faces)
- ;; Tags
- '(org-font-lock-add-tag-faces)
- ;; Tags groups
- (when (and org-group-tags org-tag-groups-alist)
- (list (concat org-outline-regexp-bol ".+\\(:"
- (regexp-opt (mapcar 'car org-tag-groups-alist))
- ":\\).*$")
- '(1 'org-tag-group prepend)))
- ;; Special keywords
- (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t))
- (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t))
- (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t))
- (list (concat "\\<" org-clock-string) '(0 'org-special-keyword t))
- ;; Emphasis
- (when em '(org-do-emphasis-faces))
- ;; Checkboxes
- '("^[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)"
- 1 'org-checkbox prepend)
- (when (cdr (assq 'checkbox org-list-automatic-rules))
- '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]"
- (0 (org-get-checkbox-statistics-face) t)))
- ;; Description list items
- '("^[ \t]*[-+*][ \t]+\\(.*?[ \t]+::\\)\\([ \t]+\\|$\\)"
- 1 'org-list-dt prepend)
- ;; ARCHIVEd headings
- (list (concat
- org-outline-regexp-bol
- "\\(.*:" org-archive-tag ":.*\\)")
- '(1 'org-archived prepend))
- ;; Specials
- '(org-do-latex-and-related)
- '(org-fontify-entities)
- '(org-raise-scripts)
- ;; Code
- '(org-activate-code (1 'org-code t))
- ;; COMMENT
- (list (format
- "^\\*+\\(?: +%s\\)?\\(?: +\\[#[A-Z0-9]\\]\\)? +\\(?9:%s\\)\\(?: \\|$\\)"
- org-todo-regexp
- org-comment-string)
- '(9 'org-special-keyword t))
- ;; Blocks and meta lines
- '(org-fontify-meta-lines-and-blocks))))
- (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords))
- (run-hooks 'org-font-lock-set-keywords-hook)
- ;; Now set the full font-lock-keywords
- (setq-local org-font-lock-keywords org-font-lock-extra-keywords)
- (setq-local font-lock-defaults
- '(org-font-lock-keywords t nil nil backward-paragraph))
- (kill-local-variable 'font-lock-keywords)
- nil))
- (defun org-toggle-pretty-entities ()
- "Toggle the composition display of entities as UTF8 characters."
- (interactive)
- (setq-local org-pretty-entities (not org-pretty-entities))
- (org-restart-font-lock)
- (if org-pretty-entities
- (message "Entities are now displayed as UTF8 characters")
- (save-restriction
- (widen)
- (decompose-region (point-min) (point-max))
- (message "Entities are now displayed as plain text"))))
- (defvar-local org-custom-properties-overlays nil
- "List of overlays used for custom properties.")
- (defun org-toggle-custom-properties-visibility ()
- "Display or hide properties in `org-custom-properties'."
- (interactive)
- (if org-custom-properties-overlays
- (progn (mapc #'delete-overlay org-custom-properties-overlays)
- (setq org-custom-properties-overlays nil))
- (when org-custom-properties
- (org-with-wide-buffer
- (goto-char (point-min))
- (let ((regexp (org-re-property (regexp-opt org-custom-properties) t t)))
- (while (re-search-forward regexp nil t)
- (let ((end (cdr (save-match-data (org-get-property-block)))))
- (when (and end (< (point) end))
- ;; Hide first custom property in current drawer.
- (let ((o (make-overlay (match-beginning 0) (1+ (match-end 0)))))
- (overlay-put o 'invisible t)
- (overlay-put o 'org-custom-property t)
- (push o org-custom-properties-overlays))
- ;; Hide additional custom properties in the same drawer.
- (while (re-search-forward regexp end t)
- (let ((o (make-overlay (match-beginning 0) (1+ (match-end 0)))))
- (overlay-put o 'invisible t)
- (overlay-put o 'org-custom-property t)
- (push o org-custom-properties-overlays)))))
- ;; Each entry is limited to a single property drawer.
- (outline-next-heading)))))))
- (defun org-fontify-entities (limit)
- "Find an entity to fontify."
- (let (ee)
- (when org-pretty-entities
- (catch 'match
- ;; "\_ "-family is left out on purpose. Only the first one,
- ;; i.e., "\_ ", could be fontified anyway, and it would be
- ;; confusing when adding a second white space character.
- (while (re-search-forward
- "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]\n]\\)"
- limit t)
- (when (and (not (org-at-comment-p))
- (setq ee (org-entity-get (match-string 1)))
- (= (length (nth 6 ee)) 1))
- (let* ((end (if (equal (match-string 2) "{}")
- (match-end 2)
- (match-end 1))))
- (add-text-properties
- (match-beginning 0) end
- (list 'font-lock-fontified t))
- (compose-region (match-beginning 0) end
- (nth 6 ee) nil)
- (backward-char 1)
- (throw 'match t))))
- nil))))
- (defun org-fontify-like-in-org-mode (s &optional odd-levels)
- "Fontify string S like in Org mode."
- (with-temp-buffer
- (insert s)
- (let ((org-odd-levels-only odd-levels))
- (org-mode)
- (org-font-lock-ensure)
- (buffer-string))))
- (defvar org-m nil)
- (defvar org-l nil)
- (defvar org-f nil)
- (defun org-get-level-face (n)
- "Get the right face for match N in font-lock matching of headlines."
- (setq org-l (- (match-end 2) (match-beginning 1) 1))
- (when org-odd-levels-only (setq org-l (1+ (/ org-l 2))))
- (if org-cycle-level-faces
- (setq org-f (nth (% (1- org-l) org-n-level-faces) org-level-faces))
- (setq org-f (nth (1- (min org-l org-n-level-faces)) org-level-faces)))
- (cond
- ((eq n 1) (if org-hide-leading-stars 'org-hide org-f))
- ((eq n 2) org-f)
- (t (unless org-level-color-stars-only org-f))))
- (defun org-face-from-face-or-color (context inherit face-or-color)
- "Create a face list that inherits INHERIT, but sets the foreground color.
- When FACE-OR-COLOR is not a string, just return it."
- (if (stringp face-or-color)
- (list :inherit inherit
- (cdr (assoc context org-faces-easy-properties))
- face-or-color)
- face-or-color))
- (defun org-get-todo-face (kwd)
- "Get the right face for a TODO keyword KWD.
- If KWD is a number, get the corresponding match group."
- (when (numberp kwd) (setq kwd (match-string kwd)))
- (or (org-face-from-face-or-color
- 'todo 'org-todo (cdr (assoc kwd org-todo-keyword-faces)))
- (and (member kwd org-done-keywords) 'org-done)
- 'org-todo))
- (defun org-get-priority-face (priority)
- "Get the right face for PRIORITY.
- PRIORITY is a character."
- (or (org-face-from-face-or-color
- 'priority 'org-priority (cdr (assq priority org-priority-faces)))
- 'org-priority))
- (defun org-get-tag-face (tag)
- "Get the right face for TAG.
- If TAG is a number, get the corresponding match group."
- (let ((tag (if (wholenump tag) (match-string tag) tag)))
- (or (org-face-from-face-or-color
- 'tag 'org-tag (cdr (assoc tag org-tag-faces)))
- 'org-tag)))
- (defun org-font-lock-add-priority-faces (limit)
- "Add the special priority faces."
- (while (re-search-forward "^\\*+ .*?\\(\\[#\\(.\\)\\]\\)" limit t)
- (add-text-properties
- (match-beginning 1) (match-end 1)
- (list 'face (org-get-priority-face (string-to-char (match-string 2)))
- 'font-lock-fontified t))))
- (defun org-font-lock-add-tag-faces (limit)
- "Add the special tag faces."
- (when (and org-tag-faces org-tags-special-faces-re)
- (while (re-search-forward org-tags-special-faces-re limit t)
- (add-text-properties (match-beginning 1) (match-end 1)
- (list 'face (org-get-tag-face 1)
- 'font-lock-fontified t))
- (backward-char 1))))
- (defun org-unfontify-region (beg end &optional _maybe_loudly)
- "Remove fontification and activation overlays from links."
- (font-lock-default-unfontify-region beg end)
- (let* ((buffer-undo-list t)
- (inhibit-read-only t) (inhibit-point-motion-hooks t)
- (inhibit-modification-hooks t)
- deactivate-mark buffer-file-name buffer-file-truename)
- (decompose-region beg end)
- (remove-text-properties beg end
- '(mouse-face t keymap t org-linked-text t
- invisible t intangible t
- org-emphasis t))
- (org-remove-font-lock-display-properties beg end)))
- (defconst org-script-display '(((raise -0.3) (height 0.7))
- ((raise 0.3) (height 0.7))
- ((raise -0.5))
- ((raise 0.5)))
- "Display properties for showing superscripts and subscripts.")
- (defun org-remove-font-lock-display-properties (beg end)
- "Remove specific display properties that have been added by font lock.
- The will remove the raise properties that are used to show superscripts
- and subscripts."
- (let (next prop)
- (while (< beg end)
- (setq next (next-single-property-change beg 'display nil end)
- prop (get-text-property beg 'display))
- (when (member prop org-script-display)
- (put-text-property beg next 'display nil))
- (setq beg next))))
- (defun org-raise-scripts (limit)
- "Add raise properties to sub/superscripts."
- (when (and org-pretty-entities org-pretty-entities-include-sub-superscripts
- (re-search-forward
- (if (eq org-use-sub-superscripts t)
- org-match-substring-regexp
- org-match-substring-with-braces-regexp)
- limit t))
- (let* ((pos (point)) table-p comment-p
- (mpos (match-beginning 3))
- (emph-p (get-text-property mpos 'org-emphasis))
- (link-p (get-text-property mpos 'mouse-face))
- (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face))))
- (goto-char (point-at-bol))
- (setq table-p (looking-at-p org-table-dataline-regexp)
- comment-p (looking-at-p "^[ \t]*#[ +]"))
- (goto-char pos)
- ;; Handle a_b^c
- (when (member (char-after) '(?_ ?^)) (goto-char (1- pos)))
- (unless (or comment-p emph-p link-p keyw-p)
- (put-text-property (match-beginning 3) (match-end 0)
- 'display
- (if (equal (char-after (match-beginning 2)) ?^)
- (nth (if table-p 3 1) org-script-display)
- (nth (if table-p 2 0) org-script-display)))
- (add-text-properties (match-beginning 2) (match-end 2)
- (list 'invisible t
- 'org-dwidth t 'org-dwidth-n 1))
- (if (and (eq (char-after (match-beginning 3)) ?{)
- (eq (char-before (match-end 3)) ?}))
- (progn
- (add-text-properties
- (match-beginning 3) (1+ (match-beginning 3))
- (list 'invisible t 'org-dwidth t 'org-dwidth-n 1))
- (add-text-properties
- (1- (match-end 3)) (match-end 3)
- (list 'invisible t 'org-dwidth t 'org-dwidth-n 1)))))
- t)))
- ;;;; Visibility cycling, including org-goto and indirect buffer
- ;;; Cycling
- (defvar-local org-cycle-global-status nil)
- (put 'org-cycle-global-status 'org-state t)
- (defvar-local org-cycle-subtree-status nil)
- (put 'org-cycle-subtree-status 'org-state t)
- (defvar org-inlinetask-min-level)
- (defun org-unlogged-message (&rest args)
- "Display a message, but avoid logging it in the *Messages* buffer."
- (let ((message-log-max nil))
- (apply 'message args)))
- ;;;###autoload
- (defun org-cycle (&optional arg)
- "TAB-action and visibility cycling for Org mode.
- This is the command invoked in Org mode by the `TAB' key. Its main
- purpose is outline visibility cycling, but it also invokes other actions
- in special contexts.
- When this function is called with a `\\[universal-argument]' prefix, rotate \
- the entire
- buffer through 3 states (global cycling)
- 1. OVERVIEW: Show only top-level headlines.
- 2. CONTENTS: Show all headlines of all levels, but no body text.
- 3. SHOW ALL: Show everything.
- With a `\\[universal-argument] \\[universal-argument]' prefix argument, \
- switch to the startup visibility,
- determined by the variable `org-startup-folded', and by any VISIBILITY
- properties in the buffer.
- With a `\\[universal-argument] \\[universal-argument] \
- \\[universal-argument]' prefix argument, show the entire buffer, including
- any drawers.
- When inside a table, re-align the table and move to the next field.
- When point is at the beginning of a headline, rotate the subtree started
- by this line through 3 different states (local cycling)
- 1. FOLDED: Only the main headline is shown.
- 2. CHILDREN: The main headline and the direct children are shown.
- From this state, you can move to one of the children
- and zoom in further.
- 3. SUBTREE: Show the entire subtree, including body text.
- If there is no subtree, switch directly from CHILDREN to FOLDED.
- When point is at the beginning of an empty headline and the variable
- `org-cycle-level-after-item/entry-creation' is set, cycle the level
- of the headline by demoting and promoting it to likely levels. This
- speeds up creation document structure by pressing `TAB' once or several
- times right after creating a new headline.
- When there is a numeric prefix, go up to a heading with level ARG, do
- a `show-subtree' and return to the previous cursor position. If ARG
- is negative, go up that many levels.
- When point is not at the beginning of a headline, execute the global
- binding for `TAB', which is re-indenting the line. See the option
- `org-cycle-emulate-tab' for details.
- As a special case, if point is at the beginning of the buffer and there is
- no headline in line 1, this function will act as if called with prefix arg
- \(`\\[universal-argument] TAB', same as `S-TAB') also when called without \
- prefix arg, but only
- if the variable `org-cycle-global-at-bob' is t."
- (interactive "P")
- (org-load-modules-maybe)
- (unless (or (run-hook-with-args-until-success 'org-tab-first-hook)
- (and org-cycle-level-after-item/entry-creation
- (or (org-cycle-level)
- (org-cycle-item-indentation))))
- (let* ((limit-level
- (or org-cycle-max-level
- (and (boundp 'org-inlinetask-min-level)
- org-inlinetask-min-level
- (1- org-inlinetask-min-level))))
- (nstars (and limit-level
- (if org-odd-levels-only
- (and limit-level (1- (* limit-level 2)))
- limit-level)))
- (org-outline-regexp
- (if (not (derived-mode-p 'org-mode))
- outline-regexp
- (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ "))))
- (bob-special (and org-cycle-global-at-bob (not arg) (bobp)
- (not (looking-at org-outline-regexp))))
- (org-cycle-hook
- (if bob-special
- (delq 'org-optimize-window-after-visibility-change
- (copy-sequence org-cycle-hook))
- org-cycle-hook))
- (pos (point)))
- (cond
- ((equal arg '(16))
- (setq last-command 'dummy)
- (org-set-startup-visibility)
- (org-unlogged-message "Startup visibility, plus VISIBILITY properties"))
- ((equal arg '(64))
- (outline-show-all)
- (org-unlogged-message "Entire buffer visible, including drawers"))
- ((equal arg '(4)) (org-cycle-internal-global))
- ;; Try hiding block at point.
- ((org-hide-block-toggle-maybe))
- ;; Try cdlatex TAB completion
- ((org-try-cdlatex-tab))
- ;; Table: enter it or move to the next field.
- ((org-at-table-p 'any)
- (if (org-at-table.el-p)
- (message "%s" (substitute-command-keys "\\<org-mode-map>\
- Use `\\[org-edit-special]' to edit table.el tables"))
- (if arg (org-table-edit-field t)
- (org-table-justify-field-maybe)
- (call-interactively 'org-table-next-field))))
- ((run-hook-with-args-until-success 'org-tab-after-check-for-table-hook))
- ;; Global cycling: delegate to `org-cycle-internal-global'.
- (bob-special (org-cycle-internal-global))
- ;; Drawers: delegate to `org-flag-drawer'.
- ((save-excursion
- (beginning-of-line 1)
- (looking-at org-drawer-regexp))
- (org-flag-drawer ; toggle block visibility
- (not (get-char-property (match-end 0) 'invisible))))
- ;; Show-subtree, ARG levels up from here.
- ((integerp arg)
- (save-excursion
- (org-back-to-heading)
- (outline-up-heading (if (< arg 0) (- arg)
- (- (funcall outline-level) arg)))
- (org-show-subtree)))
- ;; Inline task: delegate to `org-inlinetask-toggle-visibility'.
- ((and (featurep 'org-inlinetask)
- (org-inlinetask-at-task-p)
- (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
- (org-inlinetask-toggle-visibility))
- ;; At an item/headline: delegate to `org-cycle-internal-local'.
- ((and (or (and org-cycle-include-plain-lists (org-at-item-p))
- (save-excursion (move-beginning-of-line 1)
- (looking-at org-outline-regexp)))
- (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
- (org-cycle-internal-local))
- ;; From there: TAB emulation and template completion.
- (buffer-read-only (org-back-to-heading))
- ((run-hook-with-args-until-success
- 'org-tab-after-check-for-cycling-hook))
- ((org-try-structure-completion))
- ((run-hook-with-args-until-success
- 'org-tab-before-tab-emulation-hook))
- ((and (eq org-cycle-emulate-tab 'exc-hl-bol)
- (or (not (bolp))
- (not (looking-at org-outline-regexp))))
- (call-interactively (global-key-binding "\t")))
- ((if (and (memq org-cycle-emulate-tab '(white whitestart))
- (save-excursion (beginning-of-line 1) (looking-at "[ \t]*"))
- (or (and (eq org-cycle-emulate-tab 'white)
- (= (match-end 0) (point-at-eol)))
- (and (eq org-cycle-emulate-tab 'whitestart)
- (>= (match-end 0) pos))))
- t
- (eq org-cycle-emulate-tab t))
- (call-interactively (global-key-binding "\t")))
- (t (save-excursion
- (org-back-to-heading)
- (org-cycle)))))))
- (defun org-cycle-internal-global ()
- "Do the global cycling action."
- ;; Hack to avoid display of messages for .org attachments in Gnus
- (let ((ga (string-match "\\*fontification" (buffer-name))))
- (cond
- ((and (eq last-command this-command)
- (eq org-cycle-global-status 'overview))
- ;; We just created the overview - now do table of contents
- ;; This can be slow in very large buffers, so indicate action
- (run-hook-with-args 'org-pre-cycle-hook 'contents)
- (unless ga (org-unlogged-message "CONTENTS..."))
- (org-content)
- (unless ga (org-unlogged-message "CONTENTS...done"))
- (setq org-cycle-global-status 'contents)
- (run-hook-with-args 'org-cycle-hook 'contents))
- ((and (eq last-command this-command)
- (eq org-cycle-global-status 'contents))
- ;; We just showed the table of contents - now show everything
- (run-hook-with-args 'org-pre-cycle-hook 'all)
- (outline-show-all)
- (unless ga (org-unlogged-message "SHOW ALL"))
- (setq org-cycle-global-status 'all)
- (run-hook-with-args 'org-cycle-hook 'all))
- (t
- ;; Default action: go to overview
- (run-hook-with-args 'org-pre-cycle-hook 'overview)
- (org-overview)
- (unless ga (org-unlogged-message "OVERVIEW"))
- (setq org-cycle-global-status 'overview)
- (run-hook-with-args 'org-cycle-hook 'overview)))))
- (defvar org-called-with-limited-levels nil
- "Non-nil when `org-with-limited-levels' is currently active.")
- (defun org-invisible-p (&optional pos)
- "Non-nil if the character after POS is invisible.
- If POS is nil, use `point' instead."
- (get-char-property (or pos (point)) 'invisible))
- (defun org-cycle-internal-local ()
- "Do the local cycling action."
- (let ((goal-column 0) eoh eol eos has-children children-skipped struct)
- ;; First, determine end of headline (EOH), end of subtree or item
- ;; (EOS), and if item or heading has children (HAS-CHILDREN).
- (save-excursion
- (if (org-at-item-p)
- (progn
- (beginning-of-line)
- (setq struct (org-list-struct))
- (setq eoh (point-at-eol))
- (setq eos (org-list-get-item-end-before-blank (point) struct))
- (setq has-children (org-list-has-child-p (point) struct)))
- (org-back-to-heading)
- (setq eoh (save-excursion (outline-end-of-heading) (point)))
- (setq eos (save-excursion (org-end-of-subtree t t)
- (when (bolp) (backward-char)) (point)))
- (setq has-children
- (or (save-excursion
- (let ((level (funcall outline-level)))
- (outline-next-heading)
- (and (org-at-heading-p t)
- (> (funcall outline-level) level))))
- (save-excursion
- (org-list-search-forward (org-item-beginning-re) eos t)))))
- ;; Determine end invisible part of buffer (EOL)
- (beginning-of-line 2)
- (while (and (not (eobp)) ;This is like `next-line'.
- (get-char-property (1- (point)) 'invisible))
- (goto-char (next-single-char-property-change (point) 'invisible))
- (and (eolp) (beginning-of-line 2)))
- (setq eol (point)))
- ;; Find out what to do next and set `this-command'
- (cond
- ((= eos eoh)
- ;; Nothing is hidden behind this heading
- (unless (org-before-first-heading-p)
- (run-hook-with-args 'org-pre-cycle-hook 'empty))
- (org-unlogged-message "EMPTY ENTRY")
- (setq org-cycle-subtree-status nil)
- (save-excursion
- (goto-char eos)
- (outline-next-heading)
- (when (org-invisible-p) (org-flag-heading nil))))
- ((and (or (>= eol eos)
- (not (string-match "\\S-" (buffer-substring eol eos))))
- (or has-children
- (not (setq children-skipped
- org-cycle-skip-children-state-if-no-children))))
- ;; Entire subtree is hidden in one line: children view
- (unless (org-before-first-heading-p)
- (run-hook-with-args 'org-pre-cycle-hook 'children))
- (if (org-at-item-p)
- (org-list-set-item-visibility (point-at-bol) struct 'children)
- (org-show-entry)
- (org-with-limited-levels (org-show-children))
- ;; FIXME: This slows down the func way too much.
- ;; How keep drawers hidden in subtree anyway?
- ;; (when (memq 'org-cycle-hide-drawers org-cycle-hook)
- ;; (org-cycle-hide-drawers 'subtree))
- ;; Fold every list in subtree to top-level items.
- (when (eq org-cycle-include-plain-lists 'integrate)
- (save-excursion
- (org-back-to-heading)
- (while (org-list-search-forward (org-item-beginning-re) eos t)
- (beginning-of-line 1)
- (let* ((struct (org-list-struct))
- (prevs (org-list-prevs-alist struct))
- (end (org-list-get-bottom-point struct)))
- (dolist (e (org-list-get-all-items (point) struct prevs))
- (org-list-set-item-visibility e struct 'folded))
- (goto-char (if (< end eos) end eos)))))))
- (org-unlogged-message "CHILDREN")
- (save-excursion
- (goto-char eos)
- (outline-next-heading)
- (when (org-invisible-p) (org-flag-heading nil)))
- (setq org-cycle-subtree-status 'children)
- (unless (org-before-first-heading-p)
- (run-hook-with-args 'org-cycle-hook 'children)))
- ((or children-skipped
- (and (eq last-command this-command)
- (eq org-cycle-subtree-status 'children)))
- ;; We just showed the children, or no children are there,
- ;; now show everything.
- (unless (org-before-first-heading-p)
- (run-hook-with-args 'org-pre-cycle-hook 'subtree))
- (outline-flag-region eoh eos nil)
- (org-unlogged-message
- (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE"))
- (setq org-cycle-subtree-status 'subtree)
- (unless (org-before-first-heading-p)
- (run-hook-with-args 'org-cycle-hook 'subtree)))
- (t
- ;; Default action: hide the subtree.
- (run-hook-with-args 'org-pre-cycle-hook 'folded)
- (outline-flag-region eoh eos t)
- (org-unlogged-message "FOLDED")
- (setq org-cycle-subtree-status 'folded)
- (unless (org-before-first-heading-p)
- (run-hook-with-args 'org-cycle-hook 'folded))))))
- ;;;###autoload
- (defun org-global-cycle (&optional arg)
- "Cycle the global visibility. For details see `org-cycle'.
- With `\\[universal-argument]' prefix ARG, switch to startup visibility.
- With a numeric prefix, show all headlines up to that level."
- (interactive "P")
- (let ((org-cycle-include-plain-lists
- (if (derived-mode-p 'org-mode) org-cycle-include-plain-lists nil)))
- (cond
- ((integerp arg)
- (outline-show-all)
- (outline-hide-sublevels arg)
- (setq org-cycle-global-status 'contents))
- ((equal arg '(4))
- (org-set-startup-visibility)
- (org-unlogged-message "Startup visibility, plus VISIBILITY properties."))
- (t
- (org-cycle '(4))))))
- (defun org-set-startup-visibility ()
- "Set the visibility required by startup options and properties."
- (cond
- ((eq org-startup-folded t)
- (org-overview))
- ((eq org-startup-folded 'content)
- (org-content))
- ((or (eq org-startup-folded 'showeverything)
- (eq org-startup-folded nil))
- (outline-show-all)))
- (unless (eq org-startup-folded 'showeverything)
- (when org-hide-block-startup (org-hide-block-all))
- (org-set-visibility-according-to-property 'no-cleanup)
- (org-cycle-hide-archived-subtrees 'all)
- (org-cycle-hide-drawers 'all)
- (org-cycle-show-empty-lines t)))
- (defun org-set-visibility-according-to-property (&optional no-cleanup)
- "Switch subtree visibilities according to :VISIBILITY: property."
- (interactive)
- (org-with-wide-buffer
- (goto-char (point-min))
- (while (re-search-forward "^[ \t]*:VISIBILITY:" nil t)
- (if (not (org-at-property-p)) (outline-next-heading)
- (let ((state (match-string 3)))
- (save-excursion
- (org-back-to-heading t)
- (outline-hide-subtree)
- (org-reveal)
- (cond
- ((equal state "folded")
- (outline-hide-subtree))
- ((equal state "children")
- (org-show-hidden-entry)
- (org-show-children))
- ((equal state "content")
- (save-excursion
- (save-restriction
- (org-narrow-to-subtree)
- (org-content))))
- ((member state '("all" "showall"))
- (outline-show-subtree)))))))
- (unless no-cleanup
- (org-cycle-hide-archived-subtrees 'all)
- (org-cycle-hide-drawers 'all)
- (org-cycle-show-empty-lines 'all))))
- ;; This function uses outline-regexp instead of the more fundamental
- ;; org-outline-regexp so that org-cycle-global works outside of Org
- ;; buffers, where outline-regexp is needed.
- (defun org-overview ()
- "Switch to overview mode, showing only top-level headlines.
- This shows all headlines with a level equal or greater than the level
- of the first headline in the buffer. This is important, because if the
- first headline is not level one, then (hide-sublevels 1) gives confusing
- results."
- (interactive)
- (save-excursion
- (let ((level
- (save-excursion
- (goto-char (point-min))
- (when (re-search-forward (concat "^" outline-regexp) nil t)
- (goto-char (match-beginning 0))
- (funcall outline-level)))))
- (and level (outline-hide-sublevels level)))))
- (defun org-content (&optional arg)
- "Show all headlines in the buffer, like a table of contents.
- With numerical argument N, show content up to level N."
- (interactive "P")
- (org-overview)
- (save-excursion
- ;; Visit all headings and show their offspring
- (and (integerp arg) (org-overview))
- (goto-char (point-max))
- (catch 'exit
- (while (and (progn (condition-case nil
- (outline-previous-visible-heading 1)
- (error (goto-char (point-min))))
- t)
- (looking-at org-outline-regexp))
- (if (integerp arg)
- (org-show-children (1- arg))
- (outline-show-branches))
- (when (bobp) (throw 'exit nil))))))
- (defun org-optimize-window-after-visibility-change (state)
- "Adjust the window after a change in outline visibility.
- This function is the default value of the hook `org-cycle-hook'."
- (when (get-buffer-window (current-buffer))
- (cond
- ((eq state 'content) nil)
- ((eq state 'all) nil)
- ((eq state 'folded) nil)
- ((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1)))
- ((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1))))))
- (defun org-remove-empty-overlays-at (pos)
- "Remove outline overlays that do not contain non-white stuff."
- (dolist (o (overlays-at pos))
- (and (eq 'outline (overlay-get o 'invisible))
- (not (string-match "\\S-" (buffer-substring (overlay-start o)
- (overlay-end o))))
- (delete-overlay o))))
- (defun org-clean-visibility-after-subtree-move ()
- "Fix visibility issues after moving a subtree."
- ;; First, find a reasonable region to look at:
- ;; Start two siblings above, end three below
- (let* ((beg (save-excursion
- (and (org-get-last-sibling)
- (org-get-last-sibling))
- (point)))
- (end (save-excursion
- (and (org-get-next-sibling)
- (org-get-next-sibling)
- (org-get-next-sibling))
- (if (org-at-heading-p)
- (point-at-eol)
- (point))))
- (level (looking-at "\\*+"))
- (re (when level (concat "^" (regexp-quote (match-string 0)) " "))))
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (when re
- ;; Properly fold already folded siblings
- (goto-char (point-min))
- (while (re-search-forward re nil t)
- (when (and (not (org-invisible-p))
- (save-excursion
- (goto-char (point-at-eol)) (org-invisible-p)))
- (outline-hide-entry))))
- (org-cycle-show-empty-lines 'overview)
- (org-cycle-hide-drawers 'overview)))))
- (defun org-cycle-show-empty-lines (state)
- "Show empty lines above all visible headlines.
- The region to be covered depends on STATE when called through
- `org-cycle-hook'. Lisp program can use t for STATE to get the
- entire buffer covered. Note that an empty line is only shown if there
- are at least `org-cycle-separator-lines' empty lines before the headline."
- (when (/= org-cycle-separator-lines 0)
- (save-excursion
- (let* ((n (abs org-cycle-separator-lines))
- (re (cond
- ((= n 1) "\\(\n[ \t]*\n\\*+\\) ")
- ((= n 2) "^[ \t]*\\(\n[ \t]*\n\\*+\\) ")
- (t (let ((ns (number-to-string (- n 2))))
- (concat "^\\(?:[ \t]*\n\\)\\{" ns "," ns "\\}"
- "[ \t]*\\(\n[ \t]*\n\\*+\\) ")))))
- beg end)
- (cond
- ((memq state '(overview contents t))
- (setq beg (point-min) end (point-max)))
- ((memq state '(children folded))
- (setq beg (point)
- end (progn (org-end-of-subtree t t)
- (line-beginning-position 2)))))
- (when beg
- (goto-char beg)
- (while (re-search-forward re end t)
- (unless (get-char-property (match-end 1) 'invisible)
- (let ((e (match-end 1))
- (b (if (>= org-cycle-separator-lines 0)
- (match-beginning 1)
- (save-excursion
- (goto-char (match-beginning 0))
- (skip-chars-backward " \t\n")
- (line-end-position)))))
- (outline-flag-region b e nil))))))))
- ;; Never hide empty lines at the end of the file.
- (save-excursion
- (goto-char (point-max))
- (outline-previous-heading)
- (outline-end-of-heading)
- (when (and (looking-at "[ \t\n]+")
- (= (match-end 0) (point-max)))
- (outline-flag-region (point) (match-end 0) nil))))
- (defun org-show-empty-lines-in-parent ()
- "Move to the parent and re-show empty lines before visible headlines."
- (save-excursion
- (let ((context (if (org-up-heading-safe) 'children 'overview)))
- (org-cycle-show-empty-lines context))))
- (defun org-files-list ()
- "Return `org-agenda-files' list, plus all open Org files.
- This is useful for operations that need to scan all of a user's
- open and agenda-wise Org files."
- (let ((files (mapcar 'expand-file-name (org-agenda-files))))
- (dolist (buf (buffer-list))
- (with-current-buffer buf
- (when (and (derived-mode-p 'org-mode) (buffer-file-name))
- (cl-pushnew (expand-file-name (buffer-file-name)) files))))
- files))
- (defsubst org-entry-beginning-position ()
- "Return the beginning position of the current entry."
- (save-excursion (org-back-to-heading t) (point)))
- (defsubst org-entry-end-position ()
- "Return the end position of the current entry."
- (save-excursion (outline-next-heading) (point)))
- (defun org-cycle-hide-drawers (state &optional exceptions)
- "Re-hide all drawers after a visibility state change.
- STATE should be one of the symbols listed in the docstring of
- `org-cycle-hook'. When non-nil, optional argument EXCEPTIONS is
- a list of strings specifying which drawers should not be hidden."
- (when (and (derived-mode-p 'org-mode)
- (not (memq state '(overview folded contents))))
- (save-excursion
- (let* ((globalp (eq state 'all))
- (beg (if globalp (point-min) (point)))
- (end (if globalp (point-max)
- (if (eq state 'children)
- (save-excursion (outline-next-heading) (point))
- (org-end-of-subtree t)))))
- (goto-char beg)
- (while (re-search-forward org-drawer-regexp (max end (point)) t)
- (unless (member-ignore-case (match-string 1) exceptions)
- (let ((drawer (org-element-at-point)))
- (when (memq (org-element-type drawer) '(drawer property-drawer))
- (org-flag-drawer t drawer)
- ;; Make sure to skip drawer entirely or we might flag
- ;; it another time when matching its ending line with
- ;; `org-drawer-regexp'.
- (goto-char (org-element-property :end drawer))))))))))
- (defun org-flag-drawer (flag &optional element)
- "When FLAG is non-nil, hide the drawer we are at.
- Otherwise make it visible. When optional argument ELEMENT is
- a parsed drawer, as returned by `org-element-at-point', hide or
- show that drawer instead."
- (let ((drawer (or element
- (and (save-excursion
- (beginning-of-line)
- (looking-at-p org-drawer-regexp))
- (org-element-at-point)))))
- (when (memq (org-element-type drawer) '(drawer property-drawer))
- (let ((post (org-element-property :post-affiliated drawer)))
- (save-excursion
- (outline-flag-region
- (progn (goto-char post) (line-end-position))
- (progn (goto-char (org-element-property :end drawer))
- (skip-chars-backward " \r\t\n")
- (line-end-position))
- flag))
- ;; When the drawer is hidden away, make sure point lies in
- ;; a visible part of the buffer.
- (when (and flag (> (line-beginning-position) post))
- (goto-char post))))))
- (defun org-subtree-end-visible-p ()
- "Is the end of the current subtree visible?"
- (pos-visible-in-window-p
- (save-excursion (org-end-of-subtree t) (point))))
- (defun org-first-headline-recenter ()
- "Move cursor to the first headline and recenter the headline."
- (let ((window (get-buffer-window)))
- (when window
- (goto-char (point-min))
- (when (re-search-forward (concat "^\\(" org-outline-regexp "\\)") nil t)
- (set-window-start window (line-beginning-position))))))
- ;;; Saving and restoring visibility
- (defun org-outline-overlay-data (&optional use-markers)
- "Return a list of the locations of all outline overlays.
- These are overlays with the `invisible' property value `outline'.
- The return value is a list of cons cells, with start and stop
- positions for each overlay.
- If USE-MARKERS is set, return the positions as markers."
- (let (beg end)
- (org-with-wide-buffer
- (delq nil
- (mapcar (lambda (o)
- (when (eq (overlay-get o 'invisible) 'outline)
- (setq beg (overlay-start o)
- end (overlay-end o))
- (and beg end (> end beg)
- (if use-markers
- (cons (copy-marker beg)
- (copy-marker end t))
- (cons beg end)))))
- (overlays-in (point-min) (point-max)))))))
- (defun org-set-outline-overlay-data (data)
- "Create visibility overlays for all positions in DATA.
- DATA should have been made by `org-outline-overlay-data'."
- (org-with-wide-buffer
- (outline-show-all)
- (dolist (c data) (outline-flag-region (car c) (cdr c) t))))
- ;;; Folding of blocks
- (defvar-local org-hide-block-overlays nil
- "Overlays hiding blocks.")
- (defun org-block-map (function &optional start end)
- "Call FUNCTION at the head of all source blocks in the current buffer.
- Optional arguments START and END can be used to limit the range."
- (let ((start (or start (point-min)))
- (end (or end (point-max))))
- (save-excursion
- (goto-char start)
- (while (and (< (point) end) (re-search-forward org-block-regexp end t))
- (save-excursion
- (save-match-data
- (goto-char (match-beginning 0))
- (funcall function)))))))
- (defun org-hide-block-toggle-all ()
- "Toggle the visibility of all blocks in the current buffer."
- (org-block-map 'org-hide-block-toggle))
- (defun org-hide-block-all ()
- "Fold all blocks in the current buffer."
- (interactive)
- (org-show-block-all)
- (org-block-map 'org-hide-block-toggle-maybe))
- (defun org-show-block-all ()
- "Unfold all blocks in the current buffer."
- (interactive)
- (mapc #'delete-overlay org-hide-block-overlays)
- (setq org-hide-block-overlays nil))
- (defun org-hide-block-toggle-maybe ()
- "Toggle visibility of block at point.
- Unlike to `org-hide-block-toggle', this function does not throw
- an error. Return a non-nil value when toggling is successful."
- (interactive)
- (ignore-errors (org-hide-block-toggle)))
- (defun org-hide-block-toggle (&optional force)
- "Toggle the visibility of the current block.
- When optional argument FORCE is `off', make block visible. If it
- is non-nil, hide it unconditionally. Throw an error when not at
- a block. Return a non-nil value when toggling is successful."
- (interactive)
- (let ((element (org-element-at-point)))
- (unless (memq (org-element-type element)
- '(center-block comment-block dynamic-block example-block
- export-block quote-block special-block
- src-block verse-block))
- (user-error "Not at a block"))
- (let* ((start (save-excursion
- (goto-char (org-element-property :post-affiliated element))
- (line-end-position)))
- (end (save-excursion
- (goto-char (org-element-property :end element))
- (skip-chars-backward " \r\t\n")
- (line-end-position)))
- (overlays (overlays-at start)))
- (cond
- ;; Do nothing when not before or at the block opening line or
- ;; at the block closing line.
- ((let ((eol (line-end-position))) (and (> eol start) (/= eol end))) nil)
- ((and (not (eq force 'off))
- (not (memq t (mapcar
- (lambda (o)
- (eq (overlay-get o 'invisible) 'org-hide-block))
- overlays))))
- (let ((ov (make-overlay start end)))
- (overlay-put ov 'invisible 'org-hide-block)
- ;; Make the block accessible to `isearch'.
- (overlay-put
- ov 'isearch-open-invisible
- (lambda (ov)
- (when (memq ov org-hide-block-overlays)
- (setq org-hide-block-overlays (delq ov org-hide-block-overlays)))
- (when (eq (overlay-get ov 'invisible) 'org-hide-block)
- (delete-overlay ov))))
- (push ov org-hide-block-overlays)
- ;; When the block is hidden away, make sure point is left in
- ;; a visible part of the buffer.
- (when (> (line-beginning-position) start)
- (goto-char start)
- (beginning-of-line))
- ;; Signal successful toggling.
- t))
- ((or (not force) (eq force 'off))
- (dolist (ov overlays t)
- (when (memq ov org-hide-block-overlays)
- (setq org-hide-block-overlays (delq ov org-hide-block-overlays)))
- (when (eq (overlay-get ov 'invisible) 'org-hide-block)
- (delete-overlay ov))))))))
- ;; Remove overlays when changing major mode
- (add-hook 'org-mode-hook
- (lambda () (add-hook 'change-major-mode-hook
- 'org-show-block-all 'append 'local)))
- ;;; Org-goto
- (defvar org-goto-window-configuration nil)
- (defvar org-goto-marker nil)
- (defvar org-goto-map)
- (defun org-goto-map ()
- "Set the keymap `org-goto'."
- (setq org-goto-map
- (let ((map (make-sparse-keymap)))
- (let ((cmds '(isearch-forward isearch-backward kill-ring-save set-mark-command
- mouse-drag-region universal-argument org-occur)))
- (dolist (cmd cmds)
- (substitute-key-definition cmd cmd map global-map)))
- (suppress-keymap map)
- (org-defkey map "\C-m" 'org-goto-ret)
- (org-defkey map [(return)] 'org-goto-ret)
- (org-defkey map [(left)] 'org-goto-left)
- (org-defkey map [(right)] 'org-goto-right)
- (org-defkey map [(control ?g)] 'org-goto-quit)
- (org-defkey map "\C-i" 'org-cycle)
- (org-defkey map [(tab)] 'org-cycle)
- (org-defkey map [(down)] 'outline-next-visible-heading)
- (org-defkey map [(up)] 'outline-previous-visible-heading)
- (if org-goto-auto-isearch
- (if (fboundp 'define-key-after)
- (define-key-after map [t] 'org-goto-local-auto-isearch)
- nil)
- (org-defkey map "q" 'org-goto-quit)
- (org-defkey map "n" 'outline-next-visible-heading)
- (org-defkey map "p" 'outline-previous-visible-heading)
- (org-defkey map "f" 'outline-forward-same-level)
- (org-defkey map "b" 'outline-backward-same-level)
- (org-defkey map "u" 'outline-up-heading))
- (org-defkey map "/" 'org-occur)
- (org-defkey map "\C-c\C-n" 'outline-next-visible-heading)
- (org-defkey map "\C-c\C-p" 'outline-previous-visible-heading)
- (org-defkey map "\C-c\C-f" 'outline-forward-same-level)
- (org-defkey map "\C-c\C-b" 'outline-backward-same-level)
- (org-defkey map "\C-c\C-u" 'outline-up-heading)
- map)))
- (defconst org-goto-help
- "Browse buffer copy, to find location or copy text.%s
- RET=jump to location C-g=quit and return to previous location
- \[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur")
- (defvar org-goto-start-pos) ; dynamically scoped parameter
- (defun org-goto (&optional alternative-interface)
- "Look up a different location in the current file, keeping current visibility.
- When you want look-up or go to a different location in a
- document, the fastest way is often to fold the entire buffer and
- then dive into the tree. This method has the disadvantage, that
- the previous location will be folded, which may not be what you
- want.
- This command works around this by showing a copy of the current
- buffer in an indirect buffer, in overview mode. You can dive
- into the tree in that copy, use org-occur and incremental search
- to find a location. When pressing RET or `Q', the command
- returns to the original buffer in which the visibility is still
- unchanged. After RET it will also jump to the location selected
- in the indirect buffer and expose the headline hierarchy above.
- With a prefix argument, use the alternative interface: e.g., if
- `org-goto-interface' is `outline' use `outline-path-completion'."
- (interactive "P")
- (org-goto-map)
- (let* ((org-refile-targets `((nil . (:maxlevel . ,org-goto-max-level))))
- (org-refile-use-outline-path t)
- (org-refile-target-verify-function nil)
- (interface
- (if (not alternative-interface)
- org-goto-interface
- (if (eq org-goto-interface 'outline)
- 'outline-path-completion
- 'outline)))
- (org-goto-start-pos (point))
- (selected-point
- (if (eq interface 'outline)
- (car (org-get-location (current-buffer) org-goto-help))
- (let ((pa (org-refile-get-location "Goto")))
- (org-refile-check-position pa)
- (nth 3 pa)))))
- (if selected-point
- (progn
- (org-mark-ring-push org-goto-start-pos)
- (goto-char selected-point)
- (when (or (org-invisible-p) (org-invisible-p2))
- (org-show-context 'org-goto)))
- (message "Quit"))))
- (defvar org-goto-selected-point nil) ; dynamically scoped parameter
- (defvar org-goto-exit-command nil) ; dynamically scoped parameter
- (defvar org-goto-local-auto-isearch-map) ; defined below
- (defun org-get-location (_buf help)
- "Let the user select a location in current buffer.
- This function uses a recursive edit. It returns the selected position
- or nil."
- (org-no-popups
- (let ((isearch-mode-map org-goto-local-auto-isearch-map)
- (isearch-hide-immediately nil)
- (isearch-search-fun-function
- (lambda () 'org-goto-local-search-headings))
- (org-goto-selected-point org-goto-exit-command))
- (save-excursion
- (save-window-excursion
- (delete-other-windows)
- (and (get-buffer "*org-goto*") (kill-buffer "*org-goto*"))
- (pop-to-buffer-same-window
- (condition-case nil
- (make-indirect-buffer (current-buffer) "*org-goto*")
- (error (make-indirect-buffer (current-buffer) "*org-goto*"))))
- (with-output-to-temp-buffer "*Org Help*"
- (princ (format help (if org-goto-auto-isearch
- " Just type for auto-isearch."
- " n/p/f/b/u to navigate, q to quit."))))
- (org-fit-window-to-buffer (get-buffer-window "*Org Help*"))
- (setq buffer-read-only nil)
- (let ((org-startup-truncated t)
- (org-startup-folded nil)
- (org-startup-align-all-tables nil))
- (org-mode)
- (org-overview))
- (setq buffer-read-only t)
- (if (and (boundp 'org-goto-start-pos)
- (integer-or-marker-p org-goto-start-pos))
- (progn (goto-char org-goto-start-pos)
- (when (org-invisible-p)
- (org-show-set-visibility 'lineage)))
- (goto-char (point-min)))
- (let (org-special-ctrl-a/e) (org-beginning-of-line))
- (message "Select location and press RET")
- (use-local-map org-goto-map)
- (recursive-edit)))
- (kill-buffer "*org-goto*")
- (cons org-goto-selected-point org-goto-exit-command))))
- (defvar org-goto-local-auto-isearch-map (make-sparse-keymap))
- (set-keymap-parent org-goto-local-auto-isearch-map isearch-mode-map)
- ;; `isearch-other-control-char' was removed in Emacs 24.4.
- (if (fboundp 'isearch-other-control-char)
- (progn
- (define-key org-goto-local-auto-isearch-map "\C-i" 'isearch-other-control-char)
- (define-key org-goto-local-auto-isearch-map "\C-m" 'isearch-other-control-char))
- (define-key org-goto-local-auto-isearch-map "\C-i" nil)
- (define-key org-goto-local-auto-isearch-map "\C-m" nil)
- (define-key org-goto-local-auto-isearch-map [return] nil))
- (defun org-goto-local-search-headings (string bound noerror)
- "Search and make sure that any matches are in headlines."
- (catch 'return
- (while (if isearch-forward
- (search-forward string bound noerror)
- (search-backward string bound noerror))
- (when (save-match-data
- (and (save-excursion
- (beginning-of-line)
- (looking-at org-complex-heading-regexp))
- (or (not (match-beginning 5))
- (< (point) (match-beginning 5)))))
- (throw 'return (point))))))
- (defun org-goto-local-auto-isearch ()
- "Start isearch."
- (interactive)
- (goto-char (point-min))
- (let ((keys (this-command-keys)))
- (when (eq (lookup-key isearch-mode-map keys) 'isearch-printing-char)
- (isearch-mode t)
- (isearch-process-search-char (string-to-char keys)))))
- (defun org-goto-ret (&optional _arg)
- "Finish `org-goto' by going to the new location."
- (interactive "P")
- (setq org-goto-selected-point (point))
- (setq org-goto-exit-command 'return)
- (throw 'exit nil))
- (defun org-goto-left ()
- "Finish `org-goto' by going to the new location."
- (interactive)
- (if (org-at-heading-p)
- (progn
- (beginning-of-line 1)
- (setq org-goto-selected-point (point)
- org-goto-exit-command 'left)
- (throw 'exit nil))
- (user-error "Not on a heading")))
- (defun org-goto-right ()
- "Finish `org-goto' by going to the new location."
- (interactive)
- (if (org-at-heading-p)
- (progn
- (setq org-goto-selected-point (point)
- org-goto-exit-command 'right)
- (throw 'exit nil))
- (user-error "Not on a heading")))
- (defun org-goto-quit ()
- "Finish `org-goto' without cursor motion."
- (interactive)
- (setq org-goto-selected-point nil)
- (setq org-goto-exit-command 'quit)
- (throw 'exit nil))
- ;;; Indirect buffer display of subtrees
- (defvar org-indirect-dedicated-frame nil
- "This is the frame being used for indirect tree display.")
- (defvar org-last-indirect-buffer nil)
- (defun org-tree-to-indirect-buffer (&optional arg)
- "Create indirect buffer and narrow it to current subtree.
- With a numerical prefix ARG, go up to this level and then take that tree.
- If ARG is negative, go up that many levels.
- If `org-indirect-buffer-display' is not `new-frame', the command removes the
- indirect buffer previously made with this command, to avoid proliferation of
- indirect buffers. However, when you call the command with a \
- `\\[universal-argument]' prefix, or
- when `org-indirect-buffer-display' is `new-frame', the last buffer is kept
- so that you can work with several indirect buffers at the same time. If
- `org-indirect-buffer-display' is `dedicated-frame', the \
- `\\[universal-argument]' prefix also
- requests that a new frame be made for the new buffer, so that the dedicated
- frame is not changed."
- (interactive "P")
- (let ((cbuf (current-buffer))
- (cwin (selected-window))
- (pos (point))
- beg end level heading ibuf)
- (save-excursion
- (org-back-to-heading t)
- (when (numberp arg)
- (setq level (org-outline-level))
- (when (< arg 0) (setq arg (+ level arg)))
- (while (> (setq level (org-outline-level)) arg)
- (org-up-heading-safe)))
- (setq beg (point)
- heading (org-get-heading 'no-tags))
- (org-end-of-subtree t t)
- (when (org-at-heading-p) (backward-char 1))
- (setq end (point)))
- (when (and (buffer-live-p org-last-indirect-buffer)
- (not (eq org-indirect-buffer-display 'new-frame))
- (not arg))
- (kill-buffer org-last-indirect-buffer))
- (setq ibuf (org-get-indirect-buffer cbuf heading)
- org-last-indirect-buffer ibuf)
- (cond
- ((or (eq org-indirect-buffer-display 'new-frame)
- (and arg (eq org-indirect-buffer-display 'dedicated-frame)))
- (select-frame (make-frame))
- (delete-other-windows)
- (pop-to-buffer-same-window ibuf)
- (org-set-frame-title heading))
- ((eq org-indirect-buffer-display 'dedicated-frame)
- (raise-frame
- (select-frame (or (and org-indirect-dedicated-frame
- (frame-live-p org-indirect-dedicated-frame)
- org-indirect-dedicated-frame)
- (setq org-indirect-dedicated-frame (make-frame)))))
- (delete-other-windows)
- (pop-to-buffer-same-window ibuf)
- (org-set-frame-title (concat "Indirect: " heading)))
- ((eq org-indirect-buffer-display 'current-window)
- (pop-to-buffer-same-window ibuf))
- ((eq org-indirect-buffer-display 'other-window)
- (pop-to-buffer ibuf))
- (t (error "Invalid value")))
- (narrow-to-region beg end)
- (outline-show-all)
- (goto-char pos)
- (run-hook-with-args 'org-cycle-hook 'all)
- (and (window-live-p cwin) (select-window cwin))))
- (defun org-get-indirect-buffer (&optional buffer heading)
- (setq buffer (or buffer (current-buffer)))
- (let ((n 1) (base (buffer-name buffer)) bname)
- (while (buffer-live-p
- (get-buffer
- (setq bname
- (concat base "-"
- (if heading (concat heading "-" (number-to-string n))
- (number-to-string n))))))
- (setq n (1+ n)))
- (condition-case nil
- (make-indirect-buffer buffer bname 'clone)
- (error (make-indirect-buffer buffer bname)))))
- (defun org-set-frame-title (title)
- "Set the title of the current frame to the string TITLE."
- (modify-frame-parameters (selected-frame) (list (cons 'name title))))
- ;;;; Structure editing
- ;;; Inserting headlines
- (defun org--line-empty-p (n)
- "Is the Nth next line empty?
- Counts the current line as N = 1 and the previous line as N = 0;
- see `beginning-of-line'."
- (save-excursion
- (and (not (bobp))
- (or (beginning-of-line n) t)
- (save-match-data
- (looking-at "[ \t]*$")))))
- (defun org-previous-line-empty-p ()
- "Is the previous line a blank line?
- When NEXT is non-nil, check the next line instead."
- (org--line-empty-p 0))
- (defun org-next-line-empty-p ()
- "Is the previous line a blank line?
- When NEXT is non-nil, check the next line instead."
- (org--line-empty-p 2))
- (defun org-insert-heading (&optional arg invisible-ok top)
- "Insert a new heading or an item with the same depth at point.
- If point is at the beginning of a heading or a list item, insert
- a new heading or a new item above the current one. When at the
- beginning of a regular line of text, turn it into a heading.
- If point is in the middle of a line, split it and create a new
- headline/item with the text in the current line after point (see
- `org-M-RET-may-split-line' on how to modify this behavior). As
- a special case, on a headline, splitting can only happen on the
- title itself. E.g., this excludes breaking stars or tags.
- With a `\\[universal-argument]' prefix, set \
- `org-insert-heading-respect-content' to
- a non-nil value for the duration of the command. This forces the
- insertion of a heading after the current subtree, independently
- on the location of point.
- With a `\\[universal-argument] \\[universal-argument]' prefix, \
- insert the heading at the end of the tree
- above the current heading. For example, if point is within a
- 2nd-level heading, then it will insert a 2nd-level heading at
- the end of the 1st-level parent subtree.
- When INVISIBLE-OK is set, stop at invisible headlines when going
- back. This is important for non-interactive uses of the
- command.
- When optional argument TOP is non-nil, insert a level 1 heading,
- unconditionally."
- (interactive "P")
- (let ((itemp (and (not top) (org-in-item-p)))
- (may-split (org-get-alist-option org-M-RET-may-split-line 'headline))
- (respect-content (or org-insert-heading-respect-content
- (equal arg '(4))))
- (initial-content ""))
- (cond
- ((or (= (buffer-size) 0)
- (and (not (save-excursion
- (and (ignore-errors (org-back-to-heading invisible-ok))
- (org-at-heading-p))))
- (or arg (not itemp))))
- ;; At beginning of buffer or so high up that only a heading
- ;; makes sense.
- (cond ((and (bolp) (not respect-content)) (insert "* "))
- ((not respect-content)
- (unless may-split (end-of-line))
- (insert "\n* "))
- ((re-search-forward org-outline-regexp-bol nil t)
- (beginning-of-line)
- (insert "* \n")
- (backward-char))
- (t (goto-char (point-max))
- (insert "\n* ")))
- (run-hooks 'org-insert-heading-hook))
- ((and itemp (not (member arg '((4) (16)))) (org-insert-item)))
- (t
- ;; Maybe move at the end of the subtree
- (when (equal arg '(16))
- (org-up-heading-safe)
- (org-end-of-subtree t))
- ;; Insert a heading
- (save-restriction
- (widen)
- (let* ((level nil)
- (on-heading (org-at-heading-p))
- (empty-line-p (if on-heading
- (org-previous-line-empty-p)
- ;; We will decide later
- nil))
- ;; Get a level string to fall back on.
- (fix-level
- (if (org-before-first-heading-p) "*"
- (save-excursion
- (org-back-to-heading t)
- (when (org-previous-line-empty-p) (setq empty-line-p t))
- (looking-at org-outline-regexp)
- (make-string (1- (length (match-string 0))) ?*))))
- (stars
- (save-excursion
- (condition-case nil
- (if top "* "
- (org-back-to-heading invisible-ok)
- (when (and (not on-heading)
- (featurep 'org-inlinetask)
- (integerp org-inlinetask-min-level)
- (>= (length (match-string 0))
- org-inlinetask-min-level))
- ;; Find a heading level before the inline
- ;; task.
- (while (and (setq level (org-up-heading-safe))
- (>= level org-inlinetask-min-level)))
- (if (org-at-heading-p)
- (org-back-to-heading invisible-ok)
- (error "This should not happen")))
- (unless (and (save-excursion
- (save-match-data
- (org-backward-heading-same-level
- 1 invisible-ok))
- (= (point) (match-beginning 0)))
- (not (org-next-line-empty-p)))
- (setq empty-line-p (or empty-line-p
- (org-previous-line-empty-p))))
- (match-string 0))
- (error (or fix-level "* ")))))
- (blank-a (cdr (assq 'heading org-blank-before-new-entry)))
- (blank (if (eq blank-a 'auto) empty-line-p blank-a)))
- ;; If we insert after content, move there and clean up
- ;; whitespace.
- (when respect-content
- (if (not (org-before-first-heading-p))
- (org-end-of-subtree nil t)
- (re-search-forward org-outline-regexp-bol)
- (beginning-of-line 0))
- (skip-chars-backward " \r\t\n")
- (and (not (looking-back "^\\*+" (line-beginning-position)))
- (looking-at "[ \t]+") (replace-match ""))
- (unless (eobp) (forward-char 1))
- (when (looking-at "^\\*")
- (unless (bobp) (backward-char 1))
- (insert "\n")))
- ;; If we are splitting, grab the text that should be moved
- ;; to the new headline.
- (when may-split
- (if (org-at-heading-p)
- ;; This is a heading: split intelligently (keeping
- ;; tags).
- (let ((pos (point)))
- (beginning-of-line)
- (let ((case-fold-search nil))
- (unless (looking-at org-complex-heading-regexp)
- (error "This should not happen")))
- (when (and (match-beginning 4)
- (> pos (match-beginning 4))
- (< pos (match-end 4)))
- (setq initial-content (buffer-substring pos (match-end 4)))
- (goto-char pos)
- (delete-region (point) (match-end 4))
- (if (looking-at "[ \t]*$")
- (replace-match "")
- (insert (make-string (length initial-content) ?\s)))
- (setq initial-content (org-trim initial-content)))
- (goto-char pos))
- ;; A normal line.
- (setq initial-content
- (org-trim
- (delete-and-extract-region (point) (line-end-position))))))
- ;; If we are at the beginning of the line, insert before it.
- ;; Otherwise, after it.
- (cond
- ((and (bolp) (looking-at "[ \t]*$")))
- ((bolp) (save-excursion (insert "\n")))
- (t (end-of-line)
- (insert "\n")))
- ;; Insert the new heading
- (insert stars)
- (just-one-space)
- (insert initial-content)
- (unless (and blank (org-previous-line-empty-p))
- (org-N-empty-lines-before-current (if blank 1 0)))
- ;; Adjust visibility, which may be messed up if we removed
- ;; blank lines while previous entry was hidden.
- (let ((bol (line-beginning-position)))
- (dolist (o (overlays-at (1- bol)))
- (when (and (eq (overlay-get o 'invisible) 'outline)
- (eq (overlay-end o) bol))
- (move-overlay o (overlay-start o) (1- bol)))))
- (run-hooks 'org-insert-heading-hook)))))))
- (defun org-N-empty-lines-before-current (N)
- "Make the number of empty lines before current exactly N.
- So this will delete or add empty lines."
- (save-excursion
- (beginning-of-line)
- (let ((p (point)))
- (skip-chars-backward " \r\t\n")
- (unless (bolp) (forward-line))
- (delete-region (point) p))
- (when (> N 0) (insert (make-string N ?\n)))))
- (defun org-get-heading (&optional no-tags no-todo)
- "Return the heading of the current entry, without the stars.
- When NO-TAGS is non-nil, don't include tags.
- When NO-TODO is non-nil, don't include TODO keywords."
- (save-excursion
- (org-back-to-heading t)
- (let ((case-fold-search nil))
- (cond
- ((and no-tags no-todo)
- (looking-at org-complex-heading-regexp)
- ;; Return value has to be a string, but match group 4 is
- ;; optional.
- (or (match-string 4) ""))
- (no-tags
- (looking-at (concat org-outline-regexp
- "\\(.*?\\)"
- "\\(?:[ \t]+:[[:alnum:]:_@#%]+:\\)?[ \t]*$"))
- (match-string 1))
- (no-todo
- (looking-at org-todo-line-regexp)
- (match-string 3))
- (t (looking-at org-heading-regexp)
- (match-string 2))))))
- (defvar orgstruct-mode) ; defined below
- (defun org-heading-components ()
- "Return the components of the current heading.
- This is a list with the following elements:
- - the level as an integer
- - the reduced level, different if `org-odd-levels-only' is set.
- - the TODO keyword, or nil
- - the priority character, like ?A, or nil if no priority is given
- - the headline text itself, or the tags string if no headline text
- - the tags string, or nil."
- (save-excursion
- (org-back-to-heading t)
- (when (let (case-fold-search)
- (looking-at
- (if orgstruct-mode
- org-heading-regexp
- org-complex-heading-regexp)))
- (if orgstruct-mode
- (list (length (match-string 1))
- (org-reduced-level (length (match-string 1)))
- nil
- nil
- (match-string 2)
- nil)
- (list (length (match-string 1))
- (org-reduced-level (length (match-string 1)))
- (match-string-no-properties 2)
- (and (match-end 3) (aref (match-string 3) 2))
- (match-string-no-properties 4)
- (match-string-no-properties 5))))))
- (defun org-get-entry ()
- "Get the entry text, after heading, entire subtree."
- (save-excursion
- (org-back-to-heading t)
- (buffer-substring (point-at-bol 2) (org-end-of-subtree t))))
- (defun org-edit-headline (&optional heading)
- "Edit the current headline.
- Set it to HEADING when provided."
- (interactive)
- (org-with-wide-buffer
- (org-back-to-heading t)
- (let ((case-fold-search nil))
- (when (looking-at org-complex-heading-regexp)
- (let* ((old (match-string-no-properties 4))
- (new (save-match-data
- (org-trim (or heading (read-string "Edit: " old))))))
- (unless (equal old new)
- (if old (replace-match new t t nil 4)
- (goto-char (or (match-end 3) (match-end 2) (match-end 1)))
- (insert " " new))
- (org-set-tags nil t)
- (when (looking-at "[ \t]*$") (replace-match ""))))))))
- (defun org-insert-heading-after-current ()
- "Insert a new heading with same level as current, after current subtree."
- (interactive)
- (org-back-to-heading)
- (org-insert-heading)
- (org-move-subtree-down)
- (end-of-line 1))
- (defun org-insert-heading-respect-content (&optional invisible-ok)
- "Insert heading with `org-insert-heading-respect-content' set to t."
- (interactive)
- (org-insert-heading '(4) invisible-ok))
- (defun org-insert-todo-heading-respect-content (&optional force-state)
- "Insert TODO heading with `org-insert-heading-respect-content' set to t."
- (interactive)
- (org-insert-todo-heading force-state '(4)))
- (defun org-insert-todo-heading (arg &optional force-heading)
- "Insert a new heading with the same level and TODO state as current heading.
- If the heading has no TODO state, or if the state is DONE, use
- the first state (TODO by default). Also with one prefix arg,
- force first state. With two prefix args, force inserting at the
- end of the parent subtree.
- When called at a plain list item, insert a new item with an
- unchecked check box."
- (interactive "P")
- (when (or force-heading (not (org-insert-item 'checkbox)))
- (org-insert-heading (or (and (equal arg '(16)) '(16))
- force-heading))
- (save-excursion
- (org-back-to-heading)
- (outline-previous-heading)
- (let ((case-fold-search nil)) (looking-at org-todo-line-regexp)))
- (let* ((new-mark-x
- (if (or (equal arg '(4))
- (not (match-beginning 2))
- (member (match-string 2) org-done-keywords))
- (car org-todo-keywords-1)
- (match-string 2)))
- (new-mark
- (or
- (run-hook-with-args-until-success
- 'org-todo-get-default-hook new-mark-x nil)
- new-mark-x)))
- (beginning-of-line 1)
- (and (looking-at org-outline-regexp) (goto-char (match-end 0))
- (if org-treat-insert-todo-heading-as-state-change
- (org-todo new-mark)
- (insert new-mark " "))))
- (when org-provide-todo-statistics
- (org-update-parent-todo-statistics))))
- (defun org-insert-subheading (arg)
- "Insert a new subheading and demote it.
- Works for outline headings and for plain lists alike."
- (interactive "P")
- (org-insert-heading arg)
- (cond
- ((org-at-heading-p) (org-do-demote))
- ((org-at-item-p) (org-indent-item))))
- (defun org-insert-todo-subheading (arg)
- "Insert a new subheading with TODO keyword or checkbox and demote it.
- Works for outline headings and for plain lists alike."
- (interactive "P")
- (org-insert-todo-heading arg)
- (cond
- ((org-at-heading-p) (org-do-demote))
- ((org-at-item-p) (org-indent-item))))
- ;;; Promotion and Demotion
- (defvar org-after-demote-entry-hook nil
- "Hook run after an entry has been demoted.
- The cursor will be at the beginning of the entry.
- When a subtree is being demoted, the hook will be called for each node.")
- (defvar org-after-promote-entry-hook nil
- "Hook run after an entry has been promoted.
- The cursor will be at the beginning of the entry.
- When a subtree is being promoted, the hook will be called for each node.")
- (defun org-promote-subtree ()
- "Promote the entire subtree.
- See also `org-promote'."
- (interactive)
- (save-excursion
- (org-with-limited-levels (org-map-tree 'org-promote)))
- (org-fix-position-after-promote))
- (defun org-demote-subtree ()
- "Demote the entire subtree.
- See `org-demote' and `org-promote'."
- (interactive)
- (save-excursion
- (org-with-limited-levels (org-map-tree 'org-demote)))
- (org-fix-position-after-promote))
- (defun org-do-promote ()
- "Promote the current heading higher up the tree.
- If the region is active in `transient-mark-mode', promote all
- headings in the region."
- (interactive)
- (save-excursion
- (if (org-region-active-p)
- (org-map-region 'org-promote (region-beginning) (region-end))
- (org-promote)))
- (org-fix-position-after-promote))
- (defun org-do-demote ()
- "Demote the current heading lower down the tree.
- If the region is active in `transient-mark-mode', demote all
- headings in the region."
- (interactive)
- (save-excursion
- (if (org-region-active-p)
- (org-map-region 'org-demote (region-beginning) (region-end))
- (org-demote)))
- (org-fix-position-after-promote))
- (defun org-fix-position-after-promote ()
- "Fix cursor position and indentation after demoting/promoting."
- (let ((pos (point)))
- (when (save-excursion
- (beginning-of-line)
- (let ((case-fold-search nil)) (looking-at org-todo-line-regexp))
- (or (eq pos (match-end 1)) (eq pos (match-end 2))))
- (cond ((eobp) (insert " "))
- ((eolp) (insert " "))
- ((equal (char-after) ?\s) (forward-char 1))))))
- (defun org-current-level ()
- "Return the level of the current entry, or nil if before the first headline.
- The level is the number of stars at the beginning of the
- headline. Use `org-reduced-level' to remove the effect of
- `org-odd-levels'. Unlike to `org-outline-level', this function
- ignores inlinetasks."
- (let ((level (org-with-limited-levels (org-outline-level))))
- (and (> level 0) level)))
- (defun org-get-previous-line-level ()
- "Return the outline depth of the last headline before the current line.
- Returns 0 for the first headline in the buffer, and nil if before the
- first headline."
- (and (org-current-level)
- (or (and (/= (line-beginning-position) (point-min))
- (save-excursion (beginning-of-line 0) (org-current-level)))
- 0)))
- (defun org-reduced-level (l)
- "Compute the effective level of a heading.
- This takes into account the setting of `org-odd-levels-only'."
- (cond
- ((zerop l) 0)
- (org-odd-levels-only (1+ (floor (/ l 2))))
- (t l)))
- (defun org-level-increment ()
- "Return the number of stars that will be added or removed at a
- time to headlines when structure editing, based on the value of
- `org-odd-levels-only'."
- (if org-odd-levels-only 2 1))
- (defun org-get-valid-level (level &optional change)
- "Rectify a level change under the influence of `org-odd-levels-only'
- LEVEL is a current level, CHANGE is by how much the level should be
- modified. Even if CHANGE is nil, LEVEL may be returned modified because
- even level numbers will become the next higher odd number."
- (if org-odd-levels-only
- (cond ((or (not change) (= 0 change)) (1+ (* 2 (/ level 2))))
- ((> change 0) (1+ (* 2 (/ (+ level (* 2 change)) 2))))
- ((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2))))))
- (max 1 (+ level (or change 0)))))
- (defun org-promote ()
- "Promote the current heading higher up the tree."
- (org-with-wide-buffer
- (org-back-to-heading t)
- (let* ((after-change-functions (remq 'flyspell-after-change-function
- after-change-functions))
- (level (save-match-data (funcall outline-level)))
- (up-head (concat (make-string (org-get-valid-level level -1) ?*) " "))
- (diff (abs (- level (length up-head) -1))))
- (cond
- ((and (= level 1) org-allow-promoting-top-level-subtree)
- (replace-match "# " nil t))
- ((= level 1)
- (user-error "Cannot promote to level 0. UNDO to recover if necessary"))
- (t (replace-match up-head nil t)))
- (unless (= level 1)
- (when org-auto-align-tags (org-set-tags nil 'ignore-column))
- (when org-adapt-indentation (org-fixup-indentation (- diff))))
- (run-hooks 'org-after-promote-entry-hook))))
- (defun org-demote ()
- "Demote the current heading lower down the tree."
- (org-with-wide-buffer
- (org-back-to-heading t)
- (let* ((after-change-functions (remq 'flyspell-after-change-function
- after-change-functions))
- (level (save-match-data (funcall outline-level)))
- (down-head (concat (make-string (org-get-valid-level level 1) ?*) " "))
- (diff (abs (- level (length down-head) -1))))
- (replace-match down-head nil t)
- (when org-auto-align-tags (org-set-tags nil 'ignore-column))
- (when org-adapt-indentation (org-fixup-indentation diff))
- (run-hooks 'org-after-demote-entry-hook))))
- (defun org-cycle-level ()
- "Cycle the level of an empty headline through possible states.
- This goes first to child, then to parent, level, then up the hierarchy.
- After top level, it switches back to sibling level."
- (interactive)
- (let ((org-adapt-indentation nil))
- (when (org-point-at-end-of-empty-headline)
- (setq this-command 'org-cycle-level) ; Only needed for caching
- (let ((cur-level (org-current-level))
- (prev-level (org-get-previous-line-level)))
- (cond
- ;; If first headline in file, promote to top-level.
- ((= prev-level 0)
- (cl-loop repeat (/ (- cur-level 1) (org-level-increment))
- do (org-do-promote)))
- ;; If same level as prev, demote one.
- ((= prev-level cur-level)
- (org-do-demote))
- ;; If parent is top-level, promote to top level if not already.
- ((= prev-level 1)
- (cl-loop repeat (/ (- cur-level 1) (org-level-increment))
- do (org-do-promote)))
- ;; If top-level, return to prev-level.
- ((= cur-level 1)
- (cl-loop repeat (/ (- prev-level 1) (org-level-increment))
- do (org-do-demote)))
- ;; If less than prev-level, promote one.
- ((< cur-level prev-level)
- (org-do-promote))
- ;; If deeper than prev-level, promote until higher than
- ;; prev-level.
- ((> cur-level prev-level)
- (cl-loop repeat (+ 1 (/ (- cur-level prev-level) (org-level-increment)))
- do (org-do-promote))))
- t))))
- (defun org-map-tree (fun)
- "Call FUN for every heading underneath the current one."
- (org-back-to-heading t)
- (let ((level (funcall outline-level)))
- (save-excursion
- (funcall fun)
- (while (and (progn
- (outline-next-heading)
- (> (funcall outline-level) level))
- (not (eobp)))
- (funcall fun)))))
- (defun org-map-region (fun beg end)
- "Call FUN for every heading between BEG and END."
- (let ((org-ignore-region t))
- (save-excursion
- (setq end (copy-marker end))
- (goto-char beg)
- (when (and (re-search-forward org-outline-regexp-bol nil t)
- (< (point) end))
- (funcall fun))
- (while (and (progn
- (outline-next-heading)
- (< (point) end))
- (not (eobp)))
- (funcall fun)))))
- (defun org-fixup-indentation (diff)
- "Change the indentation in the current entry by DIFF.
- DIFF is an integer. Indentation is done according to the
- following rules:
- - Planning information and property drawers are always indented
- according to the new level of the headline;
- - Footnote definitions and their contents are ignored;
- - Inlinetasks' boundaries are not shifted;
- - Empty lines are ignored;
- - Other lines' indentation are shifted by DIFF columns, unless
- it would introduce a structural change in the document, in
- which case no shifting is done at all.
- Assume point is at a heading or an inlinetask beginning."
- (org-with-wide-buffer
- (narrow-to-region (line-beginning-position)
- (save-excursion
- (if (org-with-limited-levels (org-at-heading-p))
- (org-with-limited-levels (outline-next-heading))
- (org-inlinetask-goto-end))
- (point)))
- (forward-line)
- ;; Indent properly planning info and property drawer.
- (when (looking-at-p org-planning-line-re)
- (org-indent-line)
- (forward-line))
- (when (looking-at org-property-drawer-re)
- (goto-char (match-end 0))
- (forward-line)
- (save-excursion (org-indent-region (match-beginning 0) (match-end 0))))
- (catch 'no-shift
- (when (zerop diff) (throw 'no-shift nil))
- ;; If DIFF is negative, first check if a shift is possible at all
- ;; (e.g., it doesn't break structure). This can only happen if
- ;; some contents are not properly indented.
- (let ((case-fold-search t))
- (when (< diff 0)
- (let ((diff (- diff))
- (forbidden-re (concat org-outline-regexp
- "\\|"
- (substring org-footnote-definition-re 1))))
- (save-excursion
- (while (not (eobp))
- (cond
- ((looking-at-p "[ \t]*$") (forward-line))
- ((and (looking-at-p org-footnote-definition-re)
- (let ((e (org-element-at-point)))
- (and (eq (org-element-type e) 'footnote-definition)
- (goto-char (org-element-property :end e))))))
- ((looking-at-p org-outline-regexp) (forward-line))
- ;; Give up if shifting would move before column 0 or
- ;; if it would introduce a headline or a footnote
- ;; definition.
- (t
- (skip-chars-forward " \t")
- (let ((ind (current-column)))
- (when (or (< ind diff)
- (and (= ind diff) (looking-at-p forbidden-re)))
- (throw 'no-shift nil)))
- ;; Ignore contents of example blocks and source
- ;; blocks if their indentation is meant to be
- ;; preserved. Jump to block's closing line.
- (beginning-of-line)
- (or (and (looking-at-p "[ \t]*#\\+BEGIN_\\(EXAMPLE\\|SRC\\)")
- (let ((e (org-element-at-point)))
- (and (memq (org-element-type e)
- '(example-block src-block))
- (or org-src-preserve-indentation
- (org-element-property :preserve-indent e))
- (goto-char (org-element-property :end e))
- (progn (skip-chars-backward " \r\t\n")
- (beginning-of-line)
- t))))
- (forward-line))))))))
- ;; Shift lines but footnote definitions, inlinetasks boundaries
- ;; by DIFF. Also skip contents of source or example blocks
- ;; when indentation is meant to be preserved.
- (while (not (eobp))
- (cond
- ((and (looking-at-p org-footnote-definition-re)
- (let ((e (org-element-at-point)))
- (and (eq (org-element-type e) 'footnote-definition)
- (goto-char (org-element-property :end e))))))
- ((looking-at-p org-outline-regexp) (forward-line))
- ((looking-at-p "[ \t]*$") (forward-line))
- (t
- (indent-line-to (+ (org-get-indentation) diff))
- (beginning-of-line)
- (or (and (looking-at-p "[ \t]*#\\+BEGIN_\\(EXAMPLE\\|SRC\\)")
- (let ((e (org-element-at-point)))
- (and (memq (org-element-type e)
- '(example-block src-block))
- (or org-src-preserve-indentation
- (org-element-property :preserve-indent e))
- (goto-char (org-element-property :end e))
- (progn (skip-chars-backward " \r\t\n")
- (beginning-of-line)
- t))))
- (forward-line)))))))))
- (defun org-convert-to-odd-levels ()
- "Convert an Org file with all levels allowed to one with odd levels.
- This will leave level 1 alone, convert level 2 to level 3, level 3 to
- level 5 etc."
- (interactive)
- (when (yes-or-no-p "Are you sure you want to globally change levels to odd? ")
- (let ((outline-level 'org-outline-level)
- (org-odd-levels-only nil) n)
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward "^\\*\\*+ " nil t)
- (setq n (- (length (match-string 0)) 2))
- (while (>= (setq n (1- n)) 0)
- (org-demote))
- (end-of-line 1))))))
- (defun org-convert-to-oddeven-levels ()
- "Convert an Org file with only odd levels to one with odd/even levels.
- This promotes level 3 to level 2, level 5 to level 3 etc. If the
- file contains a section with an even level, conversion would
- destroy the structure of the file. An error is signaled in this
- case."
- (interactive)
- (goto-char (point-min))
- ;; First check if there are no even levels
- (when (re-search-forward "^\\(\\*\\*\\)+ " nil t)
- (org-show-set-visibility 'canonical)
- (error "Not all levels are odd in this file. Conversion not possible"))
- (when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ")
- (let ((outline-regexp org-outline-regexp)
- (outline-level 'org-outline-level)
- (org-odd-levels-only nil) n)
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward "^\\*\\*+ " nil t)
- (setq n (/ (1- (length (match-string 0))) 2))
- (while (>= (setq n (1- n)) 0)
- (org-promote))
- (end-of-line 1))))))
- (defun org-tr-level (n)
- "Make N odd if required."
- (if org-odd-levels-only (1+ (/ n 2)) n))
- ;;; Vertical tree motion, cutting and pasting of subtrees
- (defun org-move-subtree-up (&optional arg)
- "Move the current subtree up past ARG headlines of the same level."
- (interactive "p")
- (org-move-subtree-down (- (prefix-numeric-value arg))))
- (defun org-move-subtree-down (&optional arg)
- "Move the current subtree down past ARG headlines of the same level."
- (interactive "p")
- (setq arg (prefix-numeric-value arg))
- (let ((movfunc (if (> arg 0) 'org-get-next-sibling
- 'org-get-last-sibling))
- (ins-point (make-marker))
- (cnt (abs arg))
- (col (current-column))
- beg beg0 end txt folded ne-beg ne-end ne-ins ins-end)
- ;; Select the tree
- (org-back-to-heading)
- (setq beg0 (point))
- (save-excursion
- (setq ne-beg (org-back-over-empty-lines))
- (setq beg (point)))
- (save-match-data
- (save-excursion (outline-end-of-heading)
- (setq folded (org-invisible-p)))
- (progn (org-end-of-subtree nil t)
- (unless (eobp) (backward-char))))
- (outline-next-heading)
- (setq ne-end (org-back-over-empty-lines))
- (setq end (point))
- (goto-char beg0)
- (when (and (> arg 0) (org-first-sibling-p) (< ne-end ne-beg))
- ;; include less whitespace
- (save-excursion
- (goto-char beg)
- (forward-line (- ne-beg ne-end))
- (setq beg (point))))
- ;; Find insertion point, with error handling
- (while (> cnt 0)
- (or (and (funcall movfunc) (looking-at org-outline-regexp))
- (progn (goto-char beg0)
- (user-error "Cannot move past superior level or buffer limit")))
- (setq cnt (1- cnt)))
- (when (> arg 0)
- ;; Moving forward - still need to move over subtree
- (org-end-of-subtree t t)
- (save-excursion
- (org-back-over-empty-lines)
- (or (bolp) (newline))))
- (setq ne-ins (org-back-over-empty-lines))
- (move-marker ins-point (point))
- (setq txt (buffer-substring beg end))
- (org-save-markers-in-region beg end)
- (delete-region beg end)
- (org-remove-empty-overlays-at beg)
- (or (= beg (point-min)) (outline-flag-region (1- beg) beg nil))
- (or (bobp) (outline-flag-region (1- (point)) (point) nil))
- (and (not (bolp)) (looking-at "\n") (forward-char 1))
- (let ((bbb (point)))
- (insert-before-markers txt)
- (org-reinstall-markers-in-region bbb)
- (move-marker ins-point bbb))
- (or (bolp) (insert "\n"))
- (setq ins-end (point))
- (goto-char ins-point)
- (org-skip-whitespace)
- (when (and (< arg 0)
- (org-first-sibling-p)
- (> ne-ins ne-beg))
- ;; Move whitespace back to beginning
- (save-excursion
- (goto-char ins-end)
- (let ((kill-whole-line t))
- (kill-line (- ne-ins ne-beg)) (point)))
- (insert (make-string (- ne-ins ne-beg) ?\n)))
- (move-marker ins-point nil)
- (if folded
- (outline-hide-subtree)
- (org-show-entry)
- (org-show-children)
- (org-cycle-hide-drawers 'children))
- (org-clean-visibility-after-subtree-move)
- ;; move back to the initial column we were at
- (move-to-column col)))
- (defvar org-subtree-clip ""
- "Clipboard for cut and paste of subtrees.
- This is actually only a copy of the kill, because we use the normal kill
- ring. We need it to check if the kill was created by `org-copy-subtree'.")
- (defvar org-subtree-clip-folded nil
- "Was the last copied subtree folded?
- This is used to fold the tree back after pasting.")
- (defun org-cut-subtree (&optional n)
- "Cut the current subtree into the clipboard.
- With prefix arg N, cut this many sequential subtrees.
- This is a short-hand for marking the subtree and then cutting it."
- (interactive "p")
- (org-copy-subtree n 'cut))
- (defun org-copy-subtree (&optional n cut force-store-markers nosubtrees)
- "Copy the current subtree it in the clipboard.
- With prefix arg N, copy this many sequential subtrees.
- This is a short-hand for marking the subtree and then copying it.
- If CUT is non-nil, actually cut the subtree.
- If FORCE-STORE-MARKERS is non-nil, store the relative locations
- of some markers in the region, even if CUT is non-nil. This is
- useful if the caller implements cut-and-paste as copy-then-paste-then-cut."
- (interactive "p")
- (let (beg end folded (beg0 (point)))
- (if (called-interactively-p 'any)
- (org-back-to-heading nil) ; take what looks like a subtree
- (org-back-to-heading t)) ; take what is really there
- (setq beg (point))
- (skip-chars-forward " \t\r\n")
- (save-match-data
- (if nosubtrees
- (outline-next-heading)
- (save-excursion (outline-end-of-heading)
- (setq folded (org-invisible-p)))
- (ignore-errors (org-forward-heading-same-level (1- n) t))
- (org-end-of-subtree t t)))
- ;; Include the end of an inlinetask
- (when (and (featurep 'org-inlinetask)
- (looking-at-p (concat (org-inlinetask-outline-regexp)
- "END[ \t]*$")))
- (end-of-line))
- (setq end (point))
- (goto-char beg0)
- (when (> end beg)
- (setq org-subtree-clip-folded folded)
- (when (or cut force-store-markers)
- (org-save-markers-in-region beg end))
- (if cut (kill-region beg end) (copy-region-as-kill beg end))
- (setq org-subtree-clip (current-kill 0))
- (message "%s: Subtree(s) with %d characters"
- (if cut "Cut" "Copied")
- (length org-subtree-clip)))))
- (defun org-paste-subtree (&optional level tree for-yank remove)
- "Paste the clipboard as a subtree, with modification of headline level.
- The entire subtree is promoted or demoted in order to match a new headline
- level.
- If the cursor is at the beginning of a headline, the same level as
- that headline is used to paste the tree.
- If not, the new level is derived from the *visible* headings
- before and after the insertion point, and taken to be the inferior headline
- level of the two. So if the previous visible heading is level 3 and the
- next is level 4 (or vice versa), level 4 will be used for insertion.
- This makes sure that the subtree remains an independent subtree and does
- not swallow low level entries.
- You can also force a different level, either by using a numeric prefix
- argument, or by inserting the heading marker by hand. For example, if the
- cursor is after \"*****\", then the tree will be shifted to level 5.
- If optional TREE is given, use this text instead of the kill ring.
- When FOR-YANK is set, this is called by `org-yank'. In this case, do not
- move back over whitespace before inserting, and move point to the end of
- the inserted text when done.
- When REMOVE is non-nil, remove the subtree from the clipboard."
- (interactive "P")
- (setq tree (or tree (and kill-ring (current-kill 0))))
- (unless (org-kill-is-subtree-p tree)
- (user-error "%s"
- (substitute-command-keys
- "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway")))
- (org-with-limited-levels
- (let* ((visp (not (org-invisible-p)))
- (txt tree)
- (^re_ "\\(\\*+\\)[ \t]*")
- (old-level (if (string-match org-outline-regexp-bol txt)
- (- (match-end 0) (match-beginning 0) 1)
- -1))
- (force-level (cond (level (prefix-numeric-value level))
- ((and (looking-at "[ \t]*$")
- (string-match
- "^\\*+$" (buffer-substring
- (point-at-bol) (point))))
- (- (match-end 0) (match-beginning 0)))
- ((and (bolp)
- (looking-at org-outline-regexp))
- (- (match-end 0) (point) 1))))
- (previous-level (save-excursion
- (condition-case nil
- (progn
- (outline-previous-visible-heading 1)
- (if (looking-at ^re_)
- (- (match-end 0) (match-beginning 0) 1)
- 1))
- (error 1))))
- (next-level (save-excursion
- (condition-case nil
- (progn
- (or (looking-at org-outline-regexp)
- (outline-next-visible-heading 1))
- (if (looking-at ^re_)
- (- (match-end 0) (match-beginning 0) 1)
- 1))
- (error 1))))
- (new-level (or force-level (max previous-level next-level)))
- (shift (if (or (= old-level -1)
- (= new-level -1)
- (= old-level new-level))
- 0
- (- new-level old-level)))
- (delta (if (> shift 0) -1 1))
- (func (if (> shift 0) 'org-demote 'org-promote))
- (org-odd-levels-only nil)
- beg end newend)
- ;; Remove the forced level indicator
- (when force-level
- (delete-region (point-at-bol) (point)))
- ;; Paste
- (beginning-of-line (if (bolp) 1 2))
- (setq beg (point))
- (and (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt))
- (insert-before-markers txt)
- (unless (string-suffix-p "\n" txt) (insert "\n"))
- (setq newend (point))
- (org-reinstall-markers-in-region beg)
- (setq end (point))
- (goto-char beg)
- (skip-chars-forward " \t\n\r")
- (setq beg (point))
- (when (and (org-invisible-p) visp)
- (save-excursion (outline-show-heading)))
- ;; Shift if necessary
- (unless (= shift 0)
- (save-restriction
- (narrow-to-region beg end)
- (while (not (= shift 0))
- (org-map-region func (point-min) (point-max))
- (setq shift (+ delta shift)))
- (goto-char (point-min))
- (setq newend (point-max))))
- (when (or (called-interactively-p 'interactive) for-yank)
- (message "Clipboard pasted as level %d subtree" new-level))
- (when (and (not for-yank) ; in this case, org-yank will decide about folding
- kill-ring
- (eq org-subtree-clip (current-kill 0))
- org-subtree-clip-folded)
- ;; The tree was folded before it was killed/copied
- (outline-hide-subtree))
- (and for-yank (goto-char newend))
- (and remove (setq kill-ring (cdr kill-ring))))))
- (defun org-kill-is-subtree-p (&optional txt)
- "Check if the current kill is an outline subtree, or a set of trees.
- Returns nil if kill does not start with a headline, or if the first
- headline level is not the largest headline level in the tree.
- So this will actually accept several entries of equal levels as well,
- which is OK for `org-paste-subtree'.
- If optional TXT is given, check this string instead of the current kill."
- (let* ((kill (or txt (and kill-ring (current-kill 0)) ""))
- (re (org-get-limited-outline-regexp))
- (^re (concat "^" re))
- (start-level (and kill
- (string-match
- (concat "\\`\\([ \t\n\r]*?\n\\)?\\(" re "\\)")
- kill)
- (- (match-end 2) (match-beginning 2) 1)))
- (start (1+ (or (match-beginning 2) -1))))
- (if (not start-level)
- (progn
- nil) ;; does not even start with a heading
- (catch 'exit
- (while (setq start (string-match ^re kill (1+ start)))
- (when (< (- (match-end 0) (match-beginning 0) 1) start-level)
- (throw 'exit nil)))
- t))))
- (defvar org-markers-to-move nil
- "Markers that should be moved with a cut-and-paste operation.
- Those markers are stored together with their positions relative to
- the start of the region.")
- (defun org-save-markers-in-region (beg end)
- "Check markers in region.
- If these markers are between BEG and END, record their position relative
- to BEG, so that after moving the block of text, we can put the markers back
- into place.
- This function gets called just before an entry or tree gets cut from the
- buffer. After re-insertion, `org-reinstall-markers-in-region' must be
- called immediately, to move the markers with the entries."
- (setq org-markers-to-move nil)
- (when (featurep 'org-clock)
- (org-clock-save-markers-for-cut-and-paste beg end))
- (when (featurep 'org-agenda)
- (org-agenda-save-markers-for-cut-and-paste beg end)))
- (defun org-check-and-save-marker (marker beg end)
- "Check if MARKER is between BEG and END.
- If yes, remember the marker and the distance to BEG."
- (when (and (marker-buffer marker)
- (equal (marker-buffer marker) (current-buffer))
- (>= marker beg) (< marker end))
- (push (cons marker (- marker beg)) org-markers-to-move)))
- (defun org-reinstall-markers-in-region (beg)
- "Move all remembered markers to their position relative to BEG."
- (dolist (x org-markers-to-move)
- (move-marker (car x) (+ beg (cdr x))))
- (setq org-markers-to-move nil))
- (defun org-narrow-to-subtree ()
- "Narrow buffer to the current subtree."
- (interactive)
- (save-excursion
- (save-match-data
- (org-with-limited-levels
- (narrow-to-region
- (progn (org-back-to-heading t) (point))
- (progn (org-end-of-subtree t t)
- (when (and (org-at-heading-p) (not (eobp))) (backward-char 1))
- (point)))))))
- (defun org-narrow-to-block ()
- "Narrow buffer to the current block."
- (interactive)
- (let* ((case-fold-search t)
- (blockp (org-between-regexps-p "^[ \t]*#\\+begin_.*"
- "^[ \t]*#\\+end_.*")))
- (if blockp
- (narrow-to-region (car blockp) (cdr blockp))
- (user-error "Not in a block"))))
- (defun org-clone-subtree-with-time-shift (n &optional shift)
- "Clone the task (subtree) at point N times.
- The clones will be inserted as siblings.
- In interactive use, the user will be prompted for the number of
- clones to be produced. If the entry has a timestamp, the user
- will also be prompted for a time shift, which may be a repeater
- as used in time stamps, for example `+3d'. To disable this,
- you can call the function with a universal prefix argument.
- When a valid repeater is given and the entry contains any time
- stamps, the clones will become a sequence in time, with time
- stamps in the subtree shifted for each clone produced. If SHIFT
- is nil or the empty string, time stamps will be left alone. The
- ID property of the original subtree is removed.
- In each clone, all the CLOCK entries will be removed. This
- prevents Org from considering that the clocked times overlap.
- If the original subtree did contain time stamps with a repeater,
- the following will happen:
- - the repeater will be removed in each clone
- - an additional clone will be produced, with the current, unshifted
- date(s) in the entry.
- - the original entry will be placed *after* all the clones, with
- repeater intact.
- - the start days in the repeater in the original entry will be shifted
- to past the last clone.
- In this way you can spell out a number of instances of a repeating task,
- and still retain the repeater to cover future instances of the task.
- As described above, N+1 clones are produced when the original
- subtree has a repeater. Setting N to 0, then, can be used to
- remove the repeater from a subtree and create a shifted clone
- with the original repeater."
- (interactive "nNumber of clones to produce: ")
- (unless (wholenump n) (user-error "Invalid number of replications %s" n))
- (when (org-before-first-heading-p) (user-error "No subtree to clone"))
- (let* ((beg (save-excursion (org-back-to-heading t) (point)))
- (end-of-tree (save-excursion (org-end-of-subtree t t) (point)))
- (shift
- (or shift
- (if (and (not (equal current-prefix-arg '(4)))
- (save-excursion
- (goto-char beg)
- (re-search-forward org-ts-regexp-both end-of-tree t)))
- (read-from-minibuffer
- "Date shift per clone (e.g. +1w, empty to copy unchanged): ")
- ""))) ;No time shift
- (doshift
- (and (org-string-nw-p shift)
- (or (string-match "\\`[ \t]*\\+?\\([0-9]+\\)\\([dwmy]\\)[ \t]*\\'"
- shift)
- (user-error "Invalid shift specification %s" shift)))))
- (goto-char end-of-tree)
- (unless (bolp) (insert "\n"))
- (let* ((end (point))
- (template (buffer-substring beg end))
- (shift-n (and doshift (string-to-number (match-string 1 shift))))
- (shift-what (pcase (and doshift (match-string 2 shift))
- (`nil nil)
- ("d" 'day)
- ("w" (setq shift-n (* 7 shift-n)) 'day)
- ("m" 'month)
- ("y" 'year)
- (_ (error "Unsupported time unit"))))
- (nmin 1)
- (nmax n)
- (n-no-remove -1)
- (idprop (org-entry-get nil "ID")))
- (when (and doshift
- (string-match-p "<[^<>\n]+ [.+]?\\+[0-9]+[hdwmy][^<>\n]*>"
- template))
- (delete-region beg end)
- (setq end beg)
- (setq nmin 0)
- (setq nmax (1+ nmax))
- (setq n-no-remove nmax))
- (goto-char end)
- (cl-loop for n from nmin to nmax do
- (insert
- ;; Prepare clone.
- (with-temp-buffer
- (insert template)
- (org-mode)
- (goto-char (point-min))
- (org-show-subtree)
- (and idprop (if org-clone-delete-id
- (org-entry-delete nil "ID")
- (org-id-get-create t)))
- (unless (= n 0)
- (while (re-search-forward org-clock-line-re nil t)
- (delete-region (line-beginning-position)
- (line-beginning-position 2)))
- (goto-char (point-min))
- (while (re-search-forward org-drawer-regexp nil t)
- (org-remove-empty-drawer-at (point))))
- (goto-char (point-min))
- (when doshift
- (while (re-search-forward org-ts-regexp-both nil t)
- (org-timestamp-change (* n shift-n) shift-what))
- (unless (= n n-no-remove)
- (goto-char (point-min))
- (while (re-search-forward org-ts-regexp nil t)
- (save-excursion
- (goto-char (match-beginning 0))
- (when (looking-at "<[^<>\n]+\\( +[.+]?\\+[0-9]+[hdwmy]\\)")
- (delete-region (match-beginning 1) (match-end 1)))))))
- (buffer-string)))))
- (goto-char beg)))
- ;;; Outline Sorting
- (defun org-sort (with-case)
- "Call `org-sort-entries', `org-table-sort-lines' or `org-sort-list'.
- Optional argument WITH-CASE means sort case-sensitively."
- (interactive "P")
- (cond
- ((org-at-table-p) (org-call-with-arg 'org-table-sort-lines with-case))
- ((org-at-item-p) (org-call-with-arg 'org-sort-list with-case))
- (t
- (org-call-with-arg 'org-sort-entries with-case))))
- (defun org-sort-remove-invisible (s)
- "Remove invisible links from string S."
- (remove-text-properties 0 (length s) org-rm-props s)
- (while (string-match org-bracket-link-regexp s)
- (setq s (replace-match (if (match-end 2)
- (match-string 3 s)
- (match-string 1 s))
- t t s)))
- (let ((st (format " %s " s)))
- (while (string-match org-emph-re st)
- (setq st (replace-match (format " %s " (match-string 4 st)) t t st)))
- (setq s (substring st 1 -1)))
- s)
- (defvar org-priority-regexp) ; defined later in the file
- (defvar org-after-sorting-entries-or-items-hook nil
- "Hook that is run after a bunch of entries or items have been sorted.
- When children are sorted, the cursor is in the parent line when this
- hook gets called. When a region or a plain list is sorted, the cursor
- will be in the first entry of the sorted region/list.")
- (defun org-sort-entries
- (&optional with-case sorting-type getkey-func compare-func property
- interactive?)
- "Sort entries on a certain level of an outline tree.
- If there is an active region, the entries in the region are sorted.
- Else, if the cursor is before the first entry, sort the top-level items.
- Else, the children of the entry at point are sorted.
- Sorting can be alphabetically, numerically, by date/time as given by
- a time stamp, by a property, by priority order, or by a custom function.
- The command prompts for the sorting type unless it has been given to the
- function through the SORTING-TYPE argument, which needs to be a character,
- \(?n ?N ?a ?A ?t ?T ?s ?S ?d ?D ?p ?P ?o ?O ?r ?R ?f ?F ?k ?K). Here is
- the precise meaning of each character:
- a Alphabetically, ignoring the TODO keyword and the priority, if any.
- c By creation time, which is assumed to be the first inactive time stamp
- at the beginning of a line.
- d By deadline date/time.
- k By clocking time.
- n Numerically, by converting the beginning of the entry/item to a number.
- o By order of TODO keywords.
- p By priority according to the cookie.
- r By the value of a property.
- s By scheduled date/time.
- t By date/time, either the first active time stamp in the entry, or, if
- none exist, by the first inactive one.
- Capital letters will reverse the sort order.
- If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be
- called with point at the beginning of the record. It must return a
- value that is compatible with COMPARE-FUNC, the function used to
- compare entries.
- Comparing entries ignores case by default. However, with an optional argument
- WITH-CASE, the sorting considers case as well.
- Sorting is done against the visible part of the headlines, it ignores hidden
- links.
- When sorting is done, call `org-after-sorting-entries-or-items-hook'.
- A non-nil value for INTERACTIVE? is used to signal that this
- function is being called interactively."
- (interactive (list current-prefix-arg nil nil nil nil t))
- (let ((case-func (if with-case 'identity 'downcase))
- (cmstr
- ;; The clock marker is lost when using `sort-subr', let's
- ;; store the clocking string.
- (when (equal (marker-buffer org-clock-marker) (current-buffer))
- (save-excursion
- (goto-char org-clock-marker)
- (buffer-substring-no-properties (line-beginning-position)
- (point)))))
- start beg end stars re re2
- txt what tmp)
- ;; Find beginning and end of region to sort
- (cond
- ((org-region-active-p)
- ;; we will sort the region
- (setq end (region-end)
- what "region")
- (goto-char (region-beginning))
- (unless (org-at-heading-p) (outline-next-heading))
- (setq start (point)))
- ((or (org-at-heading-p)
- (ignore-errors (progn (org-back-to-heading) t)))
- ;; we will sort the children of the current headline
- (org-back-to-heading)
- (setq start (point)
- end (progn (org-end-of-subtree t t)
- (or (bolp) (insert "\n"))
- (when (>= (org-back-over-empty-lines) 1)
- (forward-line 1))
- (point))
- what "children")
- (goto-char start)
- (outline-show-subtree)
- (outline-next-heading))
- (t
- ;; we will sort the top-level entries in this file
- (goto-char (point-min))
- (or (org-at-heading-p) (outline-next-heading))
- (setq start (point))
- (goto-char (point-max))
- (beginning-of-line 1)
- (when (looking-at ".*?\\S-")
- ;; File ends in a non-white line
- (end-of-line 1)
- (insert "\n"))
- (setq end (point-max))
- (setq what "top-level")
- (goto-char start)
- (outline-show-all)))
- (setq beg (point))
- (when (>= beg end) (goto-char start) (user-error "Nothing to sort"))
- (looking-at "\\(\\*+\\)")
- (setq stars (match-string 1)
- re (concat "^" (regexp-quote stars) " +")
- re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[ \t\n]")
- txt (buffer-substring beg end))
- (unless (equal (substring txt -1) "\n") (setq txt (concat txt "\n")))
- (when (and (not (equal stars "*")) (string-match re2 txt))
- (user-error "Region to sort contains a level above the first entry"))
- (unless sorting-type
- (message
- "Sort %s: [a]lpha [n]umeric [p]riority p[r]operty todo[o]rder [f]unc
- [t]ime [s]cheduled [d]eadline [c]reated cloc[k]ing
- A/N/P/R/O/F/T/S/D/C/K means reversed:"
- what)
- (setq sorting-type (read-char-exclusive)))
- (unless getkey-func
- (and (= (downcase sorting-type) ?f)
- (setq getkey-func
- (or (and interactive?
- (org-read-function
- "Function for extracting keys: "))
- (error "Missing key extractor")))))
- (and (= (downcase sorting-type) ?r)
- (not property)
- (setq property
- (completing-read "Property: "
- (mapcar #'list (org-buffer-property-keys t))
- nil t)))
- (when (member sorting-type '(?k ?K)) (org-clock-sum))
- (message "Sorting entries...")
- (save-restriction
- (narrow-to-region start end)
- (let ((dcst (downcase sorting-type))
- (case-fold-search nil)
- (now (current-time)))
- (sort-subr
- (/= dcst sorting-type)
- ;; This function moves to the beginning character of the "record" to
- ;; be sorted.
- (lambda nil
- (if (re-search-forward re nil t)
- (goto-char (match-beginning 0))
- (goto-char (point-max))))
- ;; This function moves to the last character of the "record" being
- ;; sorted.
- (lambda nil
- (save-match-data
- (condition-case nil
- (outline-forward-same-level 1)
- (error
- (goto-char (point-max))))))
- ;; This function returns the value that gets sorted against.
- (lambda nil
- (cond
- ((= dcst ?n)
- (if (looking-at org-complex-heading-regexp)
- (string-to-number (org-sort-remove-invisible (match-string 4)))
- nil))
- ((= dcst ?a)
- (if (looking-at org-complex-heading-regexp)
- (funcall case-func (org-sort-remove-invisible (match-string 4)))
- nil))
- ((= dcst ?k)
- (or (get-text-property (point) :org-clock-minutes) 0))
- ((= dcst ?t)
- (let ((end (save-excursion (outline-next-heading) (point))))
- (if (or (re-search-forward org-ts-regexp end t)
- (re-search-forward org-ts-regexp-both end t))
- (org-time-string-to-seconds (match-string 0))
- (float-time now))))
- ((= dcst ?c)
- (let ((end (save-excursion (outline-next-heading) (point))))
- (if (re-search-forward
- (concat "^[ \t]*\\[" org-ts-regexp1 "\\]")
- end t)
- (org-time-string-to-seconds (match-string 0))
- (float-time now))))
- ((= dcst ?s)
- (let ((end (save-excursion (outline-next-heading) (point))))
- (if (re-search-forward org-scheduled-time-regexp end t)
- (org-time-string-to-seconds (match-string 1))
- (float-time now))))
- ((= dcst ?d)
- (let ((end (save-excursion (outline-next-heading) (point))))
- (if (re-search-forward org-deadline-time-regexp end t)
- (org-time-string-to-seconds (match-string 1))
- (float-time now))))
- ((= dcst ?p)
- (if (re-search-forward org-priority-regexp (point-at-eol) t)
- (string-to-char (match-string 2))
- org-default-priority))
- ((= dcst ?r)
- (or (org-entry-get nil property) ""))
- ((= dcst ?o)
- (when (looking-at org-complex-heading-regexp)
- (let* ((m (match-string 2))
- (s (if (member m org-done-keywords) '- '+)))
- (- 99 (funcall s (length (member m org-todo-keywords-1)))))))
- ((= dcst ?f)
- (if getkey-func
- (progn
- (setq tmp (funcall getkey-func))
- (when (stringp tmp) (setq tmp (funcall case-func tmp)))
- tmp)
- (error "Invalid key function `%s'" getkey-func)))
- (t (error "Invalid sorting type `%c'" sorting-type))))
- nil
- (cond
- ((= dcst ?a) 'string<)
- ((= dcst ?f)
- (or compare-func
- (and interactive?
- (org-read-function
- (concat "Function for comparing keys "
- "(empty for default `sort-subr' predicate): ")
- 'allow-empty))))
- ((member dcst '(?p ?t ?s ?d ?c ?k)) '<)))))
- (run-hooks 'org-after-sorting-entries-or-items-hook)
- ;; Reset the clock marker if needed
- (when cmstr
- (save-excursion
- (goto-char start)
- (search-forward cmstr nil t)
- (move-marker org-clock-marker (point))))
- (message "Sorting entries...done")))
- ;;; The orgstruct minor mode
- ;; Define a minor mode which can be used in other modes in order to
- ;; integrate the Org mode structure editing commands.
- ;; This is really a hack, because the Org mode structure commands use
- ;; keys which normally belong to the major mode. Here is how it
- ;; works: The minor mode defines all the keys necessary to operate the
- ;; structure commands, but wraps the commands into a function which
- ;; tests if the cursor is currently at a headline or a plain list
- ;; item. If that is the case, the structure command is used,
- ;; temporarily setting many Org mode variables like regular
- ;; expressions for filling etc. However, when any of those keys is
- ;; used at a different location, function uses `key-binding' to look
- ;; up if the key has an associated command in another currently active
- ;; keymap (minor modes, major mode, global), and executes that
- ;; command. There might be problems if any of the keys is otherwise
- ;; used as a prefix key.
- (defcustom orgstruct-heading-prefix-regexp ""
- "Regexp that matches the custom prefix of Org headlines in
- orgstruct(++)-mode."
- :group 'org
- :version "24.4"
- :package-version '(Org . "8.3")
- :type 'regexp)
- ;;;###autoload(put 'orgstruct-heading-prefix-regexp 'safe-local-variable 'stringp)
- (defcustom orgstruct-setup-hook nil
- "Hook run after orgstruct-mode-map is filled."
- :group 'org
- :version "24.4"
- :package-version '(Org . "8.0")
- :type 'hook)
- (defvar orgstruct-initialized nil)
- (defvar org-local-vars nil
- "List of local variables, for use by `orgstruct-mode'.")
- ;;;###autoload
- (define-minor-mode orgstruct-mode
- "Toggle the minor mode `orgstruct-mode'.
- This mode is for using Org mode structure commands in other
- modes. The following keys behave as if Org mode were active, if
- the cursor is on a headline, or on a plain list item (both as
- defined by Org mode)."
- nil " OrgStruct" (make-sparse-keymap)
- (funcall (if orgstruct-mode
- 'add-to-invisibility-spec
- 'remove-from-invisibility-spec)
- '(outline . t))
- (when orgstruct-mode
- (org-load-modules-maybe)
- (unless orgstruct-initialized
- (orgstruct-setup)
- (setq orgstruct-initialized t))))
- ;;;###autoload
- (defun turn-on-orgstruct ()
- "Unconditionally turn on `orgstruct-mode'."
- (orgstruct-mode 1))
- (defvar-local orgstruct-is-++ nil
- "Is `orgstruct-mode' in ++ version in the current-buffer?")
- (defvar-local org-fb-vars nil)
- (defun orgstruct++-mode (&optional arg)
- "Toggle `orgstruct-mode', the enhanced version of it.
- In addition to setting orgstruct-mode, this also exports all
- indentation and autofilling variables from Org mode into the
- buffer. It will also recognize item context in multiline items."
- (interactive "P")
- (setq arg (prefix-numeric-value (or arg (if orgstruct-mode -1 1))))
- (if (< arg 1)
- (progn (orgstruct-mode -1)
- (dolist (v org-fb-vars)
- (set (make-local-variable (car v))
- (if (eq (car-safe (cadr v)) 'quote)
- (cl-cadadr v)
- (nth 1 v)))))
- (orgstruct-mode 1)
- (setq org-fb-vars nil)
- (unless org-local-vars
- (setq org-local-vars (org-get-local-variables)))
- (let (var val)
- (dolist (x org-local-vars)
- (when (string-match
- "^\\(paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\
- \\|fill-prefix\\|indent-\\)"
- (symbol-name (car x)))
- (setq var (car x) val (nth 1 x))
- (push (list var `(quote ,(eval var))) org-fb-vars)
- (set (make-local-variable var)
- (if (eq (car-safe val) 'quote) (nth 1 val) val))))
- (setq-local orgstruct-is-++ t))))
- ;;;###autoload
- (defun turn-on-orgstruct++ ()
- "Unconditionally turn on `orgstruct++-mode'."
- (orgstruct++-mode 1))
- (defun orgstruct-error ()
- "Error when there is no default binding for a structure key."
- (interactive)
- (funcall (if (fboundp 'user-error)
- 'user-error
- 'error)
- "This key has no function outside structure elements"))
- (defun orgstruct-setup ()
- "Setup orgstruct keymap."
- (dolist (cell '((org-demote . t)
- (org-metaleft . t)
- (org-metaright . t)
- (org-promote . t)
- (org-shiftmetaleft . t)
- (org-shiftmetaright . t)
- org-backward-element
- org-backward-heading-same-level
- org-ctrl-c-ret
- org-ctrl-c-minus
- org-ctrl-c-star
- org-cycle
- org-force-cycle-archived
- org-forward-heading-same-level
- org-insert-heading
- org-insert-heading-respect-content
- org-kill-note-or-show-branches
- org-mark-subtree
- org-meta-return
- org-metadown
- org-metaup
- org-narrow-to-subtree
- org-promote-subtree
- org-reveal
- org-shiftdown
- org-shiftleft
- org-shiftmetadown
- org-shiftmetaup
- org-shiftright
- org-shifttab
- org-shifttab
- org-shiftup
- org-show-children
- org-show-subtree
- org-sort
- org-up-element
- outline-demote
- outline-next-visible-heading
- outline-previous-visible-heading
- outline-promote
- outline-up-heading))
- (let ((f (or (car-safe cell) cell))
- (disable-when-heading-prefix (cdr-safe cell)))
- (when (fboundp f)
- (let ((new-bindings))
- (dolist (binding (nconc (where-is-internal f org-mode-map)
- (where-is-internal f outline-mode-map)))
- (push binding new-bindings)
- ;; TODO use local-function-key-map
- (dolist (rep '(("<tab>" . "TAB")
- ("<return>" . "RET")
- ("<escape>" . "ESC")
- ("<delete>" . "DEL")))
- (setq binding (read-kbd-macro
- (let ((case-fold-search))
- (replace-regexp-in-string
- (regexp-quote (cdr rep))
- (car rep)
- (key-description binding)))))
- (cl-pushnew binding new-bindings :test 'equal)))
- (dolist (binding new-bindings)
- (let ((key (lookup-key orgstruct-mode-map binding)))
- (when (or (not key) (numberp key))
- (ignore-errors
- (org-defkey orgstruct-mode-map
- binding
- (orgstruct-make-binding
- f binding disable-when-heading-prefix))))))))))
- (run-hooks 'orgstruct-setup-hook))
- (defun orgstruct-make-binding (fun key disable-when-heading-prefix)
- "Create a function for binding in the structure minor mode.
- FUN is the command to call inside a table. KEY is the key that
- should be checked in for a command to execute outside of tables.
- Non-nil `disable-when-heading-prefix' means to disable the command
- if `orgstruct-heading-prefix-regexp' is not empty."
- (let ((name (concat "orgstruct-hijacker-" (symbol-name fun))))
- (let ((nname name)
- (i 0))
- (while (fboundp (intern nname))
- (setq nname (format "%s-%d" name (setq i (1+ i)))))
- (setq name (intern nname)))
- (eval
- (let ((bindings '((org-heading-regexp
- (concat "^"
- orgstruct-heading-prefix-regexp
- "\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ ]*$"))
- (org-outline-regexp
- (concat orgstruct-heading-prefix-regexp "\\*+ "))
- (org-outline-regexp-bol
- (concat "^" org-outline-regexp))
- (outline-regexp org-outline-regexp)
- (outline-heading-end-regexp "\n")
- (outline-level 'org-outline-level)
- (outline-heading-alist))))
- `(defun ,name (arg)
- ,(concat "In Structure, run `" (symbol-name fun) "'.\n"
- "Outside of structure, run the binding of `"
- (key-description key) "'."
- (when disable-when-heading-prefix
- (concat
- "\nIf `orgstruct-heading-prefix-regexp' is not empty, this command will always fall\n"
- "back to the default binding due to limitations of Org's implementation of\n"
- "`" (symbol-name fun) "'.")))
- (interactive "p")
- (let* ((disable
- ,(and disable-when-heading-prefix
- '(not (string= orgstruct-heading-prefix-regexp ""))))
- (fallback
- (or disable
- (not
- (let* ,bindings
- (org-context-p 'headline 'item
- ,(when (memq fun
- '(org-insert-heading
- org-insert-heading-respect-content
- org-meta-return))
- '(when orgstruct-is-++
- 'item-body))))))))
- (if fallback
- (let* ((orgstruct-mode)
- (binding
- (let ((key ,key))
- (catch 'exit
- (dolist
- (rep
- '(nil
- ("<\\([^>]*\\)tab>" . "\\1TAB")
- ("<\\([^>]*\\)return>" . "\\1RET")
- ("<\\([^>]*\\)escape>" . "\\1ESC")
- ("<\\([^>]*\\)delete>" . "\\1DEL"))
- nil)
- (when rep
- (setq key (read-kbd-macro
- (let ((case-fold-search))
- (replace-regexp-in-string
- (car rep)
- (cdr rep)
- (key-description key))))))
- (when (key-binding key)
- (throw 'exit (key-binding key))))))))
- (if (keymapp binding)
- (org-set-transient-map binding)
- (let ((func (or binding
- (unless disable
- 'orgstruct-error))))
- (when func
- (call-interactively func)))))
- (org-run-like-in-org-mode
- (lambda ()
- (interactive)
- (let* ,bindings
- (call-interactively ',fun)))))))))
- name))
- (defun org-contextualize-keys (alist contexts)
- "Return valid elements in ALIST depending on CONTEXTS.
- `org-agenda-custom-commands' or `org-capture-templates' are the
- values used for ALIST, and `org-agenda-custom-commands-contexts'
- or `org-capture-templates-contexts' are the associated contexts
- definitions."
- (let ((contexts
- ;; normalize contexts
- (mapcar
- (lambda(c) (cond ((listp (cadr c))
- (list (car c) (car c) (nth 1 c)))
- ((string= "" (cadr c))
- (list (car c) (car c) (nth 2 c)))
- (t c)))
- contexts))
- (a alist) r s)
- ;; loop over all commands or templates
- (dolist (c a)
- (let (vrules repl)
- (cond
- ((not (assoc (car c) contexts))
- (push c r))
- ((and (assoc (car c) contexts)
- (setq vrules (org-contextualize-validate-key
- (car c) contexts)))
- (mapc (lambda (vr)
- (unless (equal (car vr) (cadr vr))
- (setq repl vr)))
- vrules)
- (if (not repl) (push c r)
- (push (cadr repl) s)
- (push
- (cons (car c)
- (cdr (or (assoc (cadr repl) alist)
- (error "Undefined key `%s' as contextual replacement for `%s'"
- (cadr repl) (car c)))))
- r))))))
- ;; Return limited ALIST, possibly with keys modified, and deduplicated
- (delq
- nil
- (delete-dups
- (mapcar (lambda (x)
- (let ((tpl (car x)))
- (unless (delq
- nil
- (mapcar (lambda (y)
- (equal y tpl))
- s))
- x)))
- (reverse r))))))
- (defun org-contextualize-validate-key (key contexts)
- "Check CONTEXTS for agenda or capture KEY."
- (let (res)
- (dolist (r contexts)
- (dolist (rr (car (last r)))
- (when
- (and (equal key (car r))
- (if (functionp rr) (funcall rr)
- (or (and (eq (car rr) 'in-file)
- (buffer-file-name)
- (string-match (cdr rr) (buffer-file-name)))
- (and (eq (car rr) 'in-mode)
- (string-match (cdr rr) (symbol-name major-mode)))
- (and (eq (car rr) 'in-buffer)
- (string-match (cdr rr) (buffer-name)))
- (when (and (eq (car rr) 'not-in-file)
- (buffer-file-name))
- (not (string-match (cdr rr) (buffer-file-name))))
- (when (eq (car rr) 'not-in-mode)
- (not (string-match (cdr rr) (symbol-name major-mode))))
- (when (eq (car rr) 'not-in-buffer)
- (not (string-match (cdr rr) (buffer-name)))))))
- (push r res))))
- (delete-dups (delq nil res))))
- (defun org-context-p (&rest contexts)
- "Check if local context is any of CONTEXTS.
- Possible values in the list of contexts are `table', `headline', and `item'."
- (let ((pos (point)))
- (goto-char (point-at-bol))
- (prog1 (or (and (memq 'table contexts)
- (looking-at "[ \t]*|"))
- (and (memq 'headline contexts)
- (looking-at org-outline-regexp))
- (and (memq 'item contexts)
- (looking-at "[ \t]*\\([-+*] \\|[0-9]+[.)] \\)"))
- (and (memq 'item-body contexts)
- (org-in-item-p)))
- (goto-char pos))))
- (defconst org-unique-local-variables
- '(org-element--cache
- org-element--cache-objects
- org-element--cache-sync-keys
- org-element--cache-sync-requests
- org-element--cache-sync-timer)
- "List of local variables that cannot be transferred to another buffer.")
- (defun org-get-local-variables ()
- "Return a list of all local variables in an Org mode buffer."
- (delq nil
- (mapcar
- (lambda (x)
- (let* ((binding (if (symbolp x) (list x) (list (car x) (cdr x))))
- (name (car binding)))
- (and (not (get name 'org-state))
- (not (memq name org-unique-local-variables))
- (string-match-p
- "\\`\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|\
- auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)"
- (symbol-name name))
- binding)))
- (with-temp-buffer
- (org-mode)
- (buffer-local-variables)))))
- (defun org-clone-local-variables (from-buffer &optional regexp)
- "Clone local variables from FROM-BUFFER.
- Optional argument REGEXP selects variables to clone."
- (dolist (pair (buffer-local-variables from-buffer))
- (pcase pair
- (`(,name . ,value) ;ignore unbound variables
- (when (and (not (memq name org-unique-local-variables))
- (or (null regexp) (string-match-p regexp (symbol-name name))))
- (set (make-local-variable name) value))))))
- ;;;###autoload
- (defun org-run-like-in-org-mode (cmd)
- "Run a command, pretending that the current buffer is in Org mode.
- This will temporarily bind local variables that are typically bound in
- Org mode to the values they have in Org mode, and then interactively
- call CMD."
- (org-load-modules-maybe)
- (unless org-local-vars
- (setq org-local-vars (org-get-local-variables)))
- (let (binds)
- (dolist (var org-local-vars)
- (when (or (not (boundp (car var)))
- (eq (symbol-value (car var))
- (default-value (car var))))
- (push (list (car var) `(quote ,(cadr var))) binds)))
- (eval `(let ,binds
- (call-interactively (quote ,cmd))))))
- (defun org-get-category (&optional pos force-refresh)
- "Get the category applying to position POS."
- (save-match-data
- (when force-refresh (org-refresh-category-properties))
- (let ((pos (or pos (point))))
- (or (get-text-property pos 'org-category)
- (progn (org-refresh-category-properties)
- (get-text-property pos 'org-category))))))
- ;;; Refresh properties
- (defun org-refresh-properties (dprop tprop)
- "Refresh buffer text properties.
- DPROP is the drawer property and TPROP is either the
- corresponding text property to set, or an alist with each element
- being a text property (as a symbol) and a function to apply to
- the value of the drawer property."
- (let* ((case-fold-search t)
- (inhibit-read-only t)
- (inherit? (org-property-inherit-p dprop))
- (property-re (org-re-property (concat (regexp-quote dprop) "\\+?") t))
- (global (and inherit? (org--property-global-value dprop nil))))
- (org-with-silent-modifications
- (org-with-point-at 1
- ;; Set global values (e.g., values defined through
- ;; "#+PROPERTY:" keywords) to the whole buffer.
- (when global (put-text-property (point-min) (point-max) tprop global))
- ;; Set local values.
- (while (re-search-forward property-re nil t)
- (when (org-at-property-p)
- (org-refresh-property tprop (org-entry-get (point) dprop) inherit?))
- (outline-next-heading))))))
- (defun org-refresh-property (tprop p &optional inherit)
- "Refresh the buffer text property TPROP from the drawer property P.
- The refresh happens only for the current headline, or the whole
- sub-tree if optional argument INHERIT is non-nil."
- (unless (org-before-first-heading-p)
- (save-excursion
- (org-back-to-heading t)
- (let ((start (point))
- (end (save-excursion
- (if inherit (org-end-of-subtree t t)
- (or (outline-next-heading) (point-max))))))
- (if (symbolp tprop)
- ;; TPROP is a text property symbol.
- (put-text-property start end tprop p)
- ;; TPROP is an alist with (property . function) elements.
- (pcase-dolist (`(,prop . ,f) tprop)
- (put-text-property start end prop (funcall f p))))))))
- (defun org-refresh-category-properties ()
- "Refresh category text properties in the buffer."
- (let ((case-fold-search t)
- (inhibit-read-only t)
- (default-category
- (cond ((null org-category)
- (if buffer-file-name
- (file-name-sans-extension
- (file-name-nondirectory buffer-file-name))
- "???"))
- ((symbolp org-category) (symbol-name org-category))
- (t org-category))))
- (org-with-silent-modifications
- (org-with-wide-buffer
- ;; Set buffer-wide category. Search last #+CATEGORY keyword.
- ;; This is the default category for the buffer. If none is
- ;; found, fall-back to `org-category' or buffer file name.
- (put-text-property
- (point-min) (point-max)
- 'org-category
- (catch 'buffer-category
- (goto-char (point-max))
- (while (re-search-backward "^[ \t]*#\\+CATEGORY:" (point-min) t)
- (let ((element (org-element-at-point)))
- (when (eq (org-element-type element) 'keyword)
- (throw 'buffer-category
- (org-element-property :value element)))))
- default-category))
- ;; Set sub-tree specific categories.
- (goto-char (point-min))
- (let ((regexp (org-re-property "CATEGORY")))
- (while (re-search-forward regexp nil t)
- (let ((value (match-string-no-properties 3)))
- (when (org-at-property-p)
- (put-text-property
- (save-excursion (org-back-to-heading t) (point))
- (save-excursion (org-end-of-subtree t t) (point))
- 'org-category
- value)))))))))
- (defun org-refresh-stats-properties ()
- "Refresh stats text properties in the buffer."
- (org-with-silent-modifications
- (org-with-point-at 1
- (let ((regexp (concat org-outline-regexp-bol
- ".*\\[\\([0-9]*\\)\\(?:%\\|/\\([0-9]*\\)\\)\\]")))
- (while (re-search-forward regexp nil t)
- (let* ((numerator (string-to-number (match-string 1)))
- (denominator (and (match-end 2)
- (string-to-number (match-string 2))))
- (stats (cond ((not denominator) numerator) ;percent
- ((= denominator 0) 0)
- (t (/ (* numerator 100) denominator)))))
- (put-text-property (point) (progn (org-end-of-subtree t t) (point))
- 'org-stats stats)))))))
- (defun org-refresh-effort-properties ()
- "Refresh effort properties"
- (org-refresh-properties
- org-effort-property
- '((effort . identity)
- (effort-minutes . org-duration-string-to-minutes))))
- ;;;; Link Stuff
- ;;; Link abbreviations
- (defun org-link-expand-abbrev (link)
- "Apply replacements as defined in `org-link-abbrev-alist'."
- (if (string-match "^\\([^:]*\\)\\(::?\\(.*\\)\\)?$" link)
- (let* ((key (match-string 1 link))
- (as (or (assoc key org-link-abbrev-alist-local)
- (assoc key org-link-abbrev-alist)))
- (tag (and (match-end 2) (match-string 3 link)))
- rpl)
- (if (not as)
- link
- (setq rpl (cdr as))
- (cond
- ((symbolp rpl) (funcall rpl tag))
- ((string-match "%(\\([^)]+\\))" rpl)
- (replace-match
- (save-match-data
- (funcall (intern-soft (match-string 1 rpl)) tag)) t t rpl))
- ((string-match "%s" rpl) (replace-match (or tag "") t t rpl))
- ((string-match "%h" rpl)
- (replace-match (url-hexify-string (or tag "")) t t rpl))
- (t (concat rpl tag)))))
- link))
- ;;; Storing and inserting links
- (defvar org-insert-link-history nil
- "Minibuffer history for links inserted with `org-insert-link'.")
- (defvar org-stored-links nil
- "Contains the links stored with `org-store-link'.")
- (defvar org-store-link-plist nil
- "Plist with info about the most recently link created with `org-store-link'.")
- (defun org-store-link-functions ()
- "Return a list of functions that are called to create and store a link.
- The functions defined in the :store property of
- `org-link-parameters'.
- Each function will be called in turn until one returns a non-nil
- value. Each function should check if it is responsible for
- creating this link (for example by looking at the major mode).
- If not, it must exit and return nil. If yes, it should return
- a non-nil value after calling `org-store-link-props' with a list
- of properties and values. Special properties are:
- :type The link prefix, like \"http\". This must be given.
- :link The link, like \"http://www.astro.uva.nl/~dominik\".
- This is obligatory as well.
- :description Optional default description for the second pair
- of brackets in an Org mode link. The user can still change
- this when inserting this link into an Org mode buffer.
- In addition to these, any additional properties can be specified
- and then used in capture templates."
- (cl-loop for link in org-link-parameters
- with store-func
- do (setq store-func (org-link-get-parameter (car link) :store))
- if store-func
- collect store-func))
- (defvar org-agenda-buffer-name) ; Defined in org-agenda.el
- (defvar org-id-link-to-org-use-id) ; Defined in org-id.el
- ;;;###autoload
- (defun org-store-link (arg)
- "Store an org-link to the current location.
- \\<org-mode-map>
- This link is added to `org-stored-links' and can later be inserted
- into an Org buffer with `org-insert-link' (`\\[org-insert-link]').
- For some link types, a `\\[universal-argument]' prefix ARG is interpreted. \
- A single
- `\\[universal-argument]' negates `org-context-in-file-links' for file links or
- `org-gnus-prefer-web-links' for links to Usenet articles.
- A `\\[universal-argument] \\[universal-argument]' prefix ARG forces \
- skipping storing functions that are not
- part of Org core.
- A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \
- prefix ARG forces storing a link for each line in the
- active region."
- (interactive "P")
- (org-load-modules-maybe)
- (if (and (equal arg '(64)) (org-region-active-p))
- (save-excursion
- (let ((end (region-end)))
- (goto-char (region-beginning))
- (set-mark (point))
- (while (< (point-at-eol) end)
- (move-end-of-line 1) (activate-mark)
- (let (current-prefix-arg)
- (call-interactively 'org-store-link))
- (move-beginning-of-line 2)
- (set-mark (point)))))
- (setq org-store-link-plist nil)
- (let (link cpltxt desc description search
- txt custom-id agenda-link sfuns sfunsn)
- (cond
- ;; Store a link using an external link type
- ((and (not (equal arg '(16)))
- (setq sfuns
- (delq
- nil (mapcar (lambda (f)
- (let (fs) (if (funcall f) (push f fs))))
- (org-store-link-functions)))
- sfunsn (mapcar (lambda (fu) (symbol-name (car fu))) sfuns))
- (or (and (cdr sfuns)
- (funcall (intern
- (completing-read
- "Which function for creating the link? "
- sfunsn nil t (car sfunsn)))))
- (funcall (caar sfuns)))
- (setq link (plist-get org-store-link-plist :link)
- desc (or (plist-get org-store-link-plist
- :description)
- link))))
- ;; Store a link from a source code buffer.
- ((org-src-edit-buffer-p)
- (let ((coderef-format (org-src-coderef-format)))
- (cond ((save-excursion
- (beginning-of-line)
- (looking-at (org-src-coderef-regexp coderef-format)))
- (setq link (format "(%s)" (match-string-no-properties 3))))
- ((called-interactively-p 'any)
- (let ((label (read-string "Code line label: ")))
- (end-of-line)
- (setq link (format coderef-format label))
- (let ((gc (- 79 (length link))))
- (if (< (current-column) gc)
- (org-move-to-column gc t)
- (insert " ")))
- (insert link)
- (setq link (concat "(" label ")"))
- (setq desc nil)))
- (t (setq link nil)))))
- ;; We are in the agenda, link to referenced location
- ((equal (bound-and-true-p org-agenda-buffer-name) (buffer-name))
- (let ((m (or (get-text-property (point) 'org-hd-marker)
- (get-text-property (point) 'org-marker))))
- (when m
- (org-with-point-at m
- (setq agenda-link
- (if (called-interactively-p 'any)
- (call-interactively 'org-store-link)
- (org-store-link nil)))))))
- ((eq major-mode 'calendar-mode)
- (let ((cd (calendar-cursor-to-date)))
- (setq link
- (format-time-string
- (car org-time-stamp-formats)
- (apply 'encode-time
- (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd)
- nil nil nil))))
- (org-store-link-props :type "calendar" :date cd)))
- ((eq major-mode 'help-mode)
- (setq link (concat "help:" (save-excursion
- (goto-char (point-min))
- (looking-at "^[^ ]+")
- (match-string 0))))
- (org-store-link-props :type "help"))
- ((eq major-mode 'w3-mode)
- (setq cpltxt (if (and (buffer-name)
- (not (string-match "Untitled" (buffer-name))))
- (buffer-name)
- (url-view-url t))
- link (url-view-url t))
- (org-store-link-props :type "w3" :url (url-view-url t)))
- ((eq major-mode 'image-mode)
- (setq cpltxt (concat "file:"
- (abbreviate-file-name buffer-file-name))
- link cpltxt)
- (org-store-link-props :type "image" :file buffer-file-name))
- ;; In dired, store a link to the file of the current line
- ((derived-mode-p 'dired-mode)
- (let ((file (dired-get-filename nil t)))
- (setq file (if file
- (abbreviate-file-name
- (expand-file-name (dired-get-filename nil t)))
- ;; otherwise, no file so use current directory.
- default-directory))
- (setq cpltxt (concat "file:" file)
- link cpltxt)))
- ((setq search (run-hook-with-args-until-success
- 'org-create-file-search-functions))
- (setq link (concat "file:" (abbreviate-file-name buffer-file-name)
- "::" search))
- (setq cpltxt (or description link)))
- ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
- (org-with-limited-levels
- (setq custom-id (org-entry-get nil "CUSTOM_ID"))
- (cond
- ;; Store a link using the target at point
- ((org-in-regexp "[^<]<<\\([^<>]+\\)>>[^>]" 1)
- (setq cpltxt
- (concat "file:"
- (abbreviate-file-name
- (buffer-file-name (buffer-base-buffer)))
- "::" (match-string 1))
- link cpltxt))
- ((and (featurep 'org-id)
- (or (eq org-id-link-to-org-use-id t)
- (and (called-interactively-p 'any)
- (or (eq org-id-link-to-org-use-id 'create-if-interactive)
- (and (eq org-id-link-to-org-use-id
- 'create-if-interactive-and-no-custom-id)
- (not custom-id))))
- (and org-id-link-to-org-use-id (org-entry-get nil "ID"))))
- ;; Store a link using the ID at point
- (setq link (condition-case nil
- (prog1 (org-id-store-link)
- (setq desc (or (plist-get org-store-link-plist
- :description)
- "")))
- (error
- ;; Probably before first headline, link only to file
- (concat "file:"
- (abbreviate-file-name
- (buffer-file-name (buffer-base-buffer))))))))
- (t
- ;; Just link to current headline
- (setq cpltxt (concat "file:"
- (abbreviate-file-name
- (buffer-file-name (buffer-base-buffer)))))
- ;; Add a context search string
- (when (org-xor org-context-in-file-links
- (equal arg '(4)))
- (let* ((element (org-element-at-point))
- (name (org-element-property :name element)))
- (setq txt (cond
- ((org-at-heading-p) nil)
- (name)
- ((org-region-active-p)
- (buffer-substring (region-beginning) (region-end)))))
- (when (or (null txt) (string-match "\\S-" txt))
- (setq cpltxt
- (concat cpltxt "::"
- (condition-case nil
- (org-make-org-heading-search-string txt)
- (error "")))
- desc (or name
- (nth 4 (ignore-errors (org-heading-components)))
- "NONE")))))
- (when (string-match "::\\'" cpltxt)
- (setq cpltxt (substring cpltxt 0 -2)))
- (setq link cpltxt)))))
- ((buffer-file-name (buffer-base-buffer))
- ;; Just link to this file here.
- (setq cpltxt (concat "file:"
- (abbreviate-file-name
- (buffer-file-name (buffer-base-buffer)))))
- ;; Add a context string.
- (when (org-xor org-context-in-file-links
- (equal arg '(4)))
- (setq txt (if (org-region-active-p)
- (buffer-substring (region-beginning) (region-end))
- (buffer-substring (point-at-bol) (point-at-eol))))
- ;; Only use search option if there is some text.
- (when (string-match "\\S-" txt)
- (setq cpltxt
- (concat cpltxt "::" (org-make-org-heading-search-string txt))
- desc "NONE")))
- (setq link cpltxt))
- ((called-interactively-p 'interactive)
- (user-error "No method for storing a link from this buffer"))
- (t (setq link nil)))
- ;; We're done setting link and desc, clean up
- (when (consp link) (setq cpltxt (car link) link (cdr link)))
- (setq link (or link cpltxt)
- desc (or desc cpltxt))
- (cond ((not desc))
- ((equal desc "NONE") (setq desc nil))
- (t (setq desc
- (replace-regexp-in-string
- org-bracket-link-analytic-regexp
- (lambda (m) (or (match-string 5 m) (match-string 3 m)))
- desc))))
- ;; Return the link
- (if (not (and (or (called-interactively-p 'any)
- executing-kbd-macro)
- link))
- (or agenda-link (and link (org-make-link-string link desc)))
- (push (list link desc) org-stored-links)
- (message "Stored: %s" (or desc link))
- (when custom-id
- (setq link (concat "file:" (abbreviate-file-name
- (buffer-file-name)) "::#" custom-id))
- (push (list link desc) org-stored-links))
- (car org-stored-links)))))
- (defun org-store-link-props (&rest plist)
- "Store link properties, extract names, addresses and dates."
- (let ((x (plist-get plist :from)))
- (when x
- (let ((adr (mail-extract-address-components x)))
- (setq plist (plist-put plist :fromname (car adr)))
- (setq plist (plist-put plist :fromaddress (nth 1 adr))))))
- (let ((x (plist-get plist :to)))
- (when x
- (let ((adr (mail-extract-address-components x)))
- (setq plist (plist-put plist :toname (car adr)))
- (setq plist (plist-put plist :toaddress (nth 1 adr))))))
- (let ((x (ignore-errors (date-to-time (plist-get plist :date)))))
- (when x
- (setq plist (plist-put plist :date-timestamp
- (format-time-string
- (org-time-stamp-format t) x)))
- (setq plist (plist-put plist :date-timestamp-inactive
- (format-time-string
- (org-time-stamp-format t t) x)))))
- (let ((from (plist-get plist :from))
- (to (plist-get plist :to)))
- (when (and from to org-from-is-user-regexp)
- (setq plist
- (plist-put plist :fromto
- (if (string-match org-from-is-user-regexp from)
- (concat "to %t")
- (concat "from %f"))))))
- (setq org-store-link-plist plist))
- (defun org-add-link-props (&rest plist)
- "Add these properties to the link property list."
- (let (key value)
- (while plist
- (setq key (pop plist) value (pop plist))
- (setq org-store-link-plist
- (plist-put org-store-link-plist key value)))))
- (defun org-email-link-description (&optional fmt)
- "Return the description part of an email link.
- This takes information from `org-store-link-plist' and formats it
- according to FMT (default from `org-email-link-description-format')."
- (setq fmt (or fmt org-email-link-description-format))
- (let* ((p org-store-link-plist)
- (to (plist-get p :toaddress))
- (from (plist-get p :fromaddress))
- (table
- (list
- (cons "%c" (plist-get p :fromto))
- (cons "%F" (plist-get p :from))
- (cons "%f" (or (plist-get p :fromname) (plist-get p :fromaddress) "?"))
- (cons "%T" (plist-get p :to))
- (cons "%t" (or (plist-get p :toname) (plist-get p :toaddress) "?"))
- (cons "%s" (plist-get p :subject))
- (cons "%d" (plist-get p :date))
- (cons "%m" (plist-get p :message-id)))))
- (when (string-match "%c" fmt)
- ;; Check if the user wrote this message
- (if (and org-from-is-user-regexp from to
- (save-match-data (string-match org-from-is-user-regexp from)))
- (setq fmt (replace-match "to %t" t t fmt))
- (setq fmt (replace-match "from %f" t t fmt))))
- (org-replace-escapes fmt table)))
- (defun org-make-org-heading-search-string (&optional string)
- "Make search string for the current headline or STRING."
- (let ((s (or string
- (and (derived-mode-p 'org-mode)
- (save-excursion
- (org-back-to-heading t)
- (org-element-property :raw-value (org-element-at-point))))))
- (lines org-context-in-file-links))
- (or string (setq s (concat "*" s))) ; Add * for headlines
- (setq s (replace-regexp-in-string "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" s))
- (when (and string (integerp lines) (> lines 0))
- (let ((slines (org-split-string s "\n")))
- (when (< lines (length slines))
- (setq s (mapconcat
- 'identity
- (reverse (nthcdr (- (length slines) lines)
- (reverse slines))) "\n")))))
- (mapconcat 'identity (org-split-string s "[ \t]+") " ")))
- (defun org-make-link-string (link &optional description)
- "Make a link with brackets, consisting of LINK and DESCRIPTION."
- (unless (org-string-nw-p link) (error "Empty link"))
- (let ((uri (cond ((string-match org-link-types-re link)
- (concat (match-string 1 link)
- (org-link-escape (substring link (match-end 1)))))
- ;; For readability, url-encode internal links only
- ;; when absolutely needed (i.e, when they contain
- ;; square brackets). File links however, are
- ;; encoded since, e.g., spaces are significant.
- ((or (file-name-absolute-p link)
- (string-match-p "\\`\\.\\.?/\\|[][]" link))
- (org-link-escape link))
- (t link)))
- (description
- (and (org-string-nw-p description)
- ;; Remove brackets from description, as they are fatal.
- (replace-regexp-in-string
- "[][]" (lambda (m) (if (equal "[" m) "{" "}"))
- (org-trim description)))))
- (format "[[%s]%s]"
- uri
- (if description (format "[%s]" description) ""))))
- (defconst org-link-escape-chars
- ;;%20 %5B %5D %25
- '(?\s ?\[ ?\] ?%)
- "List of characters that should be escaped in a link when stored to Org.
- This is the list that is used for internal purposes.")
- (defun org-link-escape (text &optional table merge)
- "Return percent escaped representation of TEXT.
- TEXT is a string with the text to escape.
- Optional argument TABLE is a list with characters that should be
- escaped. When nil, `org-link-escape-chars' is used.
- If optional argument MERGE is set, merge TABLE into
- `org-link-escape-chars'."
- (let ((characters-to-encode
- (cond ((null table) org-link-escape-chars)
- (merge (append org-link-escape-chars table))
- (t table))))
- (mapconcat
- (lambda (c)
- (if (or (memq c characters-to-encode)
- (and org-url-hexify-p (or (< c 32) (> c 126))))
- (mapconcat (lambda (e) (format "%%%.2X" e))
- (or (encode-coding-char c 'utf-8)
- (error "Unable to percent escape character: %c" c))
- "")
- (char-to-string c)))
- text "")))
- (defun org-link-unescape (str)
- "Unhex hexified Unicode parts in string STR.
- E.g. `%C3%B6' becomes the german o-Umlaut. This is the
- reciprocal of `org-link-escape', which see."
- (if (org-string-nw-p str)
- (replace-regexp-in-string
- "\\(%[0-9A-Za-z]\\{2\\}\\)+" #'org-link-unescape-compound str t t)
- str))
- (defun org-link-unescape-compound (hex)
- "Unhexify Unicode hex-chars. E.g. `%C3%B6' is the German o-Umlaut.
- Note: this function also decodes single byte encodings like
- `%E1' (a-acute) if not followed by another `%[A-F0-9]{2}' group."
- (save-match-data
- (let* ((bytes (cdr (split-string hex "%")))
- (ret "")
- (eat 0)
- (sum 0))
- (while bytes
- (let* ((val (string-to-number (pop bytes) 16))
- (shift-xor
- (if (= 0 eat)
- (cond
- ((>= val 252) (cons 6 252))
- ((>= val 248) (cons 5 248))
- ((>= val 240) (cons 4 240))
- ((>= val 224) (cons 3 224))
- ((>= val 192) (cons 2 192))
- (t (cons 0 0)))
- (cons 6 128))))
- (when (>= val 192) (setq eat (car shift-xor)))
- (setq val (logxor val (cdr shift-xor)))
- (setq sum (+ (lsh sum (car shift-xor)) val))
- (when (> eat 0) (setq eat (- eat 1)))
- (cond
- ((= 0 eat) ;multi byte
- (setq ret (concat ret (char-to-string sum)))
- (setq sum 0))
- ((not bytes) ; single byte(s)
- (setq ret (org-link-unescape-single-byte-sequence hex))))))
- ret)))
- (defun org-link-unescape-single-byte-sequence (hex)
- "Unhexify hex-encoded single byte character sequences."
- (mapconcat (lambda (byte)
- (char-to-string (string-to-number byte 16)))
- (cdr (split-string hex "%")) ""))
- (defun org-xor (a b)
- "Exclusive or."
- (if a (not b) b))
- (defun org-fixup-message-id-for-http (s)
- "Replace special characters in a message id, so it can be used in an http query."
- (when (string-match "%" s)
- (setq s (mapconcat (lambda (c)
- (if (eq c ?%)
- "%25"
- (char-to-string c)))
- s "")))
- (while (string-match "<" s)
- (setq s (replace-match "%3C" t t s)))
- (while (string-match ">" s)
- (setq s (replace-match "%3E" t t s)))
- (while (string-match "@" s)
- (setq s (replace-match "%40" t t s)))
- s)
- (defun org-link-prettify (link)
- "Return a human-readable representation of LINK.
- The car of LINK must be a raw link.
- The cdr of LINK must be either a link description or nil."
- (let ((desc (or (cadr link) "<no description>")))
- (concat (format "%-45s" (substring desc 0 (min (length desc) 40)))
- "<" (car link) ">")))
- ;;;###autoload
- (defun org-insert-link-global ()
- "Insert a link like Org mode does.
- This command can be called in any mode to insert a link in Org syntax."
- (interactive)
- (org-load-modules-maybe)
- (org-run-like-in-org-mode 'org-insert-link))
- (defun org-insert-all-links (arg &optional pre post)
- "Insert all links in `org-stored-links'.
- When a universal prefix, do not delete the links from `org-stored-links'.
- When `ARG' is a number, insert the last N link(s).
- `PRE' and `POST' are optional arguments to define a string to
- prepend or to append."
- (interactive "P")
- (let ((org-keep-stored-link-after-insertion (equal arg '(4)))
- (links (copy-sequence org-stored-links))
- (pr (or pre "- "))
- (po (or post "\n"))
- (cnt 1) l)
- (if (null org-stored-links)
- (message "No link to insert")
- (while (and (or (listp arg) (>= arg cnt))
- (setq l (if (listp arg)
- (pop links)
- (pop org-stored-links))))
- (setq cnt (1+ cnt))
- (insert pr)
- (org-insert-link nil (car l) (or (cadr l) "<no description>"))
- (insert po)))))
- (defun org-insert-last-stored-link (arg)
- "Insert the last link stored in `org-stored-links'."
- (interactive "p")
- (org-insert-all-links arg "" "\n"))
- (defun org-link-fontify-links-to-this-file ()
- "Fontify links to the current file in `org-stored-links'."
- (let ((f (buffer-file-name)) a b)
- (setq a (mapcar (lambda(l)
- (let ((ll (car l)))
- (when (and (string-match "^file:\\(.+\\)::" ll)
- (equal f (expand-file-name (match-string 1 ll))))
- ll)))
- org-stored-links))
- (when (featurep 'org-id)
- (setq b (mapcar (lambda(l)
- (let ((ll (car l)))
- (when (and (string-match "^id:\\(.+\\)$" ll)
- (equal f (expand-file-name
- (or (org-id-find-id-file
- (match-string 1 ll)) ""))))
- ll)))
- org-stored-links)))
- (mapcar (lambda(l)
- (put-text-property 0 (length l) 'face 'font-lock-comment-face l))
- (delq nil (append a b)))))
- (defvar org--links-history nil)
- (defun org-insert-link (&optional complete-file link-location default-description)
- "Insert a link. At the prompt, enter the link.
- Completion can be used to insert any of the link protocol prefixes in use.
- The history can be used to select a link previously stored with
- `org-store-link'. When the empty string is entered (i.e. if you just
- press `RET' at the prompt), the link defaults to the most recently
- stored link. As `SPC' triggers completion in the minibuffer, you need to
- use `M-SPC' or `C-q SPC' to force the insertion of a space character.
- You will also be prompted for a description, and if one is given, it will
- be displayed in the buffer instead of the link.
- If there is already a link at point, this command will allow you to edit
- link and description parts.
- With a `\\[universal-argument]' prefix, prompts for a file to link to. The \
- file name can be
- selected using completion. The path to the file will be relative to the
- current directory if the file is in the current directory or a subdirectory.
- Otherwise, the link will be the absolute path as completed in the minibuffer
- \(i.e. normally ~/path/to/file). You can configure this behavior using the
- option `org-link-file-path-type'.
- With a `\\[universal-argument] \\[universal-argument]' prefix, enforce an \
- absolute path even if the file is in
- the current directory or below.
- A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \
- prefix negates `org-keep-stored-link-after-insertion'.
- If `org-make-link-description-function' is non-nil, this function will be
- called with the link target, and the result will be the default
- link description.
- If the LINK-LOCATION parameter is non-nil, this value will be used as
- the link location instead of reading one interactively.
- If the DEFAULT-DESCRIPTION parameter is non-nil, this value will be used
- as the default description."
- (interactive "P")
- (let* ((wcf (current-window-configuration))
- (origbuf (current-buffer))
- (region (when (org-region-active-p)
- (buffer-substring (region-beginning) (region-end))))
- (remove (and region (list (region-beginning) (region-end))))
- (desc region)
- (link link-location)
- (abbrevs org-link-abbrev-alist-local)
- entry all-prefixes auto-desc)
- (cond
- (link-location) ; specified by arg, just use it.
- ((org-in-regexp org-bracket-link-regexp 1)
- ;; We do have a link at point, and we are going to edit it.
- (setq remove (list (match-beginning 0) (match-end 0)))
- (setq desc (when (match-end 3) (match-string-no-properties 3)))
- (setq link (read-string "Link: "
- (org-link-unescape
- (match-string-no-properties 1)))))
- ((or (org-in-regexp org-angle-link-re)
- (org-in-regexp org-plain-link-re))
- ;; Convert to bracket link
- (setq remove (list (match-beginning 0) (match-end 0))
- link (read-string "Link: "
- (org-unbracket-string "<" ">" (match-string 0)))))
- ((member complete-file '((4) (16)))
- ;; Completing read for file names.
- (setq link (org-file-complete-link complete-file)))
- (t
- ;; Read link, with completion for stored links.
- (org-link-fontify-links-to-this-file)
- (org-switch-to-buffer-other-window "*Org Links*")
- (with-current-buffer "*Org Links*"
- (erase-buffer)
- (insert "Insert a link.
- Use TAB to complete link prefixes, then RET for type-specific completion support\n")
- (when org-stored-links
- (insert "\nStored links are available with <up>/<down> or M-p/n (most recent with RET):\n\n")
- (insert (mapconcat 'org-link-prettify
- (reverse org-stored-links) "\n")))
- (goto-char (point-min)))
- (let ((cw (selected-window)))
- (select-window (get-buffer-window "*Org Links*" 'visible))
- (with-current-buffer "*Org Links*" (setq truncate-lines t))
- (unless (pos-visible-in-window-p (point-max))
- (org-fit-window-to-buffer))
- (and (window-live-p cw) (select-window cw)))
- (setq all-prefixes (append (mapcar 'car abbrevs)
- (mapcar 'car org-link-abbrev-alist)
- (org-link-types)))
- (unwind-protect
- ;; Fake a link history, containing the stored links.
- (let ((org--links-history
- (append (mapcar #'car org-stored-links)
- org-insert-link-history)))
- (setq link
- (org-completing-read
- "Link: "
- (append
- (mapcar (lambda (x) (concat x ":")) all-prefixes)
- (mapcar #'car org-stored-links))
- nil nil nil
- 'org--links-history
- (caar org-stored-links)))
- (unless (org-string-nw-p link) (user-error "No link selected"))
- (dolist (l org-stored-links)
- (when (equal link (cadr l))
- (setq link (car l))
- (setq auto-desc t)))
- (when (or (member link all-prefixes)
- (and (equal ":" (substring link -1))
- (member (substring link 0 -1) all-prefixes)
- (setq link (substring link 0 -1))))
- (setq link (with-current-buffer origbuf
- (org-link-try-special-completion link)))))
- (set-window-configuration wcf)
- (kill-buffer "*Org Links*"))
- (setq entry (assoc link org-stored-links))
- (or entry (push link org-insert-link-history))
- (setq desc (or desc (nth 1 entry)))))
- (when (funcall (if (equal complete-file '(64)) 'not 'identity)
- (not org-keep-stored-link-after-insertion))
- (setq org-stored-links (delq (assoc link org-stored-links)
- org-stored-links)))
- (when (and (string-match org-plain-link-re link)
- (not (string-match org-ts-regexp link)))
- ;; URL-like link, normalize the use of angular brackets.
- (setq link (org-unbracket-string "<" ">" link)))
- ;; Check if we are linking to the current file with a search
- ;; option If yes, simplify the link by using only the search
- ;; option.
- (when (and buffer-file-name
- (let ((case-fold-search nil))
- (string-match "\\`file:\\(.+?\\)::" link)))
- (let ((path (match-string-no-properties 1 link))
- (search (substring-no-properties link (match-end 0))))
- (save-match-data
- (when (equal (file-truename buffer-file-name) (file-truename path))
- ;; We are linking to this same file, with a search option
- (setq link search)))))
- ;; Check if we can/should use a relative path. If yes, simplify the link
- (let ((case-fold-search nil))
- (when (string-match "\\`\\(file\\|docview\\):" link)
- (let* ((type (match-string-no-properties 0 link))
- (path (substring-no-properties link (match-end 0)))
- (origpath path))
- (cond
- ((or (eq org-link-file-path-type 'absolute)
- (equal complete-file '(16)))
- (setq path (abbreviate-file-name (expand-file-name path))))
- ((eq org-link-file-path-type 'noabbrev)
- (setq path (expand-file-name path)))
- ((eq org-link-file-path-type 'relative)
- (setq path (file-relative-name path)))
- (t
- (save-match-data
- (if (string-match (concat "^" (regexp-quote
- (expand-file-name
- (file-name-as-directory
- default-directory))))
- (expand-file-name path))
- ;; We are linking a file with relative path name.
- (setq path (substring (expand-file-name path)
- (match-end 0)))
- (setq path (abbreviate-file-name (expand-file-name path)))))))
- (setq link (concat type path))
- (when (equal desc origpath)
- (setq desc path)))))
- (if org-make-link-description-function
- (setq desc
- (or (condition-case nil
- (funcall org-make-link-description-function link desc)
- (error (progn (message "Can't get link description from `%s'"
- (symbol-name org-make-link-description-function))
- (sit-for 2) nil)))
- (read-string "Description: " default-description)))
- (if default-description (setq desc default-description)
- (setq desc (or (and auto-desc desc)
- (read-string "Description: " desc)))))
- (unless (string-match "\\S-" desc) (setq desc nil))
- (when remove (apply 'delete-region remove))
- (insert (org-make-link-string link desc))
- ;; Redisplay so as the new link has proper invisible characters.
- (sit-for 0)))
- (defun org-link-try-special-completion (type)
- "If there is completion support for link type TYPE, offer it."
- (let ((fun (org-link-get-parameter type :complete)))
- (if (functionp fun)
- (funcall fun)
- (read-string "Link (no completion support): " (concat type ":")))))
- (defun org-file-complete-link (&optional arg)
- "Create a file link using completion."
- (let ((file (read-file-name "File: "))
- (pwd (file-name-as-directory (expand-file-name ".")))
- (pwd1 (file-name-as-directory (abbreviate-file-name
- (expand-file-name ".")))))
- (cond ((equal arg '(16))
- (concat "file:"
- (abbreviate-file-name (expand-file-name file))))
- ((string-match
- (concat "^" (regexp-quote pwd1) "\\(.+\\)") file)
- (concat "file:" (match-string 1 file)))
- ((string-match
- (concat "^" (regexp-quote pwd) "\\(.+\\)")
- (expand-file-name file))
- (concat "file:"
- (match-string 1 (expand-file-name file))))
- (t (concat "file:" file)))))
- (defun org-completing-read (&rest args)
- "Completing-read with SPACE being a normal character."
- (let ((enable-recursive-minibuffers t)
- (minibuffer-local-completion-map
- (copy-keymap minibuffer-local-completion-map)))
- (org-defkey minibuffer-local-completion-map " " 'self-insert-command)
- (org-defkey minibuffer-local-completion-map "?" 'self-insert-command)
- (org-defkey minibuffer-local-completion-map (kbd "C-c !")
- 'org-time-stamp-inactive)
- (apply #'completing-read args)))
- ;;; Opening/following a link
- (defvar org-link-search-failed nil)
- (defvar org-open-link-functions nil
- "Hook for functions finding a plain text link.
- These functions must take a single argument, the link content.
- They will be called for links that look like [[link text][description]]
- when LINK TEXT does not have a protocol like \"http:\" and does not look
- like a filename (e.g. \"./blue.png\").
- These functions will be called *before* Org attempts to resolve the
- link by doing text searches in the current buffer - so if you want a
- link \"[[target]]\" to still find \"<<target>>\", your function should
- handle this as a special case.
- When the function does handle the link, it must return a non-nil value.
- If it decides that it is not responsible for this link, it must return
- nil to indicate that that Org can continue with other options like
- exact and fuzzy text search.")
- (defun org-next-link (&optional search-backward)
- "Move forward to the next link.
- If the link is in hidden text, expose it."
- (interactive "P")
- (when (and org-link-search-failed (eq this-command last-command))
- (goto-char (point-min))
- (message "Link search wrapped back to beginning of buffer"))
- (setq org-link-search-failed nil)
- (let* ((pos (point))
- (ct (org-context))
- (a (assq :link ct))
- (srch-fun (if search-backward 're-search-backward 're-search-forward)))
- (cond (a (goto-char (nth (if search-backward 1 2) a)))
- ((looking-at org-any-link-re)
- ;; Don't stay stuck at link without an org-link face
- (forward-char (if search-backward -1 1))))
- (if (funcall srch-fun org-any-link-re nil t)
- (progn
- (goto-char (match-beginning 0))
- (when (org-invisible-p) (org-show-context)))
- (goto-char pos)
- (setq org-link-search-failed t)
- (message "No further link found"))))
- (defun org-previous-link ()
- "Move backward to the previous link.
- If the link is in hidden text, expose it."
- (interactive)
- (funcall 'org-next-link t))
- (defun org-translate-link (s)
- "Translate a link string if a translation function has been defined."
- (with-temp-buffer
- (insert (org-trim s))
- (org-trim (org-element-interpret-data (org-element-context)))))
- (defun org-translate-link-from-planner (type path)
- "Translate a link from Emacs Planner syntax so that Org can follow it.
- This is still an experimental function, your mileage may vary."
- (cond
- ((member type '("http" "https" "news" "ftp"))
- ;; standard Internet links are the same.
- nil)
- ((and (equal type "irc") (string-match "^//" path))
- ;; Planner has two / at the beginning of an irc link, we have 1.
- ;; We should have zero, actually....
- (setq path (substring path 1)))
- ((and (equal type "lisp") (string-match "^/" path))
- ;; Planner has a slash, we do not.
- (setq type "elisp" path (substring path 1)))
- ((string-match "^//\\(.?*\\)/\\(<.*>\\)$" path)
- ;; A typical message link. Planner has the id after the final slash,
- ;; we separate it with a hash mark
- (setq path (concat (match-string 1 path) "#"
- (org-unbracket-string "<" ">" (match-string 2 path))))))
- (cons type path))
- (defun org-find-file-at-mouse (ev)
- "Open file link or URL at mouse."
- (interactive "e")
- (mouse-set-point ev)
- (org-open-at-point 'in-emacs))
- (defun org-open-at-mouse (ev)
- "Open file link or URL at mouse.
- See the docstring of `org-open-file' for details."
- (interactive "e")
- (mouse-set-point ev)
- (when (eq major-mode 'org-agenda-mode)
- (org-agenda-copy-local-variable 'org-link-abbrev-alist-local))
- (org-open-at-point))
- (defvar org-window-config-before-follow-link nil
- "The window configuration before following a link.
- This is saved in case the need arises to restore it.")
- ;;;###autoload
- (defun org-open-at-point-global ()
- "Follow a link or time-stamp like Org mode does.
- This command can be called in any mode to follow an external link
- or a time-stamp that has Org mode syntax. Its behavior is
- undefined when called on internal links (e.g., fuzzy links).
- Raise an error when there is nothing to follow. "
- (interactive)
- (cond ((org-in-regexp org-any-link-re)
- (org-open-link-from-string (match-string-no-properties 0)))
- ((or (org-in-regexp org-ts-regexp-both nil t)
- (org-in-regexp org-tsr-regexp-both nil t))
- (org-follow-timestamp-link))
- (t (user-error "No link found"))))
- ;;;###autoload
- (defun org-open-link-from-string (s &optional arg reference-buffer)
- "Open a link in the string S, as if it was in Org mode."
- (interactive "sLink: \nP")
- (let ((reference-buffer (or reference-buffer (current-buffer))))
- (with-temp-buffer
- (let ((org-inhibit-startup (not reference-buffer)))
- (org-mode)
- (insert s)
- (goto-char (point-min))
- (when reference-buffer
- (setq org-link-abbrev-alist-local
- (with-current-buffer reference-buffer
- org-link-abbrev-alist-local)))
- (org-open-at-point arg reference-buffer)))))
- (defvar org-open-at-point-functions nil
- "Hook that is run when following a link at point.
- Functions in this hook must return t if they identify and follow
- a link at point. If they don't find anything interesting at point,
- they must return nil.")
- (defvar org-link-search-inhibit-query nil)
- (defvar clean-buffer-list-kill-buffer-names) ;Defined in midnight.el
- (defun org--open-doi-link (path)
- "Open a \"doi\" type link.
- PATH is a the path to search for, as a string."
- (browse-url (url-encode-url (concat org-doi-server-url path))))
- (defun org--open-elisp-link (path)
- "Open a \"elisp\" type link.
- PATH is the sexp to evaluate, as a string."
- (let ((cmd path))
- (if (or (and (org-string-nw-p
- org-confirm-elisp-link-not-regexp)
- (string-match-p org-confirm-elisp-link-not-regexp cmd))
- (not org-confirm-elisp-link-function)
- (funcall org-confirm-elisp-link-function
- (format "Execute \"%s\" as elisp? "
- (org-add-props cmd nil 'face 'org-warning))))
- (message "%s => %s" cmd
- (if (eq (string-to-char cmd) ?\()
- (eval (read cmd))
- (call-interactively (read cmd))))
- (user-error "Abort"))))
- (defun org--open-help-link (path)
- "Open a \"help\" type link.
- PATH is a symbol name, as a string."
- (pcase (intern path)
- ((and (pred fboundp) variable) (describe-function variable))
- ((and (pred boundp) function) (describe-variable function))
- (name (user-error "Unknown function or variable: %s" name))))
- (defun org--open-shell-link (path)
- "Open a \"shell\" type link.
- PATH is the command to execute, as a string."
- (let ((buf (generate-new-buffer "*Org Shell Output*"))
- (cmd path))
- (if (or (and (org-string-nw-p
- org-confirm-shell-link-not-regexp)
- (string-match
- org-confirm-shell-link-not-regexp cmd))
- (not org-confirm-shell-link-function)
- (funcall org-confirm-shell-link-function
- (format "Execute \"%s\" in shell? "
- (org-add-props cmd nil
- 'face 'org-warning))))
- (progn
- (message "Executing %s" cmd)
- (shell-command cmd buf)
- (when (featurep 'midnight)
- (setq clean-buffer-list-kill-buffer-names
- (cons (buffer-name buf)
- clean-buffer-list-kill-buffer-names))))
- (user-error "Abort"))))
- (defun org-open-at-point (&optional arg reference-buffer)
- "Open link, timestamp, footnote or tags at point.
- When point is on a link, follow it. Normally, files will be
- opened by an appropriate application. If the optional prefix
- argument ARG is non-nil, Emacs will visit the file. With
- a double prefix argument, try to open outside of Emacs, in the
- application the system uses for this file type.
- When point is on a timestamp, open the agenda at the day
- specified.
- When point is a footnote definition, move to the first reference
- found. If it is on a reference, move to the associated
- definition.
- When point is on a headline, display a list of every link in the
- entry, so it is possible to pick one, or all, of them. If point
- is on a tag, call `org-tags-view' instead.
- When optional argument REFERENCE-BUFFER is non-nil, it should
- specify a buffer from where the link search should happen. This
- is used internally by `org-open-link-from-string'.
- On top of syntactically correct links, this function will also
- try to open links and time-stamps in comments, example
- blocks... i.e., whenever point is on something looking like
- a timestamp or a link."
- (interactive "P")
- ;; On a code block, open block's results.
- (unless (call-interactively 'org-babel-open-src-block-result)
- (org-load-modules-maybe)
- (setq org-window-config-before-follow-link (current-window-configuration))
- (org-remove-occur-highlights nil nil t)
- (unless (run-hook-with-args-until-success 'org-open-at-point-functions)
- (let* ((context
- ;; Only consider supported types, even if they are not
- ;; the closest one.
- (org-element-lineage
- (org-element-context)
- '(clock footnote-definition footnote-reference headline
- inlinetask link timestamp)
- t))
- (type (org-element-type context))
- (value (org-element-property :value context)))
- (cond
- ;; On a headline or an inlinetask, but not on a timestamp,
- ;; a link, a footnote reference or on tags.
- ((and (memq type '(headline inlinetask))
- ;; Not on tags.
- (let ((case-fold-search nil))
- (and (org-match-line org-complex-heading-regexp)
- (or (not (match-beginning 5))
- (< (point) (match-beginning 5))))))
- (let* ((data (org-offer-links-in-entry (current-buffer) (point) arg))
- (links (car data))
- (links-end (cdr data)))
- (if links
- (dolist (link (if (stringp links) (list links) links))
- (search-forward link nil links-end)
- (goto-char (match-beginning 0))
- (org-open-at-point))
- (require 'org-attach)
- (org-attach-reveal 'if-exists))))
- ;; On a footnote reference or at definition's label.
- ((or (eq type 'footnote-reference)
- (and (eq type 'footnote-definition)
- (save-excursion
- ;; Do not validate action when point is on the
- ;; spaces right after the footnote label, in
- ;; order to be on par with behaviour on links.
- (skip-chars-forward " \t")
- (let ((begin
- (org-element-property :contents-begin context)))
- (if begin (< (point) begin)
- (= (org-element-property :post-affiliated context)
- (line-beginning-position)))))))
- (org-footnote-action))
- ;; No valid context. Ignore catch-all types like `headline'.
- ;; If point is on something looking like a link or
- ;; a time-stamp, try opening it. It may be useful in
- ;; comments, example blocks...
- ((memq type '(footnote-definition headline inlinetask nil))
- (call-interactively #'org-open-at-point-global))
- ;; On a clock line, make sure point is on the timestamp
- ;; before opening it.
- ((and (eq type 'clock)
- value
- (>= (point) (org-element-property :begin value))
- (<= (point) (org-element-property :end value)))
- (org-follow-timestamp-link))
- ;; Do nothing on white spaces after an object.
- ((>= (point)
- (save-excursion
- (goto-char (org-element-property :end context))
- (skip-chars-backward " \t")
- (point)))
- (user-error "No link found"))
- ((eq type 'timestamp) (org-follow-timestamp-link))
- ;; On tags within a headline or an inlinetask.
- ((and (memq type '(headline inlinetask))
- (let ((case-fold-search nil))
- (save-excursion (beginning-of-line)
- (looking-at org-complex-heading-regexp))
- (and (match-beginning 5)
- (>= (point) (match-beginning 5)))))
- (org-tags-view arg (substring (match-string 5) 0 -1)))
- ((eq type 'link)
- ;; When link is located within the description of another
- ;; link (e.g., an inline image), always open the parent
- ;; link.
- (let* ((link (let ((up (org-element-property :parent context)))
- (if (eq (org-element-type up) 'link) up context)))
- (type (org-element-property :type link))
- (path (org-link-unescape (org-element-property :path link))))
- ;; Switch back to REFERENCE-BUFFER needed when called in
- ;; a temporary buffer through `org-open-link-from-string'.
- (with-current-buffer (or reference-buffer (current-buffer))
- (cond
- ((equal type "file")
- (if (string-match "[*?{]" (file-name-nondirectory path))
- (dired path)
- ;; Look into `org-link-parameters' in order to find
- ;; a DEDICATED-FUNCTION to open file. The function
- ;; will be applied on raw link instead of parsed
- ;; link due to the limitation in `org-add-link-type'
- ;; ("open" function called with a single argument).
- ;; If no such function is found, fallback to
- ;; `org-open-file'.
- (let* ((option (org-element-property :search-option link))
- (app (org-element-property :application link))
- (dedicated-function
- (org-link-get-parameter
- (if app (concat type "+" app) type)
- :follow)))
- (if dedicated-function
- (funcall dedicated-function
- (concat path
- (and option (concat "::" option))))
- (apply #'org-open-file
- path
- (cond (arg)
- ((equal app "emacs") 'emacs)
- ((equal app "sys") 'system))
- (cond ((not option) nil)
- ((string-match-p "\\`[0-9]+\\'" option)
- (list (string-to-number option)))
- (t (list nil
- (org-link-unescape option)))))))))
- ((functionp (org-link-get-parameter type :follow))
- (funcall (org-link-get-parameter type :follow) path))
- ((member type '("coderef" "custom-id" "fuzzy" "radio"))
- (unless (run-hook-with-args-until-success
- 'org-open-link-functions path)
- (if (not arg) (org-mark-ring-push)
- (switch-to-buffer-other-window
- (org-get-buffer-for-internal-link (current-buffer))))
- (let ((destination
- (org-with-wide-buffer
- (if (equal type "radio")
- (org-search-radio-target
- (org-element-property :path link))
- (org-link-search
- (if (member type '("custom-id" "coderef"))
- (org-element-property :raw-link link)
- path)
- ;; Prevent fuzzy links from matching
- ;; themselves.
- (and (equal type "fuzzy")
- (+ 2 (org-element-property :begin link)))))
- (point))))
- (unless (and (<= (point-min) destination)
- (>= (point-max) destination))
- (widen))
- (goto-char destination))))
- (t (browse-url-at-point))))))
- (t (user-error "No link found")))))
- (run-hook-with-args 'org-follow-link-hook)))
- (defun org-offer-links-in-entry (buffer marker &optional nth zero)
- "Offer links in the current entry and return the selected link.
- If there is only one link, return it.
- If NTH is an integer, return the NTH link found.
- If ZERO is a string, check also this string for a link, and if
- there is one, return it."
- (with-current-buffer buffer
- (org-with-wide-buffer
- (goto-char marker)
- (let ((cnt ?0)
- have-zero end links link c)
- (when (and (stringp zero) (string-match org-bracket-link-regexp zero))
- (push (match-string 0 zero) links)
- (setq cnt (1- cnt) have-zero t))
- (save-excursion
- (org-back-to-heading t)
- (setq end (save-excursion (outline-next-heading) (point)))
- (while (re-search-forward org-any-link-re end t)
- (push (match-string 0) links))
- (setq links (org-uniquify (reverse links))))
- (cond
- ((null links)
- (message "No links"))
- ((equal (length links) 1)
- (setq link (car links)))
- ((and (integerp nth) (>= (length links) (if have-zero (1+ nth) nth)))
- (setq link (nth (if have-zero nth (1- nth)) links)))
- (t ; we have to select a link
- (save-excursion
- (save-window-excursion
- (delete-other-windows)
- (with-output-to-temp-buffer "*Select Link*"
- (dolist (l links)
- (cond
- ((not (string-match org-bracket-link-regexp l))
- (princ (format "[%c] %s\n" (cl-incf cnt)
- (org-unbracket-string "<" ">" l))))
- ((match-end 3)
- (princ (format "[%c] %s (%s)\n" (cl-incf cnt)
- (match-string 3 l) (match-string 1 l))))
- (t (princ (format "[%c] %s\n" (cl-incf cnt)
- (match-string 1 l)))))))
- (org-fit-window-to-buffer (get-buffer-window "*Select Link*"))
- (message "Select link to open, RET to open all:")
- (setq c (read-char-exclusive))
- (and (get-buffer "*Select Link*") (kill-buffer "*Select Link*"))))
- (when (equal c ?q) (user-error "Abort"))
- (if (equal c ?\C-m)
- (setq link links)
- (setq nth (- c ?0))
- (when have-zero (setq nth (1+ nth)))
- (unless (and (integerp nth) (>= (length links) nth))
- (user-error "Invalid link selection"))
- (setq link (nth (1- nth) links)))))
- (cons link end)))))
- ;; TODO: These functions are deprecated since `org-open-at-point'
- ;; hard-codes behaviour for "file+emacs" and "file+sys" types.
- (defun org-open-file-with-system (path)
- "Open file at PATH using the system way of opening it."
- (org-open-file path 'system))
- (defun org-open-file-with-emacs (path)
- "Open file at PATH in Emacs."
- (org-open-file path 'emacs))
- ;;; File search
- (defvar org-create-file-search-functions nil
- "List of functions to construct the right search string for a file link.
- These functions are called in turn with point at the location to
- which the link should point.
- A function in the hook should first test if it would like to
- handle this file type, for example by checking the `major-mode'
- or the file extension. If it decides not to handle this file, it
- should just return nil to give other functions a chance. If it
- does handle the file, it must return the search string to be used
- when following the link. The search string will be part of the
- file link, given after a double colon, and `org-open-at-point'
- will automatically search for it. If special measures must be
- taken to make the search successful, another function should be
- added to the companion hook `org-execute-file-search-functions',
- which see.
- A function in this hook may also use `setq' to set the variable
- `description' to provide a suggestion for the descriptive text to
- be used for this link when it gets inserted into an Org buffer
- with \\[org-insert-link].")
- (defvar org-execute-file-search-functions nil
- "List of functions to execute a file search triggered by a link.
- Functions added to this hook must accept a single argument, the
- search string that was part of the file link, the part after the
- double colon. The function must first check if it would like to
- handle this search, for example by checking the `major-mode' or
- the file extension. If it decides not to handle this search, it
- should just return nil to give other functions a chance. If it
- does handle the search, it must return a non-nil value to keep
- other functions from trying.
- Each function can access the current prefix argument through the
- variable `current-prefix-arg'. Note that a single prefix is used
- to force opening a link in Emacs, so it may be good to only use a
- numeric or double prefix to guide the search function.
- In case this is needed, a function in this hook can also restore
- the window configuration before `org-open-at-point' was called using:
- (set-window-configuration org-window-config-before-follow-link)")
- (defun org-search-radio-target (target)
- "Search a radio target matching TARGET in current buffer.
- White spaces are not significant."
- (let ((re (format "<<<%s>>>"
- (mapconcat #'regexp-quote
- (org-split-string target "[ \t\n]+")
- "[ \t]+\\(?:\n[ \t]*\\)?")))
- (origin (point)))
- (goto-char (point-min))
- (catch :radio-match
- (while (re-search-forward re nil t)
- (backward-char)
- (let ((object (org-element-context)))
- (when (eq (org-element-type object) 'radio-target)
- (goto-char (org-element-property :begin object))
- (org-show-context 'link-search)
- (throw :radio-match nil))))
- (goto-char origin)
- (user-error "No match for radio target: %s" target))))
- (defun org-link-search (s &optional avoid-pos stealth)
- "Search for a search string S.
- If S starts with \"#\", it triggers a custom ID search.
- If S is enclosed within parenthesis, it initiates a coderef
- search.
- If S is surrounded by forward slashes, it is interpreted as
- a regular expression. In Org mode files, this will create an
- `org-occur' sparse tree. In ordinary files, `occur' will be used
- to list matches. If the current buffer is in `dired-mode', grep
- will be used to search in all files.
- When AVOID-POS is given, ignore matches near that position.
- When optional argument STEALTH is non-nil, do not modify
- visibility around point, thus ignoring `org-show-context-detail'
- variable.
- Search is case-insensitive and ignores white spaces. Return type
- of matched result, which is either `dedicated' or `fuzzy'."
- (unless (org-string-nw-p s) (error "Invalid search string \"%s\"" s))
- (let* ((case-fold-search t)
- (origin (point))
- (normalized (replace-regexp-in-string "\n[ \t]*" " " s))
- (starred (eq (string-to-char normalized) ?*))
- (words (split-string (if starred (substring s 1) s)))
- (s-multi-re (mapconcat #'regexp-quote words "\\(?:[ \t\n]+\\)"))
- (s-single-re (mapconcat #'regexp-quote words "[ \t]+"))
- type)
- (cond
- ;; Check if there are any special search functions.
- ((run-hook-with-args-until-success 'org-execute-file-search-functions s))
- ((eq (string-to-char s) ?#)
- ;; Look for a custom ID S if S starts with "#".
- (let* ((id (substring normalized 1))
- (match (org-find-property "CUSTOM_ID" id)))
- (if match (progn (goto-char match) (setf type 'dedicated))
- (error "No match for custom ID: %s" id))))
- ((string-match "\\`(\\(.*\\))\\'" normalized)
- ;; Look for coderef targets if S is enclosed within parenthesis.
- (let ((coderef (match-string-no-properties 1 normalized))
- (re (substring s-single-re 1 -1)))
- (goto-char (point-min))
- (catch :coderef-match
- (while (re-search-forward re nil t)
- (let ((element (org-element-at-point)))
- (when (and (memq (org-element-type element)
- '(example-block src-block))
- ;; Build proper regexp according to current
- ;; block's label format.
- (let ((label-fmt
- (regexp-quote
- (or (org-element-property :label-fmt element)
- org-coderef-label-format))))
- (save-excursion
- (beginning-of-line)
- (looking-at (format ".*?\\(%s\\)[ \t]*$"
- (format label-fmt coderef))))))
- (setq type 'dedicated)
- (goto-char (match-beginning 1))
- (throw :coderef-match nil))))
- (goto-char origin)
- (error "No match for coderef: %s" coderef))))
- ((string-match "\\`/\\(.*\\)/\\'" normalized)
- ;; Look for a regular expression.
- (funcall (if (derived-mode-p 'org-mode) #'org-occur #'org-do-occur)
- (match-string 1 s)))
- ;; From here, we handle fuzzy links.
- ;;
- ;; Look for targets, only if not in a headline search.
- ((and (not starred)
- (let ((target (format "<<%s>>" s-multi-re)))
- (catch :target-match
- (goto-char (point-min))
- (while (re-search-forward target nil t)
- (backward-char)
- (let ((context (org-element-context)))
- (when (eq (org-element-type context) 'target)
- (setq type 'dedicated)
- (goto-char (org-element-property :begin context))
- (throw :target-match t))))
- nil))))
- ;; Look for elements named after S, only if not in a headline
- ;; search.
- ((and (not starred)
- (let ((name (format "^[ \t]*#\\+NAME: +%s[ \t]*$" s-single-re)))
- (catch :name-match
- (goto-char (point-min))
- (while (re-search-forward name nil t)
- (let ((element (org-element-at-point)))
- (when (equal words
- (split-string
- (org-element-property :name element)))
- (setq type 'dedicated)
- (beginning-of-line)
- (throw :name-match t))))
- nil))))
- ;; Regular text search. Prefer headlines in Org mode buffers.
- ;; Ignore COMMENT keyword, TODO keywords, priority cookies,
- ;; statistics cookies and tags.
- ((and (derived-mode-p 'org-mode)
- (let ((title-re
- (format "%s.*\\(?:%s[ \t]\\)?.*%s"
- org-outline-regexp-bol
- org-comment-string
- (mapconcat #'regexp-quote words ".+")))
- (cookie-re "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]")
- (comment-re (format "\\`%s[ \t]+" org-comment-string)))
- (goto-char (point-min))
- (catch :found
- (while (re-search-forward title-re nil t)
- (when (equal words
- (split-string
- (replace-regexp-in-string
- cookie-re ""
- (replace-regexp-in-string
- comment-re "" (org-get-heading t t)))))
- (throw :found t)))
- nil)))
- (beginning-of-line)
- (setq type 'dedicated))
- ;; Offer to create non-existent headline depending on
- ;; `org-link-search-must-match-exact-headline'.
- ((and (derived-mode-p 'org-mode)
- (not org-link-search-inhibit-query)
- (eq org-link-search-must-match-exact-headline 'query-to-create)
- (yes-or-no-p "No match - create this as a new heading? "))
- (goto-char (point-max))
- (unless (bolp) (newline))
- (org-insert-heading nil t t)
- (insert s "\n")
- (beginning-of-line 0))
- ;; Only headlines are looked after. No need to process
- ;; further: throw an error.
- ((and (derived-mode-p 'org-mode)
- (or starred org-link-search-must-match-exact-headline))
- (goto-char origin)
- (error "No match for fuzzy expression: %s" normalized))
- ;; Regular text search.
- ((catch :fuzzy-match
- (goto-char (point-min))
- (while (re-search-forward s-multi-re nil t)
- ;; Skip match if it contains AVOID-POS or it is included in
- ;; a link with a description but outside the description.
- (unless (or (and avoid-pos
- (<= (match-beginning 0) avoid-pos)
- (> (match-end 0) avoid-pos))
- (and (save-match-data
- (org-in-regexp org-bracket-link-regexp))
- (match-beginning 3)
- (or (> (match-beginning 3) (point))
- (<= (match-end 3) (point)))
- (org-element-lineage
- (save-match-data (org-element-context))
- '(link) t)))
- (goto-char (match-beginning 0))
- (setq type 'fuzzy)
- (throw :fuzzy-match t)))
- nil))
- ;; All failed. Throw an error.
- (t (goto-char origin)
- (error "No match for fuzzy expression: %s" normalized)))
- ;; Disclose surroundings of match, if appropriate.
- (when (and (derived-mode-p 'org-mode) (not stealth))
- (org-show-context 'link-search))
- type))
- (defun org-get-buffer-for-internal-link (buffer)
- "Return a buffer to be used for displaying the link target of internal links."
- (cond
- ((not org-display-internal-link-with-indirect-buffer)
- buffer)
- ((string-suffix-p "(Clone)" (buffer-name buffer))
- (message "Buffer is already a clone, not making another one")
- ;; we also do not modify visibility in this case
- buffer)
- (t ; make a new indirect buffer for displaying the link
- (let* ((bn (buffer-name buffer))
- (ibn (concat bn "(Clone)"))
- (ib (or (get-buffer ibn) (make-indirect-buffer buffer ibn 'clone))))
- (with-current-buffer ib (org-overview))
- ib))))
- (defun org-do-occur (regexp &optional cleanup)
- "Call the Emacs command `occur'.
- If CLEANUP is non-nil, remove the printout of the regular expression
- in the *Occur* buffer. This is useful if the regex is long and not useful
- to read."
- (occur regexp)
- (when cleanup
- (let ((cwin (selected-window)) win beg end)
- (when (setq win (get-buffer-window "*Occur*"))
- (select-window win))
- (goto-char (point-min))
- (when (re-search-forward "match[a-z]+" nil t)
- (setq beg (match-end 0))
- (when (re-search-forward "^[ \t]*[0-9]+" nil t)
- (setq end (1- (match-beginning 0)))))
- (and beg end (let ((inhibit-read-only t)) (delete-region beg end)))
- (goto-char (point-min))
- (select-window cwin))))
- ;;; The mark ring for links jumps
- (defvar org-mark-ring nil
- "Mark ring for positions before jumps in Org mode.")
- (defvar org-mark-ring-last-goto nil
- "Last position in the mark ring used to go back.")
- ;; Fill and close the ring
- (setq org-mark-ring nil org-mark-ring-last-goto nil) ;; in case file is reloaded
- (dotimes (_ org-mark-ring-length)
- (push (make-marker) org-mark-ring))
- (setcdr (nthcdr (1- org-mark-ring-length) org-mark-ring)
- org-mark-ring)
- (defun org-mark-ring-push (&optional pos buffer)
- "Put the current position or POS into the mark ring and rotate it."
- (interactive)
- (setq pos (or pos (point)))
- (setq org-mark-ring (nthcdr (1- org-mark-ring-length) org-mark-ring))
- (move-marker (car org-mark-ring)
- (or pos (point))
- (or buffer (current-buffer)))
- (message "%s"
- (substitute-command-keys
- "Position saved to mark ring, go back with \
- `\\[org-mark-ring-goto]'.")))
- (defun org-mark-ring-goto (&optional n)
- "Jump to the previous position in the mark ring.
- With prefix arg N, jump back that many stored positions. When
- called several times in succession, walk through the entire ring.
- Org mode commands jumping to a different position in the current file,
- or to another Org file, automatically push the old position onto the ring."
- (interactive "p")
- (let (p m)
- (if (eq last-command this-command)
- (setq p (nthcdr n (or org-mark-ring-last-goto org-mark-ring)))
- (setq p org-mark-ring))
- (setq org-mark-ring-last-goto p)
- (setq m (car p))
- (pop-to-buffer-same-window (marker-buffer m))
- (goto-char m)
- (when (or (org-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto))))
- (defun org-add-angle-brackets (s)
- (unless (equal (substring s 0 1) "<") (setq s (concat "<" s)))
- (unless (equal (substring s -1) ">") (setq s (concat s ">")))
- s)
- ;;; Following specific links
- (defvar org-agenda-buffer-tmp-name)
- (defvar org-agenda-start-on-weekday)
- (defun org-follow-timestamp-link ()
- "Open an agenda view for the time-stamp date/range at point."
- (cond
- ((org-at-date-range-p t)
- (let ((org-agenda-start-on-weekday)
- (t1 (match-string 1))
- (t2 (match-string 2)) tt1 tt2)
- (setq tt1 (time-to-days (org-time-string-to-time t1))
- tt2 (time-to-days (org-time-string-to-time t2)))
- (let ((org-agenda-buffer-tmp-name
- (format "*Org Agenda(a:%s)"
- (concat (substring t1 0 10) "--" (substring t2 0 10)))))
- (org-agenda-list nil tt1 (1+ (- tt2 tt1))))))
- ((org-at-timestamp-p t)
- (let ((org-agenda-buffer-tmp-name
- (format "*Org Agenda(a:%s)" (substring (match-string 1) 0 10))))
- (org-agenda-list nil (time-to-days (org-time-string-to-time
- (substring (match-string 1) 0 10)))
- 1)))
- (t (error "This should not happen"))))
- ;;; Following file links
- (declare-function mailcap-parse-mailcaps "mailcap" (&optional path force))
- (declare-function mailcap-extension-to-mime "mailcap" (extn))
- (declare-function mailcap-mime-info
- "mailcap" (string &optional request no-decode))
- (defvar org-wait nil)
- (defun org-open-file (path &optional in-emacs line search)
- "Open the file at PATH.
- First, this expands any special file name abbreviations. Then the
- configuration variable `org-file-apps' is checked if it contains an
- entry for this file type, and if yes, the corresponding command is launched.
- If no application is found, Emacs simply visits the file.
- With optional prefix argument IN-EMACS, Emacs will visit the file.
- With a double \\[universal-argument] \\[universal-argument] \
- prefix arg, Org tries to avoid opening in Emacs
- and to use an external application to visit the file.
- Optional LINE specifies a line to go to, optional SEARCH a string
- to search for. If LINE or SEARCH is given, the file will be
- opened in Emacs, unless an entry from org-file-apps that makes
- use of groups in a regexp matches.
- If you want to change the way frames are used when following a
- link, please customize `org-link-frame-setup'.
- If the file does not exist, an error is thrown."
- (let* ((file (if (equal path "")
- buffer-file-name
- (substitute-in-file-name (expand-file-name path))))
- (file-apps (append org-file-apps (org-default-apps)))
- (apps (cl-remove-if
- 'org-file-apps-entry-match-against-dlink-p file-apps))
- (apps-dlink (cl-remove-if-not
- 'org-file-apps-entry-match-against-dlink-p file-apps))
- (remp (and (assq 'remote apps) (org-file-remote-p file)))
- (dirp (unless remp (file-directory-p file)))
- (file (if (and dirp org-open-directory-means-index-dot-org)
- (concat (file-name-as-directory file) "index.org")
- file))
- (a-m-a-p (assq 'auto-mode apps))
- (dfile (downcase file))
- ;; Reconstruct the original link from the PATH, LINE and
- ;; SEARCH args.
- (link (cond (line (concat file "::" (number-to-string line)))
- (search (concat file "::" search))
- (t file)))
- (dlink (downcase link))
- (old-buffer (current-buffer))
- (old-pos (point))
- (old-mode major-mode)
- (ext
- (and (string-match "\\`.*?\\.\\([a-zA-Z0-9]+\\(\\.gz\\)?\\)\\'" dfile)
- (match-string 1 dfile)))
- cmd link-match-data)
- (cond
- ((member in-emacs '((16) system))
- (setq cmd (cdr (assq 'system apps))))
- (in-emacs (setq cmd 'emacs))
- (t
- (setq cmd (or (and remp (cdr (assq 'remote apps)))
- (and dirp (cdr (assq 'directory apps)))
- ;; First, try matching against apps-dlink if we
- ;; get a match here, store the match data for
- ;; later.
- (let ((match (assoc-default dlink apps-dlink
- 'string-match)))
- (if match
- (progn (setq link-match-data (match-data))
- match)
- (progn (setq in-emacs (or in-emacs line search))
- nil))) ; if we have no match in apps-dlink,
- ; always open the file in emacs if line or search
- ; is given (for backwards compatibility)
- (assoc-default dfile (org-apps-regexp-alist apps a-m-a-p)
- 'string-match)
- (cdr (assoc ext apps))
- (cdr (assq t apps))))))
- (when (eq cmd 'system)
- (setq cmd (cdr (assq 'system apps))))
- (when (eq cmd 'default)
- (setq cmd (cdr (assoc t apps))))
- (when (eq cmd 'mailcap)
- (require 'mailcap)
- (mailcap-parse-mailcaps)
- (let* ((mime-type (mailcap-extension-to-mime (or ext "")))
- (command (mailcap-mime-info mime-type)))
- (if (stringp command)
- (setq cmd command)
- (setq cmd 'emacs))))
- (when (and (not (eq cmd 'emacs)) ; Emacs has no problems with non-ex files
- (not (file-exists-p file))
- (not org-open-non-existing-files))
- (user-error "No such file: %s" file))
- (cond
- ((and (stringp cmd) (not (string-match "^\\s-*$" cmd)))
- ;; Remove quotes around the file name - we'll use shell-quote-argument.
- (while (string-match "['\"]%s['\"]" cmd)
- (setq cmd (replace-match "%s" t t cmd)))
- (setq cmd (replace-regexp-in-string
- "%s"
- (shell-quote-argument (convert-standard-filename file))
- cmd
- nil t))
- ;; Replace "%1", "%2" etc. in command with group matches from regex
- (save-match-data
- (let ((match-index 1)
- (number-of-groups (- (/ (length link-match-data) 2) 1)))
- (set-match-data link-match-data)
- (while (<= match-index number-of-groups)
- (let ((regex (concat "%" (number-to-string match-index)))
- (replace-with (match-string match-index dlink)))
- (while (string-match regex cmd)
- (setq cmd (replace-match replace-with t t cmd))))
- (setq match-index (+ match-index 1)))))
- (save-window-excursion
- (message "Running %s...done" cmd)
- (start-process-shell-command cmd nil cmd)
- (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))))
- ((or (stringp cmd)
- (eq cmd 'emacs))
- (funcall (cdr (assq 'file org-link-frame-setup)) file)
- (widen)
- (cond (line (org-goto-line line)
- (when (derived-mode-p 'org-mode) (org-reveal)))
- (search (org-link-search search))))
- ((functionp cmd)
- (save-match-data
- (set-match-data link-match-data)
- (condition-case nil
- (funcall cmd file link)
- ;; FIXME: Remove this check when most default installations
- ;; of Emacs have at least Org 9.0.
- ((debug wrong-number-of-arguments wrong-type-argument
- invalid-function)
- (user-error "Please see Org News for version 9.0 about \
- `org-file-apps'--Lisp error: %S" cmd)))))
- ((consp cmd)
- ;; FIXME: Remove this check when most default installations of
- ;; Emacs have at least Org 9.0.
- ;; Heads-up instead of silently fall back to
- ;; `org-link-frame-setup' for an old usage of `org-file-apps'
- ;; with sexp instead of a function for `cmd'.
- (user-error "Please see Org News for version 9.0 about \
- `org-file-apps'--Error: Deprecated usage of %S" cmd))
- (t (funcall (cdr (assq 'file org-link-frame-setup)) file)))
- (and (derived-mode-p 'org-mode)
- (eq old-mode 'org-mode)
- (or (not (eq old-buffer (current-buffer)))
- (not (eq old-pos (point))))
- (org-mark-ring-push old-pos old-buffer))))
- (defun org-file-apps-entry-match-against-dlink-p (entry)
- "This function returns non-nil if `entry' uses a regular
- expression which should be matched against the whole link by
- org-open-file.
- It assumes that is the case when the entry uses a regular
- expression which has at least one grouping construct and the
- action is either a lisp form or a command string containing
- `%1', i.e. using at least one subexpression match as a
- parameter."
- (let ((selector (car entry))
- (action (cdr entry)))
- (if (stringp selector)
- (and (> (regexp-opt-depth selector) 0)
- (or (and (stringp action)
- (string-match "%[0-9]" action))
- (consp action)))
- nil)))
- (defun org-default-apps ()
- "Return the default applications for this operating system."
- (cond
- ((eq system-type 'darwin)
- org-file-apps-defaults-macosx)
- ((eq system-type 'windows-nt)
- org-file-apps-defaults-windowsnt)
- (t org-file-apps-defaults-gnu)))
- (defun org-apps-regexp-alist (list &optional add-auto-mode)
- "Convert extensions to regular expressions in the cars of LIST.
- Also, weed out any non-string entries, because the return value is used
- only for regexp matching.
- When ADD-AUTO-MODE is set, make all matches in `auto-mode-alist'
- point to the symbol `emacs', indicating that the file should
- be opened in Emacs."
- (append
- (delq nil
- (mapcar (lambda (x)
- (unless (not (stringp (car x)))
- (if (string-match "\\W" (car x))
- x
- (cons (concat "\\." (car x) "\\'") (cdr x)))))
- list))
- (when add-auto-mode
- (mapcar (lambda (x) (cons (car x) 'emacs)) auto-mode-alist))))
- (defvar ange-ftp-name-format)
- (defun org-file-remote-p (file)
- "Test whether FILE specifies a location on a remote system.
- Return non-nil if the location is indeed remote.
- For example, the filename \"/user@host:/foo\" specifies a location
- on the system \"/user@host:\"."
- (cond ((fboundp 'file-remote-p)
- (file-remote-p file))
- ((fboundp 'tramp-handle-file-remote-p)
- (tramp-handle-file-remote-p file))
- ((and (boundp 'ange-ftp-name-format)
- (string-match (car ange-ftp-name-format) file))
- t)))
- ;;;; Refiling
- (defun org-get-org-file ()
- "Read a filename, with default directory `org-directory'."
- (let ((default (or org-default-notes-file remember-data-file)))
- (read-file-name (format "File name [%s]: " default)
- (file-name-as-directory org-directory)
- default)))
- (defun org-notes-order-reversed-p ()
- "Check if the current file should receive notes in reversed order."
- (cond
- ((not org-reverse-note-order) nil)
- ((eq t org-reverse-note-order) t)
- ((not (listp org-reverse-note-order)) nil)
- (t (catch 'exit
- (dolist (entry org-reverse-note-order)
- (when (string-match (car entry) buffer-file-name)
- (throw 'exit (cdr entry))))))))
- (defvar org-refile-target-table nil
- "The list of refile targets, created by `org-refile'.")
- (defvar org-agenda-new-buffers nil
- "Buffers created to visit agenda files.")
- (defvar org-refile-cache nil
- "Cache for refile targets.")
- (defvar org-refile-markers nil
- "All the markers used for caching refile locations.")
- (defun org-refile-marker (pos)
- "Get a new refile marker, but only if caching is in use."
- (if (not org-refile-use-cache)
- pos
- (let ((m (make-marker)))
- (move-marker m pos)
- (push m org-refile-markers)
- m)))
- (defun org-refile-cache-clear ()
- "Clear the refile cache and disable all the markers."
- (dolist (m org-refile-markers) (move-marker m nil))
- (setq org-refile-markers nil)
- (setq org-refile-cache nil)
- (message "Refile cache has been cleared"))
- (defun org-refile-cache-check-set (set)
- "Check if all the markers in the cache still have live buffers."
- (let (marker)
- (catch 'exit
- (while (and set (setq marker (nth 3 (pop set))))
- ;; If `org-refile-use-outline-path' is 'file, marker may be nil
- (when (and marker (null (marker-buffer marker)))
- (message "Please regenerate the refile cache with `C-0 C-c C-w'")
- (sit-for 3)
- (throw 'exit nil)))
- t)))
- (defun org-refile-cache-put (set &rest identifiers)
- "Push the refile targets SET into the cache, under IDENTIFIERS."
- (let* ((key (sha1 (prin1-to-string identifiers)))
- (entry (assoc key org-refile-cache)))
- (if entry
- (setcdr entry set)
- (push (cons key set) org-refile-cache))))
- (defun org-refile-cache-get (&rest identifiers)
- "Retrieve the cached value for refile targets given by IDENTIFIERS."
- (cond
- ((not org-refile-cache) nil)
- ((not org-refile-use-cache) (org-refile-cache-clear) nil)
- (t
- (let ((set (cdr (assoc (sha1 (prin1-to-string identifiers))
- org-refile-cache))))
- (and set (org-refile-cache-check-set set) set)))))
- (defvar org-outline-path-cache nil
- "Alist between buffer positions and outline paths.
- It value is an alist (POSITION . PATH) where POSITION is the
- buffer position at the beginning of an entry and PATH is a list
- of strings describing the outline path for that entry, in reverse
- order.")
- (defun org-refile-get-targets (&optional default-buffer)
- "Produce a table with refile targets."
- (let ((case-fold-search nil)
- ;; otherwise org confuses "TODO" as a kw and "Todo" as a word
- (entries (or org-refile-targets '((nil . (:level . 1)))))
- targets tgs files desc descre)
- (message "Getting targets...")
- (with-current-buffer (or default-buffer (current-buffer))
- (dolist (entry entries)
- (setq files (car entry) desc (cdr entry))
- (cond
- ((null files) (setq files (list (current-buffer))))
- ((eq files 'org-agenda-files)
- (setq files (org-agenda-files 'unrestricted)))
- ((and (symbolp files) (fboundp files))
- (setq files (funcall files)))
- ((and (symbolp files) (boundp files))
- (setq files (symbol-value files))))
- (when (stringp files) (setq files (list files)))
- (cond
- ((eq (car desc) :tag)
- (setq descre (concat "^\\*+[ \t]+.*?:" (regexp-quote (cdr desc)) ":")))
- ((eq (car desc) :todo)
- (setq descre (concat "^\\*+[ \t]+" (regexp-quote (cdr desc)) "[ \t]")))
- ((eq (car desc) :regexp)
- (setq descre (cdr desc)))
- ((eq (car desc) :level)
- (setq descre (concat "^\\*\\{" (number-to-string
- (if org-odd-levels-only
- (1- (* 2 (cdr desc)))
- (cdr desc)))
- "\\}[ \t]")))
- ((eq (car desc) :maxlevel)
- (setq descre (concat "^\\*\\{1," (number-to-string
- (if org-odd-levels-only
- (1- (* 2 (cdr desc)))
- (cdr desc)))
- "\\}[ \t]")))
- (t (error "Bad refiling target description %s" desc)))
- (dolist (f files)
- (with-current-buffer (if (bufferp f) f (org-get-agenda-file-buffer f))
- (or
- (setq tgs (org-refile-cache-get (buffer-file-name) descre))
- (progn
- (when (bufferp f)
- (setq f (buffer-file-name (buffer-base-buffer f))))
- (setq f (and f (expand-file-name f)))
- (when (eq org-refile-use-outline-path 'file)
- (push (list (file-name-nondirectory f) f nil nil) tgs))
- (org-with-wide-buffer
- (goto-char (point-min))
- (setq org-outline-path-cache nil)
- (while (re-search-forward descre nil t)
- (beginning-of-line)
- (let ((case-fold-search nil))
- (looking-at org-complex-heading-regexp))
- (let ((begin (point))
- (heading (match-string-no-properties 4)))
- (unless (or (and
- org-refile-target-verify-function
- (not
- (funcall org-refile-target-verify-function)))
- (not heading))
- (let ((re (format org-complex-heading-regexp-format
- (regexp-quote heading)))
- (target
- (if (not org-refile-use-outline-path) heading
- (mapconcat
- #'org-protect-slash
- (append
- (pcase org-refile-use-outline-path
- (`file (list (file-name-nondirectory
- (buffer-file-name
- (buffer-base-buffer)))))
- (`full-file-path
- (list (buffer-file-name
- (buffer-base-buffer))))
- (_ nil))
- (org-get-outline-path t t))
- "/"))))
- (push (list target f re (org-refile-marker (point)))
- tgs)))
- (when (= (point) begin)
- ;; Verification function has not moved point.
- (end-of-line)))))))
- (when org-refile-use-cache
- (org-refile-cache-put tgs (buffer-file-name) descre))
- (setq targets (append tgs targets))))))
- (message "Getting targets...done")
- (delete-dups (nreverse targets))))
- (defun org-protect-slash (s)
- (replace-regexp-in-string "/" "\\/" s nil t))
- (defun org--get-outline-path-1 (&optional use-cache)
- "Return outline path to current headline.
- Outline path is a list of strings, in reverse order. When
- optional argument USE-CACHE is non-nil, make use of a cache. See
- `org-get-outline-path' for details.
- Assume buffer is widened and point is on a headline."
- (or (and use-cache (cdr (assq (point) org-outline-path-cache)))
- (let ((p (point))
- (heading (let ((case-fold-search nil))
- (looking-at org-complex-heading-regexp)
- (if (not (match-end 4)) ""
- ;; Remove statistics cookies.
- (org-trim
- (org-link-display-format
- (replace-regexp-in-string
- "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
- (match-string-no-properties 4))))))))
- (if (org-up-heading-safe)
- (let ((path (cons heading (org--get-outline-path-1 use-cache))))
- (when use-cache
- (push (cons p path) org-outline-path-cache))
- path)
- ;; This is a new root node. Since we assume we are moving
- ;; forward, we can drop previous cache so as to limit number
- ;; of associations there.
- (let ((path (list heading)))
- (when use-cache (setq org-outline-path-cache (list (cons p path))))
- path)))))
- (defun org-get-outline-path (&optional with-self use-cache)
- "Return the outline path to the current entry.
- An outline path is a list of ancestors for current headline, as
- a list of strings. Statistics cookies are removed and links are
- replaced with their description, if any, or their path otherwise.
- When optional argument WITH-SELF is non-nil, the path also
- includes the current headline.
- When optional argument USE-CACHE is non-nil, cache outline paths
- between calls to this function so as to avoid backtracking. This
- argument is useful when planning to find more than one outline
- path in the same document. In that case, there are two
- conditions to satisfy:
- - `org-outline-path-cache' is set to nil before starting the
- process;
- - outline paths are computed by increasing buffer positions."
- (org-with-wide-buffer
- (and (or (and with-self (org-back-to-heading t))
- (org-up-heading-safe))
- (reverse (org--get-outline-path-1 use-cache)))))
- (defun org-format-outline-path (path &optional width prefix separator)
- "Format the outline path PATH for display.
- WIDTH is the maximum number of characters that is available.
- PREFIX is a prefix to be included in the returned string,
- such as the file name.
- SEPARATOR is inserted between the different parts of the path,
- the default is \"/\"."
- (setq width (or width 79))
- (setq path (delq nil path))
- (unless (> width 0)
- (user-error "Argument `width' must be positive"))
- (setq separator (or separator "/"))
- (let* ((org-odd-levels-only nil)
- (fpath (concat
- prefix (and prefix path separator)
- (mapconcat
- (lambda (s) (replace-regexp-in-string "[ \t]+\\'" "" s))
- (cl-loop for head in path
- for n from 0
- collect (org-add-props
- head nil 'face
- (nth (% n org-n-level-faces) org-level-faces)))
- separator))))
- (when (> (length fpath) width)
- (if (< width 7)
- ;; It's unlikely that `width' will be this small, but don't
- ;; waste characters by adding ".." if it is.
- (setq fpath (substring fpath 0 width))
- (setf (substring fpath (- width 2)) "..")))
- fpath))
- (defun org-display-outline-path (&optional file current separator just-return-string)
- "Display the current outline path in the echo area.
- If FILE is non-nil, prepend the output with the file name.
- If CURRENT is non-nil, append the current heading to the output.
- SEPARATOR is passed through to `org-format-outline-path'. It separates
- the different parts of the path and defaults to \"/\".
- If JUST-RETURN-STRING is non-nil, return a string, don't display a message."
- (interactive "P")
- (let* (case-fold-search
- (bfn (buffer-file-name (buffer-base-buffer)))
- (path (and (derived-mode-p 'org-mode) (org-get-outline-path)))
- res)
- (when current (setq path (append path
- (save-excursion
- (org-back-to-heading t)
- (when (looking-at org-complex-heading-regexp)
- (list (match-string 4)))))))
- (setq res
- (org-format-outline-path
- path
- (1- (frame-width))
- (and file bfn (concat (file-name-nondirectory bfn) separator))
- separator))
- (if just-return-string
- (org-no-properties res)
- (org-unlogged-message "%s" res))))
- (defvar org-refile-history nil
- "History for refiling operations.")
- (defvar org-after-refile-insert-hook nil
- "Hook run after `org-refile' has inserted its stuff at the new location.
- Note that this is still *before* the stuff will be removed from
- the *old* location.")
- (defvar org-capture-last-stored-marker)
- (defvar org-refile-keep nil
- "Non-nil means `org-refile' will copy instead of refile.")
- (defun org-copy ()
- "Like `org-refile', but copy."
- (interactive)
- (let ((org-refile-keep t))
- (funcall 'org-refile nil nil nil "Copy")))
- (defun org-refile (&optional arg default-buffer rfloc msg)
- "Move the entry or entries at point to another heading.
- The list of target headings is compiled using the information in
- `org-refile-targets', which see.
- At the target location, the entry is filed as a subitem of the
- target heading. Depending on `org-reverse-note-order', the new
- subitem will either be the first or the last subitem.
- If there is an active region, all entries in that region will be
- refiled. However, the region must fulfill the requirement that
- the first heading sets the top-level of the moved text.
- With a `\\[universal-argument]' ARG, the command will only visit the target \
- location
- and not actually move anything.
- With a prefix `\\[universal-argument] \\[universal-argument]', go to the \
- location where the last
- refiling operation has put the subtree.
- With a numeric prefix argument of `2', refile to the running clock.
- With a numeric prefix argument of `3', emulate `org-refile-keep'
- being set to t and copy to the target location, don't move it.
- Beware that keeping refiled entries may result in duplicated ID
- properties.
- RFLOC can be a refile location obtained in a different way.
- MSG is a string to replace \"Refile\" in the default prompt with
- another verb. E.g. `org-copy' sets this parameter to \"Copy\".
- See also `org-refile-use-outline-path'.
- If you are using target caching (see `org-refile-use-cache'), you
- have to clear the target cache in order to find new targets.
- This can be done with a `0' prefix (`C-0 C-c C-w') or a triple
- prefix argument (`C-u C-u C-u C-c C-w')."
- (interactive "P")
- (if (member arg '(0 (64)))
- (org-refile-cache-clear)
- (let* ((actionmsg (cond (msg msg)
- ((equal arg 3) "Refile (and keep)")
- (t "Refile")))
- (regionp (org-region-active-p))
- (region-start (and regionp (region-beginning)))
- (region-end (and regionp (region-end)))
- (org-refile-keep (if (equal arg 3) t org-refile-keep))
- pos it nbuf file level reversed)
- (setq last-command nil)
- (when regionp
- (goto-char region-start)
- (or (bolp) (goto-char (point-at-bol)))
- (setq region-start (point))
- (unless (or (org-kill-is-subtree-p
- (buffer-substring region-start region-end))
- (prog1 org-refile-active-region-within-subtree
- (let ((s (point-at-eol)))
- (org-toggle-heading)
- (setq region-end (+ (- (point-at-eol) s) region-end)))))
- (user-error "The region is not a (sequence of) subtree(s)")))
- (if (equal arg '(16))
- (org-refile-goto-last-stored)
- (when (or
- (and (equal arg 2)
- org-clock-hd-marker (marker-buffer org-clock-hd-marker)
- (prog1
- (setq it (list (or org-clock-heading "running clock")
- (buffer-file-name
- (marker-buffer org-clock-hd-marker))
- ""
- (marker-position org-clock-hd-marker)))
- (setq arg nil)))
- (setq it
- (or rfloc
- (let (heading-text)
- (save-excursion
- (unless (and arg (listp arg))
- (org-back-to-heading t)
- (setq heading-text
- (replace-regexp-in-string
- org-bracket-link-regexp
- "\\3"
- (or (nth 4 (org-heading-components))
- ""))))
- (org-refile-get-location
- (cond ((and arg (listp arg)) "Goto")
- (regionp (concat actionmsg " region to"))
- (t (concat actionmsg " subtree \""
- heading-text "\" to")))
- default-buffer
- (and (not (equal '(4) arg))
- org-refile-allow-creating-parent-nodes)))))))
- (setq file (nth 1 it)
- pos (nth 3 it))
- (when (and (not arg)
- pos
- (equal (buffer-file-name) file)
- (if regionp
- (and (>= pos region-start)
- (<= pos region-end))
- (and (>= pos (point))
- (< pos (save-excursion
- (org-end-of-subtree t t))))))
- (error "Cannot refile to position inside the tree or region"))
- (setq nbuf (or (find-buffer-visiting file)
- (find-file-noselect file)))
- (if (and arg (not (equal arg 3)))
- (progn
- (pop-to-buffer-same-window nbuf)
- (goto-char pos)
- (org-show-context 'org-goto))
- (if regionp
- (progn
- (org-kill-new (buffer-substring region-start region-end))
- (org-save-markers-in-region region-start region-end))
- (org-copy-subtree 1 nil t))
- (with-current-buffer (setq nbuf (or (find-buffer-visiting file)
- (find-file-noselect file)))
- (setq reversed (org-notes-order-reversed-p))
- (org-with-wide-buffer
- (if pos
- (progn
- (goto-char pos)
- (looking-at org-outline-regexp)
- (setq level (org-get-valid-level (funcall outline-level) 1))
- (goto-char
- (if reversed
- (or (outline-next-heading) (point-max))
- (or (save-excursion (org-get-next-sibling))
- (org-end-of-subtree t t)
- (point-max)))))
- (setq level 1)
- (if (not reversed)
- (goto-char (point-max))
- (goto-char (point-min))
- (or (outline-next-heading) (goto-char (point-max)))))
- (unless (bolp) (newline))
- (org-paste-subtree level nil nil t)
- (when org-log-refile
- (org-add-log-setup 'refile nil nil org-log-refile)
- (unless (eq org-log-refile 'note)
- (save-excursion (org-add-log-note))))
- (and org-auto-align-tags
- (let ((org-loop-over-headlines-in-active-region nil))
- (org-set-tags nil t)))
- (let ((bookmark-name (plist-get org-bookmark-names-plist
- :last-refile)))
- (when bookmark-name
- (with-demoted-errors
- (bookmark-set bookmark-name))))
- ;; If we are refiling for capture, make sure that the
- ;; last-capture pointers point here
- (when (bound-and-true-p org-capture-is-refiling)
- (let ((bookmark-name (plist-get org-bookmark-names-plist
- :last-capture-marker)))
- (when bookmark-name
- (with-demoted-errors
- (bookmark-set bookmark-name))))
- (move-marker org-capture-last-stored-marker (point)))
- (when (fboundp 'deactivate-mark) (deactivate-mark))
- (run-hooks 'org-after-refile-insert-hook)))
- (unless org-refile-keep
- (if regionp
- (delete-region (point) (+ (point) (- region-end region-start)))
- (delete-region
- (and (org-back-to-heading t) (point))
- (min (1+ (buffer-size)) (org-end-of-subtree t t) (point)))))
- (when (featurep 'org-inlinetask)
- (org-inlinetask-remove-END-maybe))
- (setq org-markers-to-move nil)
- (message (concat actionmsg " to \"%s\" in file %s: done") (car it) file)))))))
- (defun org-refile-goto-last-stored ()
- "Go to the location where the last refile was stored."
- (interactive)
- (bookmark-jump (plist-get org-bookmark-names-plist :last-refile))
- (message "This is the location of the last refile"))
- (defun org-refile--get-location (refloc tbl)
- "When user refile to REFLOC, find the associated target in TBL.
- Also check `org-refile-target-table'."
- (car (delq
- nil
- (mapcar
- (lambda (r) (or (assoc r tbl)
- (assoc r org-refile-target-table)))
- (list (replace-regexp-in-string "/$" "" refloc)
- (replace-regexp-in-string "\\([^/]\\)$" "\\1/" refloc))))))
- (defun org-refile-get-location (&optional prompt default-buffer new-nodes)
- "Prompt the user for a refile location, using PROMPT.
- PROMPT should not be suffixed with a colon and a space, because
- this function appends the default value from
- `org-refile-history' automatically, if that is not empty."
- (let ((org-refile-targets org-refile-targets)
- (org-refile-use-outline-path org-refile-use-outline-path))
- (setq org-refile-target-table (org-refile-get-targets default-buffer)))
- (unless org-refile-target-table
- (user-error "No refile targets"))
- (let* ((cbuf (current-buffer))
- (cfn (buffer-file-name (buffer-base-buffer cbuf)))
- (cfunc (if (and org-refile-use-outline-path
- org-outline-path-complete-in-steps)
- #'org-olpath-completing-read
- #'completing-read))
- (extra (if org-refile-use-outline-path "/" ""))
- (cbnex (concat (buffer-name) extra))
- (filename (and cfn (expand-file-name cfn)))
- (tbl (mapcar
- (lambda (x)
- (if (and (not (member org-refile-use-outline-path
- '(file full-file-path)))
- (not (equal filename (nth 1 x))))
- (cons (concat (car x) extra " ("
- (file-name-nondirectory (nth 1 x)) ")")
- (cdr x))
- (cons (concat (car x) extra) (cdr x))))
- org-refile-target-table))
- (completion-ignore-case t)
- cdef
- (prompt (concat prompt
- (or (and (car org-refile-history)
- (concat " (default " (car org-refile-history) ")"))
- (and (assoc cbnex tbl) (setq cdef cbnex)
- (concat " (default " cbnex ")"))) ": "))
- pa answ parent-target child parent old-hist)
- (setq old-hist org-refile-history)
- (setq answ (funcall cfunc prompt tbl nil (not new-nodes)
- nil 'org-refile-history (or cdef (car org-refile-history))))
- (if (setq pa (org-refile--get-location answ tbl))
- (progn
- (org-refile-check-position pa)
- (when (or (not org-refile-history)
- (not (eq old-hist org-refile-history))
- (not (equal (car pa) (car org-refile-history))))
- (setq org-refile-history
- (cons (car pa) (if (assoc (car org-refile-history) tbl)
- org-refile-history
- (cdr org-refile-history))))
- (when (equal (car org-refile-history) (nth 1 org-refile-history))
- (pop org-refile-history)))
- pa)
- (if (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ)
- (progn
- (setq parent (match-string 1 answ)
- child (match-string 2 answ))
- (setq parent-target (org-refile--get-location parent tbl))
- (when (and parent-target
- (or (eq new-nodes t)
- (and (eq new-nodes 'confirm)
- (y-or-n-p (format "Create new node \"%s\"? "
- child)))))
- (org-refile-new-child parent-target child)))
- (user-error "Invalid target location")))))
- (declare-function org-string-nw-p "org-macs" (s))
- (defun org-refile-check-position (refile-pointer)
- "Check if the refile pointer matches the headline to which it points."
- (let* ((file (nth 1 refile-pointer))
- (re (nth 2 refile-pointer))
- (pos (nth 3 refile-pointer))
- buffer)
- (if (and (not (markerp pos)) (not file))
- (user-error "Please indicate a target file in the refile path")
- (when (org-string-nw-p re)
- (setq buffer (if (markerp pos)
- (marker-buffer pos)
- (or (find-buffer-visiting file)
- (find-file-noselect file))))
- (with-current-buffer buffer
- (org-with-wide-buffer
- (goto-char pos)
- (beginning-of-line 1)
- (unless (looking-at-p re)
- (user-error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling"))))))))
- (defun org-refile-new-child (parent-target child)
- "Use refile target PARENT-TARGET to add new CHILD below it."
- (unless parent-target
- (error "Cannot find parent for new node"))
- (let ((file (nth 1 parent-target))
- (pos (nth 3 parent-target))
- level)
- (with-current-buffer (or (find-buffer-visiting file)
- (find-file-noselect file))
- (org-with-wide-buffer
- (if pos
- (goto-char pos)
- (goto-char (point-max))
- (unless (bolp) (newline)))
- (when (looking-at org-outline-regexp)
- (setq level (funcall outline-level))
- (org-end-of-subtree t t))
- (org-back-over-empty-lines)
- (insert "\n" (make-string
- (if pos (org-get-valid-level level 1) 1) ?*)
- " " child "\n")
- (beginning-of-line 0)
- (list (concat (car parent-target) "/" child) file "" (point))))))
- (defun org-olpath-completing-read (prompt collection &rest args)
- "Read an outline path like a file name."
- (let ((thetable collection))
- (apply #'completing-read
- prompt
- (lambda (string predicate &optional flag)
- (cond
- ((eq flag nil) (try-completion string thetable))
- ((eq flag t)
- (let ((l (length string)))
- (mapcar (lambda (x)
- (let ((r (substring x l))
- (f (if (string-match " ([^)]*)$" x)
- (match-string 0 x)
- "")))
- (if (string-match "/" r)
- (concat string (substring r 0 (match-end 0)) f)
- x)))
- (all-completions string thetable predicate))))
- ;; Exact match?
- ((eq flag 'lambda) (assoc string thetable))))
- args)))
- ;;;; Dynamic blocks
- (defun org-find-dblock (name)
- "Find the first dynamic block with name NAME in the buffer.
- If not found, stay at current position and return nil."
- (let ((case-fold-search t) pos)
- (save-excursion
- (goto-char (point-min))
- (setq pos (and (re-search-forward
- (concat "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+" name "\\>") nil t)
- (match-beginning 0))))
- (when pos (goto-char pos))
- pos))
- (defun org-create-dblock (plist)
- "Create a dynamic block section, with parameters taken from PLIST.
- PLIST must contain a :name entry which is used as the name of the block."
- (when (string-match "\\S-" (buffer-substring (point-at-bol) (point-at-eol)))
- (end-of-line 1)
- (newline))
- (let ((col (current-column))
- (name (plist-get plist :name)))
- (insert "#+BEGIN: " name)
- (while plist
- (if (eq (car plist) :name)
- (setq plist (cddr plist))
- (insert " " (prin1-to-string (pop plist)))))
- (insert "\n\n" (make-string col ?\ ) "#+END:\n")
- (beginning-of-line -2)))
- (defun org-prepare-dblock ()
- "Prepare dynamic block for refresh.
- This empties the block, puts the cursor at the insert position and returns
- the property list including an extra property :name with the block name."
- (unless (looking-at org-dblock-start-re)
- (user-error "Not at a dynamic block"))
- (let* ((begdel (1+ (match-end 0)))
- (name (org-no-properties (match-string 1)))
- (params (append (list :name name)
- (read (concat "(" (match-string 3) ")")))))
- (save-excursion
- (beginning-of-line 1)
- (skip-chars-forward " \t")
- (setq params (plist-put params :indentation-column (current-column))))
- (unless (re-search-forward org-dblock-end-re nil t)
- (error "Dynamic block not terminated"))
- (setq params
- (append params
- (list :content (buffer-substring
- begdel (match-beginning 0)))))
- (delete-region begdel (match-beginning 0))
- (goto-char begdel)
- (open-line 1)
- params))
- (defun org-map-dblocks (&optional command)
- "Apply COMMAND to all dynamic blocks in the current buffer.
- If COMMAND is not given, use `org-update-dblock'."
- (let ((cmd (or command 'org-update-dblock)))
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward org-dblock-start-re nil t)
- (goto-char (match-beginning 0))
- (save-excursion
- (condition-case nil
- (funcall cmd)
- (error (message "Error during update of dynamic block"))))
- (unless (re-search-forward org-dblock-end-re nil t)
- (error "Dynamic block not terminated"))))))
- (defun org-dblock-update (&optional arg)
- "User command for updating dynamic blocks.
- Update the dynamic block at point. With prefix ARG, update all dynamic
- blocks in the buffer."
- (interactive "P")
- (if arg
- (org-update-all-dblocks)
- (or (looking-at org-dblock-start-re)
- (org-beginning-of-dblock))
- (org-update-dblock)))
- (defun org-update-dblock ()
- "Update the dynamic block at point.
- This means to empty the block, parse for parameters and then call
- the correct writing function."
- (interactive)
- (save-excursion
- (let* ((win (selected-window))
- (pos (point))
- (line (org-current-line))
- (params (org-prepare-dblock))
- (name (plist-get params :name))
- (indent (plist-get params :indentation-column))
- (cmd (intern (concat "org-dblock-write:" name))))
- (message "Updating dynamic block `%s' at line %d..." name line)
- (funcall cmd params)
- (message "Updating dynamic block `%s' at line %d...done" name line)
- (goto-char pos)
- (when (and indent (> indent 0))
- (setq indent (make-string indent ?\ ))
- (save-excursion
- (select-window win)
- (org-beginning-of-dblock)
- (forward-line 1)
- (while (not (looking-at org-dblock-end-re))
- (insert indent)
- (beginning-of-line 2))
- (when (looking-at org-dblock-end-re)
- (and (looking-at "[ \t]+")
- (replace-match ""))
- (insert indent)))))))
- (defun org-beginning-of-dblock ()
- "Find the beginning of the dynamic block at point.
- Error if there is no such block at point."
- (let ((pos (point))
- beg)
- (end-of-line 1)
- (if (and (re-search-backward org-dblock-start-re nil t)
- (setq beg (match-beginning 0))
- (re-search-forward org-dblock-end-re nil t)
- (> (match-end 0) pos))
- (goto-char beg)
- (goto-char pos)
- (error "Not in a dynamic block"))))
- (defun org-update-all-dblocks ()
- "Update all dynamic blocks in the buffer.
- This function can be used in a hook."
- (interactive)
- (when (derived-mode-p 'org-mode)
- (org-map-dblocks 'org-update-dblock)))
- ;;;; Completion
- (declare-function org-export-backend-options "ox" (cl-x) t)
- (defun org-get-export-keywords ()
- "Return a list of all currently understood export keywords.
- Export keywords include options, block names, attributes and
- keywords relative to each registered export back-end."
- (let (keywords)
- (dolist (backend
- (bound-and-true-p org-export-registered-backends)
- (delq nil keywords))
- ;; Back-end name (for keywords, like #+LATEX:)
- (push (upcase (symbol-name (org-export-backend-name backend))) keywords)
- (dolist (option-entry (org-export-backend-options backend))
- ;; Back-end options.
- (push (nth 1 option-entry) keywords)))))
- (defconst org-options-keywords
- '("ARCHIVE:" "AUTHOR:" "BIND:" "CATEGORY:" "COLUMNS:" "CREATOR:" "DATE:"
- "DESCRIPTION:" "DRAWERS:" "EMAIL:" "EXCLUDE_TAGS:" "FILETAGS:" "INCLUDE:"
- "INDEX:" "KEYWORDS:" "LANGUAGE:" "MACRO:" "OPTIONS:" "PROPERTY:"
- "PRIORITIES:" "SELECT_TAGS:" "SEQ_TODO:" "SETUPFILE:" "STARTUP:" "TAGS:"
- "TITLE:" "TODO:" "TYP_TODO:" "SELECT_TAGS:" "EXCLUDE_TAGS:"))
- (defcustom org-structure-template-alist
- '(("s" "#+BEGIN_SRC ?\n\n#+END_SRC")
- ("e" "#+BEGIN_EXAMPLE\n?\n#+END_EXAMPLE")
- ("q" "#+BEGIN_QUOTE\n?\n#+END_QUOTE")
- ("v" "#+BEGIN_VERSE\n?\n#+END_VERSE")
- ("V" "#+BEGIN_VERBATIM\n?\n#+END_VERBATIM")
- ("c" "#+BEGIN_CENTER\n?\n#+END_CENTER")
- ("l" "#+BEGIN_EXPORT latex\n?\n#+END_EXPORT")
- ("L" "#+LaTeX: ")
- ("h" "#+BEGIN_EXPORT html\n?\n#+END_EXPORT")
- ("H" "#+HTML: ")
- ("a" "#+BEGIN_EXPORT ascii\n?\n#+END_EXPORT")
- ("A" "#+ASCII: ")
- ("i" "#+INDEX: ?")
- ("I" "#+INCLUDE: %file ?"))
- "Structure completion elements.
- This is a list of abbreviation keys and values. The value gets inserted
- if you type `<' followed by the key and then press the completion key,
- usually `TAB'. %file will be replaced by a file name after prompting
- for the file using completion. The cursor will be placed at the position
- of the `?' in the template.
- There are two templates for each key, the first uses the original Org syntax,
- the second uses Emacs Muse-like syntax tags. These Muse-like tags become
- the default when the /org-mtags.el/ module has been loaded. See also the
- variable `org-mtags-prefer-muse-templates'."
- :group 'org-completion
- :type '(repeat
- (list
- (string :tag "Key")
- (string :tag "Template")))
- :version "26.1"
- :package-version '(Org . "8.3"))
- (defun org-try-structure-completion ()
- "Try to complete a structure template before point.
- This looks for strings like \"<e\" on an otherwise empty line and
- expands them."
- (let ((l (buffer-substring (point-at-bol) (point)))
- a)
- (when (and (looking-at "[ \t]*$")
- (string-match "^[ \t]*<\\([a-zA-Z]+\\)$" l)
- (setq a (assoc (match-string 1 l) org-structure-template-alist)))
- (org-complete-expand-structure-template (+ -1 (point-at-bol)
- (match-beginning 1)) a)
- t)))
- (defun org-complete-expand-structure-template (start cell)
- "Expand a structure template."
- (let ((rpl (nth 1 cell))
- (ind ""))
- (delete-region start (point))
- (when (string-match "\\`[ \t]*#\\+" rpl)
- (cond
- ((bolp))
- ((not (string-match "\\S-" (buffer-substring (point-at-bol) (point))))
- (setq ind (buffer-substring (point-at-bol) (point))))
- (t (newline))))
- (setq start (point))
- (when (string-match "%file" rpl)
- (setq rpl (replace-match
- (concat
- "\""
- (save-match-data
- (abbreviate-file-name (read-file-name "Include file: ")))
- "\"")
- t t rpl)))
- (setq rpl (mapconcat 'identity (split-string rpl "\n")
- (concat "\n" ind)))
- (insert rpl)
- (when (re-search-backward "\\?" start t) (delete-char 1))))
- ;;;; TODO, DEADLINE, Comments
- (defun org-toggle-comment ()
- "Change the COMMENT state of an entry."
- (interactive)
- (save-excursion
- (org-back-to-heading)
- (let ((case-fold-search nil))
- (looking-at org-complex-heading-regexp))
- (goto-char (or (match-end 3) (match-end 2) (match-end 1)))
- (skip-chars-forward " \t")
- (unless (memq (char-before) '(?\s ?\t)) (insert " "))
- (if (org-in-commented-heading-p t)
- (delete-region (point)
- (progn (search-forward " " (line-end-position) 'move)
- (skip-chars-forward " \t")
- (point)))
- (insert org-comment-string)
- (unless (eolp) (insert " ")))))
- (defvar org-last-todo-state-is-todo nil
- "This is non-nil when the last TODO state change led to a TODO state.
- If the last change removed the TODO tag or switched to DONE, then
- this is nil.")
- (defvar org-setting-tags nil) ; dynamically skipped
- (defvar org-todo-setup-filter-hook nil
- "Hook for functions that pre-filter todo specs.
- Each function takes a todo spec and returns either nil or the spec
- transformed into canonical form." )
- (defvar org-todo-get-default-hook nil
- "Hook for functions that get a default item for todo.
- Each function takes arguments (NEW-MARK OLD-MARK) and returns either
- nil or a string to be used for the todo mark." )
- (defvar org-agenda-headline-snapshot-before-repeat)
- (defun org-current-effective-time ()
- "Return current time adjusted for `org-extend-today-until' variable."
- (let* ((ct (org-current-time))
- (dct (decode-time ct))
- (ct1
- (cond
- (org-use-last-clock-out-time-as-effective-time
- (or (org-clock-get-last-clock-out-time) ct))
- ((and org-use-effective-time (< (nth 2 dct) org-extend-today-until))
- (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct)))
- (t ct))))
- ct1))
- (defun org-todo-yesterday (&optional arg)
- "Like `org-todo' but the time of change will be 23:59 of yesterday."
- (interactive "P")
- (if (eq major-mode 'org-agenda-mode)
- (apply 'org-agenda-todo-yesterday arg)
- (let* ((org-use-effective-time t)
- (hour (nth 2 (decode-time (org-current-time))))
- (org-extend-today-until (1+ hour)))
- (org-todo arg))))
- (defvar org-block-entry-blocking ""
- "First entry preventing the TODO state change.")
- (defun org-cancel-repeater ()
- "Cancel a repeater by setting its numeric value to zero."
- (interactive)
- (save-excursion
- (org-back-to-heading t)
- (let ((bound1 (point))
- (bound0 (save-excursion (outline-next-heading) (point))))
- (when (and (re-search-forward
- (concat "\\(" org-scheduled-time-regexp "\\)\\|\\("
- org-deadline-time-regexp "\\)\\|\\("
- org-ts-regexp "\\)")
- bound0 t)
- (re-search-backward "[ \t]+\\(?:[.+]\\)?\\+\\([0-9]+\\)[hdwmy]"
- bound1 t))
- (replace-match "0" t nil nil 1)))))
- (defvar org-state)
- (defvar org-blocked-by-checkboxes)
- (defun org-todo (&optional arg)
- "Change the TODO state of an item.
- The state of an item is given by a keyword at the start of the heading,
- like
- *** TODO Write paper
- *** DONE Call mom
- The different keywords are specified in the variable `org-todo-keywords'.
- By default the available states are \"TODO\" and \"DONE\". So, for this
- example: when the item starts with TODO, it is changed to DONE.
- When it starts with DONE, the DONE is removed. And when neither TODO nor
- DONE are present, add TODO at the beginning of the heading.
- With `\\[universal-argument]' prefix ARG, use completion to determine the new \
- state.
- With numeric prefix ARG, switch to that state.
- With a `\\[universal-argument] \\[universal-argument]' prefix, switch to the \
- next set of TODO \
- keywords (nextset).
- With a `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \
- prefix, circumvent any state blocking.
- With a numeric prefix arg of 0, inhibit note taking for the change.
- With a numeric prefix arg of -1, cancel repeater to allow marking as DONE.
- When called through ELisp, arg is also interpreted in the following way:
- `none' -> empty state
- \"\" -> switch to empty state
- `done' -> switch to DONE
- `nextset' -> switch to the next set of keywords
- `previousset' -> switch to the previous set of keywords
- \"WAITING\" -> switch to the specified keyword, but only if it
- really is a member of `org-todo-keywords'."
- (interactive "P")
- (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
- (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
- 'region-start-level 'region))
- org-loop-over-headlines-in-active-region)
- (org-map-entries
- `(org-todo ,arg)
- org-loop-over-headlines-in-active-region
- cl (when (org-invisible-p) (org-end-of-subtree nil t))))
- (when (equal arg '(16)) (setq arg 'nextset))
- (when (equal arg -1) (org-cancel-repeater) (setq arg nil))
- (let ((org-blocker-hook org-blocker-hook)
- commentp
- case-fold-search)
- (when (equal arg '(64))
- (setq arg nil org-blocker-hook nil))
- (when (and org-blocker-hook
- (or org-inhibit-blocking
- (org-entry-get nil "NOBLOCKING")))
- (setq org-blocker-hook nil))
- (save-excursion
- (catch 'exit
- (org-back-to-heading t)
- (when (org-in-commented-heading-p t)
- (org-toggle-comment)
- (setq commentp t))
- (when (looking-at org-outline-regexp) (goto-char (1- (match-end 0))))
- (or (looking-at (concat " +" org-todo-regexp "\\( +\\|[ \t]*$\\)"))
- (looking-at "\\(?: *\\|[ \t]*$\\)"))
- (let* ((match-data (match-data))
- (startpos (point-at-bol))
- (logging (save-match-data (org-entry-get nil "LOGGING" t t)))
- (org-log-done org-log-done)
- (org-log-repeat org-log-repeat)
- (org-todo-log-states org-todo-log-states)
- (org-inhibit-logging
- (if (equal arg 0)
- (progn (setq arg nil) 'note) org-inhibit-logging))
- (this (match-string 1))
- (hl-pos (match-beginning 0))
- (head (org-get-todo-sequence-head this))
- (ass (assoc head org-todo-kwd-alist))
- (interpret (nth 1 ass))
- (done-word (nth 3 ass))
- (final-done-word (nth 4 ass))
- (org-last-state (or this ""))
- (completion-ignore-case t)
- (member (member this org-todo-keywords-1))
- (tail (cdr member))
- (org-state (cond
- ((and org-todo-key-trigger
- (or (and (equal arg '(4))
- (eq org-use-fast-todo-selection 'prefix))
- (and (not arg) org-use-fast-todo-selection
- (not (eq org-use-fast-todo-selection
- 'prefix)))))
- ;; Use fast selection.
- (org-fast-todo-selection))
- ((and (equal arg '(4))
- (or (not org-use-fast-todo-selection)
- (not org-todo-key-trigger)))
- ;; Read a state with completion.
- (completing-read
- "State: " (mapcar #'list org-todo-keywords-1)
- nil t))
- ((eq arg 'right)
- (if this
- (if tail (car tail) nil)
- (car org-todo-keywords-1)))
- ((eq arg 'left)
- (unless (equal member org-todo-keywords-1)
- (if this
- (nth (- (length org-todo-keywords-1)
- (length tail) 2)
- org-todo-keywords-1)
- (org-last org-todo-keywords-1))))
- ((and (eq org-use-fast-todo-selection t) (equal arg '(4))
- (setq arg nil))) ;hack to fall back to cycling
- (arg
- ;; User or caller requests a specific state.
- (cond
- ((equal arg "") nil)
- ((eq arg 'none) nil)
- ((eq arg 'done) (or done-word (car org-done-keywords)))
- ((eq arg 'nextset)
- (or (car (cdr (member head org-todo-heads)))
- (car org-todo-heads)))
- ((eq arg 'previousset)
- (let ((org-todo-heads (reverse org-todo-heads)))
- (or (car (cdr (member head org-todo-heads)))
- (car org-todo-heads))))
- ((car (member arg org-todo-keywords-1)))
- ((stringp arg)
- (user-error "State `%s' not valid in this file" arg))
- ((nth (1- (prefix-numeric-value arg))
- org-todo-keywords-1))))
- ((null member) (or head (car org-todo-keywords-1)))
- ((equal this final-done-word) nil) ;-> make empty
- ((null tail) nil) ;-> first entry
- ((memq interpret '(type priority))
- (if (eq this-command last-command)
- (car tail)
- (if (> (length tail) 0)
- (or done-word (car org-done-keywords))
- nil)))
- (t
- (car tail))))
- (org-state (or
- (run-hook-with-args-until-success
- 'org-todo-get-default-hook org-state org-last-state)
- org-state))
- (next (if org-state (concat " " org-state " ") " "))
- (change-plist (list :type 'todo-state-change :from this :to org-state
- :position startpos))
- dolog now-done-p)
- (when org-blocker-hook
- (let (org-blocked-by-checkboxes block-reason)
- (setq org-last-todo-state-is-todo
- (not (member this org-done-keywords)))
- (unless (save-excursion
- (save-match-data
- (org-with-wide-buffer
- (run-hook-with-args-until-failure
- 'org-blocker-hook change-plist))))
- (setq block-reason (if org-blocked-by-checkboxes
- "contained checkboxes"
- (format "\"%s\"" org-block-entry-blocking)))
- (if (called-interactively-p 'interactive)
- (user-error "TODO state change from %s to %s blocked (by %s)"
- this org-state block-reason)
- ;; Fail silently.
- (message "TODO state change from %s to %s blocked (by %s)"
- this org-state block-reason)
- (throw 'exit nil)))))
- (store-match-data match-data)
- (replace-match next t t)
- (cond ((equal this org-state)
- (message "TODO state was already %s" (org-trim next)))
- ((not (pos-visible-in-window-p hl-pos))
- (message "TODO state changed to %s" (org-trim next))))
- (unless head
- (setq head (org-get-todo-sequence-head org-state)
- ass (assoc head org-todo-kwd-alist)
- interpret (nth 1 ass)
- done-word (nth 3 ass)
- final-done-word (nth 4 ass)))
- (when (memq arg '(nextset previousset))
- (message "Keyword-Set %d/%d: %s"
- (- (length org-todo-sets) -1
- (length (memq (assoc org-state org-todo-sets) org-todo-sets)))
- (length org-todo-sets)
- (mapconcat 'identity (assoc org-state org-todo-sets) " ")))
- (setq org-last-todo-state-is-todo
- (not (member org-state org-done-keywords)))
- (setq now-done-p (and (member org-state org-done-keywords)
- (not (member this org-done-keywords))))
- (and logging (org-local-logging logging))
- (when (and (or org-todo-log-states org-log-done)
- (not (eq org-inhibit-logging t))
- (not (memq arg '(nextset previousset))))
- ;; We need to look at recording a time and note.
- (setq dolog (or (nth 1 (assoc org-state org-todo-log-states))
- (nth 2 (assoc this org-todo-log-states))))
- (when (and (eq dolog 'note) (eq org-inhibit-logging 'note))
- (setq dolog 'time))
- (when (or (and (not org-state) (not org-closed-keep-when-no-todo))
- (and org-state
- (member org-state org-not-done-keywords)
- (not (member this org-not-done-keywords))))
- ;; This is now a todo state and was not one before
- ;; If there was a CLOSED time stamp, get rid of it.
- (org-add-planning-info nil nil 'closed))
- (when (and now-done-p org-log-done)
- ;; It is now done, and it was not done before.
- (org-add-planning-info 'closed (org-current-effective-time))
- (when (and (not dolog) (eq 'note org-log-done))
- (org-add-log-setup 'done org-state this 'note)))
- (when (and org-state dolog)
- ;; This is a non-nil state, and we need to log it.
- (org-add-log-setup 'state org-state this dolog)))
- ;; Fixup tag positioning.
- (org-todo-trigger-tag-changes org-state)
- (and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t))
- (when org-provide-todo-statistics
- (org-update-parent-todo-statistics))
- (run-hooks 'org-after-todo-state-change-hook)
- (when (and arg (not (member org-state org-done-keywords)))
- (setq head (org-get-todo-sequence-head org-state)))
- (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head)
- ;; Do we need to trigger a repeat?
- (when now-done-p
- (when (boundp 'org-agenda-headline-snapshot-before-repeat)
- ;; This is for the agenda, take a snapshot of the headline.
- (save-match-data
- (setq org-agenda-headline-snapshot-before-repeat
- (org-get-heading))))
- (org-auto-repeat-maybe org-state))
- ;; Fixup cursor location if close to the keyword.
- (when (and (outline-on-heading-p)
- (not (bolp))
- (save-excursion (beginning-of-line 1)
- (looking-at org-todo-line-regexp))
- (< (point) (+ 2 (or (match-end 2) (match-end 1)))))
- (goto-char (or (match-end 2) (match-end 1)))
- (and (looking-at " ") (just-one-space)))
- (when org-trigger-hook
- (save-excursion
- (run-hook-with-args 'org-trigger-hook change-plist)))
- (when commentp (org-toggle-comment))))))))
- (defun org-block-todo-from-children-or-siblings-or-parent (change-plist)
- "Block turning an entry into a TODO, using the hierarchy.
- This checks whether the current task should be blocked from state
- changes. Such blocking occurs when:
- 1. The task has children which are not all in a completed state.
- 2. A task has a parent with the property :ORDERED:, and there
- are siblings prior to the current task with incomplete
- status.
- 3. The parent of the task is blocked because it has siblings that should
- be done first, or is child of a block grandparent TODO entry."
- (if (not org-enforce-todo-dependencies)
- t ; if locally turned off don't block
- (catch 'dont-block
- ;; If this is not a todo state change, or if this entry is already DONE,
- ;; do not block
- (when (or (not (eq (plist-get change-plist :type) 'todo-state-change))
- (member (plist-get change-plist :from)
- (cons 'done org-done-keywords))
- (member (plist-get change-plist :to)
- (cons 'todo org-not-done-keywords))
- (not (plist-get change-plist :to)))
- (throw 'dont-block t))
- ;; If this task has children, and any are undone, it's blocked
- (save-excursion
- (org-back-to-heading t)
- (let ((this-level (funcall outline-level)))
- (outline-next-heading)
- (let ((child-level (funcall outline-level)))
- (while (and (not (eobp))
- (> child-level this-level))
- ;; this todo has children, check whether they are all
- ;; completed
- (when (and (not (org-entry-is-done-p))
- (org-entry-is-todo-p))
- (setq org-block-entry-blocking (org-get-heading))
- (throw 'dont-block nil))
- (outline-next-heading)
- (setq child-level (funcall outline-level))))))
- ;; Otherwise, if the task's parent has the :ORDERED: property, and
- ;; any previous siblings are undone, it's blocked
- (save-excursion
- (org-back-to-heading t)
- (let* ((pos (point))
- (parent-pos (and (org-up-heading-safe) (point)))
- (case-fold-search nil))
- (unless parent-pos (throw 'dont-block t)) ; no parent
- (when (and (org-not-nil (org-entry-get (point) "ORDERED"))
- (forward-line 1)
- (re-search-forward org-not-done-heading-regexp pos t))
- (setq org-block-entry-blocking (match-string 0))
- (throw 'dont-block nil)) ; block, there is an older sibling not done.
- ;; Search further up the hierarchy, to see if an ancestor is blocked
- (while t
- (goto-char parent-pos)
- (unless (looking-at org-not-done-heading-regexp)
- (throw 'dont-block t)) ; do not block, parent is not a TODO
- (setq pos (point))
- (setq parent-pos (and (org-up-heading-safe) (point)))
- (unless parent-pos (throw 'dont-block t)) ; no parent
- (when (and (org-not-nil (org-entry-get (point) "ORDERED"))
- (forward-line 1)
- (re-search-forward org-not-done-heading-regexp pos t)
- (setq org-block-entry-blocking (org-get-heading)))
- (throw 'dont-block nil)))))))) ; block, older sibling not done.
- (defcustom org-track-ordered-property-with-tag nil
- "Should the ORDERED property also be shown as a tag?
- The ORDERED property decides if an entry should require subtasks to be
- completed in sequence. Since a property is not very visible, setting
- this option means that toggling the ORDERED property with the command
- `org-toggle-ordered-property' will also toggle a tag ORDERED. That tag is
- not relevant for the behavior, but it makes things more visible.
- Note that toggling the tag with tags commands will not change the property
- and therefore not influence behavior!
- This can be t, meaning the tag ORDERED should be used, It can also be a
- string to select a different tag for this task."
- :group 'org-todo
- :type '(choice
- (const :tag "No tracking" nil)
- (const :tag "Track with ORDERED tag" t)
- (string :tag "Use other tag")))
- (defun org-toggle-ordered-property ()
- "Toggle the ORDERED property of the current entry.
- For better visibility, you can track the value of this property with a tag.
- See variable `org-track-ordered-property-with-tag'."
- (interactive)
- (let* ((t1 org-track-ordered-property-with-tag)
- (tag (and t1 (if (stringp t1) t1 "ORDERED"))))
- (save-excursion
- (org-back-to-heading)
- (if (org-entry-get nil "ORDERED")
- (progn
- (org-delete-property "ORDERED")
- (and tag (org-toggle-tag tag 'off))
- (message "Subtasks can be completed in arbitrary order"))
- (org-entry-put nil "ORDERED" "t")
- (and tag (org-toggle-tag tag 'on))
- (message "Subtasks must be completed in sequence")))))
- (defun org-block-todo-from-checkboxes (change-plist)
- "Block turning an entry into a TODO, using checkboxes.
- This checks whether the current task should be blocked from state
- changes because there are unchecked boxes in this entry."
- (if (not org-enforce-todo-checkbox-dependencies)
- t ; if locally turned off don't block
- (catch 'dont-block
- ;; If this is not a todo state change, or if this entry is already DONE,
- ;; do not block
- (when (or (not (eq (plist-get change-plist :type) 'todo-state-change))
- (member (plist-get change-plist :from)
- (cons 'done org-done-keywords))
- (member (plist-get change-plist :to)
- (cons 'todo org-not-done-keywords))
- (not (plist-get change-plist :to)))
- (throw 'dont-block t))
- ;; If this task has checkboxes that are not checked, it's blocked
- (save-excursion
- (org-back-to-heading t)
- (let ((beg (point)) end)
- (outline-next-heading)
- (setq end (point))
- (goto-char beg)
- (when (org-list-search-forward
- (concat (org-item-beginning-re)
- "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?"
- "\\[[- ]\\]")
- end t)
- (when (boundp 'org-blocked-by-checkboxes)
- (setq org-blocked-by-checkboxes t))
- (throw 'dont-block nil))))
- t))) ; do not block
- (defun org-entry-blocked-p ()
- "Non-nil if entry at point is blocked."
- (and (not (org-entry-get nil "NOBLOCKING"))
- (member (org-entry-get nil "TODO") org-not-done-keywords)
- (not (run-hook-with-args-until-failure
- 'org-blocker-hook
- (list :type 'todo-state-change
- :position (point)
- :from 'todo
- :to 'done)))))
- (defun org-update-statistics-cookies (all)
- "Update the statistics cookie, either from TODO or from checkboxes.
- This should be called with the cursor in a line with a statistics
- cookie. When called with a \\[universal-argument] prefix, update
- all statistics cookies in the buffer."
- (interactive "P")
- (if all
- (progn
- (org-update-checkbox-count 'all)
- (org-map-entries 'org-update-parent-todo-statistics))
- (if (not (org-at-heading-p))
- (org-update-checkbox-count)
- (let ((pos (point-marker))
- end l1 l2)
- (ignore-errors (org-back-to-heading t))
- (if (not (org-at-heading-p))
- (org-update-checkbox-count)
- (setq l1 (org-outline-level))
- (setq end (save-excursion
- (outline-next-heading)
- (when (org-at-heading-p) (setq l2 (org-outline-level)))
- (point)))
- (if (and (save-excursion
- (re-search-forward
- "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) \\[[- X]\\]" end t))
- (not (save-excursion (re-search-forward
- ":COOKIE_DATA:.*\\<todo\\>" end t))))
- (org-update-checkbox-count)
- (if (and l2 (> l2 l1))
- (progn
- (goto-char end)
- (org-update-parent-todo-statistics))
- (goto-char pos)
- (beginning-of-line 1)
- (while (re-search-forward
- "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)"
- (point-at-eol) t)
- (replace-match (if (match-end 2) "[100%]" "[0/0]") t t)))))
- (goto-char pos)
- (move-marker pos nil)))))
- (defvar org-entry-property-inherited-from) ;; defined below
- (defun org-update-parent-todo-statistics ()
- "Update any statistics cookie in the parent of the current headline.
- When `org-hierarchical-todo-statistics' is nil, statistics will cover
- the entire subtree and this will travel up the hierarchy and update
- statistics everywhere."
- (let* ((prop (save-excursion (org-up-heading-safe)
- (org-entry-get nil "COOKIE_DATA" 'inherit)))
- (recursive (or (not org-hierarchical-todo-statistics)
- (and prop (string-match "\\<recursive\\>" prop))))
- (lim (or (and prop (marker-position org-entry-property-inherited-from))
- 0))
- (first t)
- (box-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
- level ltoggle l1 new ndel
- (cnt-all 0) (cnt-done 0) is-percent kwd
- checkbox-beg cookie-present)
- (catch 'exit
- (save-excursion
- (beginning-of-line 1)
- (setq ltoggle (funcall outline-level))
- ;; Three situations are to consider:
- ;; 1. if `org-hierarchical-todo-statistics' is nil, repeat up
- ;; to the top-level ancestor on the headline;
- ;; 2. If parent has "recursive" property, repeat up to the
- ;; headline setting that property, taking inheritance into
- ;; account;
- ;; 3. Else, move up to direct parent and proceed only once.
- (while (and (setq level (org-up-heading-safe))
- (or recursive first)
- (>= (point) lim))
- (setq first nil cookie-present nil)
- (unless (and level
- (not (string-match
- "\\<checkbox\\>"
- (downcase (or (org-entry-get nil "COOKIE_DATA")
- "")))))
- (throw 'exit nil))
- (while (re-search-forward box-re (point-at-eol) t)
- (setq cnt-all 0 cnt-done 0 cookie-present t)
- (setq is-percent (match-end 2) checkbox-beg (match-beginning 0))
- (save-match-data
- (unless (outline-next-heading) (throw 'exit nil))
- (while (and (looking-at org-complex-heading-regexp)
- (> (setq l1 (length (match-string 1))) level))
- (setq kwd (and (or recursive (= l1 ltoggle))
- (match-string 2)))
- (if (or (eq org-provide-todo-statistics 'all-headlines)
- (and (eq org-provide-todo-statistics t)
- (or (member kwd org-done-keywords)))
- (and (listp org-provide-todo-statistics)
- (stringp (car org-provide-todo-statistics))
- (or (member kwd org-provide-todo-statistics)
- (member kwd org-done-keywords)))
- (and (listp org-provide-todo-statistics)
- (listp (car org-provide-todo-statistics))
- (or (member kwd (car org-provide-todo-statistics))
- (and (member kwd org-done-keywords)
- (member kwd (cadr org-provide-todo-statistics))))))
- (setq cnt-all (1+ cnt-all))
- (and (eq org-provide-todo-statistics t)
- kwd
- (setq cnt-all (1+ cnt-all))))
- (when (or (and (member org-provide-todo-statistics '(t all-headlines))
- (member kwd org-done-keywords))
- (and (listp org-provide-todo-statistics)
- (listp (car org-provide-todo-statistics))
- (member kwd org-done-keywords)
- (member kwd (cadr org-provide-todo-statistics)))
- (and (listp org-provide-todo-statistics)
- (stringp (car org-provide-todo-statistics))
- (member kwd org-done-keywords)))
- (setq cnt-done (1+ cnt-done)))
- (outline-next-heading)))
- (setq new
- (if is-percent
- (format "[%d%%]" (floor (* 100.0 cnt-done)
- (max 1 cnt-all)))
- (format "[%d/%d]" cnt-done cnt-all))
- ndel (- (match-end 0) checkbox-beg))
- (goto-char checkbox-beg)
- (insert new)
- (delete-region (point) (+ (point) ndel))
- (when org-auto-align-tags (org-fix-tags-on-the-fly)))
- (when cookie-present
- (run-hook-with-args 'org-after-todo-statistics-hook
- cnt-done (- cnt-all cnt-done))))))
- (run-hooks 'org-todo-statistics-hook)))
- (defvar org-after-todo-statistics-hook nil
- "Hook that is called after a TODO statistics cookie has been updated.
- Each function is called with two arguments: the number of not-done entries
- and the number of done entries.
- For example, the following function, when added to this hook, will switch
- an entry to DONE when all children are done, and back to TODO when new
- entries are set to a TODO status. Note that this hook is only called
- when there is a statistics cookie in the headline!
- (defun org-summary-todo (n-done n-not-done)
- \"Switch entry to DONE when all subentries are done, to TODO otherwise.\"
- (let (org-log-done org-log-states) ; turn off logging
- (org-todo (if (= n-not-done 0) \"DONE\" \"TODO\"))))
- ")
- (defvar org-todo-statistics-hook nil
- "Hook that is run whenever Org thinks TODO statistics should be updated.
- This hook runs even if there is no statistics cookie present, in which case
- `org-after-todo-statistics-hook' would not run.")
- (defun org-todo-trigger-tag-changes (state)
- "Apply the changes defined in `org-todo-state-tags-triggers'."
- (let ((l org-todo-state-tags-triggers)
- changes)
- (when (or (not state) (equal state ""))
- (setq changes (append changes (cdr (assoc "" l)))))
- (when (and (stringp state) (> (length state) 0))
- (setq changes (append changes (cdr (assoc state l)))))
- (when (member state org-not-done-keywords)
- (setq changes (append changes (cdr (assq 'todo l)))))
- (when (member state org-done-keywords)
- (setq changes (append changes (cdr (assq 'done l)))))
- (dolist (c changes)
- (org-toggle-tag (car c) (if (cdr c) 'on 'off)))))
- (defun org-local-logging (value)
- "Get logging settings from a property VALUE."
- ;; Directly set the variables, they are already local.
- (setq org-log-done nil
- org-log-repeat nil
- org-todo-log-states nil)
- (dolist (w (org-split-string value))
- (let (a)
- (cond
- ((setq a (assoc w org-startup-options))
- (and (member (nth 1 a) '(org-log-done org-log-repeat))
- (set (nth 1 a) (nth 2 a))))
- ((setq a (org-extract-log-state-settings w))
- (and (member (car a) org-todo-keywords-1)
- (push a org-todo-log-states)))))))
- (defun org-get-todo-sequence-head (kwd)
- "Return the head of the TODO sequence to which KWD belongs.
- If KWD is not set, check if there is a text property remembering the
- right sequence."
- (let (p)
- (cond
- ((not kwd)
- (or (get-text-property (point-at-bol) 'org-todo-head)
- (progn
- (setq p (next-single-property-change (point-at-bol) 'org-todo-head
- nil (point-at-eol)))
- (get-text-property p 'org-todo-head))))
- ((not (member kwd org-todo-keywords-1))
- (car org-todo-keywords-1))
- (t (nth 2 (assoc kwd org-todo-kwd-alist))))))
- (defun org-fast-todo-selection ()
- "Fast TODO keyword selection with single keys.
- Returns the new TODO keyword, or nil if no state change should occur."
- (let* ((fulltable org-todo-key-alist)
- (done-keywords org-done-keywords) ;; needed for the faces.
- (maxlen (apply 'max (mapcar
- (lambda (x)
- (if (stringp (car x)) (string-width (car x)) 0))
- fulltable)))
- (expert nil)
- (fwidth (+ maxlen 3 1 3))
- (ncol (/ (- (window-width) 4) fwidth))
- tg cnt e c tbl
- groups ingroup)
- (save-excursion
- (save-window-excursion
- (if expert
- (set-buffer (get-buffer-create " *Org todo*"))
- (org-switch-to-buffer-other-window (get-buffer-create " *Org todo*")))
- (erase-buffer)
- (setq-local org-done-keywords done-keywords)
- (setq tbl fulltable cnt 0)
- (while (setq e (pop tbl))
- (cond
- ((equal e '(:startgroup))
- (push '() groups) (setq ingroup t)
- (unless (= cnt 0)
- (setq cnt 0)
- (insert "\n"))
- (insert "{ "))
- ((equal e '(:endgroup))
- (setq ingroup nil cnt 0)
- (insert "}\n"))
- ((equal e '(:newline))
- (unless (= cnt 0)
- (setq cnt 0)
- (insert "\n")
- (setq e (car tbl))
- (while (equal (car tbl) '(:newline))
- (insert "\n")
- (setq tbl (cdr tbl)))))
- (t
- (setq tg (car e) c (cdr e))
- (when ingroup (push tg (car groups)))
- (setq tg (org-add-props tg nil 'face
- (org-get-todo-face tg)))
- (when (and (= cnt 0) (not ingroup)) (insert " "))
- (insert "[" c "] " tg (make-string
- (- fwidth 4 (length tg)) ?\ ))
- (when (= (setq cnt (1+ cnt)) ncol)
- (insert "\n")
- (when ingroup (insert " "))
- (setq cnt 0)))))
- (insert "\n")
- (goto-char (point-min))
- (unless expert (org-fit-window-to-buffer))
- (message "[a-z..]:Set [SPC]:clear")
- (setq c (let ((inhibit-quit t)) (read-char-exclusive)))
- (cond
- ((or (= c ?\C-g)
- (and (= c ?q) (not (rassoc c fulltable))))
- (setq quit-flag t))
- ((= c ?\ ) nil)
- ((setq e (rassoc c fulltable) tg (car e))
- tg)
- (t (setq quit-flag t)))))))
- (defun org-entry-is-todo-p ()
- (member (org-get-todo-state) org-not-done-keywords))
- (defun org-entry-is-done-p ()
- (member (org-get-todo-state) org-done-keywords))
- (defun org-get-todo-state ()
- "Return the TODO keyword of the current subtree."
- (save-excursion
- (org-back-to-heading t)
- (and (let ((case-fold-search nil)) (looking-at org-todo-line-regexp))
- (match-end 2)
- (match-string 2))))
- (defun org-at-date-range-p (&optional inactive-ok)
- "Non-nil if point is inside a date range.
- When optional argument INACTIVE-OK is non-nil, also consider
- inactive time ranges.
- When this function returns a non-nil value, match data is set
- according to `org-tr-regexp-both' or `org-tr-regexp', depending
- on INACTIVE-OK."
- (interactive)
- (save-excursion
- (catch 'exit
- (let ((pos (point)))
- (skip-chars-backward "^[<\r\n")
- (skip-chars-backward "<[")
- (and (looking-at (if inactive-ok org-tr-regexp-both org-tr-regexp))
- (>= (match-end 0) pos)
- (throw 'exit t))
- (skip-chars-backward "^<[\r\n")
- (skip-chars-backward "<[")
- (and (looking-at (if inactive-ok org-tr-regexp-both org-tr-regexp))
- (>= (match-end 0) pos)
- (throw 'exit t)))
- nil)))
- (defun org-get-repeat (&optional tagline)
- "Check if there is a deadline/schedule with repeater in this entry."
- (save-match-data
- (save-excursion
- (org-back-to-heading t)
- (and (re-search-forward (if tagline
- (concat tagline "\\s-*" org-repeat-re)
- org-repeat-re)
- (org-entry-end-position) t)
- (match-string-no-properties 1)))))
- (defvar org-last-changed-timestamp)
- (defvar org-last-inserted-timestamp)
- (defvar org-log-post-message)
- (defvar org-log-note-purpose)
- (defvar org-log-note-how nil)
- (defvar org-log-note-extra)
- (defun org-auto-repeat-maybe (done-word)
- "Check if the current headline contains a repeated time-stamp.
- If yes, set TODO state back to what it was and change the base date
- of repeating deadline/scheduled time stamps to new date.
- This function is run automatically after each state change to a DONE state."
- (let* ((repeat (org-get-repeat))
- (aa (assoc org-last-state org-todo-kwd-alist))
- (interpret (nth 1 aa))
- (head (nth 2 aa))
- (whata '(("h" . hour) ("d" . day) ("m" . month) ("y" . year)))
- (msg "Entry repeats: ")
- (org-log-done nil)
- (org-todo-log-states nil))
- (when (and repeat (not (zerop (string-to-number (substring repeat 1)))))
- (when (eq org-log-repeat t) (setq org-log-repeat 'state))
- (let ((to-state (or (org-entry-get nil "REPEAT_TO_STATE" 'selective)
- org-todo-repeat-to-state)))
- (org-todo (cond ((and to-state (member to-state org-todo-keywords-1))
- to-state)
- ((eq interpret 'type) org-last-state)
- (head)
- (t 'none))))
- (when (or org-log-repeat (org-entry-get nil "CLOCK"))
- (org-entry-put nil "LAST_REPEAT" (format-time-string
- (org-time-stamp-format t t))))
- (when org-log-repeat
- (if (or (memq 'org-add-log-note (default-value 'post-command-hook))
- (memq 'org-add-log-note post-command-hook))
- ;; We are already setup for some record.
- (when (eq org-log-repeat 'note)
- ;; Make sure we take a note, not only a time stamp.
- (setq org-log-note-how 'note))
- ;; Set up for taking a record.
- (org-add-log-setup 'state
- (or done-word (car org-done-keywords))
- org-last-state
- org-log-repeat)))
- (org-back-to-heading t)
- (org-add-planning-info nil nil 'closed)
- (let ((end (save-excursion (outline-next-heading) (point)))
- (planning-re (regexp-opt
- (list org-scheduled-string org-deadline-string))))
- (while (re-search-forward org-ts-regexp end t)
- (let* ((ts (match-string 0))
- (planning? (org-at-planning-p))
- (type (if (not planning?) "Plain:"
- (save-excursion
- (re-search-backward
- planning-re (line-beginning-position) t)
- (match-string 0)))))
- (cond
- ;; Ignore fake time-stamps (e.g., within comments).
- ((and (not planning?)
- (not (org-at-property-p))
- (not (eq 'timestamp
- (org-element-type (save-excursion
- (backward-char)
- (org-element-context)))))))
- ;; Time-stamps without a repeater are usually skipped.
- ;; However, a SCHEDULED time-stamp without one is
- ;; removed, as it is considered as no longer relevant.
- ((not (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts))
- (when (equal type org-scheduled-string)
- (org-remove-timestamp-with-keyword type)))
- (t
- (let ((n (string-to-number (match-string 2 ts)))
- (what (match-string 3 ts)))
- (when (equal what "w") (setq n (* n 7) what "d"))
- (when (and (equal what "h")
- (not (string-match-p "[0-9]\\{1,2\\}:[0-9]\\{2\\}"
- ts)))
- (user-error
- "Cannot repeat in Repeat in %d hour(s) because no hour \
- has been set"
- n))
- ;; Preparation, see if we need to modify the start
- ;; date for the change.
- (when (match-end 1)
- (let ((time (save-match-data (org-time-string-to-time ts))))
- (cond
- ((equal (match-string 1 ts) ".")
- ;; Shift starting date to today
- (org-timestamp-change
- (- (org-today) (time-to-days time))
- 'day))
- ((equal (match-string 1 ts) "+")
- (let ((nshiftmax 10)
- (nshift 0))
- (while (or (= nshift 0)
- (not (time-less-p (current-time) time)))
- (when (= (cl-incf nshift) nshiftmax)
- (or (y-or-n-p
- (format "%d repeater intervals were not \
- enough to shift date past today. Continue? "
- nshift))
- (user-error "Abort")))
- (org-timestamp-change n (cdr (assoc what whata)))
- (org-at-timestamp-p t)
- (setq ts (match-string 1))
- (setq time
- (save-match-data
- (org-time-string-to-time ts)))))
- (org-timestamp-change (- n) (cdr (assoc what whata)))
- ;; Rematch, so that we have everything in place
- ;; for the real shift.
- (org-at-timestamp-p t)
- (setq ts (match-string 1))
- (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)"
- ts)))))
- (save-excursion
- (org-timestamp-change n (cdr (assoc what whata)) nil t))
- (setq msg
- (concat
- msg type " " org-last-changed-timestamp " "))))))))
- (setq org-log-post-message msg)
- (message "%s" msg))))
- (defun org-show-todo-tree (arg)
- "Make a compact tree which shows all headlines marked with TODO.
- The tree will show the lines where the regexp matches, and all higher
- headlines above the match.
- With a `\\[universal-argument]' prefix, prompt for a regexp to match.
- With a numeric prefix N, construct a sparse tree for the Nth element
- of `org-todo-keywords-1'."
- (interactive "P")
- (let ((case-fold-search nil)
- (kwd-re
- (cond ((null arg) org-not-done-regexp)
- ((equal arg '(4))
- (let ((kwd
- (completing-read "Keyword (or KWD1|KWD2|...): "
- (mapcar #'list org-todo-keywords-1))))
- (concat "\\("
- (mapconcat 'identity (org-split-string kwd "|") "\\|")
- "\\)\\>")))
- ((<= (prefix-numeric-value arg) (length org-todo-keywords-1))
- (regexp-quote (nth (1- (prefix-numeric-value arg))
- org-todo-keywords-1)))
- (t (user-error "Invalid prefix argument: %s" arg)))))
- (message "%d TODO entries found"
- (org-occur (concat "^" org-outline-regexp " *" kwd-re )))))
- (defun org--deadline-or-schedule (arg type time)
- "Insert DEADLINE or SCHEDULE information in current entry.
- TYPE is either `deadline' or `scheduled'. See `org-deadline' or
- `org-schedule' for information about ARG and TIME arguments."
- (let* ((deadline? (eq type 'deadline))
- (keyword (if deadline? org-deadline-string org-scheduled-string))
- (log (if deadline? org-log-redeadline org-log-reschedule))
- (old-date (org-entry-get nil (if deadline? "DEADLINE" "SCHEDULED")))
- (old-date-time (and old-date (org-time-string-to-time old-date)))
- ;; Save repeater cookie from either TIME or current scheduled
- ;; time stamp. We are going to insert it back at the end of
- ;; the process.
- (repeater (or (and (org-string-nw-p time)
- ;; We use `org-repeat-re' because we need
- ;; to tell the difference between a real
- ;; repeater and a time delta, e.g. "+2d".
- (string-match org-repeat-re time)
- (match-string 1 time))
- (and (org-string-nw-p old-date)
- (string-match "\\([.+-]+[0-9]+[hdwmy]\
- \\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\)"
- old-date)
- (match-string 1 old-date)))))
- (pcase arg
- (`(4)
- (when (and old-date log)
- (org-add-log-setup (if deadline? 'deldeadline 'delschedule)
- nil old-date log))
- (org-remove-timestamp-with-keyword keyword)
- (message (if deadline? "Item no longer has a deadline."
- "Item is no longer scheduled.")))
- (`(16)
- (save-excursion
- (org-back-to-heading t)
- (let ((regexp (if deadline? org-deadline-time-regexp
- org-scheduled-time-regexp)))
- (if (not (re-search-forward regexp (line-end-position 2) t))
- (user-error (if deadline? "No deadline information to update"
- "No scheduled information to update"))
- (let* ((rpl0 (match-string 1))
- (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0))
- (msg (if deadline? "Warn starting from" "Delay until")))
- (replace-match
- (concat keyword
- " <" rpl
- (format " -%dd"
- (abs (- (time-to-days
- (save-match-data
- (org-read-date
- nil t nil msg old-date-time)))
- (time-to-days old-date-time))))
- ">") t t))))))
- (_
- (org-add-planning-info type time 'closed)
- (when (and old-date
- log
- (not (equal old-date org-last-inserted-timestamp)))
- (org-add-log-setup (if deadline? 'redeadline 'reschedule)
- org-last-inserted-timestamp
- old-date
- log))
- (when repeater
- (save-excursion
- (org-back-to-heading t)
- (when (re-search-forward
- (concat keyword " " org-last-inserted-timestamp)
- (line-end-position 2)
- t)
- (goto-char (1- (match-end 0)))
- (insert " " repeater)
- (setq org-last-inserted-timestamp
- (concat (substring org-last-inserted-timestamp 0 -1)
- " " repeater
- (substring org-last-inserted-timestamp -1))))))
- (message (if deadline? "Deadline on %s" "Scheduled to %s")
- org-last-inserted-timestamp)))))
- (defun org-deadline (arg &optional time)
- "Insert the \"DEADLINE:\" string with a timestamp to make a deadline.
- With one universal prefix argument, remove any deadline from the item.
- With two universal prefix arguments, prompt for a warning delay.
- With argument TIME, set the deadline at the corresponding date. TIME
- can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
- (interactive "P")
- (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
- (org-map-entries
- (lambda () (org--deadline-or-schedule arg 'deadline time))
- nil
- (if (eq org-loop-over-headlines-in-active-region 'start-level)
- 'region-start-level
- 'region)
- (lambda () (when (org-invisible-p) (org-end-of-subtree nil t))))
- (org--deadline-or-schedule arg 'deadline time)))
- (defun org-schedule (arg &optional time)
- "Insert the SCHEDULED: string with a timestamp to schedule a TODO item.
- With one universal prefix argument, remove any scheduling date from the item.
- With two universal prefix arguments, prompt for a delay cookie.
- With argument TIME, scheduled at the corresponding date. TIME can
- either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
- (interactive "P")
- (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
- (org-map-entries
- (lambda () (org--deadline-or-schedule arg 'scheduled time))
- nil
- (if (eq org-loop-over-headlines-in-active-region 'start-level)
- 'region-start-level
- 'region)
- (lambda () (when (org-invisible-p) (org-end-of-subtree nil t))))
- (org--deadline-or-schedule arg 'scheduled time)))
- (defun org-get-scheduled-time (pom &optional inherit)
- "Get the scheduled time as a time tuple, of a format suitable
- for calling org-schedule with, or if there is no scheduling,
- returns nil."
- (let ((time (org-entry-get pom "SCHEDULED" inherit)))
- (when time
- (apply 'encode-time (org-parse-time-string time)))))
- (defun org-get-deadline-time (pom &optional inherit)
- "Get the deadline as a time tuple, of a format suitable for
- calling org-deadline with, or if there is no scheduling, returns
- nil."
- (let ((time (org-entry-get pom "DEADLINE" inherit)))
- (when time
- (apply 'encode-time (org-parse-time-string time)))))
- (defun org-remove-timestamp-with-keyword (keyword)
- "Remove all time stamps with KEYWORD in the current entry."
- (let ((re (concat "\\<" (regexp-quote keyword) " +<[^>\n]+>[ \t]*"))
- beg)
- (save-excursion
- (org-back-to-heading t)
- (setq beg (point))
- (outline-next-heading)
- (while (re-search-backward re beg t)
- (replace-match "")
- (if (and (string-match "\\S-" (buffer-substring (point-at-bol) (point)))
- (equal (char-before) ?\ ))
- (backward-delete-char 1)
- (when (string-match "^[ \t]*$" (buffer-substring
- (point-at-bol) (point-at-eol)))
- (delete-region (point-at-bol)
- (min (point-max) (1+ (point-at-eol))))))))))
- (defvar org-time-was-given) ; dynamically scoped parameter
- (defvar org-end-time-was-given) ; dynamically scoped parameter
- (defun org-at-planning-p ()
- "Non-nil when point is on a planning info line."
- ;; This is as accurate and faster than `org-element-at-point' since
- ;; planning info location is fixed in the section.
- (org-with-wide-buffer
- (beginning-of-line)
- (and (looking-at-p org-planning-line-re)
- (eq (point)
- (ignore-errors
- (if (and (featurep 'org-inlinetask) (org-inlinetask-in-task-p))
- (org-back-to-heading t)
- (org-with-limited-levels (org-back-to-heading t)))
- (line-beginning-position 2))))))
- (defun org-add-planning-info (what &optional time &rest remove)
- "Insert new timestamp with keyword in the planning line.
- WHAT indicates what kind of time stamp to add. It is a symbol
- among `closed', `deadline', `scheduled' and nil. TIME indicates
- the time to use. If none is given, the user is prompted for
- a date. REMOVE indicates what kind of entries to remove. An old
- WHAT entry will also be removed."
- (let (org-time-was-given org-end-time-was-given default-time default-input)
- (catch 'exit
- (when (and (memq what '(scheduled deadline))
- (or (not time)
- (and (stringp time)
- (string-match "^[-+]+[0-9]" time))))
- ;; Try to get a default date/time from existing timestamp
- (save-excursion
- (org-back-to-heading t)
- (let ((end (save-excursion (outline-next-heading) (point))) ts)
- (when (re-search-forward (if (eq what 'scheduled)
- org-scheduled-time-regexp
- org-deadline-time-regexp)
- end t)
- (setq ts (match-string 1)
- default-time (apply 'encode-time (org-parse-time-string ts))
- default-input (and ts (org-get-compact-tod ts)))))))
- (when what
- (setq time
- (if (stringp time)
- ;; This is a string (relative or absolute), set
- ;; proper date.
- (apply #'encode-time
- (org-read-date-analyze
- time default-time (decode-time default-time)))
- ;; If necessary, get the time from the user
- (or time (org-read-date nil 'to-time nil nil
- default-time default-input)))))
- (org-with-wide-buffer
- (org-back-to-heading t)
- (forward-line)
- (unless (bolp) (insert "\n"))
- (cond ((looking-at-p org-planning-line-re)
- ;; Move to current indentation.
- (skip-chars-forward " \t")
- ;; Check if we have to remove something.
- (dolist (type (if what (cons what remove) remove))
- (save-excursion
- (when (re-search-forward
- (cl-case type
- (closed org-closed-time-regexp)
- (deadline org-deadline-time-regexp)
- (scheduled org-scheduled-time-regexp)
- (otherwise
- (error "Invalid planning type: %s" type)))
- (line-end-position) t)
- ;; Delete until next keyword or end of line.
- (delete-region
- (match-beginning 0)
- (if (re-search-forward org-keyword-time-not-clock-regexp
- (line-end-position)
- t)
- (match-beginning 0)
- (line-end-position))))))
- ;; If there is nothing more to add and no more keyword
- ;; is left, remove the line completely.
- (if (and (looking-at-p "[ \t]*$") (not what))
- (delete-region (line-beginning-position)
- (line-beginning-position 2))
- ;; If we removed last keyword, do not leave trailing
- ;; white space at the end of line.
- (let ((p (point)))
- (save-excursion
- (end-of-line)
- (unless (= (skip-chars-backward " \t" p) 0)
- (delete-region (point) (line-end-position)))))))
- ((not what) (throw 'exit nil)) ; Nothing to do.
- (t (insert-before-markers "\n")
- (backward-char 1)
- (when org-adapt-indentation
- (indent-to-column (1+ (org-outline-level))))))
- (when what
- ;; Insert planning keyword.
- (insert (cl-case what
- (closed org-closed-string)
- (deadline org-deadline-string)
- (scheduled org-scheduled-string)
- (otherwise (error "Invalid planning type: %s" what)))
- " ")
- ;; Insert associated timestamp.
- (let ((ts (org-insert-time-stamp
- time
- (or org-time-was-given
- (and (eq what 'closed) org-log-done-with-time))
- (eq what 'closed)
- nil nil (list org-end-time-was-given))))
- (unless (eolp) (insert " "))
- ts))))))
- (defvar org-log-note-marker (make-marker)
- "Marker pointing at the entry where the note is to be inserted.")
- (defvar org-log-note-purpose nil)
- (defvar org-log-note-state nil)
- (defvar org-log-note-previous-state nil)
- (defvar org-log-note-extra nil)
- (defvar org-log-note-window-configuration nil)
- (defvar org-log-note-return-to (make-marker))
- (defvar org-log-note-effective-time nil
- "Remembered current time so that dynamically scoped
- `org-extend-today-until' affects timestamps in state change log")
- (defvar org-log-post-message nil
- "Message to be displayed after a log note has been stored.
- The auto-repeater uses this.")
- (defun org-add-note ()
- "Add a note to the current entry.
- This is done in the same way as adding a state change note."
- (interactive)
- (org-add-log-setup 'note))
- (defun org-log-beginning (&optional create)
- "Return expected start of log notes in current entry.
- When optional argument CREATE is non-nil, the function creates
- a drawer to store notes, if necessary. Returned position ignores
- narrowing."
- (org-with-wide-buffer
- (let ((drawer (org-log-into-drawer)))
- (cond
- (drawer
- (org-end-of-meta-data)
- (let ((regexp (concat "^[ \t]*:" (regexp-quote drawer) ":[ \t]*$"))
- (end (if (org-at-heading-p) (point)
- (save-excursion (outline-next-heading) (point))))
- (case-fold-search t))
- (catch 'exit
- ;; Try to find existing drawer.
- (while (re-search-forward regexp end t)
- (let ((element (org-element-at-point)))
- (when (eq (org-element-type element) 'drawer)
- (let ((cend (org-element-property :contents-end element)))
- (when (and (not org-log-states-order-reversed) cend)
- (goto-char cend)))
- (throw 'exit nil))))
- ;; No drawer found. Create one, if permitted.
- (when create
- (unless (bolp) (insert "\n"))
- (let ((beg (point)))
- (insert ":" drawer ":\n:END:\n")
- (org-indent-region beg (point)))
- (end-of-line -1)))))
- (t
- (org-end-of-meta-data org-log-state-notes-insert-after-drawers)
- (skip-chars-forward " \t\n")
- (beginning-of-line)
- (unless org-log-states-order-reversed
- (org-skip-over-state-notes)
- (skip-chars-backward " \t\n")
- (forward-line)))))
- (if (bolp) (point) (line-beginning-position 2))))
- (defun org-add-log-setup (&optional purpose state prev-state how extra)
- "Set up the post command hook to take a note.
- If this is about to TODO state change, the new state is expected in STATE.
- HOW is an indicator what kind of note should be created.
- EXTRA is additional text that will be inserted into the notes buffer."
- (move-marker org-log-note-marker (point))
- (setq org-log-note-purpose purpose
- org-log-note-state state
- org-log-note-previous-state prev-state
- org-log-note-how how
- org-log-note-extra extra
- org-log-note-effective-time (org-current-effective-time))
- (add-hook 'post-command-hook 'org-add-log-note 'append))
- (defun org-skip-over-state-notes ()
- "Skip past the list of State notes in an entry."
- (when (ignore-errors (goto-char (org-in-item-p)))
- (let* ((struct (org-list-struct))
- (prevs (org-list-prevs-alist struct))
- (regexp
- (concat "[ \t]*- +"
- (replace-regexp-in-string
- " +" " +"
- (org-replace-escapes
- (regexp-quote (cdr (assq 'state org-log-note-headings)))
- `(("%d" . ,org-ts-regexp-inactive)
- ("%D" . ,org-ts-regexp)
- ("%s" . "\"\\S-+\"")
- ("%S" . "\"\\S-+\"")
- ("%t" . ,org-ts-regexp-inactive)
- ("%T" . ,org-ts-regexp)
- ("%u" . ".*?")
- ("%U" . ".*?")))))))
- (while (looking-at-p regexp)
- (goto-char (or (org-list-get-next-item (point) struct prevs)
- (org-list-get-item-end (point) struct)))))))
- (defun org-add-log-note (&optional _purpose)
- "Pop up a window for taking a note, and add this note later."
- (remove-hook 'post-command-hook 'org-add-log-note)
- (setq org-log-note-window-configuration (current-window-configuration))
- (delete-other-windows)
- (move-marker org-log-note-return-to (point))
- (pop-to-buffer-same-window (marker-buffer org-log-note-marker))
- (goto-char org-log-note-marker)
- (org-switch-to-buffer-other-window "*Org Note*")
- (erase-buffer)
- (if (memq org-log-note-how '(time state))
- (org-store-log-note)
- (let ((org-inhibit-startup t)) (org-mode))
- (insert (format "# Insert note for %s.
- # Finish with C-c C-c, or cancel with C-c C-k.\n\n"
- (cond
- ((eq org-log-note-purpose 'clock-out) "stopped clock")
- ((eq org-log-note-purpose 'done) "closed todo item")
- ((eq org-log-note-purpose 'state)
- (format "state change from \"%s\" to \"%s\""
- (or org-log-note-previous-state "")
- (or org-log-note-state "")))
- ((eq org-log-note-purpose 'reschedule)
- "rescheduling")
- ((eq org-log-note-purpose 'delschedule)
- "no longer scheduled")
- ((eq org-log-note-purpose 'redeadline)
- "changing deadline")
- ((eq org-log-note-purpose 'deldeadline)
- "removing deadline")
- ((eq org-log-note-purpose 'refile)
- "refiling")
- ((eq org-log-note-purpose 'note)
- "this entry")
- (t (error "This should not happen")))))
- (when org-log-note-extra (insert org-log-note-extra))
- (setq-local org-finish-function 'org-store-log-note)
- (run-hooks 'org-log-buffer-setup-hook)))
- (defvar org-note-abort nil) ; dynamically scoped
- (defun org-store-log-note ()
- "Finish taking a log note, and insert it to where it belongs."
- (let ((txt (prog1 (buffer-string)
- (kill-buffer)))
- (note (cdr (assq org-log-note-purpose org-log-note-headings)))
- lines)
- (while (string-match "\\`# .*\n[ \t\n]*" txt)
- (setq txt (replace-match "" t t txt)))
- (when (string-match "\\s-+\\'" txt)
- (setq txt (replace-match "" t t txt)))
- (setq lines (org-split-string txt "\n"))
- (when (org-string-nw-p note)
- (setq note
- (org-replace-escapes
- note
- (list (cons "%u" (user-login-name))
- (cons "%U" user-full-name)
- (cons "%t" (format-time-string
- (org-time-stamp-format 'long 'inactive)
- org-log-note-effective-time))
- (cons "%T" (format-time-string
- (org-time-stamp-format 'long nil)
- org-log-note-effective-time))
- (cons "%d" (format-time-string
- (org-time-stamp-format nil 'inactive)
- org-log-note-effective-time))
- (cons "%D" (format-time-string
- (org-time-stamp-format nil nil)
- org-log-note-effective-time))
- (cons "%s" (cond
- ((not org-log-note-state) "")
- ((string-match-p org-ts-regexp
- org-log-note-state)
- (format "\"[%s]\""
- (substring org-log-note-state 1 -1)))
- (t (format "\"%s\"" org-log-note-state))))
- (cons "%S"
- (cond
- ((not org-log-note-previous-state) "")
- ((string-match-p org-ts-regexp
- org-log-note-previous-state)
- (format "\"[%s]\""
- (substring
- org-log-note-previous-state 1 -1)))
- (t (format "\"%s\""
- org-log-note-previous-state)))))))
- (when lines (setq note (concat note " \\\\")))
- (push note lines))
- (when (and lines (not org-note-abort))
- (with-current-buffer (marker-buffer org-log-note-marker)
- (org-with-wide-buffer
- ;; Find location for the new note.
- (goto-char org-log-note-marker)
- (set-marker org-log-note-marker nil)
- ;; Note associated to a clock is to be located right after
- ;; the clock. Do not move point.
- (unless (eq org-log-note-purpose 'clock-out)
- (goto-char (org-log-beginning t)))
- ;; Make sure point is at the beginning of an empty line.
- (cond ((not (bolp)) (let ((inhibit-read-only t)) (insert "\n")))
- ((looking-at "[ \t]*\\S-") (save-excursion (insert "\n"))))
- ;; In an existing list, add a new item at the top level.
- ;; Otherwise, indent line like a regular one.
- (let ((itemp (org-in-item-p)))
- (if itemp
- (indent-line-to
- (let ((struct (save-excursion
- (goto-char itemp) (org-list-struct))))
- (org-list-get-ind (org-list-get-top-point struct) struct)))
- (org-indent-line)))
- (insert (org-list-bullet-string "-") (pop lines))
- (let ((ind (org-list-item-body-column (line-beginning-position))))
- (dolist (line lines)
- (insert "\n")
- (indent-line-to ind)
- (insert line)))
- (message "Note stored")
- (org-back-to-heading t)
- (org-cycle-hide-drawers 'children))
- ;; Fix `buffer-undo-list' when `org-store-log-note' is called
- ;; from within `org-add-log-note' because `buffer-undo-list'
- ;; is then modified outside of `org-with-remote-undo'.
- (when (eq this-command 'org-agenda-todo)
- (setcdr buffer-undo-list (cddr buffer-undo-list))))))
- ;; Don't add undo information when called from `org-agenda-todo'.
- (let ((buffer-undo-list (eq this-command 'org-agenda-todo)))
- (set-window-configuration org-log-note-window-configuration)
- (with-current-buffer (marker-buffer org-log-note-return-to)
- (goto-char org-log-note-return-to))
- (move-marker org-log-note-return-to nil)
- (when org-log-post-message (message "%s" org-log-post-message))))
- (defun org-remove-empty-drawer-at (pos)
- "Remove an empty drawer at position POS.
- POS may also be a marker."
- (with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer))
- (org-with-wide-buffer
- (goto-char pos)
- (let ((drawer (org-element-at-point)))
- (when (and (memq (org-element-type drawer) '(drawer property-drawer))
- (not (org-element-property :contents-begin drawer)))
- (delete-region (org-element-property :begin drawer)
- (progn (goto-char (org-element-property :end drawer))
- (skip-chars-backward " \r\t\n")
- (forward-line)
- (point))))))))
- (defvar org-ts-type nil)
- (defun org-sparse-tree (&optional arg type)
- "Create a sparse tree, prompt for the details.
- This command can create sparse trees. You first need to select the type
- of match used to create the tree:
- t Show all TODO entries.
- T Show entries with a specific TODO keyword.
- m Show entries selected by a tags/property match.
- p Enter a property name and its value (both with completion on existing
- names/values) and show entries with that property.
- r Show entries matching a regular expression (`/' can be used as well).
- b Show deadlines and scheduled items before a date.
- a Show deadlines and scheduled items after a date.
- d Show deadlines due within `org-deadline-warning-days'.
- D Show deadlines and scheduled items between a date range."
- (interactive "P")
- (setq type (or type org-sparse-tree-default-date-type))
- (setq org-ts-type type)
- (message "Sparse tree: [r]egexp [t]odo [T]odo-kwd [m]atch [p]roperty
- \[d]eadlines [b]efore-date [a]fter-date [D]ates range
- \[c]ycle through date types: %s"
- (cl-case type
- (all "all timestamps")
- (scheduled "only scheduled")
- (deadline "only deadline")
- (active "only active timestamps")
- (inactive "only inactive timestamps")
- (closed "with a closed time-stamp")
- (otherwise "scheduled/deadline")))
- (let ((answer (read-char-exclusive)))
- (cl-case answer
- (?c
- (org-sparse-tree
- arg
- (cadr
- (memq type '(nil all scheduled deadline active inactive closed)))))
- (?d (call-interactively 'org-check-deadlines))
- (?b (call-interactively 'org-check-before-date))
- (?a (call-interactively 'org-check-after-date))
- (?D (call-interactively 'org-check-dates-range))
- (?t (call-interactively 'org-show-todo-tree))
- (?T (org-show-todo-tree '(4)))
- (?m (call-interactively 'org-match-sparse-tree))
- ((?p ?P)
- (let* ((kwd (completing-read
- "Property: " (mapcar #'list (org-buffer-property-keys))))
- (value (completing-read
- "Value: " (mapcar #'list (org-property-values kwd)))))
- (unless (string-match "\\`{.*}\\'" value)
- (setq value (concat "\"" value "\"")))
- (org-match-sparse-tree arg (concat kwd "=" value))))
- ((?r ?R ?/) (call-interactively 'org-occur))
- (otherwise (user-error "No such sparse tree command \"%c\"" answer)))))
- (defvar-local org-occur-highlights nil
- "List of overlays used for occur matches.")
- (defvar-local org-occur-parameters nil
- "Parameters of the active org-occur calls.
- This is a list, each call to org-occur pushes as cons cell,
- containing the regular expression and the callback, onto the list.
- The list can contain several entries if `org-occur' has been called
- several time with the KEEP-PREVIOUS argument. Otherwise, this list
- will only contain one set of parameters. When the highlights are
- removed (for example with `C-c C-c', or with the next edit (depending
- on `org-remove-highlights-with-change'), this variable is emptied
- as well.")
- (defun org-occur (regexp &optional keep-previous callback)
- "Make a compact tree which shows all matches of REGEXP.
- The tree will show the lines where the regexp matches, and any other context
- defined in `org-show-context-detail', which see.
- When optional argument KEEP-PREVIOUS is non-nil, highlighting and exposing
- done by a previous call to `org-occur' will be kept, to allow stacking of
- calls to this command.
- Optional argument CALLBACK can be a function of no argument. In this case,
- it is called with point at the end of the match, match data being set
- accordingly. Current match is shown only if the return value is non-nil.
- The function must neither move point nor alter narrowing."
- (interactive "sRegexp: \nP")
- (when (equal regexp "")
- (user-error "Regexp cannot be empty"))
- (unless keep-previous
- (org-remove-occur-highlights nil nil t))
- (push (cons regexp callback) org-occur-parameters)
- (let ((cnt 0))
- (save-excursion
- (goto-char (point-min))
- (when (or (not keep-previous) ; do not want to keep
- (not org-occur-highlights)) ; no previous matches
- ;; hide everything
- (org-overview))
- (let ((case-fold-search (if (eq org-occur-case-fold-search 'smart)
- (isearch-no-upper-case-p regexp t)
- org-occur-case-fold-search)))
- (while (re-search-forward regexp nil t)
- (when (or (not callback)
- (save-match-data (funcall callback)))
- (setq cnt (1+ cnt))
- (when org-highlight-sparse-tree-matches
- (org-highlight-new-match (match-beginning 0) (match-end 0)))
- (org-show-context 'occur-tree)))))
- (when org-remove-highlights-with-change
- (add-hook 'before-change-functions 'org-remove-occur-highlights
- nil 'local))
- (unless org-sparse-tree-open-archived-trees
- (org-hide-archived-subtrees (point-min) (point-max)))
- (run-hooks 'org-occur-hook)
- (when (called-interactively-p 'interactive)
- (message "%d match(es) for regexp %s" cnt regexp))
- cnt))
- (defun org-occur-next-match (&optional n _reset)
- "Function for `next-error-function' to find sparse tree matches.
- N is the number of matches to move, when negative move backwards.
- This function always goes back to the starting point when no
- match is found."
- (let* ((limit (if (< n 0) (point-min) (point-max)))
- (search-func (if (< n 0)
- 'previous-single-char-property-change
- 'next-single-char-property-change))
- (n (abs n))
- (pos (point))
- p1)
- (catch 'exit
- (while (setq p1 (funcall search-func (point) 'org-type))
- (when (equal p1 limit)
- (goto-char pos)
- (user-error "No more matches"))
- (when (equal (get-char-property p1 'org-type) 'org-occur)
- (setq n (1- n))
- (when (= n 0)
- (goto-char p1)
- (throw 'exit (point))))
- (goto-char p1))
- (goto-char p1)
- (user-error "No more matches"))))
- (defun org-show-context (&optional key)
- "Make sure point and context are visible.
- Optional argument KEY, when non-nil, is a symbol. See
- `org-show-context-detail' for allowed values and how much is to
- be shown."
- (org-show-set-visibility
- (cond ((symbolp org-show-context-detail) org-show-context-detail)
- ((cdr (assq key org-show-context-detail)))
- (t (cdr (assq 'default org-show-context-detail))))))
- (defun org-show-set-visibility (detail)
- "Set visibility around point according to DETAIL.
- DETAIL is either nil, `minimal', `local', `ancestors', `lineage',
- `tree', `canonical' or t. See `org-show-context-detail' for more
- information."
- ;; Show current heading and possibly its entry, following headline
- ;; or all children.
- (if (and (org-at-heading-p) (not (eq detail 'local)))
- (org-flag-heading nil)
- (org-show-entry)
- ;; If point is hidden within a drawer or a block, make sure to
- ;; expose it.
- (dolist (o (overlays-at (point)))
- (when (memq (overlay-get o 'invisible) '(org-hide-block outline))
- (delete-overlay o)))
- (unless (org-before-first-heading-p)
- (org-with-limited-levels
- (cl-case detail
- ((tree canonical t) (org-show-children))
- ((nil minimal ancestors))
- (t (save-excursion
- (outline-next-heading)
- (org-flag-heading nil)))))))
- ;; Show all siblings.
- (when (eq detail 'lineage) (org-show-siblings))
- ;; Show ancestors, possibly with their children.
- (when (memq detail '(ancestors lineage tree canonical t))
- (save-excursion
- (while (org-up-heading-safe)
- (org-flag-heading nil)
- (when (memq detail '(canonical t)) (org-show-entry))
- (when (memq detail '(tree canonical t)) (org-show-children))))))
- (defvar org-reveal-start-hook nil
- "Hook run before revealing a location.")
- (defun org-reveal (&optional siblings)
- "Show current entry, hierarchy above it, and the following headline.
- This can be used to show a consistent set of context around
- locations exposed with `org-show-context'.
- With optional argument SIBLINGS, on each level of the hierarchy all
- siblings are shown. This repairs the tree structure to what it would
- look like when opened with hierarchical calls to `org-cycle'.
- With a \\[universal-argument] \\[universal-argument] prefix, \
- go to the parent and show the entire tree."
- (interactive "P")
- (run-hooks 'org-reveal-start-hook)
- (cond ((equal siblings '(4)) (org-show-set-visibility 'canonical))
- ((equal siblings '(16))
- (save-excursion
- (when (org-up-heading-safe)
- (org-show-subtree)
- (run-hook-with-args 'org-cycle-hook 'subtree))))
- (t (org-show-set-visibility 'lineage))))
- (defun org-highlight-new-match (beg end)
- "Highlight from BEG to END and mark the highlight is an occur headline."
- (let ((ov (make-overlay beg end)))
- (overlay-put ov 'face 'secondary-selection)
- (overlay-put ov 'org-type 'org-occur)
- (push ov org-occur-highlights)))
- (defun org-remove-occur-highlights (&optional _beg _end noremove)
- "Remove the occur highlights from the buffer.
- BEG and END are ignored. If NOREMOVE is nil, remove this function
- from the `before-change-functions' in the current buffer."
- (interactive)
- (unless org-inhibit-highlight-removal
- (mapc #'delete-overlay org-occur-highlights)
- (setq org-occur-highlights nil)
- (setq org-occur-parameters nil)
- (unless noremove
- (remove-hook 'before-change-functions
- 'org-remove-occur-highlights 'local))))
- ;;;; Priorities
- (defvar org-priority-regexp ".*?\\(\\[#\\([A-Z0-9]\\)\\] ?\\)"
- "Regular expression matching the priority indicator.")
- (defvar org-remove-priority-next-time nil)
- (defun org-priority-up ()
- "Increase the priority of the current item."
- (interactive)
- (org-priority 'up))
- (defun org-priority-down ()
- "Decrease the priority of the current item."
- (interactive)
- (org-priority 'down))
- (defun org-priority (&optional action _show)
- "Change the priority of an item.
- ACTION can be `set', `up', `down', or a character."
- (interactive "P")
- (if (equal action '(4))
- (org-show-priority)
- (unless org-enable-priority-commands
- (user-error "Priority commands are disabled"))
- (setq action (or action 'set))
- (let (current new news have remove)
- (save-excursion
- (org-back-to-heading t)
- (when (looking-at org-priority-regexp)
- (setq current (string-to-char (match-string 2))
- have t))
- (cond
- ((eq action 'remove)
- (setq remove t new ?\ ))
- ((or (eq action 'set)
- (integerp action))
- (if (not (eq action 'set))
- (setq new action)
- (message "Priority %c-%c, SPC to remove: "
- org-highest-priority org-lowest-priority)
- (save-match-data
- (setq new (read-char-exclusive))))
- (when (and (= (upcase org-highest-priority) org-highest-priority)
- (= (upcase org-lowest-priority) org-lowest-priority))
- (setq new (upcase new)))
- (cond ((equal new ?\ ) (setq remove t))
- ((or (< (upcase new) org-highest-priority) (> (upcase new) org-lowest-priority))
- (user-error "Priority must be between `%c' and `%c'"
- org-highest-priority org-lowest-priority))))
- ((eq action 'up)
- (setq new (if have
- (1- current) ; normal cycling
- ;; last priority was empty
- (if (eq last-command this-command)
- org-lowest-priority ; wrap around empty to lowest
- ;; default
- (if org-priority-start-cycle-with-default
- org-default-priority
- (1- org-default-priority))))))
- ((eq action 'down)
- (setq new (if have
- (1+ current) ; normal cycling
- ;; last priority was empty
- (if (eq last-command this-command)
- org-highest-priority ; wrap around empty to highest
- ;; default
- (if org-priority-start-cycle-with-default
- org-default-priority
- (1+ org-default-priority))))))
- (t (user-error "Invalid action")))
- (when (or (< (upcase new) org-highest-priority)
- (> (upcase new) org-lowest-priority))
- (if (and (memq action '(up down))
- (not have) (not (eq last-command this-command)))
- ;; `new' is from default priority
- (error
- "The default can not be set, see `org-default-priority' why")
- ;; normal cycling: `new' is beyond highest/lowest priority
- ;; and is wrapped around to the empty priority
- (setq remove t)))
- (setq news (format "%c" new))
- (if have
- (if remove
- (replace-match "" t t nil 1)
- (replace-match news t t nil 2))
- (if remove
- (user-error "No priority cookie found in line")
- (let ((case-fold-search nil)) (looking-at org-todo-line-regexp))
- (if (match-end 2)
- (progn
- (goto-char (match-end 2))
- (insert " [#" news "]"))
- (goto-char (match-beginning 3))
- (insert "[#" news "] "))))
- (org-set-tags nil 'align))
- (if remove
- (message "Priority removed")
- (message "Priority of current item set to %s" news)))))
- (defun org-show-priority ()
- "Show the priority of the current item.
- This priority is composed of the main priority given with the [#A] cookies,
- and by additional input from the age of a schedules or deadline entry."
- (interactive)
- (let ((pri (if (eq major-mode 'org-agenda-mode)
- (org-get-at-bol 'priority)
- (save-excursion
- (save-match-data
- (beginning-of-line)
- (and (looking-at org-heading-regexp)
- (org-get-priority (match-string 0))))))))
- (message "Priority is %d" (if pri pri -1000))))
- (defun org-get-priority (s)
- "Find priority cookie and return priority."
- (save-match-data
- (if (functionp org-get-priority-function)
- (funcall org-get-priority-function)
- (if (not (string-match org-priority-regexp s))
- (* 1000 (- org-lowest-priority org-default-priority))
- (* 1000 (- org-lowest-priority
- (string-to-char (match-string 2 s))))))))
- ;;;; Tags
- (defvar org-agenda-archives-mode)
- (defvar org-map-continue-from nil
- "Position from where mapping should continue.
- Can be set by the action argument to `org-scan-tags' and `org-map-entries'.")
- (defvar org-scanner-tags nil
- "The current tag list while the tags scanner is running.")
- (defvar org-trust-scanner-tags nil
- "Should `org-get-tags-at' use the tags for the scanner.
- This is for internal dynamical scoping only.
- When this is non-nil, the function `org-get-tags-at' will return the value
- of `org-scanner-tags' instead of building the list by itself. This
- can lead to large speed-ups when the tags scanner is used in a file with
- many entries, and when the list of tags is retrieved, for example to
- obtain a list of properties. Building the tags list for each entry in such
- a file becomes an N^2 operation - but with this variable set, it scales
- as N.")
- (defvar org--matcher-tags-todo-only nil)
- (defun org-scan-tags (action matcher todo-only &optional start-level)
- "Scan headline tags with inheritance and produce output ACTION.
- ACTION can be `sparse-tree' to produce a sparse tree in the current buffer,
- or `agenda' to produce an entry list for an agenda view. It can also be
- a Lisp form or a function that should be called at each matched headline, in
- this case the return value is a list of all return values from these calls.
- MATCHER is a function accepting three arguments, returning
- a non-nil value whenever a given set of tags qualifies a headline
- for inclusion. See `org-make-tags-matcher' for more information.
- As a special case, it can also be set to t (respectively nil) in
- order to match all (respectively none) headline.
- When TODO-ONLY is non-nil, only lines with a not-done TODO
- keyword are included in the output.
- START-LEVEL can be a string with asterisks, reducing the scope to
- headlines matching this string."
- (require 'org-agenda)
- (let* ((re (concat "^"
- (if start-level
- ;; Get the correct level to match
- (concat "\\*\\{" (number-to-string start-level) "\\} ")
- org-outline-regexp)
- " *\\(\\<\\("
- (mapconcat #'regexp-quote org-todo-keywords-1 "\\|")
- "\\)\\>\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$"))
- (props (list 'face 'default
- 'done-face 'org-agenda-done
- 'undone-face 'default
- 'mouse-face 'highlight
- 'org-not-done-regexp org-not-done-regexp
- 'org-todo-regexp org-todo-regexp
- 'org-complex-heading-regexp org-complex-heading-regexp
- 'help-echo
- (format "mouse-2 or RET jump to org file %s"
- (abbreviate-file-name
- (or (buffer-file-name (buffer-base-buffer))
- (buffer-name (buffer-base-buffer)))))))
- (org-map-continue-from nil)
- lspos tags tags-list
- (tags-alist (list (cons 0 org-file-tags)))
- (llast 0) rtn rtn1 level category i txt
- todo marker entry priority
- ts-date ts-date-type ts-date-pair)
- (unless (or (member action '(agenda sparse-tree)) (functionp action))
- (setq action (list 'lambda nil action)))
- (save-excursion
- (goto-char (point-min))
- (when (eq action 'sparse-tree)
- (org-overview)
- (org-remove-occur-highlights))
- (while (let (case-fold-search)
- (re-search-forward re nil t))
- (setq org-map-continue-from nil)
- (catch :skip
- (setq todo
- ;; TODO: is the 1-2 difference a bug?
- (when (match-end 1) (match-string-no-properties 2))
- tags (when (match-end 4) (match-string-no-properties 4)))
- (goto-char (setq lspos (match-beginning 0)))
- (setq level (org-reduced-level (org-outline-level))
- category (org-get-category))
- (when (eq action 'agenda)
- (setq ts-date-pair (org-agenda-entry-get-agenda-timestamp (point))
- ts-date (car ts-date-pair)
- ts-date-type (cdr ts-date-pair)))
- (setq i llast llast level)
- ;; remove tag lists from same and sublevels
- (while (>= i level)
- (when (setq entry (assoc i tags-alist))
- (setq tags-alist (delete entry tags-alist)))
- (setq i (1- i)))
- ;; add the next tags
- (when tags
- (setq tags (org-split-string tags ":")
- tags-alist
- (cons (cons level tags) tags-alist)))
- ;; compile tags for current headline
- (setq tags-list
- (if org-use-tag-inheritance
- (apply 'append (mapcar 'cdr (reverse tags-alist)))
- tags)
- org-scanner-tags tags-list)
- (when org-use-tag-inheritance
- (setcdr (car tags-alist)
- (mapcar (lambda (x)
- (setq x (copy-sequence x))
- (org-add-prop-inherited x))
- (cdar tags-alist))))
- (when (and tags org-use-tag-inheritance
- (or (not (eq t org-use-tag-inheritance))
- org-tags-exclude-from-inheritance))
- ;; Selective inheritance, remove uninherited ones.
- (setcdr (car tags-alist)
- (org-remove-uninherited-tags (cdar tags-alist))))
- (when (and
- ;; eval matcher only when the todo condition is OK
- (and (or (not todo-only) (member todo org-not-done-keywords))
- (if (functionp matcher)
- (let ((case-fold-search t) (org-trust-scanner-tags t))
- (funcall matcher todo tags-list level))
- matcher))
- ;; Call the skipper, but return t if it does not
- ;; skip, so that the `and' form continues evaluating.
- (progn
- (unless (eq action 'sparse-tree) (org-agenda-skip))
- t)
- ;; Check if timestamps are deselecting this entry
- (or (not todo-only)
- (and (member todo org-not-done-keywords)
- (or (not org-agenda-tags-todo-honor-ignore-options)
- (not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item))))))
- ;; select this headline
- (cond
- ((eq action 'sparse-tree)
- (and org-highlight-sparse-tree-matches
- (org-get-heading) (match-end 0)
- (org-highlight-new-match
- (match-beginning 1) (match-end 1)))
- (org-show-context 'tags-tree))
- ((eq action 'agenda)
- (setq txt (org-agenda-format-item
- ""
- (concat
- (if (eq org-tags-match-list-sublevels 'indented)
- (make-string (1- level) ?.) "")
- (org-get-heading))
- (make-string level ?\s)
- category
- tags-list)
- priority (org-get-priority txt))
- (goto-char lspos)
- (setq marker (org-agenda-new-marker))
- (org-add-props txt props
- 'org-marker marker 'org-hd-marker marker 'org-category category
- 'todo-state todo
- 'ts-date ts-date
- 'priority priority
- 'type (concat "tagsmatch" ts-date-type))
- (push txt rtn))
- ((functionp action)
- (setq org-map-continue-from nil)
- (save-excursion
- (setq rtn1 (funcall action))
- (push rtn1 rtn)))
- (t (user-error "Invalid action")))
- ;; if we are to skip sublevels, jump to end of subtree
- (unless org-tags-match-list-sublevels
- (org-end-of-subtree t)
- (backward-char 1))))
- ;; Get the correct position from where to continue
- (if org-map-continue-from
- (goto-char org-map-continue-from)
- (and (= (point) lspos) (end-of-line 1)))))
- (when (and (eq action 'sparse-tree)
- (not org-sparse-tree-open-archived-trees))
- (org-hide-archived-subtrees (point-min) (point-max)))
- (nreverse rtn)))
- (defun org-remove-uninherited-tags (tags)
- "Remove all tags that are not inherited from the list TAGS."
- (cond
- ((eq org-use-tag-inheritance t)
- (if org-tags-exclude-from-inheritance
- (org-delete-all org-tags-exclude-from-inheritance tags)
- tags))
- ((not org-use-tag-inheritance) nil)
- ((stringp org-use-tag-inheritance)
- (delq nil (mapcar
- (lambda (x)
- (if (and (string-match org-use-tag-inheritance x)
- (not (member x org-tags-exclude-from-inheritance)))
- x nil))
- tags)))
- ((listp org-use-tag-inheritance)
- (delq nil (mapcar
- (lambda (x)
- (if (member x org-use-tag-inheritance) x nil))
- tags)))))
- (defun org-match-sparse-tree (&optional todo-only match)
- "Create a sparse tree according to tags string MATCH.
- MATCH is a string with match syntax. It can contain a selection
- of tags (\"+work+urgent-boss\"), properties (\"LEVEL>3\"), and
- TODO keywords (\"TODO=\\\"WAITING\\\"\") or a combination of
- those. See the manual for details.
- If optional argument TODO-ONLY is non-nil, only select lines that
- are also TODO tasks."
- (interactive "P")
- (org-agenda-prepare-buffers (list (current-buffer)))
- (let ((org--matcher-tags-todo-only todo-only))
- (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match))
- org--matcher-tags-todo-only)))
- (defalias 'org-tags-sparse-tree 'org-match-sparse-tree)
- (defvar org-cached-props nil)
- (defun org-cached-entry-get (pom property)
- (if (or (eq t org-use-property-inheritance)
- (and (stringp org-use-property-inheritance)
- (let ((case-fold-search t))
- (string-match-p org-use-property-inheritance property)))
- (and (listp org-use-property-inheritance)
- (member-ignore-case property org-use-property-inheritance)))
- ;; Caching is not possible, check it directly.
- (org-entry-get pom property 'inherit)
- ;; Get all properties, so we can do complicated checks easily.
- (cdr (assoc-string property
- (or org-cached-props
- (setq org-cached-props (org-entry-properties pom)))
- t))))
- (defun org-global-tags-completion-table (&optional files)
- "Return the list of all tags in all agenda buffer/files.
- Optional FILES argument is a list of files which can be used
- instead of the agenda files."
- (save-excursion
- (org-uniquify
- (delq nil
- (apply #'append
- (mapcar
- (lambda (file)
- (set-buffer (find-file-noselect file))
- (mapcar (lambda (x)
- (and (stringp (car-safe x))
- (list (car-safe x))))
- (or org-current-tag-alist (org-get-buffer-tags))))
- (if (car-safe files) files
- (org-agenda-files))))))))
- (defun org-make-tags-matcher (match)
- "Create the TAGS/TODO matcher form for the selection string MATCH.
- Returns a cons of the selection string MATCH and a function
- implementing the matcher.
- The matcher is to be called at an Org entry, with point on the
- headline, and returns non-nil if the entry matches the selection
- string MATCH. It must be called with three arguments: the TODO
- keyword at the entry (or nil if none), the list of all tags at
- the entry including inherited ones and the reduced level of the
- headline. Additionally, the category of the entry, if any, must
- be specified as the text property `org-category' on the headline.
- This function sets the variable `org--matcher-tags-todo-only' to
- a non-nil value if the matcher restricts matching to TODO
- entries, otherwise it is not touched.
- See also `org-scan-tags'."
- (unless match
- ;; Get a new match request, with completion against the global
- ;; tags table and the local tags in current buffer.
- (let ((org-last-tags-completion-table
- (org-uniquify
- (delq nil (append (org-get-buffer-tags)
- (org-global-tags-completion-table))))))
- (setq match
- (completing-read
- "Match: "
- 'org-tags-completion-function nil nil nil 'org-tags-history))))
- (let ((match0 match)
- (re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@#%]+\\)")
- (start 0)
- tagsmatch todomatch tagsmatcher todomatcher)
- ;; Expand group tags.
- (setq match (org-tags-expand match))
- ;; Check if there is a TODO part of this match, which would be the
- ;; part after a "/". To make sure that this slash is not part of
- ;; a property value to be matched against, we also check that
- ;; there is no / after that slash. First, find the last slash.
- (let ((s 0))
- (while (string-match "/+" match s)
- (setq start (match-beginning 0))
- (setq s (match-end 0))))
- (if (and (string-match "/+" match start)
- (not (string-match-p "\"" match start)))
- ;; Match contains also a TODO-matching request.
- (progn
- (setq tagsmatch (substring match 0 (match-beginning 0)))
- (setq todomatch (substring match (match-end 0)))
- (when (string-prefix-p "!" todomatch)
- (setq org--matcher-tags-todo-only t)
- (setq todomatch (substring todomatch 1)))
- (when (string-match "\\`\\s-*\\'" todomatch)
- (setq todomatch nil)))
- ;; Only matching tags.
- (setq tagsmatch match)
- (setq todomatch nil))
- ;; Make the tags matcher.
- (when (org-string-nw-p tagsmatch)
- (let ((orlist nil)
- (orterms (org-split-string tagsmatch "|"))
- term)
- (while (setq term (pop orterms))
- (while (and (equal (substring term -1) "\\") orterms)
- (setq term (concat term "|" (pop orterms)))) ;repair bad split.
- (while (string-match re term)
- (let* ((rest (substring term (match-end 0)))
- (minus (and (match-end 1)
- (equal (match-string 1 term) "-")))
- (tag (save-match-data
- (replace-regexp-in-string
- "\\\\-" "-" (match-string 2 term))))
- (regexp (eq (string-to-char tag) ?{))
- (levelp (match-end 4))
- (propp (match-end 5))
- (mm
- (cond
- (regexp `(org-match-any-p ,(substring tag 1 -1) tags-list))
- (levelp
- `(,(org-op-to-function (match-string 3 term))
- level
- ,(string-to-number (match-string 4 term))))
- (propp
- (let* ((gv (pcase (upcase (match-string 5 term))
- ("CATEGORY"
- '(get-text-property (point) 'org-category))
- ("TODO" 'todo)
- (p `(org-cached-entry-get nil ,p))))
- (pv (match-string 7 term))
- (regexp (eq (string-to-char pv) ?{))
- (strp (eq (string-to-char pv) ?\"))
- (timep (string-match-p "^\"[[<].*[]>]\"$" pv))
- (po (org-op-to-function (match-string 6 term)
- (if timep 'time strp))))
- (setq pv (if (or regexp strp) (substring pv 1 -1) pv))
- (when timep (setq pv (org-matcher-time pv)))
- (cond ((and regexp (eq po 'org<>))
- `(not (string-match ,pv (or ,gv ""))))
- (regexp `(string-match ,pv (or ,gv "")))
- (strp `(,po (or ,gv "") ,pv))
- (t
- `(,po
- (string-to-number (or ,gv ""))
- ,(string-to-number pv))))))
- (t `(member ,tag tags-list)))))
- (push (if minus `(not ,mm) mm) tagsmatcher)
- (setq term rest)))
- (push `(and ,@tagsmatcher) orlist)
- (setq tagsmatcher nil))
- (setq tagsmatcher `(progn (setq org-cached-props nil) (or ,@orlist)))))
- ;; Make the TODO matcher.
- (when (org-string-nw-p todomatch)
- (let ((orlist nil))
- (dolist (term (org-split-string todomatch "|"))
- (while (string-match re term)
- (let* ((minus (and (match-end 1)
- (equal (match-string 1 term) "-")))
- (kwd (match-string 2 term))
- (regexp (eq (string-to-char kwd) ?{))
- (mm (if regexp `(string-match ,(substring kwd 1 -1) todo)
- `(equal todo ,kwd))))
- (push (if minus `(not ,mm) mm) todomatcher))
- (setq term (substring term (match-end 0))))
- (push (if (> (length todomatcher) 1)
- (cons 'and todomatcher)
- (car todomatcher))
- orlist)
- (setq todomatcher nil))
- (setq todomatcher (cons 'or orlist))))
- ;; Return the string and function of the matcher. If no
- ;; tags-specific or todo-specific matcher exists, match
- ;; everything.
- (let ((matcher (if (and tagsmatcher todomatcher)
- `(and ,tagsmatcher ,todomatcher)
- (or tagsmatcher todomatcher t))))
- (when org--matcher-tags-todo-only
- (setq matcher `(and (member todo org-not-done-keywords) ,matcher)))
- (cons match0 `(lambda (todo tags-list level) ,matcher)))))
- (defun org-tags-expand (match &optional single-as-list downcased tags-already-expanded)
- "Expand group tags in MATCH.
- This replaces every group tag in MATCH with a regexp tag search.
- For example, a group tag \"Work\" defined as { Work : Lab Conf }
- will be replaced like this:
- Work => {\\<\\(?:Work\\|Lab\\|Conf\\)\\>}
- +Work => +{\\<\\(?:Work\\|Lab\\|Conf\\)\\>}
- -Work => -{\\<\\(?:Work\\|Lab\\|Conf\\)\\>}
- Replacing by a regexp preserves the structure of the match.
- E.g., this expansion
- Work|Home => {\\(?:Work\\|Lab\\|Conf\\}|Home
- will match anything tagged with \"Lab\" and \"Home\", or tagged
- with \"Conf\" and \"Home\" or tagged with \"Work\" and \"home\".
- A group tag in MATCH can contain regular expressions of its own.
- For example, a group tag \"Proj\" defined as { Proj : {P@.+} }
- will be replaced like this:
- Proj => {\\<\\(?:Proj\\)\\>\\|P@.+}
- When the optional argument SINGLE-AS-LIST is non-nil, MATCH is
- assumed to be a single group tag, and the function will return
- the list of tags in this group.
- When DOWNCASE is non-nil, expand downcased TAGS."
- (if org-group-tags
- (let* ((case-fold-search t)
- (stable org-mode-syntax-table)
- (taggroups (or org-tag-groups-alist-for-agenda org-tag-groups-alist))
- (taggroups (if downcased
- (mapcar (lambda (tg) (mapcar #'downcase tg))
- taggroups)
- taggroups))
- (taggroups-keys (mapcar #'car taggroups))
- (return-match (if downcased (downcase match) match))
- (count 0)
- (work-already-expanded tags-already-expanded)
- regexps-in-match tags-in-group regexp-in-group regexp-in-group-escaped)
- ;; @ and _ are allowed as word-components in tags.
- (modify-syntax-entry ?@ "w" stable)
- (modify-syntax-entry ?_ "w" stable)
- ;; Temporarily replace regexp-expressions in the match-expression.
- (while (string-match "{.+?}" return-match)
- (cl-incf count)
- (push (match-string 0 return-match) regexps-in-match)
- (setq return-match (replace-match (format "<%d>" count) t nil return-match)))
- (while (and taggroups-keys
- (with-syntax-table stable
- (string-match
- (concat "\\(?1:[+-]?\\)\\(?2:\\<"
- (regexp-opt taggroups-keys) "\\>\\)")
- return-match)))
- (let* ((dir (match-string 1 return-match))
- (tag (match-string 2 return-match))
- (tag (if downcased (downcase tag) tag)))
- (unless (or (get-text-property 0 'grouptag (match-string 2 return-match))
- (member tag work-already-expanded))
- (setq tags-in-group (assoc tag taggroups))
- (push tag work-already-expanded)
- ;; Recursively expand each tag in the group, if the tag hasn't
- ;; already been expanded. Restore the match-data after all recursive calls.
- (save-match-data
- (let (tags-expanded)
- (dolist (x (cdr tags-in-group))
- (if (and (member x taggroups-keys)
- (not (member x work-already-expanded)))
- (setq tags-expanded
- (delete-dups
- (append
- (org-tags-expand x t downcased
- work-already-expanded)
- tags-expanded)))
- (setq tags-expanded
- (append (list x) tags-expanded)))
- (setq work-already-expanded
- (delete-dups
- (append tags-expanded
- work-already-expanded))))
- (setq tags-in-group
- (delete-dups (cons (car tags-in-group)
- tags-expanded)))))
- ;; Filter tag-regexps from tags.
- (setq regexp-in-group-escaped
- (delq nil (mapcar (lambda (x)
- (if (stringp x)
- (and (equal "{" (substring x 0 1))
- (equal "}" (substring x -1))
- x)
- x))
- tags-in-group))
- regexp-in-group
- (mapcar (lambda (x)
- (substring x 1 -1))
- regexp-in-group-escaped)
- tags-in-group
- (delq nil (mapcar (lambda (x)
- (if (stringp x)
- (and (not (equal "{" (substring x 0 1)))
- (not (equal "}" (substring x -1)))
- x)
- x))
- tags-in-group)))
- ;; If single-as-list, do no more in the while-loop.
- (if (not single-as-list)
- (progn
- (when regexp-in-group
- (setq regexp-in-group
- (concat "\\|"
- (mapconcat 'identity regexp-in-group
- "\\|"))))
- (setq tags-in-group
- (concat dir
- "{\\<"
- (regexp-opt tags-in-group)
- "\\>"
- regexp-in-group
- "}"))
- (when (stringp tags-in-group)
- (org-add-props tags-in-group '(grouptag t)))
- (setq return-match
- (replace-match tags-in-group t t return-match)))
- (setq tags-in-group
- (append regexp-in-group-escaped tags-in-group))))
- (setq taggroups-keys (delete tag taggroups-keys))))
- ;; Add the regular expressions back into the match-expression again.
- (while regexps-in-match
- (setq return-match (replace-regexp-in-string (format "<%d>" count)
- (pop regexps-in-match)
- return-match t t))
- (cl-decf count))
- (if single-as-list
- (if tags-in-group tags-in-group (list return-match))
- return-match))
- (if single-as-list
- (list (if downcased (downcase match) match))
- match)))
- (defun org-op-to-function (op &optional stringp)
- "Turn an operator into the appropriate function."
- (setq op
- (cond
- ((equal op "<" ) '(< string< org-time<))
- ((equal op ">" ) '(> org-string> org-time>))
- ((member op '("<=" "=<")) '(<= org-string<= org-time<=))
- ((member op '(">=" "=>")) '(>= org-string>= org-time>=))
- ((member op '("=" "==")) '(= string= org-time=))
- ((member op '("<>" "!=")) '(org<> org-string<> org-time<>))))
- (nth (if (eq stringp 'time) 2 (if stringp 1 0)) op))
- (defun org<> (a b) (not (= a b)))
- (defun org-string<= (a b) (or (string= a b) (string< a b)))
- (defun org-string>= (a b) (not (string< a b)))
- (defun org-string> (a b) (and (not (string= a b)) (not (string< a b))))
- (defun org-string<> (a b) (not (string= a b)))
- (defun org-time= (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (= a b)))
- (defun org-time< (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (< a b)))
- (defun org-time<= (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (<= a b)))
- (defun org-time> (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (> a b)))
- (defun org-time>= (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (>= a b)))
- (defun org-time<> (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (org<> a b)))
- (defun org-2ft (s)
- "Convert S to a floating point time.
- If S is already a number, just return it. If it is a string, parse
- it as a time string and apply `float-time' to it. If S is nil, just return 0."
- (cond
- ((numberp s) s)
- ((stringp s)
- (condition-case nil
- (float-time (apply #'encode-time (org-parse-time-string s nil t)))
- (error 0.)))
- (t 0.)))
- (defun org-time-today ()
- "Time in seconds today at 0:00.
- Returns the float number of seconds since the beginning of the
- epoch to the beginning of today (00:00)."
- (float-time (apply 'encode-time
- (append '(0 0 0) (nthcdr 3 (decode-time))))))
- (defun org-matcher-time (s)
- "Interpret a time comparison value."
- (save-match-data
- (cond
- ((string= s "<now>") (float-time))
- ((string= s "<today>") (org-time-today))
- ((string= s "<tomorrow>") (+ 86400.0 (org-time-today)))
- ((string= s "<yesterday>") (- (org-time-today) 86400.0))
- ((string-match "^<\\([-+][0-9]+\\)\\([hdwmy]\\)>$" s)
- (+ (org-time-today)
- (* (string-to-number (match-string 1 s))
- (cdr (assoc (match-string 2 s)
- '(("d" . 86400.0) ("w" . 604800.0)
- ("m" . 2678400.0) ("y" . 31557600.0)))))))
- (t (org-2ft s)))))
- (defun org-match-any-p (re list)
- "Does re match any element of list?"
- (setq list (mapcar (lambda (x) (string-match re x)) list))
- (delq nil list))
- (defvar org-add-colon-after-tag-completion nil) ;; dynamically scoped param
- (defvar org-tags-overlay (make-overlay 1 1))
- (delete-overlay org-tags-overlay)
- (defun org-get-local-tags-at (&optional pos)
- "Get a list of tags defined in the current headline."
- (org-get-tags-at pos 'local))
- (defun org-get-local-tags ()
- "Get a list of tags defined in the current headline."
- (org-get-tags-at nil 'local))
- (defun org-get-tags-at (&optional pos local)
- "Get a list of all headline tags applicable at POS.
- POS defaults to point. If tags are inherited, the list contains
- the targets in the same sequence as the headlines appear, i.e.
- the tags of the current headline come last.
- When LOCAL is non-nil, only return tags from the current headline,
- ignore inherited ones."
- (interactive)
- (if (and org-trust-scanner-tags
- (or (not pos) (equal pos (point)))
- (not local))
- org-scanner-tags
- (let (tags ltags lastpos parent)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (or pos (point)))
- (save-match-data
- (catch 'done
- (condition-case nil
- (progn
- (org-back-to-heading t)
- (while (not (equal lastpos (point)))
- (setq lastpos (point))
- (when (looking-at ".+?:\\([[:alnum:]_@#%:]+\\):[ \t]*$")
- (setq ltags (org-split-string
- (match-string-no-properties 1) ":"))
- (when parent
- (setq ltags (mapcar 'org-add-prop-inherited ltags)))
- (setq tags (append
- (if parent
- (org-remove-uninherited-tags ltags)
- ltags)
- tags)))
- (or org-use-tag-inheritance (throw 'done t))
- (when local (throw 'done t))
- (or (org-up-heading-safe) (error nil))
- (setq parent t)))
- (error nil)))))
- (if local
- tags
- (reverse (delete-dups
- (reverse (append
- (org-remove-uninherited-tags
- org-file-tags)
- tags)))))))))
- (defun org-add-prop-inherited (s)
- (add-text-properties 0 (length s) '(inherited t) s)
- s)
- (defun org-toggle-tag (tag &optional onoff)
- "Toggle the tag TAG for the current line.
- If ONOFF is `on' or `off', don't toggle but set to this state."
- (let (res current)
- (save-excursion
- (org-back-to-heading t)
- (if (re-search-forward "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t]*$"
- (point-at-eol) t)
- (progn
- (setq current (match-string 1))
- (replace-match ""))
- (setq current ""))
- (setq current (nreverse (org-split-string current ":")))
- (cond
- ((eq onoff 'on)
- (setq res t)
- (or (member tag current) (push tag current)))
- ((eq onoff 'off)
- (or (not (member tag current)) (setq current (delete tag current))))
- (t (if (member tag current)
- (setq current (delete tag current))
- (setq res t)
- (push tag current))))
- (end-of-line 1)
- (if current
- (progn
- (insert " :" (mapconcat 'identity (nreverse current) ":") ":")
- (org-set-tags nil t))
- (delete-horizontal-space))
- (run-hooks 'org-after-tags-change-hook))
- res))
- (defun org--align-tags-here (to-col)
- "Align tags on the current headline to TO-COL.
- Assume point is on a headline."
- (let ((pos (point)))
- (beginning-of-line)
- (if (or (not (looking-at ".*?\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))
- (>= pos (match-beginning 2)))
- ;; No tags or point within tags: do not align.
- (goto-char pos)
- (goto-char (match-beginning 1))
- (let ((shift (max (- (if (>= to-col 0) to-col
- (- (abs to-col) (string-width (match-string 2))))
- (current-column))
- 1)))
- (replace-match (make-string shift ?\s) nil nil nil 1)
- ;; Preserve initial position, if possible. In any case, stop
- ;; before tags.
- (when (< pos (point)) (goto-char pos))))))
- (defun org-set-tags-command (&optional arg just-align)
- "Call the set-tags command for the current entry."
- (interactive "P")
- (if (or (org-at-heading-p) (and arg (org-before-first-heading-p)))
- (org-set-tags arg just-align)
- (save-excursion
- (unless (and (org-region-active-p)
- org-loop-over-headlines-in-active-region)
- (org-back-to-heading t))
- (org-set-tags arg just-align))))
- (defun org-set-tags-to (data)
- "Set the tags of the current entry to DATA, replacing the current tags.
- DATA may be a tags string like :aa:bb:cc:, or a list of tags.
- If DATA is nil or the empty string, any tags will be removed."
- (interactive "sTags: ")
- (setq data
- (cond
- ((eq data nil) "")
- ((equal data "") "")
- ((stringp data)
- (concat ":" (mapconcat 'identity (org-split-string data ":+") ":")
- ":"))
- ((listp data)
- (concat ":" (mapconcat 'identity data ":") ":"))))
- (when data
- (save-excursion
- (org-back-to-heading t)
- (when (let ((case-fold-search nil))
- (looking-at org-complex-heading-regexp))
- (if (match-end 5)
- (progn
- (goto-char (match-beginning 5))
- (insert data)
- (delete-region (point) (point-at-eol))
- (org-set-tags nil 'align))
- (goto-char (point-at-eol))
- (insert " " data)
- (org-set-tags nil 'align)))
- (beginning-of-line 1)
- (when (looking-at ".*?\\([ \t]+\\)$")
- (delete-region (match-beginning 1) (match-end 1))))))
- (defun org-align-all-tags ()
- "Align the tags in all headings."
- (interactive)
- (save-excursion
- (or (ignore-errors (org-back-to-heading t))
- (outline-next-heading))
- (if (org-at-heading-p)
- (org-set-tags t)
- (message "No headings"))))
- (defvar org-indent-indentation-per-level)
- (defun org-set-tags (&optional arg just-align)
- "Set the tags for the current headline.
- With prefix ARG, realign all tags in headings in the current buffer.
- When JUST-ALIGN is non-nil, only align tags."
- (interactive "P")
- (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
- (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
- 'region-start-level
- 'region))
- org-loop-over-headlines-in-active-region)
- (org-map-entries
- ;; We don't use ARG and JUST-ALIGN here because these args
- ;; are not useful when looping over headlines.
- #'org-set-tags
- org-loop-over-headlines-in-active-region
- cl
- '(when (org-invisible-p) (org-end-of-subtree nil t))))
- (let ((org-setting-tags t))
- (if arg
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward org-outline-regexp-bol nil t)
- (org-set-tags nil t)
- (end-of-line))
- (message "All tags realigned to column %d" org-tags-column))
- (let* ((current (org-get-tags-string))
- (tags
- (if just-align current
- ;; Get a new set of tags from the user.
- (save-excursion
- (let* ((seen)
- (table
- (setq
- org-last-tags-completion-table
- ;; Uniquify tags in alists, yet preserve
- ;; structure (i.e., keywords).
- (delq nil
- (mapcar
- (lambda (pair)
- (let ((head (car pair)))
- (cond ((symbolp head) pair)
- ((member head seen) nil)
- (t (push head seen)
- pair))))
- (append
- (or org-current-tag-alist
- (org-get-buffer-tags))
- (and
- org-complete-tags-always-offer-all-agenda-tags
- (org-global-tags-completion-table
- (org-agenda-files))))))))
- (current-tags (org-split-string current ":"))
- (inherited-tags
- (nreverse (nthcdr (length current-tags)
- (nreverse (org-get-tags-at))))))
- (replace-regexp-in-string
- "\\([-+&]+\\|,\\)"
- ":"
- (if (or (eq t org-use-fast-tag-selection)
- (and org-use-fast-tag-selection
- (delq nil (mapcar #'cdr table))))
- (org-fast-tag-selection
- current-tags inherited-tags table
- (and org-fast-tag-selection-include-todo
- org-todo-key-alist))
- (let ((org-add-colon-after-tag-completion
- (< 1 (length table))))
- (org-trim
- (completing-read
- "Tags: "
- #'org-tags-completion-function
- nil nil current 'org-tags-history))))))))))
- (when org-tags-sort-function
- (setq tags
- (mapconcat
- #'identity
- (sort (org-split-string tags "[^[:alnum:]_@#%]+")
- org-tags-sort-function)
- ":")))
- (if (or (string= ":" tags)
- (string= "::" tags))
- (setq tags ""))
- (if (not (org-string-nw-p tags)) (setq tags "")
- (unless (string-suffix-p ":" tags) (setq tags (concat tags ":")))
- (unless (string-prefix-p ":" tags) (setq tags (concat ":" tags))))
- ;; Insert new tags at the correct column.
- (unless (equal current tags)
- (save-excursion
- (beginning-of-line)
- (let ((case-fold-search nil))
- (looking-at org-complex-heading-regexp))
- ;; Remove current tags, if any.
- (when (match-end 5) (replace-match "" nil nil nil 5))
- ;; Insert new tags, if any. Otherwise, remove trailing
- ;; white spaces.
- (end-of-line)
- (if (not (equal tags ""))
- ;; When text is being inserted on an invisible
- ;; region boundary, it can be inadvertently sucked
- ;; into invisibility.
- (outline-flag-region (point) (progn (insert " " tags) (point)) nil)
- (skip-chars-backward " \t")
- (delete-region (point) (line-end-position)))))
- ;; Align tags, if any. Fix tags column if `org-indent-mode'
- ;; is on.
- (unless (equal tags "")
- (let* ((level (save-excursion
- (beginning-of-line)
- (skip-chars-forward "\\*")))
- (offset (if (bound-and-true-p org-indent-mode)
- (* (1- org-indent-indentation-per-level)
- (1- level))
- 0))
- (tags-column
- (+ org-tags-column
- (if (> org-tags-column 0) (- offset) offset))))
- (org--align-tags-here tags-column))))
- (unless just-align (run-hooks 'org-after-tags-change-hook))))))
- (defun org-change-tag-in-region (beg end tag off)
- "Add or remove TAG for each entry in the region.
- This works in the agenda, and also in an Org buffer."
- (interactive
- (list (region-beginning) (region-end)
- (let ((org-last-tags-completion-table
- (if (derived-mode-p 'org-mode)
- (org-uniquify
- (delq nil (append (org-get-buffer-tags)
- (org-global-tags-completion-table))))
- (org-global-tags-completion-table))))
- (completing-read
- "Tag: " 'org-tags-completion-function nil nil nil
- 'org-tags-history))
- (progn
- (message "[s]et or [r]emove? ")
- (equal (read-char-exclusive) ?r))))
- (when (fboundp 'deactivate-mark) (deactivate-mark))
- (let ((agendap (equal major-mode 'org-agenda-mode))
- l1 l2 m buf pos newhead (cnt 0))
- (goto-char end)
- (setq l2 (1- (org-current-line)))
- (goto-char beg)
- (setq l1 (org-current-line))
- (cl-loop for l from l1 to l2 do
- (org-goto-line l)
- (setq m (get-text-property (point) 'org-hd-marker))
- (when (or (and (derived-mode-p 'org-mode) (org-at-heading-p))
- (and agendap m))
- (setq buf (if agendap (marker-buffer m) (current-buffer))
- pos (if agendap m (point)))
- (with-current-buffer buf
- (save-excursion
- (save-restriction
- (goto-char pos)
- (setq cnt (1+ cnt))
- (org-toggle-tag tag (if off 'off 'on))
- (setq newhead (org-get-heading)))))
- (and agendap (org-agenda-change-all-lines newhead m))))
- (message "Tag :%s: %s in %d headings" tag (if off "removed" "set") cnt)))
- (defun org-tags-completion-function (string _predicate &optional flag)
- (let (s1 s2 rtn (ctable org-last-tags-completion-table)
- (confirm (lambda (x) (stringp (car x)))))
- (if (string-match "^\\(.*[-+:&,|]\\)\\([^-+:&,|]*\\)$" string)
- (setq s1 (match-string 1 string)
- s2 (match-string 2 string))
- (setq s1 "" s2 string))
- (cond
- ((eq flag nil)
- ;; try completion
- (setq rtn (try-completion s2 ctable confirm))
- (when (stringp rtn)
- (setq rtn
- (concat s1 s2 (substring rtn (length s2))
- (if (and org-add-colon-after-tag-completion
- (assoc rtn ctable))
- ":" ""))))
- rtn)
- ((eq flag t)
- ;; all-completions
- (all-completions s2 ctable confirm))
- ((eq flag 'lambda)
- ;; exact match?
- (assoc s2 ctable)))))
- (defun org-fast-tag-insert (kwd tags face &optional end)
- "Insert KDW, and the TAGS, the latter with face FACE.
- Also insert END."
- (insert (format "%-12s" (concat kwd ":"))
- (org-add-props (mapconcat 'identity tags " ") nil 'face face)
- (or end "")))
- (defun org-fast-tag-show-exit (flag)
- (save-excursion
- (org-goto-line 3)
- (when (re-search-forward "[ \t]+Next change exits" (point-at-eol) t)
- (replace-match ""))
- (when flag
- (end-of-line 1)
- (org-move-to-column (- (window-width) 19) t)
- (insert (org-add-props " Next change exits" nil 'face 'org-warning)))))
- (defun org-set-current-tags-overlay (current prefix)
- "Add an overlay to CURRENT tag with PREFIX."
- (let ((s (concat ":" (mapconcat 'identity current ":") ":")))
- (put-text-property 0 (length s) 'face '(secondary-selection org-tag) s)
- (org-overlay-display org-tags-overlay (concat prefix s))))
- (defvar org-last-tag-selection-key nil)
- (defun org-fast-tag-selection (current inherited table &optional todo-table)
- "Fast tag selection with single keys.
- CURRENT is the current list of tags in the headline, INHERITED is the
- list of inherited tags, and TABLE is an alist of tags and corresponding keys,
- possibly with grouping information. TODO-TABLE is a similar table with
- TODO keywords, should these have keys assigned to them.
- If the keys are nil, a-z are automatically assigned.
- Returns the new tags string, or nil to not change the current settings."
- (let* ((fulltable (append table todo-table))
- (maxlen (apply 'max (mapcar
- (lambda (x)
- (if (stringp (car x)) (string-width (car x)) 0))
- fulltable)))
- (buf (current-buffer))
- (expert (eq org-fast-tag-selection-single-key 'expert))
- (buffer-tags nil)
- (fwidth (+ maxlen 3 1 3))
- (ncol (/ (- (window-width) 4) fwidth))
- (i-face 'org-done)
- (c-face 'org-todo)
- tg cnt e c char c1 c2 ntable tbl rtn
- ov-start ov-end ov-prefix
- (exit-after-next org-fast-tag-selection-single-key)
- (done-keywords org-done-keywords)
- groups ingroup intaggroup)
- (save-excursion
- (beginning-of-line 1)
- (if (looking-at ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")
- (setq ov-start (match-beginning 1)
- ov-end (match-end 1)
- ov-prefix "")
- (setq ov-start (1- (point-at-eol))
- ov-end (1+ ov-start))
- (skip-chars-forward "^\n\r")
- (setq ov-prefix
- (concat
- (buffer-substring (1- (point)) (point))
- (if (> (current-column) org-tags-column)
- " "
- (make-string (- org-tags-column (current-column)) ?\ ))))))
- (move-overlay org-tags-overlay ov-start ov-end)
- (save-window-excursion
- (if expert
- (set-buffer (get-buffer-create " *Org tags*"))
- (delete-other-windows)
- (set-window-buffer (split-window-vertically) (get-buffer-create " *Org tags*"))
- (org-switch-to-buffer-other-window " *Org tags*"))
- (erase-buffer)
- (setq-local org-done-keywords done-keywords)
- (org-fast-tag-insert "Inherited" inherited i-face "\n")
- (org-fast-tag-insert "Current" current c-face "\n\n")
- (org-fast-tag-show-exit exit-after-next)
- (org-set-current-tags-overlay current ov-prefix)
- (setq tbl fulltable char ?a cnt 0)
- (while (setq e (pop tbl))
- (cond
- ((eq (car e) :startgroup)
- (push '() groups) (setq ingroup t)
- (unless (zerop cnt)
- (setq cnt 0)
- (insert "\n"))
- (insert (if (cdr e) (format "%s: " (cdr e)) "") "{ "))
- ((eq (car e) :endgroup)
- (setq ingroup nil cnt 0)
- (insert "}" (if (cdr e) (format " (%s) " (cdr e)) "") "\n"))
- ((eq (car e) :startgrouptag)
- (setq intaggroup t)
- (unless (zerop cnt)
- (setq cnt 0)
- (insert "\n"))
- (insert "[ "))
- ((eq (car e) :endgrouptag)
- (setq intaggroup nil cnt 0)
- (insert "]\n"))
- ((equal e '(:newline))
- (unless (zerop cnt)
- (setq cnt 0)
- (insert "\n")
- (setq e (car tbl))
- (while (equal (car tbl) '(:newline))
- (insert "\n")
- (setq tbl (cdr tbl)))))
- ((equal e '(:grouptags)) (insert " : "))
- (t
- (setq tg (copy-sequence (car e)) c2 nil)
- (if (cdr e)
- (setq c (cdr e))
- ;; automatically assign a character.
- (setq c1 (string-to-char
- (downcase (substring
- tg (if (= (string-to-char tg) ?@) 1 0)))))
- (if (or (rassoc c1 ntable) (rassoc c1 table))
- (while (or (rassoc char ntable) (rassoc char table))
- (setq char (1+ char)))
- (setq c2 c1))
- (setq c (or c2 char)))
- (when ingroup (push tg (car groups)))
- (setq tg (org-add-props tg nil 'face
- (cond
- ((not (assoc tg table))
- (org-get-todo-face tg))
- ((member tg current) c-face)
- ((member tg inherited) i-face))))
- (when (equal (caar tbl) :grouptags)
- (org-add-props tg nil 'face 'org-tag-group))
- (when (and (zerop cnt) (not ingroup) (not intaggroup)) (insert " "))
- (insert "[" c "] " tg (make-string
- (- fwidth 4 (length tg)) ?\ ))
- (push (cons tg c) ntable)
- (when (= (cl-incf cnt) ncol)
- (insert "\n")
- (when (or ingroup intaggroup) (insert " "))
- (setq cnt 0)))))
- (setq ntable (nreverse ntable))
- (insert "\n")
- (goto-char (point-min))
- (unless expert (org-fit-window-to-buffer))
- (setq rtn
- (catch 'exit
- (while t
- (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free [!] %sgroups%s"
- (if (not groups) "no " "")
- (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi")))
- (setq c (let ((inhibit-quit t)) (read-char-exclusive)))
- (setq org-last-tag-selection-key c)
- (cond
- ((= c ?\r) (throw 'exit t))
- ((= c ?!)
- (setq groups (not groups))
- (goto-char (point-min))
- (while (re-search-forward "[{}]" nil t) (replace-match " ")))
- ((= c ?\C-c)
- (if (not expert)
- (org-fast-tag-show-exit
- (setq exit-after-next (not exit-after-next)))
- (setq expert nil)
- (delete-other-windows)
- (set-window-buffer (split-window-vertically) " *Org tags*")
- (org-switch-to-buffer-other-window " *Org tags*")
- (org-fit-window-to-buffer)))
- ((or (= c ?\C-g)
- (and (= c ?q) (not (rassoc c ntable))))
- (delete-overlay org-tags-overlay)
- (setq quit-flag t))
- ((= c ?\ )
- (setq current nil)
- (when exit-after-next (setq exit-after-next 'now)))
- ((= c ?\t)
- (condition-case nil
- (setq tg (completing-read
- "Tag: "
- (or buffer-tags
- (with-current-buffer buf
- (setq buffer-tags
- (org-get-buffer-tags))))))
- (quit (setq tg "")))
- (when (string-match "\\S-" tg)
- (cl-pushnew (list tg) buffer-tags :test #'equal)
- (if (member tg current)
- (setq current (delete tg current))
- (push tg current)))
- (when exit-after-next (setq exit-after-next 'now)))
- ((setq e (rassoc c todo-table) tg (car e))
- (with-current-buffer buf
- (save-excursion (org-todo tg)))
- (when exit-after-next (setq exit-after-next 'now)))
- ((setq e (rassoc c ntable) tg (car e))
- (if (member tg current)
- (setq current (delete tg current))
- (cl-loop for g in groups do
- (when (member tg g)
- (dolist (x g) (setq current (delete x current)))))
- (push tg current))
- (when exit-after-next (setq exit-after-next 'now))))
- ;; Create a sorted list
- (setq current
- (sort current
- (lambda (a b)
- (assoc b (cdr (memq (assoc a ntable) ntable))))))
- (when (eq exit-after-next 'now) (throw 'exit t))
- (goto-char (point-min))
- (beginning-of-line 2)
- (delete-region (point) (point-at-eol))
- (org-fast-tag-insert "Current" current c-face)
- (org-set-current-tags-overlay current ov-prefix)
- (while (re-search-forward "\\[.\\] \\([[:alnum:]_@#%]+\\)" nil t)
- (setq tg (match-string 1))
- (add-text-properties
- (match-beginning 1) (match-end 1)
- (list 'face
- (cond
- ((member tg current) c-face)
- ((member tg inherited) i-face)
- (t (get-text-property (match-beginning 1) 'face))))))
- (goto-char (point-min)))))
- (delete-overlay org-tags-overlay)
- (if rtn
- (mapconcat 'identity current ":")
- nil))))
- (defun org-get-tags-string ()
- "Get the TAGS string in the current headline."
- (unless (org-at-heading-p t)
- (user-error "Not on a heading"))
- (save-excursion
- (beginning-of-line 1)
- (if (looking-at ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")
- (match-string-no-properties 1)
- "")))
- (defun org-get-tags ()
- "Get the list of tags specified in the current headline."
- (org-split-string (org-get-tags-string) ":"))
- (defun org-get-buffer-tags ()
- "Get a table of all tags used in the buffer, for completion."
- (org-with-wide-buffer
- (goto-char (point-min))
- (let ((tag-re (concat org-outline-regexp-bol
- "\\(?:.*?[ \t]\\)?:\\([[:alnum:]_@#%:]+\\):[ \t]*$"))
- tags)
- (while (re-search-forward tag-re nil t)
- (dolist (tag (org-split-string (match-string-no-properties 1) ":"))
- (push tag tags)))
- (mapcar #'list (append org-file-tags (org-uniquify tags))))))
- ;;;; The mapping API
- (defvar org-agenda-skip-comment-trees)
- (defvar org-agenda-skip-function)
- (defun org-map-entries (func &optional match scope &rest skip)
- "Call FUNC at each headline selected by MATCH in SCOPE.
- FUNC is a function or a lisp form. The function will be called without
- arguments, with the cursor positioned at the beginning of the headline.
- The return values of all calls to the function will be collected and
- returned as a list.
- The call to FUNC will be wrapped into a save-excursion form, so FUNC
- does not need to preserve point. After evaluation, the cursor will be
- moved to the end of the line (presumably of the headline of the
- processed entry) and search continues from there. Under some
- circumstances, this may not produce the wanted results. For example,
- if you have removed (e.g. archived) the current (sub)tree it could
- mean that the next entry will be skipped entirely. In such cases, you
- can specify the position from where search should continue by making
- FUNC set the variable `org-map-continue-from' to the desired buffer
- position.
- MATCH is a tags/property/todo match as it is used in the agenda tags view.
- Only headlines that are matched by this query will be considered during
- the iteration. When MATCH is nil or t, all headlines will be
- visited by the iteration.
- SCOPE determines the scope of this command. It can be any of:
- nil The current buffer, respecting the restriction if any
- tree The subtree started with the entry at point
- region The entries within the active region, if any
- region-start-level
- The entries within the active region, but only those at
- the same level than the first one.
- file The current buffer, without restriction
- file-with-archives
- The current buffer, and any archives associated with it
- agenda All agenda files
- agenda-with-archives
- All agenda files with any archive files associated with them
- \(file1 file2 ...)
- If this is a list, all files in the list will be scanned
- The remaining args are treated as settings for the skipping facilities of
- the scanner. The following items can be given here:
- archive skip trees with the archive tag
- comment skip trees with the COMMENT keyword
- function or Emacs Lisp form:
- will be used as value for `org-agenda-skip-function', so
- whenever the function returns a position, FUNC will not be
- called for that entry and search will continue from the
- position returned
- If your function needs to retrieve the tags including inherited tags
- at the *current* entry, you can use the value of the variable
- `org-scanner-tags' which will be much faster than getting the value
- with `org-get-tags-at'. If your function gets properties with
- `org-entry-properties' at the *current* entry, bind `org-trust-scanner-tags'
- to t around the call to `org-entry-properties' to get the same speedup.
- Note that if your function moves around to retrieve tags and properties at
- a *different* entry, you cannot use these techniques."
- (unless (and (or (eq scope 'region) (eq scope 'region-start-level))
- (not (org-region-active-p)))
- (let* ((org-agenda-archives-mode nil) ; just to make sure
- (org-agenda-skip-archived-trees (memq 'archive skip))
- (org-agenda-skip-comment-trees (memq 'comment skip))
- (org-agenda-skip-function
- (car (org-delete-all '(comment archive) skip)))
- (org-tags-match-list-sublevels t)
- (start-level (eq scope 'region-start-level))
- matcher res
- org-todo-keywords-for-agenda
- org-done-keywords-for-agenda
- org-todo-keyword-alist-for-agenda
- org-tag-alist-for-agenda
- org--matcher-tags-todo-only)
- (cond
- ((eq match t) (setq matcher t))
- ((eq match nil) (setq matcher t))
- (t (setq matcher (if match (cdr (org-make-tags-matcher match)) t))))
- (save-excursion
- (save-restriction
- (cond ((eq scope 'tree)
- (org-back-to-heading t)
- (org-narrow-to-subtree)
- (setq scope nil))
- ((and (or (eq scope 'region) (eq scope 'region-start-level))
- (org-region-active-p))
- ;; If needed, set start-level to a string like "2"
- (when start-level
- (save-excursion
- (goto-char (region-beginning))
- (unless (org-at-heading-p) (outline-next-heading))
- (setq start-level (org-current-level))))
- (narrow-to-region (region-beginning)
- (save-excursion
- (goto-char (region-end))
- (unless (and (bolp) (org-at-heading-p))
- (outline-next-heading))
- (point)))
- (setq scope nil)))
- (if (not scope)
- (progn
- (org-agenda-prepare-buffers
- (and buffer-file-name (list buffer-file-name)))
- (setq res
- (org-scan-tags
- func matcher org--matcher-tags-todo-only start-level)))
- ;; Get the right scope
- (cond
- ((and scope (listp scope) (symbolp (car scope)))
- (setq scope (eval scope)))
- ((eq scope 'agenda)
- (setq scope (org-agenda-files t)))
- ((eq scope 'agenda-with-archives)
- (setq scope (org-agenda-files t))
- (setq scope (org-add-archive-files scope)))
- ((eq scope 'file)
- (setq scope (and buffer-file-name (list buffer-file-name))))
- ((eq scope 'file-with-archives)
- (setq scope (org-add-archive-files (list (buffer-file-name))))))
- (org-agenda-prepare-buffers scope)
- (dolist (file scope)
- (with-current-buffer (org-find-base-buffer-visiting file)
- (org-with-wide-buffer
- (goto-char (point-min))
- (setq res
- (append
- res
- (org-scan-tags
- func matcher org--matcher-tags-todo-only)))))))))
- res)))
- ;;; Properties API
- (defconst org-special-properties
- '("ALLTAGS" "BLOCKED" "CLOCKSUM" "CLOCKSUM_T" "CLOSED" "DEADLINE" "FILE"
- "ITEM" "PRIORITY" "SCHEDULED" "TAGS" "TIMESTAMP" "TIMESTAMP_IA" "TODO")
- "The special properties valid in Org mode.
- These are properties that are not defined in the property drawer,
- but in some other way.")
- (defconst org-default-properties
- '("ARCHIVE" "CATEGORY" "SUMMARY" "DESCRIPTION" "CUSTOM_ID"
- "LOCATION" "LOGGING" "COLUMNS" "VISIBILITY"
- "TABLE_EXPORT_FORMAT" "TABLE_EXPORT_FILE"
- "EXPORT_OPTIONS" "EXPORT_TEXT" "EXPORT_FILE_NAME"
- "EXPORT_TITLE" "EXPORT_AUTHOR" "EXPORT_DATE" "UNNUMBERED"
- "ORDERED" "NOBLOCKING" "COOKIE_DATA" "LOG_INTO_DRAWER" "REPEAT_TO_STATE"
- "CLOCK_MODELINE_TOTAL" "STYLE" "HTML_CONTAINER_CLASS")
- "Some properties that are used by Org mode for various purposes.
- Being in this list makes sure that they are offered for completion.")
- (defun org--valid-property-p (property)
- "Non nil when string PROPERTY is a valid property name."
- (not
- (or (equal property "")
- (string-match-p "\\s-" property))))
- (defun org--update-property-plist (key val props)
- "Associate KEY to VAL in alist PROPS.
- Modifications are made by side-effect. Return new alist."
- (let* ((appending (string= (substring key -1) "+"))
- (key (if appending (substring key 0 -1) key))
- (old (assoc-string key props t)))
- (if (not old) (cons (cons key val) props)
- (setcdr old (if appending (concat (cdr old) " " val) val))
- props)))
- (defun org-get-property-block (&optional beg force)
- "Return the (beg . end) range of the body of the property drawer.
- BEG is the beginning of the current subtree, or of the part
- before the first headline. If it is not given, it will be found.
- If the drawer does not exist, create it if FORCE is non-nil, or
- return nil."
- (org-with-wide-buffer
- (when beg (goto-char beg))
- (unless (org-before-first-heading-p)
- (let ((beg (cond (beg)
- ((or (not (featurep 'org-inlinetask))
- (org-inlinetask-in-task-p))
- (org-back-to-heading t))
- (t (org-with-limited-levels (org-back-to-heading t))))))
- (forward-line)
- (when (looking-at-p org-planning-line-re) (forward-line))
- (cond ((looking-at org-property-drawer-re)
- (forward-line)
- (cons (point) (progn (goto-char (match-end 0))
- (line-beginning-position))))
- (force
- (goto-char beg)
- (org-insert-property-drawer)
- (let ((pos (save-excursion (search-forward ":END:")
- (line-beginning-position))))
- (cons pos pos))))))))
- (defun org-at-property-p ()
- "Non-nil when point is inside a property drawer.
- See `org-property-re' for match data, if applicable."
- (save-excursion
- (beginning-of-line)
- (and (looking-at org-property-re)
- (let ((property-drawer (save-match-data (org-get-property-block))))
- (and property-drawer
- (>= (point) (car property-drawer))
- (< (point) (cdr property-drawer)))))))
- (defun org-property-action ()
- "Do an action on properties."
- (interactive)
- (unless (org-at-property-p) (user-error "Not at a property"))
- (message "Property Action: [s]et [d]elete [D]elete globally [c]ompute")
- (let ((c (read-char-exclusive)))
- (cl-case c
- (?s (call-interactively #'org-set-property))
- (?d (call-interactively #'org-delete-property))
- (?D (call-interactively #'org-delete-property-globally))
- (?c (call-interactively #'org-compute-property-at-point))
- (otherwise (user-error "No such property action %c" c)))))
- (defun org-inc-effort ()
- "Increment the value of the effort property in the current entry."
- (interactive)
- (org-set-effort nil t))
- (defvar org-clock-effort) ; Defined in org-clock.el.
- (defvar org-clock-current-task) ; Defined in org-clock.el.
- (defun org-set-effort (&optional value increment)
- "Set the effort property of the current entry.
- With numerical prefix arg, use the nth allowed value, 0 stands for the
- 10th allowed value.
- When INCREMENT is non-nil, set the property to the next allowed value."
- (interactive "P")
- (when (equal value 0) (setq value 10))
- (let* ((completion-ignore-case t)
- (prop org-effort-property)
- (cur (org-entry-get nil prop))
- (allowed (org-property-get-allowed-values nil prop 'table))
- (existing (mapcar 'list (org-property-values prop)))
- (heading (nth 4 (org-heading-components)))
- rpl
- (val (cond
- ((stringp value) value)
- ((and allowed (integerp value))
- (or (car (nth (1- value) allowed))
- (car (org-last allowed))))
- ((and allowed increment)
- (or (cl-caadr (member (list cur) allowed))
- (user-error "Allowed effort values are not set")))
- (allowed
- (message "Select 1-9,0, [RET%s]: %s"
- (if cur (concat "=" cur) "")
- (mapconcat 'car allowed " "))
- (setq rpl (read-char-exclusive))
- (if (equal rpl ?\r)
- cur
- (setq rpl (- rpl ?0))
- (when (equal rpl 0) (setq rpl 10))
- (if (and (> rpl 0) (<= rpl (length allowed)))
- (car (nth (1- rpl) allowed))
- (org-completing-read "Effort: " allowed nil))))
- (t
- (org-completing-read
- (concat "Effort" (and cur (string-match "\\S-" cur)
- (concat " [" cur "]"))
- ": ")
- existing nil nil "" nil cur)))))
- (unless (equal (org-entry-get nil prop) val)
- (org-entry-put nil prop val))
- (org-refresh-property
- '((effort . identity)
- (effort-minutes . org-duration-string-to-minutes))
- val)
- (when (equal heading (bound-and-true-p org-clock-current-task))
- (setq org-clock-effort (get-text-property (point-at-bol) 'effort))
- (org-clock-update-mode-line))
- (message "%s is now %s" prop val)))
- (defun org-entry-properties (&optional pom which)
- "Get all properties of the current entry.
- When POM is a buffer position, get all properties from the entry
- there instead.
- This includes the TODO keyword, the tags, time strings for
- deadline, scheduled, and clocking, and any additional properties
- defined in the entry.
- If WHICH is nil or `all', get all properties. If WHICH is
- `special' or `standard', only get that subclass. If WHICH is
- a string, only get that property.
- Return value is an alist. Keys are properties, as upcased
- strings."
- (org-with-point-at pom
- (when (and (derived-mode-p 'org-mode)
- (ignore-errors (org-back-to-heading t)))
- (catch 'exit
- (let* ((beg (point))
- (specific (and (stringp which) (upcase which)))
- (which (cond ((not specific) which)
- ((member specific org-special-properties) 'special)
- (t 'standard)))
- props)
- ;; Get the special properties, like TODO and TAGS.
- (when (memq which '(nil all special))
- (when (or (not specific) (string= specific "CLOCKSUM"))
- (let ((clocksum (get-text-property (point) :org-clock-minutes)))
- (when clocksum
- (push (cons "CLOCKSUM"
- (org-minutes-to-clocksum-string clocksum))
- props)))
- (when specific (throw 'exit props)))
- (when (or (not specific) (string= specific "CLOCKSUM_T"))
- (let ((clocksumt (get-text-property (point)
- :org-clock-minutes-today)))
- (when clocksumt
- (push (cons "CLOCKSUM_T"
- (org-minutes-to-clocksum-string clocksumt))
- props)))
- (when specific (throw 'exit props)))
- (when (or (not specific) (string= specific "ITEM"))
- (let ((case-fold-search nil))
- (when (looking-at org-complex-heading-regexp)
- (push (cons "ITEM"
- (let ((title (match-string-no-properties 4)))
- (if (org-string-nw-p title)
- (org-remove-tabs title)
- "")))
- props)))
- (when specific (throw 'exit props)))
- (when (or (not specific) (string= specific "TODO"))
- (let ((case-fold-search nil))
- (when (and (looking-at org-todo-line-regexp) (match-end 2))
- (push (cons "TODO" (match-string-no-properties 2)) props)))
- (when specific (throw 'exit props)))
- (when (or (not specific) (string= specific "PRIORITY"))
- (push (cons "PRIORITY"
- (if (looking-at org-priority-regexp)
- (match-string-no-properties 2)
- (char-to-string org-default-priority)))
- props)
- (when specific (throw 'exit props)))
- (when (or (not specific) (string= specific "FILE"))
- (push (cons "FILE" (buffer-file-name (buffer-base-buffer)))
- props)
- (when specific (throw 'exit props)))
- (when (or (not specific) (string= specific "TAGS"))
- (let ((value (org-string-nw-p (org-get-tags-string))))
- (when value (push (cons "TAGS" value) props)))
- (when specific (throw 'exit props)))
- (when (or (not specific) (string= specific "ALLTAGS"))
- (let ((value (org-get-tags-at)))
- (when value
- (push (cons "ALLTAGS"
- (format ":%s:" (mapconcat #'identity value ":")))
- props)))
- (when specific (throw 'exit props)))
- (when (or (not specific) (string= specific "BLOCKED"))
- (push (cons "BLOCKED" (if (org-entry-blocked-p) "t" "")) props)
- (when specific (throw 'exit props)))
- (when (or (not specific)
- (member specific '("CLOSED" "DEADLINE" "SCHEDULED")))
- (forward-line)
- (when (looking-at-p org-planning-line-re)
- (end-of-line)
- (let ((bol (line-beginning-position))
- ;; Backward compatibility: time keywords used to
- ;; be configurable (before 8.3). Make sure we
- ;; get the correct keyword.
- (key-assoc `(("CLOSED" . ,org-closed-string)
- ("DEADLINE" . ,org-deadline-string)
- ("SCHEDULED" . ,org-scheduled-string))))
- (dolist (pair (if specific (list (assoc specific key-assoc))
- key-assoc))
- (save-excursion
- (when (search-backward (cdr pair) bol t)
- (goto-char (match-end 0))
- (skip-chars-forward " \t")
- (and (looking-at org-ts-regexp-both)
- (push (cons (car pair)
- (match-string-no-properties 0))
- props)))))))
- (when specific (throw 'exit props)))
- (when (or (not specific)
- (member specific '("TIMESTAMP" "TIMESTAMP_IA")))
- (let ((find-ts
- (lambda (end ts)
- ;; Fix next time-stamp before END. TS is the
- ;; list of time-stamps found so far.
- (let ((ts ts)
- (regexp (cond
- ((string= specific "TIMESTAMP")
- org-ts-regexp)
- ((string= specific "TIMESTAMP_IA")
- org-ts-regexp-inactive)
- ((assoc "TIMESTAMP_IA" ts)
- org-ts-regexp)
- ((assoc "TIMESTAMP" ts)
- org-ts-regexp-inactive)
- (t org-ts-regexp-both))))
- (catch 'next
- (while (re-search-forward regexp end t)
- (backward-char)
- (let ((object (org-element-context)))
- ;; Accept to match timestamps in node
- ;; properties, too.
- (when (memq (org-element-type object)
- '(node-property timestamp))
- (let ((type
- (org-element-property :type object)))
- (cond
- ((and (memq type '(active active-range))
- (not (equal specific "TIMESTAMP_IA")))
- (unless (assoc "TIMESTAMP" ts)
- (push (cons "TIMESTAMP"
- (org-element-property
- :raw-value object))
- ts)
- (when specific (throw 'exit ts))))
- ((and (memq type '(inactive inactive-range))
- (not (string= specific "TIMESTAMP")))
- (unless (assoc "TIMESTAMP_IA" ts)
- (push (cons "TIMESTAMP_IA"
- (org-element-property
- :raw-value object))
- ts)
- (when specific (throw 'exit ts))))))
- ;; Both timestamp types are found,
- ;; move to next part.
- (when (= (length ts) 2) (throw 'next ts)))))
- ts)))))
- (goto-char beg)
- ;; First look for timestamps within headline.
- (let ((ts (funcall find-ts (line-end-position) nil)))
- (if (= (length ts) 2) (setq props (nconc ts props))
- ;; Then find timestamps in the section, skipping
- ;; planning line.
- (let ((end (save-excursion (outline-next-heading))))
- (forward-line)
- (when (looking-at-p org-planning-line-re) (forward-line))
- (setq props (nconc (funcall find-ts end ts) props))))))))
- ;; Get the standard properties, like :PROP:.
- (when (memq which '(nil all standard))
- ;; If we are looking after a specific property, delegate
- ;; to `org-entry-get', which is faster. However, make an
- ;; exception for "CATEGORY", since it can be also set
- ;; through keywords (i.e. #+CATEGORY).
- (if (and specific (not (equal specific "CATEGORY")))
- (let ((value (org-entry-get beg specific nil t)))
- (throw 'exit (and value (list (cons specific value)))))
- (let ((range (org-get-property-block beg)))
- (when range
- (let ((end (cdr range)) seen-base)
- (goto-char (car range))
- ;; Unlike to `org--update-property-plist', we
- ;; handle the case where base values is found
- ;; after its extension. We also forbid standard
- ;; properties to be named as special properties.
- (while (re-search-forward org-property-re end t)
- (let* ((key (upcase (match-string-no-properties 2)))
- (extendp (string-match-p "\\+\\'" key))
- (key-base (if extendp (substring key 0 -1) key))
- (value (match-string-no-properties 3)))
- (cond
- ((member-ignore-case key-base org-special-properties))
- (extendp
- (setq props
- (org--update-property-plist key value props)))
- ((member key seen-base))
- (t (push key seen-base)
- (let ((p (assoc-string key props t)))
- (if p (setcdr p (concat value " " (cdr p)))
- (push (cons key value) props))))))))))))
- (unless (assoc "CATEGORY" props)
- (push (cons "CATEGORY" (org-get-category beg)) props)
- (when (string= specific "CATEGORY") (throw 'exit props)))
- ;; Return value.
- props)))))
- (defun org--property-local-values (property literal-nil)
- "Return value for PROPERTY in current entry.
- Value is a list whose car is the base value for PROPERTY and cdr
- a list of accumulated values. Return nil if neither is found in
- the entry. Also return nil when PROPERTY is set to \"nil\",
- unless LITERAL-NIL is non-nil."
- (let ((range (org-get-property-block)))
- (when range
- (goto-char (car range))
- (let* ((case-fold-search t)
- (end (cdr range))
- (value
- ;; Base value.
- (save-excursion
- (let ((v (and (re-search-forward
- (org-re-property property nil t) end t)
- (match-string-no-properties 3))))
- (list (if literal-nil v (org-not-nil v)))))))
- ;; Find additional values.
- (let* ((property+ (org-re-property (concat property "+") nil t)))
- (while (re-search-forward property+ end t)
- (push (match-string-no-properties 3) value)))
- ;; Return final values.
- (and (not (equal value '(nil))) (nreverse value))))))
- (defun org--property-global-value (property literal-nil)
- "Return value for PROPERTY in current buffer.
- Return value is a string. Return nil if property is not set
- globally. Also return nil when PROPERTY is set to \"nil\",
- unless LITERAL-NIL is non-nil."
- (let ((global
- (cdr (or (assoc-string property org-file-properties t)
- (assoc-string property org-global-properties t)
- (assoc-string property org-global-properties-fixed t)))))
- (if literal-nil global (org-not-nil global))))
- (defun org-entry-get (pom property &optional inherit literal-nil)
- "Get value of PROPERTY for entry or content at point-or-marker POM.
- If INHERIT is non-nil and the entry does not have the property,
- then also check higher levels of the hierarchy. If INHERIT is
- the symbol `selective', use inheritance only if the setting in
- `org-use-property-inheritance' selects PROPERTY for inheritance.
- If the property is present but empty, the return value is the
- empty string. If the property is not present at all, nil is
- returned. In any other case, return the value as a string.
- Search is case-insensitive.
- If LITERAL-NIL is set, return the string value \"nil\" as
- a string, do not interpret it as the list atom nil. This is used
- for inheritance when a \"nil\" value can supersede a non-nil
- value higher up the hierarchy."
- (org-with-point-at pom
- (cond
- ((member-ignore-case property (cons "CATEGORY" org-special-properties))
- ;; We need a special property. Use `org-entry-properties' to
- ;; retrieve it, but specify the wanted property.
- (cdr (assoc-string property (org-entry-properties nil property))))
- ((and inherit
- (or (not (eq inherit 'selective)) (org-property-inherit-p property)))
- (org-entry-get-with-inheritance property literal-nil))
- (t
- (let* ((local (org--property-local-values property literal-nil))
- (value (and local (mapconcat #'identity (delq nil local) " "))))
- (if literal-nil value (org-not-nil value)))))))
- (defun org-property-or-variable-value (var &optional inherit)
- "Check if there is a property fixing the value of VAR.
- If yes, return this value. If not, return the current value of the variable."
- (let ((prop (org-entry-get nil (symbol-name var) inherit)))
- (if (and prop (stringp prop) (string-match "\\S-" prop))
- (read prop)
- (symbol-value var))))
- (defun org-entry-delete (pom property)
- "Delete PROPERTY from entry at point-or-marker POM.
- Accumulated properties, i.e. PROPERTY+, are also removed. Return
- non-nil when a property was removed."
- (org-with-point-at pom
- (pcase (org-get-property-block)
- (`(,begin . ,origin)
- (let* ((end (copy-marker origin))
- (re (org-re-property
- (concat (regexp-quote property) "\\+?") t t)))
- (goto-char begin)
- (while (re-search-forward re end t)
- (delete-region (match-beginning 0) (line-beginning-position 2)))
- ;; If drawer is empty, remove it altogether.
- (when (= begin end)
- (delete-region (line-beginning-position 0)
- (line-beginning-position 2)))
- ;; Return non-nil if some property was removed.
- (prog1 (/= end origin) (set-marker end nil))))
- (_ nil))))
- ;; Multi-values properties are properties that contain multiple values
- ;; These values are assumed to be single words, separated by whitespace.
- (defun org-entry-add-to-multivalued-property (pom property value)
- "Add VALUE to the words in the PROPERTY in entry at point-or-marker POM."
- (let* ((old (org-entry-get pom property))
- (values (and old (org-split-string old "[ \t]"))))
- (setq value (org-entry-protect-space value))
- (unless (member value values)
- (setq values (append values (list value)))
- (org-entry-put pom property
- (mapconcat 'identity values " ")))))
- (defun org-entry-remove-from-multivalued-property (pom property value)
- "Remove VALUE from words in the PROPERTY in entry at point-or-marker POM."
- (let* ((old (org-entry-get pom property))
- (values (and old (org-split-string old "[ \t]"))))
- (setq value (org-entry-protect-space value))
- (when (member value values)
- (setq values (delete value values))
- (org-entry-put pom property
- (mapconcat 'identity values " ")))))
- (defun org-entry-member-in-multivalued-property (pom property value)
- "Is VALUE one of the words in the PROPERTY in entry at point-or-marker POM?"
- (let* ((old (org-entry-get pom property))
- (values (and old (org-split-string old "[ \t]"))))
- (setq value (org-entry-protect-space value))
- (member value values)))
- (defun org-entry-get-multivalued-property (pom property)
- "Return a list of values in a multivalued property."
- (let* ((value (org-entry-get pom property))
- (values (and value (org-split-string value "[ \t]"))))
- (mapcar 'org-entry-restore-space values)))
- (defun org-entry-put-multivalued-property (pom property &rest values)
- "Set multivalued PROPERTY at point-or-marker POM to VALUES.
- VALUES should be a list of strings. Spaces will be protected."
- (org-entry-put pom property
- (mapconcat 'org-entry-protect-space values " "))
- (let* ((value (org-entry-get pom property))
- (values (and value (org-split-string value "[ \t]"))))
- (mapcar 'org-entry-restore-space values)))
- (defun org-entry-protect-space (s)
- "Protect spaces and newline in string S."
- (while (string-match " " s)
- (setq s (replace-match "%20" t t s)))
- (while (string-match "\n" s)
- (setq s (replace-match "%0A" t t s)))
- s)
- (defun org-entry-restore-space (s)
- "Restore spaces and newline in string S."
- (while (string-match "%20" s)
- (setq s (replace-match " " t t s)))
- (while (string-match "%0A" s)
- (setq s (replace-match "\n" t t s)))
- s)
- (defvar org-entry-property-inherited-from (make-marker)
- "Marker pointing to the entry from where a property was inherited.
- Each call to `org-entry-get-with-inheritance' will set this marker to the
- location of the entry where the inheritance search matched. If there was
- no match, the marker will point nowhere.
- Note that also `org-entry-get' calls this function, if the INHERIT flag
- is set.")
- (defun org-entry-get-with-inheritance (property &optional literal-nil)
- "Get PROPERTY of entry or content at point, search higher levels if needed.
- The search will stop at the first ancestor which has the property defined.
- If the value found is \"nil\", return nil to show that the property
- should be considered as undefined (this is the meaning of nil here).
- However, if LITERAL-NIL is set, return the string value \"nil\" instead."
- (move-marker org-entry-property-inherited-from nil)
- (org-with-wide-buffer
- (let (value)
- (catch 'exit
- (while t
- (let ((v (org--property-local-values property literal-nil)))
- (when v
- (setq value
- (concat (mapconcat #'identity (delq nil v) " ")
- (and value " ")
- value)))
- (cond
- ((car v)
- (org-back-to-heading t)
- (move-marker org-entry-property-inherited-from (point))
- (throw 'exit nil))
- ((org-up-heading-safe))
- (t
- (let ((global (org--property-global-value property literal-nil)))
- (cond ((not global))
- (value (setq value (concat global " " value)))
- (t (setq value global))))
- (throw 'exit nil))))))
- (if literal-nil value (org-not-nil value)))))
- (defvar org-property-changed-functions nil
- "Hook called when the value of a property has changed.
- Each hook function should accept two arguments, the name of the property
- and the new value.")
- (defun org-entry-put (pom property value)
- "Set PROPERTY to VALUE for entry at point-or-marker POM.
- If the value is nil, it is converted to the empty string. If it
- is not a string, an error is raised. Also raise an error on
- invalid property names.
- PROPERTY can be any regular property (see
- `org-special-properties'). It can also be \"TODO\",
- \"PRIORITY\", \"SCHEDULED\" and \"DEADLINE\".
- For the last two properties, VALUE may have any of the special
- values \"earlier\" and \"later\". The function then increases or
- decreases scheduled or deadline date by one day."
- (cond ((null value) (setq value ""))
- ((not (stringp value)) (error "Properties values should be strings"))
- ((not (org--valid-property-p property))
- (user-error "Invalid property name: \"%s\"" property)))
- (org-with-point-at pom
- (if (or (not (featurep 'org-inlinetask)) (org-inlinetask-in-task-p))
- (org-back-to-heading t)
- (org-with-limited-levels (org-back-to-heading t)))
- (let ((beg (point)))
- (cond
- ((equal property "TODO")
- (cond ((not (org-string-nw-p value)) (setq value 'none))
- ((not (member value org-todo-keywords-1))
- (user-error "\"%s\" is not a valid TODO state" value)))
- (org-todo value)
- (org-set-tags nil 'align))
- ((equal property "PRIORITY")
- (org-priority (if (org-string-nw-p value) (string-to-char value) ?\s))
- (org-set-tags nil 'align))
- ((equal property "SCHEDULED")
- (forward-line)
- (if (and (looking-at-p org-planning-line-re)
- (re-search-forward
- org-scheduled-time-regexp (line-end-position) t))
- (cond ((string= value "earlier") (org-timestamp-change -1 'day))
- ((string= value "later") (org-timestamp-change 1 'day))
- ((string= value "") (org-schedule '(4)))
- (t (org-schedule nil value)))
- (if (member value '("earlier" "later" ""))
- (call-interactively #'org-schedule)
- (org-schedule nil value))))
- ((equal property "DEADLINE")
- (forward-line)
- (if (and (looking-at-p org-planning-line-re)
- (re-search-forward
- org-deadline-time-regexp (line-end-position) t))
- (cond ((string= value "earlier") (org-timestamp-change -1 'day))
- ((string= value "later") (org-timestamp-change 1 'day))
- ((string= value "") (org-deadline '(4)))
- (t (org-deadline nil value)))
- (if (member value '("earlier" "later" ""))
- (call-interactively #'org-deadline)
- (org-deadline nil value))))
- ((member property org-special-properties)
- (error "The %s property cannot be set with `org-entry-put'" property))
- (t
- (let* ((range (org-get-property-block beg 'force))
- (end (cdr range))
- (case-fold-search t))
- (goto-char (car range))
- (if (re-search-forward (org-re-property property nil t) end t)
- (progn (delete-region (match-beginning 0) (match-end 0))
- (goto-char (match-beginning 0)))
- (goto-char end)
- (insert "\n")
- (backward-char))
- (insert ":" property ":")
- (when value (insert " " value))
- (org-indent-line)))))
- (run-hook-with-args 'org-property-changed-functions property value)))
- (defun org-buffer-property-keys
- (&optional specials defaults columns ignore-malformed)
- "Get all property keys in the current buffer.
- When SPECIALS is non-nil, also list the special properties that
- reflect things like tags and TODO state.
- When DEFAULTS is non-nil, also include properties that has
- special meaning internally: ARCHIVE, CATEGORY, SUMMARY,
- DESCRIPTION, LOCATION, and LOGGING and others.
- When COLUMNS in non-nil, also include property names given in
- COLUMN formats in the current buffer.
- When IGNORE-MALFORMED is non-nil, malformed drawer repair will not be
- automatically performed, such drawers will be silently ignored."
- (let ((case-fold-search t)
- (props (append
- (and specials org-special-properties)
- (and defaults (cons org-effort-property org-default-properties))
- nil)))
- (org-with-wide-buffer
- (goto-char (point-min))
- (while (re-search-forward org-property-start-re nil t)
- (let ((range (org-get-property-block)))
- (catch 'skip
- (unless range
- (when (and (not ignore-malformed)
- (not (org-before-first-heading-p))
- (y-or-n-p (format "Malformed drawer at %d, repair?"
- (line-beginning-position))))
- (org-get-property-block nil t))
- (throw 'skip nil))
- (goto-char (car range))
- (let ((begin (car range))
- (end (cdr range)))
- ;; Make sure that found property block is not located
- ;; before current point, as it would generate an infloop.
- ;; It can happen, for example, in the following
- ;; situation:
- ;;
- ;; * Headline
- ;; :PROPERTIES:
- ;; ...
- ;; :END:
- ;; *************** Inlinetask
- ;; #+BEGIN_EXAMPLE
- ;; :PROPERTIES:
- ;; #+END_EXAMPLE
- ;;
- (if (< begin (point)) (throw 'skip nil) (goto-char begin))
- (while (< (point) end)
- (let ((p (progn (looking-at org-property-re)
- (match-string-no-properties 2))))
- ;; Only add true property name, not extension symbol.
- (push (if (not (string-match-p "\\+\\'" p)) p
- (substring p 0 -1))
- props))
- (forward-line))))
- (outline-next-heading)))
- (when columns
- (goto-char (point-min))
- (while (re-search-forward "^[ \t]*\\(?:#\\+\\|:\\)COLUMNS:" nil t)
- (let ((element (org-element-at-point)))
- (when (memq (org-element-type element) '(keyword node-property))
- (let ((value (org-element-property :value element))
- (start 0))
- (while (string-match "%[0-9]*\\(\\S-+\\)" value start)
- (setq start (match-end 0))
- (let ((p (match-string-no-properties 1 value)))
- (unless (member-ignore-case p org-special-properties)
- (push p props))))))))))
- (sort (delete-dups props) (lambda (a b) (string< (upcase a) (upcase b))))))
- (defun org-property-values (key)
- "List all non-nil values of property KEY in current buffer."
- (org-with-wide-buffer
- (goto-char (point-min))
- (let ((case-fold-search t)
- (re (org-re-property key))
- values)
- (while (re-search-forward re nil t)
- (push (org-entry-get (point) key) values))
- (delete-dups values))))
- (defun org-insert-property-drawer ()
- "Insert a property drawer into the current entry."
- (org-with-wide-buffer
- (if (or (not (featurep 'org-inlinetask)) (org-inlinetask-in-task-p))
- (org-back-to-heading t)
- (org-with-limited-levels (org-back-to-heading t)))
- (forward-line)
- (when (looking-at-p org-planning-line-re) (forward-line))
- (unless (looking-at-p org-property-drawer-re)
- ;; Make sure we start editing a line from current entry, not from
- ;; next one. It prevents extending text properties or overlays
- ;; belonging to the latter.
- (when (bolp) (backward-char))
- (let ((begin (1+ (point)))
- (inhibit-read-only t))
- (insert "\n:PROPERTIES:\n:END:")
- (when (eobp) (insert "\n"))
- (org-indent-region begin (point))))))
- (defun org-insert-drawer (&optional arg drawer)
- "Insert a drawer at point.
- When optional argument ARG is non-nil, insert a property drawer.
- Optional argument DRAWER, when non-nil, is a string representing
- drawer's name. Otherwise, the user is prompted for a name.
- If a region is active, insert the drawer around that region
- instead.
- Point is left between drawer's boundaries."
- (interactive "P")
- (let* ((drawer (if arg "PROPERTIES"
- (or drawer (read-from-minibuffer "Drawer: ")))))
- (cond
- ;; With C-u, fall back on `org-insert-property-drawer'
- (arg (org-insert-property-drawer))
- ;; Check validity of suggested drawer's name.
- ((not (string-match-p org-drawer-regexp (format ":%s:" drawer)))
- (user-error "Invalid drawer name"))
- ;; With an active region, insert a drawer at point.
- ((not (org-region-active-p))
- (progn
- (unless (bolp) (insert "\n"))
- (insert (format ":%s:\n\n:END:\n" drawer))
- (forward-line -2)))
- ;; Otherwise, insert the drawer at point
- (t
- (let ((rbeg (region-beginning))
- (rend (copy-marker (region-end))))
- (unwind-protect
- (progn
- (goto-char rbeg)
- (beginning-of-line)
- (when (save-excursion
- (re-search-forward org-outline-regexp-bol rend t))
- (user-error "Drawers cannot contain headlines"))
- ;; Position point at the beginning of the first
- ;; non-blank line in region. Insert drawer's opening
- ;; there, then indent it.
- (org-skip-whitespace)
- (beginning-of-line)
- (insert ":" drawer ":\n")
- (forward-line -1)
- (indent-for-tab-command)
- ;; Move point to the beginning of the first blank line
- ;; after the last non-blank line in region. Insert
- ;; drawer's closing, then indent it.
- (goto-char rend)
- (skip-chars-backward " \r\t\n")
- (insert "\n:END:")
- (deactivate-mark t)
- (indent-for-tab-command)
- (unless (eolp) (insert "\n")))
- ;; Clear marker, whatever the outcome of insertion is.
- (set-marker rend nil)))))))
- (defvar org-property-set-functions-alist nil
- "Property set function alist.
- Each entry should have the following format:
- (PROPERTY . READ-FUNCTION)
- The read function will be called with the same argument as
- `org-completing-read'.")
- (defun org-set-property-function (property)
- "Get the function that should be used to set PROPERTY.
- This is computed according to `org-property-set-functions-alist'."
- (or (cdr (assoc property org-property-set-functions-alist))
- 'org-completing-read))
- (defun org-read-property-value (property)
- "Read PROPERTY value from user."
- (let* ((completion-ignore-case t)
- (allowed (org-property-get-allowed-values nil property 'table))
- (cur (org-entry-get nil property))
- (prompt (concat property " value"
- (if (and cur (string-match "\\S-" cur))
- (concat " [" cur "]") "") ": "))
- (set-function (org-set-property-function property))
- (val (if allowed
- (funcall set-function prompt allowed nil
- (not (get-text-property 0 'org-unrestricted
- (caar allowed))))
- (funcall set-function prompt
- (mapcar 'list (org-property-values property))
- nil nil "" nil cur))))
- (org-trim val)))
- (defvar org-last-set-property nil)
- (defvar org-last-set-property-value nil)
- (defun org-read-property-name ()
- "Read a property name."
- (let ((completion-ignore-case t)
- (default-prop (or (and (org-at-property-p)
- (match-string-no-properties 2))
- org-last-set-property)))
- (org-completing-read
- (concat "Property"
- (if default-prop (concat " [" default-prop "]") "")
- ": ")
- (mapcar #'list (org-buffer-property-keys nil t t))
- nil nil nil nil default-prop)))
- (defun org-set-property-and-value (use-last)
- "Allow to set [PROPERTY]: [value] direction from prompt.
- When use-default, don't even ask, just use the last
- \"[PROPERTY]: [value]\" string from the history."
- (interactive "P")
- (let* ((completion-ignore-case t)
- (pv (or (and use-last org-last-set-property-value)
- (org-completing-read
- "Enter a \"[Property]: [value]\" pair: "
- nil nil nil nil nil
- org-last-set-property-value)))
- prop val)
- (when (string-match "^[ \t]*\\([^:]+\\):[ \t]*\\(.*\\)[ \t]*$" pv)
- (setq prop (match-string 1 pv)
- val (match-string 2 pv))
- (org-set-property prop val))))
- (defun org-set-property (property value)
- "In the current entry, set PROPERTY to VALUE.
- When called interactively, this will prompt for a property name, offering
- completion on existing and default properties. And then it will prompt
- for a value, offering completion either on allowed values (via an inherited
- xxx_ALL property) or on existing values in other instances of this property
- in the current file.
- Throw an error when trying to set a property with an invalid name."
- (interactive (list nil nil))
- (let ((property (or property (org-read-property-name))))
- ;; `org-entry-put' also makes the following check, but this one
- ;; avoids polluting `org-last-set-property' and
- ;; `org-last-set-property-value' needlessly.
- (unless (org--valid-property-p property)
- (user-error "Invalid property name: \"%s\"" property))
- (let ((value (or value (org-read-property-value property)))
- (fn (cdr (assoc-string property org-properties-postprocess-alist t))))
- (setq org-last-set-property property)
- (setq org-last-set-property-value (concat property ": " value))
- ;; Possibly postprocess the inserted value:
- (when fn (setq value (funcall fn value)))
- (unless (equal (org-entry-get nil property) value)
- (org-entry-put nil property value)))))
- (defun org-find-property (property &optional value)
- "Find first entry in buffer that sets PROPERTY.
- When optional argument VALUE is non-nil, only consider an entry
- if it contains PROPERTY set to this value. If PROPERTY should be
- explicitly set to nil, use string \"nil\" for VALUE.
- Return position where the entry begins, or nil if there is no
- such entry. If narrowing is in effect, only search the visible
- part of the buffer."
- (save-excursion
- (goto-char (point-min))
- (let ((case-fold-search t)
- (re (org-re-property property nil (not value) value)))
- (catch 'exit
- (while (re-search-forward re nil t)
- (when (if value (org-at-property-p)
- (org-entry-get (point) property nil t))
- (throw 'exit (progn (org-back-to-heading t) (point)))))))))
- (defun org-delete-property (property)
- "In the current entry, delete PROPERTY."
- (interactive
- (let* ((completion-ignore-case t)
- (cat (org-entry-get (point) "CATEGORY"))
- (props0 (org-entry-properties nil 'standard))
- (props (if cat props0
- (delete `("CATEGORY" . ,(org-get-category)) props0)))
- (prop (if (< 1 (length props))
- (completing-read "Property: " props nil t)
- (caar props))))
- (list prop)))
- (if (not property)
- (message "No property to delete in this entry")
- (org-entry-delete nil property)
- (message "Property \"%s\" deleted" property)))
- (defun org-delete-property-globally (property)
- "Remove PROPERTY globally, from all entries.
- This function ignores narrowing, if any."
- (interactive
- (let* ((completion-ignore-case t)
- (prop (completing-read
- "Globally remove property: "
- (mapcar #'list (org-buffer-property-keys)))))
- (list prop)))
- (org-with-wide-buffer
- (goto-char (point-min))
- (let ((count 0)
- (re (org-re-property (concat (regexp-quote property) "\\+?") t t)))
- (while (re-search-forward re nil t)
- (when (org-entry-delete (point) property) (cl-incf count)))
- (message "Property \"%s\" removed from %d entries" property count))))
- (defvar org-columns-current-fmt-compiled) ; defined in org-colview.el
- (defun org-compute-property-at-point ()
- "Compute the property at point.
- This looks for an enclosing column format, extracts the operator and
- then applies it to the property in the column format's scope."
- (interactive)
- (unless (org-at-property-p)
- (user-error "Not at a property"))
- (let ((prop (match-string-no-properties 2)))
- (org-columns-get-format-and-top-level)
- (unless (nth 3 (assoc-string prop org-columns-current-fmt-compiled t))
- (user-error "No operator defined for property %s" prop))
- (org-columns-compute prop)))
- (defvar org-property-allowed-value-functions nil
- "Hook for functions supplying allowed values for a specific property.
- The functions must take a single argument, the name of the property, and
- return a flat list of allowed values. If \":ETC\" is one of
- the values, this means that these values are intended as defaults for
- completion, but that other values should be allowed too.
- The functions must return nil if they are not responsible for this
- property.")
- (defun org-property-get-allowed-values (pom property &optional table)
- "Get allowed values for the property PROPERTY.
- When TABLE is non-nil, return an alist that can directly be used for
- completion."
- (let (vals)
- (cond
- ((equal property "TODO")
- (setq vals (org-with-point-at pom
- (append org-todo-keywords-1 '("")))))
- ((equal property "PRIORITY")
- (let ((n org-lowest-priority))
- (while (>= n org-highest-priority)
- (push (char-to-string n) vals)
- (setq n (1- n)))))
- ((equal property "CATEGORY"))
- ((member property org-special-properties))
- ((setq vals (run-hook-with-args-until-success
- 'org-property-allowed-value-functions property)))
- (t
- (setq vals (org-entry-get pom (concat property "_ALL") 'inherit))
- (when (and vals (string-match "\\S-" vals))
- (setq vals (car (read-from-string (concat "(" vals ")"))))
- (setq vals (mapcar (lambda (x)
- (cond ((stringp x) x)
- ((numberp x) (number-to-string x))
- ((symbolp x) (symbol-name x))
- (t "???")))
- vals)))))
- (when (member ":ETC" vals)
- (setq vals (remove ":ETC" vals))
- (org-add-props (car vals) '(org-unrestricted t)))
- (if table (mapcar 'list vals) vals)))
- (defun org-property-previous-allowed-value (&optional _previous)
- "Switch to the next allowed value for this property."
- (interactive)
- (org-property-next-allowed-value t))
- (defun org-property-next-allowed-value (&optional previous)
- "Switch to the next allowed value for this property."
- (interactive)
- (unless (org-at-property-p)
- (user-error "Not at a property"))
- (let* ((prop (car (save-match-data (org-split-string (match-string 1) ":"))))
- (key (match-string 2))
- (value (match-string 3))
- (allowed (or (org-property-get-allowed-values (point) key)
- (and (member value '("[ ]" "[-]" "[X]"))
- '("[ ]" "[X]"))))
- (heading (save-match-data (nth 4 (org-heading-components))))
- nval)
- (unless allowed
- (user-error "Allowed values for this property have not been defined"))
- (when previous (setq allowed (reverse allowed)))
- (when (member value allowed)
- (setq nval (car (cdr (member value allowed)))))
- (setq nval (or nval (car allowed)))
- (when (equal nval value)
- (user-error "Only one allowed value for this property"))
- (org-at-property-p)
- (replace-match (concat " :" key ": " nval) t t)
- (org-indent-line)
- (beginning-of-line 1)
- (skip-chars-forward " \t")
- (when (equal prop org-effort-property)
- (org-refresh-property
- '((effort . identity)
- (effort-minutes . org-duration-string-to-minutes))
- nval)
- (when (string= org-clock-current-task heading)
- (setq org-clock-effort nval)
- (org-clock-update-mode-line)))
- (run-hook-with-args 'org-property-changed-functions key nval)))
- (defun org-find-olp (path &optional this-buffer)
- "Return a marker pointing to the entry at outline path OLP.
- If anything goes wrong, throw an error.
- You can wrap this call to catch the error like this:
- (condition-case msg
- (org-mobile-locate-entry (match-string 4))
- (error (nth 1 msg)))
- The return value will then be either a string with the error message,
- or a marker if everything is OK.
- If THIS-BUFFER is set, the outline path does not contain a file,
- only headings."
- (let* ((file (if this-buffer buffer-file-name (pop path)))
- (buffer (if this-buffer (current-buffer) (find-file-noselect file)))
- (level 1)
- (lmin 1)
- (lmax 1)
- end found flevel)
- (unless buffer (error "File not found :%s" file))
- (with-current-buffer buffer
- (org-with-wide-buffer
- (goto-char (point-min))
- (dolist (heading path)
- (let ((re (format org-complex-heading-regexp-format
- (regexp-quote heading)))
- (cnt 0))
- (while (re-search-forward re end t)
- (setq level (- (match-end 1) (match-beginning 1)))
- (when (and (>= level lmin) (<= level lmax))
- (setq found (match-beginning 0) flevel level cnt (1+ cnt))))
- (when (= cnt 0)
- (error "Heading not found on level %d: %s" lmax heading))
- (when (> cnt 1)
- (error "Heading not unique on level %d: %s" lmax heading))
- (goto-char found)
- (setq lmin (1+ flevel) lmax (+ lmin (if org-odd-levels-only 1 0)))
- (setq end (save-excursion (org-end-of-subtree t t)))))
- (when (org-at-heading-p)
- (point-marker))))))
- (defun org-find-exact-headline-in-buffer (heading &optional buffer pos-only)
- "Find node HEADING in BUFFER.
- Return a marker to the heading if it was found, or nil if not.
- If POS-ONLY is set, return just the position instead of a marker.
- The heading text must match exact, but it may have a TODO keyword,
- a priority cookie and tags in the standard locations."
- (with-current-buffer (or buffer (current-buffer))
- (org-with-wide-buffer
- (goto-char (point-min))
- (let (case-fold-search)
- (when (re-search-forward
- (format org-complex-heading-regexp-format
- (regexp-quote heading)) nil t)
- (if pos-only
- (match-beginning 0)
- (move-marker (make-marker) (match-beginning 0))))))))
- (defun org-find-exact-heading-in-directory (heading &optional dir)
- "Find Org node headline HEADING in all .org files in directory DIR.
- When the target headline is found, return a marker to this location."
- (let ((files (directory-files (or dir default-directory)
- t "\\`[^.#].*\\.org\\'"))
- visiting m buffer)
- (catch 'found
- (dolist (file files)
- (message "trying %s" file)
- (setq visiting (org-find-base-buffer-visiting file))
- (setq buffer (or visiting (find-file-noselect file)))
- (setq m (org-find-exact-headline-in-buffer
- heading buffer))
- (when (and (not m) (not visiting)) (kill-buffer buffer))
- (and m (throw 'found m))))))
- (defun org-find-entry-with-id (ident)
- "Locate the entry that contains the ID property with exact value IDENT.
- IDENT can be a string, a symbol or a number, this function will search for
- the string representation of it.
- Return the position where this entry starts, or nil if there is no such entry."
- (interactive "sID: ")
- (let ((id (cond
- ((stringp ident) ident)
- ((symbolp ident) (symbol-name ident))
- ((numberp ident) (number-to-string ident))
- (t (error "IDENT %s must be a string, symbol or number" ident)))))
- (org-with-wide-buffer (org-find-property "ID" id))))
- ;;;; Timestamps
- (defvar org-last-changed-timestamp nil)
- (defvar org-last-inserted-timestamp nil
- "The last time stamp inserted with `org-insert-time-stamp'.")
- (defvar org-ts-what) ; dynamically scoped parameter
- (defun org-time-stamp (arg &optional inactive)
- "Prompt for a date/time and insert a time stamp.
- If the user specifies a time like HH:MM or if this command is
- called with at least one prefix argument, the time stamp contains
- the date and the time. Otherwise, only the date is included.
- All parts of a date not specified by the user are filled in from
- the timestamp at point, if any, or the current date/time
- otherwise.
- If there is already a timestamp at the cursor, it is replaced.
- With two universal prefix arguments, insert an active timestamp
- with the current time without prompting the user.
- When called from lisp, the timestamp is inactive if INACTIVE is
- non-nil."
- (interactive "P")
- (let* ((ts (cond
- ((org-at-date-range-p t)
- (match-string (if (< (point) (- (match-beginning 2) 2)) 1 2)))
- ((org-at-timestamp-p t) (match-string 0))))
- ;; Default time is either the timestamp at point or today.
- ;; When entering a range, only the range start is considered.
- (default-time (if (not ts) (current-time)
- (apply #'encode-time (org-parse-time-string ts))))
- (default-input (and ts (org-get-compact-tod ts)))
- (repeater (and ts
- (string-match "\\([.+-]+[0-9]+[hdwmy] ?\\)+" ts)
- (match-string 0 ts)))
- org-time-was-given
- org-end-time-was-given
- (time
- (and (if (equal arg '(16)) (current-time)
- ;; Preserve `this-command' and `last-command'.
- (let ((this-command this-command)
- (last-command last-command))
- (org-read-date
- arg 'totime nil nil default-time default-input
- inactive))))))
- (cond
- ((and ts
- (memq last-command '(org-time-stamp org-time-stamp-inactive))
- (memq this-command '(org-time-stamp org-time-stamp-inactive)))
- (insert "--")
- (org-insert-time-stamp time (or org-time-was-given arg) inactive))
- (ts
- ;; Make sure we're on a timestamp. When in the middle of a date
- ;; range, move arbitrarily to range end.
- (unless (org-at-timestamp-p t)
- (skip-chars-forward "-")
- (org-at-timestamp-p t))
- (replace-match "")
- (setq org-last-changed-timestamp
- (org-insert-time-stamp
- time (or org-time-was-given arg)
- inactive nil nil (list org-end-time-was-given)))
- (when repeater
- (backward-char)
- (insert " " repeater)
- (setq org-last-changed-timestamp
- (concat (substring org-last-inserted-timestamp 0 -1)
- " " repeater ">")))
- (message "Timestamp updated"))
- ((equal arg '(16)) (org-insert-time-stamp time t inactive))
- (t (org-insert-time-stamp
- time (or org-time-was-given arg) inactive nil nil
- (list org-end-time-was-given))))))
- ;; FIXME: can we use this for something else, like computing time differences?
- (defun org-get-compact-tod (s)
- (when (string-match "\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\(-\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\)?" s)
- (let* ((t1 (match-string 1 s))
- (h1 (string-to-number (match-string 2 s)))
- (m1 (string-to-number (match-string 3 s)))
- (t2 (and (match-end 4) (match-string 5 s)))
- (h2 (and t2 (string-to-number (match-string 6 s))))
- (m2 (and t2 (string-to-number (match-string 7 s))))
- dh dm)
- (if (not t2)
- t1
- (setq dh (- h2 h1) dm (- m2 m1))
- (when (< dm 0) (setq dm (+ dm 60) dh (1- dh)))
- (concat t1 "+" (number-to-string dh)
- (and (/= 0 dm) (format ":%02d" dm)))))))
- (defun org-time-stamp-inactive (&optional arg)
- "Insert an inactive time stamp.
- An inactive time stamp is enclosed in square brackets instead of angle
- brackets. It is inactive in the sense that it does not trigger agenda entries,
- does not link to the calendar and cannot be changed with the S-cursor keys.
- So these are more for recording a certain time/date."
- (interactive "P")
- (org-time-stamp arg 'inactive))
- (defvar org-date-ovl (make-overlay 1 1))
- (overlay-put org-date-ovl 'face 'org-date-selected)
- (delete-overlay org-date-ovl)
- (defvar org-ans1) ; dynamically scoped parameter
- (defvar org-ans2) ; dynamically scoped parameter
- (defvar org-plain-time-of-day-regexp) ; defined below
- (defvar org-overriding-default-time nil) ; dynamically scoped
- (defvar org-read-date-overlay nil)
- (defvar org-dcst nil) ; dynamically scoped
- (defvar org-read-date-history nil)
- (defvar org-read-date-final-answer nil)
- (defvar org-read-date-analyze-futurep nil)
- (defvar org-read-date-analyze-forced-year nil)
- (defvar org-read-date-inactive)
- (defvar org-read-date-minibuffer-local-map
- (let* ((map (make-sparse-keymap)))
- (set-keymap-parent map minibuffer-local-map)
- (org-defkey map (kbd ".")
- (lambda () (interactive)
- ;; Are we at the beginning of the prompt?
- (if (looking-back "^[^:]+: "
- (let ((inhibit-field-text-motion t))
- (line-beginning-position)))
- (org-eval-in-calendar '(calendar-goto-today))
- (insert "."))))
- (org-defkey map (kbd "C-.")
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-goto-today))))
- (org-defkey map [(meta shift left)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-backward-month 1))))
- (org-defkey map [(meta shift right)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-forward-month 1))))
- (org-defkey map [(meta shift up)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-backward-year 1))))
- (org-defkey map [(meta shift down)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-forward-year 1))))
- (org-defkey map [?\e (shift left)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-backward-month 1))))
- (org-defkey map [?\e (shift right)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-forward-month 1))))
- (org-defkey map [?\e (shift up)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-backward-year 1))))
- (org-defkey map [?\e (shift down)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-forward-year 1))))
- (org-defkey map [(shift up)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-backward-week 1))))
- (org-defkey map [(shift down)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-forward-week 1))))
- (org-defkey map [(shift left)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-backward-day 1))))
- (org-defkey map [(shift right)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-forward-day 1))))
- (org-defkey map "!"
- (lambda () (interactive)
- (org-eval-in-calendar '(diary-view-entries))
- (message "")))
- (org-defkey map ">"
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-scroll-left 1))))
- (org-defkey map "<"
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-scroll-right 1))))
- (org-defkey map "\C-v"
- (lambda () (interactive)
- (org-eval-in-calendar
- '(calendar-scroll-left-three-months 1))))
- (org-defkey map "\M-v"
- (lambda () (interactive)
- (org-eval-in-calendar
- '(calendar-scroll-right-three-months 1))))
- map)
- "Keymap for minibuffer commands when using `org-read-date'.")
- (defvar org-def)
- (defvar org-defdecode)
- (defvar org-with-time)
- (defvar calendar-setup) ; Dynamically scoped.
- (defun org-read-date (&optional with-time to-time from-string prompt
- default-time default-input inactive)
- "Read a date, possibly a time, and make things smooth for the user.
- The prompt will suggest to enter an ISO date, but you can also enter anything
- which will at least partially be understood by `parse-time-string'.
- Unrecognized parts of the date will default to the current day, month, year,
- hour and minute. If this command is called to replace a timestamp at point,
- or to enter the second timestamp of a range, the default time is taken
- from the existing stamp. Furthermore, the command prefers the future,
- so if you are giving a date where the year is not given, and the day-month
- combination is already past in the current year, it will assume you
- mean next year. For details, see the manual. A few examples:
- 3-2-5 --> 2003-02-05
- feb 15 --> currentyear-02-15
- 2/15 --> currentyear-02-15
- sep 12 9 --> 2009-09-12
- 12:45 --> today 12:45
- 22 sept 0:34 --> currentyear-09-22 0:34
- 12 --> currentyear-currentmonth-12
- Fri --> nearest Friday after today
- -Tue --> last Tuesday
- etc.
- Furthermore you can specify a relative date by giving, as the *first* thing
- in the input: a plus/minus sign, a number and a letter [hdwmy] to indicate
- change in days weeks, months, years.
- With a single plus or minus, the date is relative to today. With a double
- plus or minus, it is relative to the date in DEFAULT-TIME. E.g.
- +4d --> four days from today
- +4 --> same as above
- +2w --> two weeks from today
- ++5 --> five days from default date
- The function understands only English month and weekday abbreviations.
- While prompting, a calendar is popped up - you can also select the
- date with the mouse (button 1). The calendar shows a period of three
- months. To scroll it to other months, use the keys `>' and `<'.
- If you don't like the calendar, turn it off with
- (setq org-read-date-popup-calendar nil)
- With optional argument TO-TIME, the date will immediately be converted
- to an internal time.
- With an optional argument WITH-TIME, the prompt will suggest to
- also insert a time. Note that when WITH-TIME is not set, you can
- still enter a time, and this function will inform the calling routine
- about this change. The calling routine may then choose to change the
- format used to insert the time stamp into the buffer to include the time.
- With optional argument FROM-STRING, read from this string instead from
- the user. PROMPT can overwrite the default prompt. DEFAULT-TIME is
- the time/date that is used for everything that is not specified by the
- user."
- (require 'parse-time)
- (let* ((org-with-time with-time)
- (org-time-stamp-rounding-minutes
- (if (equal org-with-time '(16))
- '(0 0)
- org-time-stamp-rounding-minutes))
- (org-dcst org-display-custom-times)
- (ct (org-current-time))
- (org-def (or org-overriding-default-time default-time ct))
- (org-defdecode (decode-time org-def))
- (cur-frame (selected-frame))
- (mouse-autoselect-window nil) ; Don't let the mouse jump
- (calendar-setup
- (and (eq calendar-setup 'calendar-only) 'calendar-only))
- (calendar-move-hook nil)
- (calendar-view-diary-initially-flag nil)
- (calendar-view-holidays-initially-flag nil)
- ans (org-ans0 "") org-ans1 org-ans2 final cal-frame)
- ;; Rationalize `org-def' and `org-defdecode', if required.
- (when (< (nth 2 org-defdecode) org-extend-today-until)
- (setf (nth 2 org-defdecode) -1)
- (setf (nth 1 org-defdecode) 59)
- (setq org-def (apply #'encode-time org-defdecode))
- (setq org-defdecode (decode-time org-def)))
- (let* ((timestr (format-time-string
- (if org-with-time "%Y-%m-%d %H:%M" "%Y-%m-%d")
- org-def))
- (prompt (concat (if prompt (concat prompt " ") "")
- (format "Date+time [%s]: " timestr))))
- (cond
- (from-string (setq ans from-string))
- (org-read-date-popup-calendar
- (save-excursion
- (save-window-excursion
- (calendar)
- (when (eq calendar-setup 'calendar-only)
- (setq cal-frame
- (window-frame (get-buffer-window "*Calendar*" 'visible)))
- (select-frame cal-frame))
- (org-eval-in-calendar '(setq cursor-type nil) t)
- (unwind-protect
- (progn
- (calendar-forward-day (- (time-to-days org-def)
- (calendar-absolute-from-gregorian
- (calendar-current-date))))
- (org-eval-in-calendar nil t)
- (let* ((old-map (current-local-map))
- (map (copy-keymap calendar-mode-map))
- (minibuffer-local-map
- (copy-keymap org-read-date-minibuffer-local-map)))
- (org-defkey map (kbd "RET") 'org-calendar-select)
- (org-defkey map [mouse-1] 'org-calendar-select-mouse)
- (org-defkey map [mouse-2] 'org-calendar-select-mouse)
- (unwind-protect
- (progn
- (use-local-map map)
- (setq org-read-date-inactive inactive)
- (add-hook 'post-command-hook 'org-read-date-display)
- (setq org-ans0
- (read-string prompt
- default-input
- 'org-read-date-history
- nil))
- ;; org-ans0: from prompt
- ;; org-ans1: from mouse click
- ;; org-ans2: from calendar motion
- (setq ans
- (concat org-ans0 " " (or org-ans1 org-ans2))))
- (remove-hook 'post-command-hook 'org-read-date-display)
- (use-local-map old-map)
- (when org-read-date-overlay
- (delete-overlay org-read-date-overlay)
- (setq org-read-date-overlay nil)))))
- (bury-buffer "*Calendar*")
- (when cal-frame
- (delete-frame cal-frame)
- (select-frame-set-input-focus cur-frame))))))
- (t ; Naked prompt only
- (unwind-protect
- (setq ans (read-string prompt default-input
- 'org-read-date-history timestr))
- (when org-read-date-overlay
- (delete-overlay org-read-date-overlay)
- (setq org-read-date-overlay nil))))))
- (setq final (org-read-date-analyze ans org-def org-defdecode))
- (when org-read-date-analyze-forced-year
- (message "Year was forced into %s"
- (if org-read-date-force-compatible-dates
- "compatible range (1970-2037)"
- "range representable on this machine"))
- (ding))
- ;; One round trip to get rid of 34th of August and stuff like that....
- (setq final (decode-time (apply 'encode-time final)))
- (setq org-read-date-final-answer ans)
- (if to-time
- (apply 'encode-time final)
- (if (and (boundp 'org-time-was-given) org-time-was-given)
- (format "%04d-%02d-%02d %02d:%02d"
- (nth 5 final) (nth 4 final) (nth 3 final)
- (nth 2 final) (nth 1 final))
- (format "%04d-%02d-%02d" (nth 5 final) (nth 4 final) (nth 3 final))))))
- (defun org-read-date-display ()
- "Display the current date prompt interpretation in the minibuffer."
- (when org-read-date-display-live
- (when org-read-date-overlay
- (delete-overlay org-read-date-overlay))
- (when (minibufferp (current-buffer))
- (save-excursion
- (end-of-line 1)
- (while (not (equal (buffer-substring
- (max (point-min) (- (point) 4)) (point))
- " "))
- (insert " ")))
- (let* ((ans (concat (buffer-substring (point-at-bol) (point-max))
- " " (or org-ans1 org-ans2)))
- (org-end-time-was-given nil)
- (f (org-read-date-analyze ans org-def org-defdecode))
- (fmts (if org-dcst
- org-time-stamp-custom-formats
- org-time-stamp-formats))
- (fmt (if (or org-with-time
- (and (boundp 'org-time-was-given) org-time-was-given))
- (cdr fmts)
- (car fmts)))
- (txt (format-time-string fmt (apply 'encode-time f)))
- (txt (if org-read-date-inactive (concat "[" (substring txt 1 -1) "]") txt))
- (txt (concat "=> " txt)))
- (when (and org-end-time-was-given
- (string-match org-plain-time-of-day-regexp txt))
- (setq txt (concat (substring txt 0 (match-end 0)) "-"
- org-end-time-was-given
- (substring txt (match-end 0)))))
- (when org-read-date-analyze-futurep
- (setq txt (concat txt " (=>F)")))
- (setq org-read-date-overlay
- (make-overlay (1- (point-at-eol)) (point-at-eol)))
- (org-overlay-display org-read-date-overlay txt 'secondary-selection)))))
- (defun org-read-date-analyze (ans def defdecode)
- "Analyze the combined answer of the date prompt."
- ;; FIXME: cleanup and comment
- ;; Pass `current-time' result to `decode-time' (instead of calling
- ;; without arguments) so that only `current-time' has to be
- ;; overridden in tests.
- (let ((org-def def)
- (org-defdecode defdecode)
- (nowdecode (decode-time (current-time)))
- delta deltan deltaw deltadef year month day
- hour minute second wday pm h2 m2 tl wday1
- iso-year iso-weekday iso-week iso-date futurep kill-year)
- (setq org-read-date-analyze-futurep nil
- org-read-date-analyze-forced-year nil)
- (when (string-match "\\`[ \t]*\\.[ \t]*\\'" ans)
- (setq ans "+0"))
- (when (setq delta (org-read-date-get-relative ans (current-time) org-def))
- (setq ans (replace-match "" t t ans)
- deltan (car delta)
- deltaw (nth 1 delta)
- deltadef (nth 2 delta)))
- ;; Check if there is an iso week date in there. If yes, store the
- ;; info and postpone interpreting it until the rest of the parsing
- ;; is done.
- (when (string-match "\\<\\(?:\\([0-9]+\\)-\\)?[wW]\\([0-9]\\{1,2\\}\\)\\(?:-\\([0-6]\\)\\)?\\([ \t]\\|$\\)" ans)
- (setq iso-year (when (match-end 1)
- (org-small-year-to-year
- (string-to-number (match-string 1 ans))))
- iso-weekday (when (match-end 3)
- (string-to-number (match-string 3 ans)))
- iso-week (string-to-number (match-string 2 ans)))
- (setq ans (replace-match "" t t ans)))
- ;; Help matching ISO dates with single digit month or day, like 2006-8-11.
- (when (string-match
- "^ *\\(\\([0-9]+\\)-\\)?\\([0-1]?[0-9]\\)-\\([0-3]?[0-9]\\)\\([^-0-9]\\|$\\)" ans)
- (setq year (if (match-end 2)
- (string-to-number (match-string 2 ans))
- (progn (setq kill-year t)
- (string-to-number (format-time-string "%Y"))))
- month (string-to-number (match-string 3 ans))
- day (string-to-number (match-string 4 ans)))
- (setq year (org-small-year-to-year year))
- (setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day)
- t nil ans)))
- ;; Help matching dotted european dates
- (when (string-match
- "^ *\\(3[01]\\|0?[1-9]\\|[12][0-9]\\)\\. ?\\(0?[1-9]\\|1[012]\\)\\.\\( ?[1-9][0-9]\\{3\\}\\)?" ans)
- (setq year (if (match-end 3) (string-to-number (match-string 3 ans))
- (setq kill-year t)
- (string-to-number (format-time-string "%Y")))
- day (string-to-number (match-string 1 ans))
- month (string-to-number (match-string 2 ans))
- ans (replace-match (format "%04d-%02d-%02d" year month day)
- t nil ans)))
- ;; Help matching american dates, like 5/30 or 5/30/7
- (when (string-match
- "^ *\\(0?[1-9]\\|1[012]\\)/\\(0?[1-9]\\|[12][0-9]\\|3[01]\\)\\(/\\([0-9]+\\)\\)?\\([^/0-9]\\|$\\)" ans)
- (setq year (if (match-end 4)
- (string-to-number (match-string 4 ans))
- (progn (setq kill-year t)
- (string-to-number (format-time-string "%Y"))))
- month (string-to-number (match-string 1 ans))
- day (string-to-number (match-string 2 ans)))
- (setq year (org-small-year-to-year year))
- (setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day)
- t nil ans)))
- ;; Help matching am/pm times, because `parse-time-string' does not do that.
- ;; If there is a time with am/pm, and *no* time without it, we convert
- ;; so that matching will be successful.
- (cl-loop for i from 1 to 2 do ; twice, for end time as well
- (when (and (not (string-match "\\(\\`\\|[^+]\\)[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans))
- (string-match "\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\(am\\|AM\\|pm\\|PM\\)\\>" ans))
- (setq hour (string-to-number (match-string 1 ans))
- minute (if (match-end 3)
- (string-to-number (match-string 3 ans))
- 0)
- pm (equal ?p
- (string-to-char (downcase (match-string 4 ans)))))
- (if (and (= hour 12) (not pm))
- (setq hour 0)
- (when (and pm (< hour 12)) (setq hour (+ 12 hour))))
- (setq ans (replace-match (format "%02d:%02d" hour minute)
- t t ans))))
- ;; Check if a time range is given as a duration
- (when (string-match "\\([012]?[0-9]\\):\\([0-6][0-9]\\)\\+\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?" ans)
- (setq hour (string-to-number (match-string 1 ans))
- h2 (+ hour (string-to-number (match-string 3 ans)))
- minute (string-to-number (match-string 2 ans))
- m2 (+ minute (if (match-end 5) (string-to-number
- (match-string 5 ans))0)))
- (when (>= m2 60) (setq h2 (1+ h2) m2 (- m2 60)))
- (setq ans (replace-match (format "%02d:%02d-%02d:%02d" hour minute h2 m2)
- t t ans)))
- ;; Check if there is a time range
- (when (boundp 'org-end-time-was-given)
- (setq org-time-was-given nil)
- (when (and (string-match org-plain-time-of-day-regexp ans)
- (match-end 8))
- (setq org-end-time-was-given (match-string 8 ans))
- (setq ans (concat (substring ans 0 (match-beginning 7))
- (substring ans (match-end 7))))))
- (setq tl (parse-time-string ans)
- day (or (nth 3 tl) (nth 3 org-defdecode))
- month
- (cond ((nth 4 tl))
- ((not org-read-date-prefer-future) (nth 4 org-defdecode))
- ;; Day was specified. Make sure DAY+MONTH
- ;; combination happens in the future.
- ((nth 3 tl)
- (setq futurep t)
- (if (< day (nth 3 nowdecode)) (1+ (nth 4 nowdecode))
- (nth 4 nowdecode)))
- (t (nth 4 org-defdecode)))
- year
- (cond ((and (not kill-year) (nth 5 tl)))
- ((not org-read-date-prefer-future) (nth 5 org-defdecode))
- ;; Month was guessed in the future and is at least
- ;; equal to NOWDECODE's. Fix year accordingly.
- (futurep
- (if (or (> month (nth 4 nowdecode))
- (>= day (nth 3 nowdecode)))
- (nth 5 nowdecode)
- (1+ (nth 5 nowdecode))))
- ;; Month was specified. Make sure MONTH+YEAR
- ;; combination happens in the future.
- ((nth 4 tl)
- (setq futurep t)
- (cond ((> month (nth 4 nowdecode)) (nth 5 nowdecode))
- ((< month (nth 4 nowdecode)) (1+ (nth 5 nowdecode)))
- ((< day (nth 3 nowdecode)) (1+ (nth 5 nowdecode)))
- (t (nth 5 nowdecode))))
- (t (nth 5 org-defdecode)))
- hour (or (nth 2 tl) (nth 2 org-defdecode))
- minute (or (nth 1 tl) (nth 1 org-defdecode))
- second (or (nth 0 tl) 0)
- wday (nth 6 tl))
- (when (and (eq org-read-date-prefer-future 'time)
- (not (nth 3 tl)) (not (nth 4 tl)) (not (nth 5 tl))
- (equal day (nth 3 nowdecode))
- (equal month (nth 4 nowdecode))
- (equal year (nth 5 nowdecode))
- (nth 2 tl)
- (or (< (nth 2 tl) (nth 2 nowdecode))
- (and (= (nth 2 tl) (nth 2 nowdecode))
- (nth 1 tl)
- (< (nth 1 tl) (nth 1 nowdecode)))))
- (setq day (1+ day)
- futurep t))
- ;; Special date definitions below
- (cond
- (iso-week
- ;; There was an iso week
- (require 'cal-iso)
- (setq futurep nil)
- (setq year (or iso-year year)
- day (or iso-weekday wday 1)
- wday nil ; to make sure that the trigger below does not match
- iso-date (calendar-gregorian-from-absolute
- (calendar-iso-to-absolute
- (list iso-week day year))))
- ; FIXME: Should we also push ISO weeks into the future?
- ; (when (and org-read-date-prefer-future
- ; (not iso-year)
- ; (< (calendar-absolute-from-gregorian iso-date)
- ; (time-to-days (current-time))))
- ; (setq year (1+ year)
- ; iso-date (calendar-gregorian-from-absolute
- ; (calendar-iso-to-absolute
- ; (list iso-week day year)))))
- (setq month (car iso-date)
- year (nth 2 iso-date)
- day (nth 1 iso-date)))
- (deltan
- (setq futurep nil)
- (unless deltadef
- ;; Pass `current-time' result to `decode-time' (instead of
- ;; calling without arguments) so that only `current-time' has
- ;; to be overridden in tests.
- (let ((now (decode-time (current-time))))
- (setq day (nth 3 now) month (nth 4 now) year (nth 5 now))))
- (cond ((member deltaw '("d" "")) (setq day (+ day deltan)))
- ((equal deltaw "w") (setq day (+ day (* 7 deltan))))
- ((equal deltaw "m") (setq month (+ month deltan)))
- ((equal deltaw "y") (setq year (+ year deltan)))))
- ((and wday (not (nth 3 tl)))
- ;; Weekday was given, but no day, so pick that day in the week
- ;; on or after the derived date.
- (setq wday1 (nth 6 (decode-time (encode-time 0 0 0 day month year))))
- (unless (equal wday wday1)
- (setq day (+ day (% (- wday wday1 -7) 7))))))
- (when (and (boundp 'org-time-was-given)
- (nth 2 tl))
- (setq org-time-was-given t))
- (when (< year 100) (setq year (+ 2000 year)))
- ;; Check of the date is representable
- (if org-read-date-force-compatible-dates
- (progn
- (when (< year 1970)
- (setq year 1970 org-read-date-analyze-forced-year t))
- (when (> year 2037)
- (setq year 2037 org-read-date-analyze-forced-year t)))
- (condition-case nil
- (ignore (encode-time second minute hour day month year))
- (error
- (setq year (nth 5 org-defdecode))
- (setq org-read-date-analyze-forced-year t))))
- (setq org-read-date-analyze-futurep futurep)
- (list second minute hour day month year)))
- (defvar parse-time-weekdays)
- (defun org-read-date-get-relative (s today default)
- "Check string S for special relative date string.
- TODAY and DEFAULT are internal times, for today and for a default.
- Return shift list (N what def-flag)
- WHAT is \"d\", \"w\", \"m\", or \"y\" for day, week, month, year.
- N is the number of WHATs to shift.
- DEF-FLAG is t when a double ++ or -- indicates shift relative to
- the DEFAULT date rather than TODAY."
- (require 'parse-time)
- (when (and
- (string-match
- (concat
- "\\`[ \t]*\\([-+]\\{0,2\\}\\)"
- "\\([0-9]+\\)?"
- "\\([hdwmy]\\|\\(" (mapconcat 'car parse-time-weekdays "\\|") "\\)\\)?"
- "\\([ \t]\\|$\\)") s)
- (or (> (match-end 1) (match-beginning 1)) (match-end 4)))
- (let* ((dir (if (> (match-end 1) (match-beginning 1))
- (string-to-char (substring (match-string 1 s) -1))
- ?+))
- (rel (and (match-end 1) (= 2 (- (match-end 1) (match-beginning 1)))))
- (n (if (match-end 2) (string-to-number (match-string 2 s)) 1))
- (what (if (match-end 3) (match-string 3 s) "d"))
- (wday1 (cdr (assoc (downcase what) parse-time-weekdays)))
- (date (if rel default today))
- (wday (nth 6 (decode-time date)))
- delta)
- (if wday1
- (progn
- (setq delta (mod (+ 7 (- wday1 wday)) 7))
- (when (= delta 0) (setq delta 7))
- (when (= dir ?-)
- (setq delta (- delta 7))
- (when (= delta 0) (setq delta -7)))
- (when (> n 1) (setq delta (+ delta (* (1- n) (if (= dir ?-) -7 7)))))
- (list delta "d" rel))
- (list (* n (if (= dir ?-) -1 1)) what rel)))))
- (defun org-order-calendar-date-args (arg1 arg2 arg3)
- "Turn a user-specified date into the internal representation.
- The internal representation needed by the calendar is (month day year).
- This is a wrapper to handle the brain-dead convention in calendar that
- user function argument order change dependent on argument order."
- (pcase calendar-date-style
- (`american (list arg1 arg2 arg3))
- (`european (list arg2 arg1 arg3))
- (`iso (list arg2 arg3 arg1))))
- (defun org-eval-in-calendar (form &optional keepdate)
- "Eval FORM in the calendar window and return to current window.
- Unless KEEPDATE is non-nil, update `org-ans2' to the cursor date."
- (let ((sf (selected-frame))
- (sw (selected-window)))
- (select-window (get-buffer-window "*Calendar*" t))
- (eval form)
- (when (and (not keepdate) (calendar-cursor-to-date))
- (let* ((date (calendar-cursor-to-date))
- (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
- (setq org-ans2 (format-time-string "%Y-%m-%d" time))))
- (move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer))
- (select-window sw)
- (select-frame-set-input-focus sf)))
- (defun org-calendar-select ()
- "Return to `org-read-date' with the date currently selected.
- This is used by `org-read-date' in a temporary keymap for the calendar buffer."
- (interactive)
- (when (calendar-cursor-to-date)
- (let* ((date (calendar-cursor-to-date))
- (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
- (setq org-ans1 (format-time-string "%Y-%m-%d" time)))
- (when (active-minibuffer-window) (exit-minibuffer))))
- (defun org-insert-time-stamp (time &optional with-hm inactive pre post extra)
- "Insert a date stamp for the date given by the internal TIME.
- See `format-time-string' for the format of TIME.
- WITH-HM means use the stamp format that includes the time of the day.
- INACTIVE means use square brackets instead of angular ones, so that the
- stamp will not contribute to the agenda.
- PRE and POST are optional strings to be inserted before and after the
- stamp.
- The command returns the inserted time stamp."
- (let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats))
- stamp)
- (when inactive (setq fmt (concat "[" (substring fmt 1 -1) "]")))
- (insert-before-markers (or pre ""))
- (when (listp extra)
- (setq extra (car extra))
- (if (and (stringp extra)
- (string-match "\\([0-9]+\\):\\([0-9]+\\)" extra))
- (setq extra (format "-%02d:%02d"
- (string-to-number (match-string 1 extra))
- (string-to-number (match-string 2 extra))))
- (setq extra nil)))
- (when extra
- (setq fmt (concat (substring fmt 0 -1) extra (substring fmt -1))))
- (insert-before-markers (setq stamp (format-time-string fmt time)))
- (insert-before-markers (or post ""))
- (setq org-last-inserted-timestamp stamp)))
- (defun org-toggle-time-stamp-overlays ()
- "Toggle the use of custom time stamp formats."
- (interactive)
- (setq org-display-custom-times (not org-display-custom-times))
- (unless org-display-custom-times
- (let ((p (point-min)) (bmp (buffer-modified-p)))
- (while (setq p (next-single-property-change p 'display))
- (when (and (get-text-property p 'display)
- (eq (get-text-property p 'face) 'org-date))
- (remove-text-properties
- p (setq p (next-single-property-change p 'display))
- '(display t))))
- (set-buffer-modified-p bmp)))
- (org-restart-font-lock)
- (setq org-table-may-need-update t)
- (if org-display-custom-times
- (message "Time stamps are overlaid with custom format")
- (message "Time stamp overlays removed")))
- (defun org-display-custom-time (beg end)
- "Overlay modified time stamp format over timestamp between BEG and END."
- (let* ((ts (buffer-substring beg end))
- t1 w1 with-hm tf time str w2 (off 0))
- (save-match-data
- (setq t1 (org-parse-time-string ts t))
- (when (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)?\\'" ts)
- (setq off (- (match-end 0) (match-beginning 0)))))
- (setq end (- end off))
- (setq w1 (- end beg)
- with-hm (and (nth 1 t1) (nth 2 t1))
- tf (funcall (if with-hm 'cdr 'car) org-time-stamp-custom-formats)
- time (org-fix-decoded-time t1)
- str (org-add-props
- (format-time-string
- (substring tf 1 -1) (apply 'encode-time time))
- nil 'mouse-face 'highlight)
- w2 (length str))
- (unless (= w2 w1)
- (add-text-properties (1+ beg) (+ 2 beg)
- (list 'org-dwidth t 'org-dwidth-n (- w1 w2))))
- (put-text-property beg end 'display str)))
- (defun org-fix-decoded-time (time)
- "Set 0 instead of nil for the first 6 elements of time.
- Don't touch the rest."
- (let ((n 0))
- (mapcar (lambda (x) (if (< (setq n (1+ n)) 7) (or x 0) x)) time)))
- (defun org-time-stamp-to-now (timestamp-string &optional seconds)
- "Difference between TIMESTAMP-STRING and now in days.
- If SECONDS is non-nil, return the difference in seconds."
- (let ((fdiff (if seconds #'float-time #'time-to-days)))
- (- (funcall fdiff (org-time-string-to-time timestamp-string))
- (funcall fdiff (current-time)))))
- (defun org-deadline-close-p (timestamp-string &optional ndays)
- "Is the time in TIMESTAMP-STRING close to the current date?"
- (setq ndays (or ndays (org-get-wdays timestamp-string)))
- (and (<= (org-time-stamp-to-now timestamp-string) ndays)
- (not (org-entry-is-done-p))))
- (defun org-get-wdays (ts &optional delay zero-delay)
- "Get the deadline lead time appropriate for timestring TS.
- When DELAY is non-nil, get the delay time for scheduled items
- instead of the deadline lead time. When ZERO-DELAY is non-nil
- and `org-scheduled-delay-days' is 0, enforce 0 as the delay,
- don't try to find the delay cookie in the scheduled timestamp."
- (let ((tv (if delay org-scheduled-delay-days
- org-deadline-warning-days)))
- (cond
- ((or (and delay (< tv 0))
- (and delay zero-delay (<= tv 0))
- (and (not delay) (<= tv 0)))
- ;; Enforce this value no matter what
- (- tv))
- ((string-match "-\\([0-9]+\\)\\([hdwmy]\\)\\(\\'\\|>\\| \\)" ts)
- ;; lead time is specified.
- (floor (* (string-to-number (match-string 1 ts))
- (cdr (assoc (match-string 2 ts)
- '(("d" . 1) ("w" . 7)
- ("m" . 30.4) ("y" . 365.25)
- ("h" . 0.041667)))))))
- ;; go for the default.
- (t tv))))
- (defun org-calendar-select-mouse (ev)
- "Return to `org-read-date' with the date currently selected.
- This is used by `org-read-date' in a temporary keymap for the calendar buffer."
- (interactive "e")
- (mouse-set-point ev)
- (when (calendar-cursor-to-date)
- (let* ((date (calendar-cursor-to-date))
- (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
- (setq org-ans1 (format-time-string "%Y-%m-%d" time)))
- (when (active-minibuffer-window) (exit-minibuffer))))
- (defun org-check-deadlines (ndays)
- "Check if there are any deadlines due or past due.
- A deadline is considered due if it happens within `org-deadline-warning-days'
- days from today's date. If the deadline appears in an entry marked DONE,
- it is not shown. A numeric prefix argument NDAYS can be used to test that
- many days. If the prefix is a raw `\\[universal-argument]', all deadlines \
- are shown."
- (interactive "P")
- (let* ((org-warn-days
- (cond
- ((equal ndays '(4)) 100000)
- (ndays (prefix-numeric-value ndays))
- (t (abs org-deadline-warning-days))))
- (case-fold-search nil)
- (regexp (concat "\\<" org-deadline-string " *<\\([^>]+\\)>"))
- (callback
- (lambda () (org-deadline-close-p (match-string 1) org-warn-days))))
- (message "%d deadlines past-due or due within %d days"
- (org-occur regexp nil callback)
- org-warn-days)))
- (defsubst org-re-timestamp (type)
- "Return a regexp for timestamp TYPE.
- Allowed values for TYPE are:
- all: all timestamps
- active: only active timestamps (<...>)
- inactive: only inactive timestamps ([...])
- scheduled: only scheduled timestamps
- deadline: only deadline timestamps
- closed: only closed time-stamps
- When TYPE is nil, fall back on returning a regexp that matches
- both scheduled and deadline timestamps."
- (cl-case type
- (all org-ts-regexp-both)
- (active org-ts-regexp)
- (inactive org-ts-regexp-inactive)
- (scheduled org-scheduled-time-regexp)
- (deadline org-deadline-time-regexp)
- (closed org-closed-time-regexp)
- (otherwise
- (concat "\\<"
- (regexp-opt (list org-deadline-string org-scheduled-string))
- " *<\\([^>]+\\)>"))))
- (defun org-check-before-date (d)
- "Check if there are deadlines or scheduled entries before date D."
- (interactive (list (org-read-date)))
- (let* ((case-fold-search nil)
- (regexp (org-re-timestamp org-ts-type))
- (ts-type org-ts-type)
- (callback
- (lambda ()
- (let ((match (match-string 1)))
- (and (if (memq ts-type '(active inactive all))
- (eq (org-element-type (save-excursion
- (backward-char)
- (org-element-context)))
- 'timestamp)
- (org-at-planning-p))
- (time-less-p
- (org-time-string-to-time match)
- (org-time-string-to-time d)))))))
- (message "%d entries before %s"
- (org-occur regexp nil callback)
- d)))
- (defun org-check-after-date (d)
- "Check if there are deadlines or scheduled entries after date D."
- (interactive (list (org-read-date)))
- (let* ((case-fold-search nil)
- (regexp (org-re-timestamp org-ts-type))
- (ts-type org-ts-type)
- (callback
- (lambda ()
- (let ((match (match-string 1)))
- (and (if (memq ts-type '(active inactive all))
- (eq (org-element-type (save-excursion
- (backward-char)
- (org-element-context)))
- 'timestamp)
- (org-at-planning-p))
- (not (time-less-p
- (org-time-string-to-time match)
- (org-time-string-to-time d))))))))
- (message "%d entries after %s"
- (org-occur regexp nil callback)
- d)))
- (defun org-check-dates-range (start-date end-date)
- "Check for deadlines/scheduled entries between START-DATE and END-DATE."
- (interactive (list (org-read-date nil nil nil "Range starts")
- (org-read-date nil nil nil "Range end")))
- (let ((case-fold-search nil)
- (regexp (org-re-timestamp org-ts-type))
- (callback
- (let ((type org-ts-type))
- (lambda ()
- (let ((match (match-string 1)))
- (and
- (if (memq type '(active inactive all))
- (eq (org-element-type (save-excursion
- (backward-char)
- (org-element-context)))
- 'timestamp)
- (org-at-planning-p))
- (not (time-less-p
- (org-time-string-to-time match)
- (org-time-string-to-time start-date)))
- (time-less-p
- (org-time-string-to-time match)
- (org-time-string-to-time end-date))))))))
- (message "%d entries between %s and %s"
- (org-occur regexp nil callback) start-date end-date)))
- (defun org-evaluate-time-range (&optional to-buffer)
- "Evaluate a time range by computing the difference between start and end.
- Normally the result is just printed in the echo area, but with prefix arg
- TO-BUFFER, the result is inserted just after the date stamp into the buffer.
- If the time range is actually in a table, the result is inserted into the
- next column.
- For time difference computation, a year is assumed to be exactly 365
- days in order to avoid rounding problems."
- (interactive "P")
- (or
- (org-clock-update-time-maybe)
- (save-excursion
- (unless (org-at-date-range-p t)
- (goto-char (point-at-bol))
- (re-search-forward org-tr-regexp-both (point-at-eol) t))
- (unless (org-at-date-range-p t)
- (user-error "Not at a time-stamp range, and none found in current line")))
- (let* ((ts1 (match-string 1))
- (ts2 (match-string 2))
- (havetime (or (> (length ts1) 15) (> (length ts2) 15)))
- (match-end (match-end 0))
- (time1 (org-time-string-to-time ts1))
- (time2 (org-time-string-to-time ts2))
- (t1 (float-time time1))
- (t2 (float-time time2))
- (diff (abs (- t2 t1)))
- (negative (< (- t2 t1) 0))
- ;; (ys (floor (* 365 24 60 60)))
- (ds (* 24 60 60))
- (hs (* 60 60))
- (fy "%dy %dd %02d:%02d")
- (fy1 "%dy %dd")
- (fd "%dd %02d:%02d")
- (fd1 "%dd")
- (fh "%02d:%02d")
- y d h m align)
- (if havetime
- (setq ; y (floor (/ diff ys)) diff (mod diff ys)
- y 0
- d (floor (/ diff ds)) diff (mod diff ds)
- h (floor (/ diff hs)) diff (mod diff hs)
- m (floor (/ diff 60)))
- (setq ; y (floor (/ diff ys)) diff (mod diff ys)
- y 0
- d (floor (+ (/ diff ds) 0.5))
- h 0 m 0))
- (if (not to-buffer)
- (message "%s" (org-make-tdiff-string y d h m))
- (if (org-at-table-p)
- (progn
- (goto-char match-end)
- (setq align t)
- (and (looking-at " *|") (goto-char (match-end 0))))
- (goto-char match-end))
- (when (looking-at
- "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]")
- (replace-match ""))
- (when negative (insert " -"))
- (if (> y 0) (insert " " (format (if havetime fy fy1) y d h m))
- (if (> d 0) (insert " " (format (if havetime fd fd1) d h m))
- (insert " " (format fh h m))))
- (when align (org-table-align))
- (message "Time difference inserted")))))
- (defun org-make-tdiff-string (y d h m)
- (let ((fmt "")
- (l nil))
- (when (> y 0)
- (setq fmt (concat fmt "%d year" (if (> y 1) "s" "") " "))
- (push y l))
- (when (> d 0)
- (setq fmt (concat fmt "%d day" (if (> d 1) "s" "") " "))
- (push d l))
- (when (> h 0)
- (setq fmt (concat fmt "%d hour" (if (> h 1) "s" "") " "))
- (push h l))
- (when (> m 0)
- (setq fmt (concat fmt "%d minute" (if (> m 1) "s" "") " "))
- (push m l))
- (apply 'format fmt (nreverse l))))
- (defun org-time-string-to-time (s &optional buffer pos)
- "Convert a timestamp string into internal time."
- (condition-case errdata
- (apply 'encode-time (org-parse-time-string s))
- (error (error "Bad timestamp `%s'%s\nError was: %s"
- s (if (not (and buffer pos))
- ""
- (format-message " at %d in buffer `%s'" pos buffer))
- (cdr errdata)))))
- (defun org-time-string-to-seconds (s)
- "Convert a timestamp string to a number of seconds."
- (float-time (org-time-string-to-time s)))
- (org-define-error 'org-diary-sexp-no-match "Unable to match diary sexp")
- (defun org-time-string-to-absolute (s &optional daynr prefer buffer pos)
- "Convert time stamp S to an absolute day number.
- If DAYNR in non-nil, and there is a specifier for a cyclic time
- stamp, get the closest date to DAYNR. If PREFER is
- `past' (respectively `future') return a date past (respectively
- after) or equal to DAYNR.
- POS is the location of time stamp S, as a buffer position in
- BUFFER.
- Diary sexp timestamps are matched against DAYNR, when non-nil.
- If matching fails or DAYNR is nil, `org-diary-sexp-no-match' is
- signaled."
- (cond
- ((string-match "\\`%%\\((.*)\\)" s)
- ;; Sexp timestamp: try to match DAYNR, if available, since we're
- ;; only able to match individual dates. If it fails, raise an
- ;; error.
- (if (and daynr
- (org-diary-sexp-entry
- (match-string 1 s) "" (calendar-gregorian-from-absolute daynr)))
- daynr
- (signal 'org-diary-sexp-no-match (list s))))
- (daynr (org-closest-date s daynr prefer))
- (t (time-to-days
- (condition-case errdata
- (apply #'encode-time (org-parse-time-string s))
- (error (error "Bad timestamp `%s'%s\nError was: %s"
- s
- (if (not (and buffer pos)) ""
- (format-message " at %d in buffer `%s'" pos buffer))
- (cdr errdata))))))))
- (defun org-days-to-iso-week (days)
- "Return the iso week number."
- (require 'cal-iso)
- (car (calendar-iso-from-absolute days)))
- (defun org-small-year-to-year (year)
- "Convert 2-digit years into 4-digit years.
- YEAR is expanded into one of the 30 next years, if possible, or
- into a past one. Any year larger than 99 is returned unchanged."
- (if (>= year 100) year
- (let* ((current (string-to-number (format-time-string "%Y" (current-time))))
- (century (/ current 100))
- (offset (- year (% current 100))))
- (cond ((> offset 30) (+ (* (1- century) 100) year))
- ((> offset -70) (+ (* century 100) year))
- (t (+ (* (1+ century) 100) year))))))
- (defun org-time-from-absolute (d)
- "Return the time corresponding to date D.
- D may be an absolute day number, or a calendar-type list (month day year)."
- (when (numberp d) (setq d (calendar-gregorian-from-absolute d)))
- (encode-time 0 0 0 (nth 1 d) (car d) (nth 2 d)))
- (defvar org-agenda-current-date)
- (defun org-calendar-holiday ()
- "List of holidays, for Diary display in Org mode."
- (require 'holidays)
- (let ((hl (calendar-check-holidays org-agenda-current-date)))
- (and hl (mapconcat #'identity hl "; "))))
- (defun org-diary-sexp-entry (sexp entry d)
- "Process a SEXP diary ENTRY for date D."
- (require 'diary-lib)
- ;; `org-anniversary' and alike expect ENTRY and DATE to be bound
- ;; dynamically.
- (let* ((sexp `(let ((entry ,entry)
- (date ',d))
- ,(car (read-from-string sexp))))
- (result (if calendar-debug-sexp (eval sexp)
- (condition-case nil
- (eval sexp)
- (error
- (beep)
- (message "Bad sexp at line %d in %s: %s"
- (org-current-line)
- (buffer-file-name) sexp)
- (sleep-for 2))))))
- (cond ((stringp result) (split-string result "; "))
- ((and (consp result)
- (not (consp (cdr result)))
- (stringp (cdr result))) (cdr result))
- ((and (consp result)
- (stringp (car result))) result)
- (result entry))))
- (defun org-diary-to-ical-string (frombuf)
- "Get iCalendar entries from diary entries in buffer FROMBUF.
- This uses the icalendar.el library."
- (let* ((tmpdir temporary-file-directory)
- (tmpfile (make-temp-name
- (expand-file-name "orgics" tmpdir)))
- buf rtn b e)
- (with-current-buffer frombuf
- (icalendar-export-region (point-min) (point-max) tmpfile)
- (setq buf (find-buffer-visiting tmpfile))
- (set-buffer buf)
- (goto-char (point-min))
- (when (re-search-forward "^BEGIN:VEVENT" nil t)
- (setq b (match-beginning 0)))
- (goto-char (point-max))
- (when (re-search-backward "^END:VEVENT" nil t)
- (setq e (match-end 0)))
- (setq rtn (if (and b e) (concat (buffer-substring b e) "\n") "")))
- (kill-buffer buf)
- (delete-file tmpfile)
- rtn))
- (defun org-closest-date (start current prefer)
- "Return closest date to CURRENT starting from START.
- CURRENT and START are both time stamps.
- When PREFER is `past', return a date that is either CURRENT or
- past. When PREFER is `future', return a date that is either
- CURRENT or future.
- Only time stamps with a repeater are modified. Any other time
- stamp stay unchanged. In any case, return value is an absolute
- day number."
- (if (not (string-match "\\+\\([0-9]+\\)\\([hdwmy]\\)" start))
- ;; No repeater. Do not shift time stamp.
- (time-to-days (apply #'encode-time (org-parse-time-string start)))
- (let ((value (string-to-number (match-string 1 start)))
- (type (match-string 2 start)))
- (if (= 0 value)
- ;; Repeater with a 0-value is considered as void.
- (time-to-days (apply #'encode-time (org-parse-time-string start)))
- (let* ((base (org-date-to-gregorian start))
- (target (org-date-to-gregorian current))
- (sday (calendar-absolute-from-gregorian base))
- (cday (calendar-absolute-from-gregorian target))
- n1 n2)
- ;; If START is already past CURRENT, just return START.
- (if (<= cday sday) sday
- ;; Compute closest date before (N1) and closest date past
- ;; (N2) CURRENT.
- (pcase type
- ("h"
- (let ((missing-hours
- (mod (+ (- (* 24 (- cday sday))
- (nth 2 (org-parse-time-string start)))
- org-extend-today-until)
- value)))
- (setf n1 (if (= missing-hours 0) cday
- (- cday (1+ (/ missing-hours 24)))))
- (setf n2 (+ cday (/ (- value missing-hours) 24)))))
- ((or "d" "w")
- (let ((value (if (equal type "w") (* 7 value) value)))
- (setf n1 (+ sday (* value (/ (- cday sday) value))))
- (setf n2 (+ n1 value))))
- ("m"
- (let* ((add-months
- (lambda (d n)
- ;; Add N months to gregorian date D, i.e.,
- ;; a list (MONTH DAY YEAR). Return a valid
- ;; gregorian date.
- (let ((m (+ (nth 0 d) n)))
- (list (mod m 12)
- (nth 1 d)
- (+ (/ m 12) (nth 2 d))))))
- (months ; Complete months to TARGET.
- (* (/ (+ (* 12 (- (nth 2 target) (nth 2 base)))
- (- (nth 0 target) (nth 0 base))
- ;; If START's day is greater than
- ;; TARGET's, remove incomplete month.
- (if (> (nth 1 target) (nth 1 base)) 0 -1))
- value)
- value))
- (before (funcall add-months base months)))
- (setf n1 (calendar-absolute-from-gregorian before))
- (setf n2
- (calendar-absolute-from-gregorian
- (funcall add-months before value)))))
- (_
- (let* ((d (nth 1 base))
- (m (nth 0 base))
- (y (nth 2 base))
- (years ; Complete years to TARGET.
- (* (/ (- (nth 2 target)
- y
- ;; If START's month and day are
- ;; greater than TARGET's, remove
- ;; incomplete year.
- (if (or (> (nth 0 target) m)
- (and (= (nth 0 target) m)
- (> (nth 1 target) d)))
- 0
- 1))
- value)
- value))
- (before (list m d (+ y years))))
- (setf n1 (calendar-absolute-from-gregorian before))
- (setf n2 (calendar-absolute-from-gregorian
- (list m d (+ (nth 2 before) value)))))))
- ;; Handle PREFER parameter, if any.
- (cond
- ((eq prefer 'past) (if (= cday n2) n2 n1))
- ((eq prefer 'future) (if (= cday n1) n1 n2))
- (t (if (> (abs (- cday n1)) (abs (- cday n2))) n2 n1)))))))))
- (defun org-date-to-gregorian (d)
- "Turn any specification of date D into a Gregorian date for the calendar."
- (cond ((integerp d) (calendar-gregorian-from-absolute d))
- ((and (listp d) (= (length d) 3)) d)
- ((stringp d)
- (let ((d (org-parse-time-string d)))
- (list (nth 4 d) (nth 3 d) (nth 5 d))))
- ((listp d) (list (nth 4 d) (nth 3 d) (nth 5 d)))))
- (defun org-parse-time-string (s &optional nodefault zone)
- "Parse the standard Org time string.
- This should be a lot faster than the normal `parse-time-string'.
- If time is not given, defaults to 0:00. However, with optional
- NODEFAULT, hour and minute fields will be nil if not given.
- The optional ZONE is omitted or nil for Emacs local time, t for
- Universal Time, ‘wall’ for system wall clock time, or a string as
- in the TZ environment variable."
- (cond ((string-match org-ts-regexp0 s)
- (list 0
- (when (or (match-beginning 8) (not nodefault))
- (string-to-number (or (match-string 8 s) "0")))
- (when (or (match-beginning 7) (not nodefault))
- (string-to-number (or (match-string 7 s) "0")))
- (string-to-number (match-string 4 s))
- (string-to-number (match-string 3 s))
- (string-to-number (match-string 2 s))
- nil nil zone))
- ((string-match "^<[^>]+>$" s)
- ;; FIXME: `decode-time' needs to be called with ZONE as its
- ;; second argument. However, this requires at least Emacs
- ;; 25.1. We can do it when we switch to this version as our
- ;; minimal requirement.
- (decode-time (seconds-to-time (org-matcher-time s))))
- (t (error "Not a standard Org time string: %s" s))))
- (defun org-timestamp-up (&optional arg)
- "Increase the date item at the cursor by one.
- If the cursor is on the year, change the year. If it is on the month,
- the day or the time, change that.
- With prefix ARG, change by that many units."
- (interactive "p")
- (org-timestamp-change (prefix-numeric-value arg) nil 'updown))
- (defun org-timestamp-down (&optional arg)
- "Decrease the date item at the cursor by one.
- If the cursor is on the year, change the year. If it is on the month,
- the day or the time, change that.
- With prefix ARG, change by that many units."
- (interactive "p")
- (org-timestamp-change (- (prefix-numeric-value arg)) nil 'updown))
- (defun org-timestamp-up-day (&optional arg)
- "Increase the date in the time stamp by one day.
- With prefix ARG, change that many days."
- (interactive "p")
- (if (and (not (org-at-timestamp-p t))
- (org-at-heading-p))
- (org-todo 'up)
- (org-timestamp-change (prefix-numeric-value arg) 'day 'updown)))
- (defun org-timestamp-down-day (&optional arg)
- "Decrease the date in the time stamp by one day.
- With prefix ARG, change that many days."
- (interactive "p")
- (if (and (not (org-at-timestamp-p t))
- (org-at-heading-p))
- (org-todo 'down)
- (org-timestamp-change (- (prefix-numeric-value arg)) 'day) 'updown))
- (defun org-at-timestamp-p (&optional inactive-ok)
- "Non-nil if point is inside a timestamp.
- When optional argument INACTIVE-OK is non-nil, also consider
- inactive timestamps.
- When this function returns a non-nil value, match data is set
- according to `org-ts-regexp3' or `org-ts-regexp2', depending on
- INACTIVE-OK."
- (interactive)
- (let* ((tsr (if inactive-ok org-ts-regexp3 org-ts-regexp2))
- (pos (point))
- (ans (or (looking-at tsr)
- (save-excursion
- (skip-chars-backward "^[<\n\r\t")
- (when (> (point) (point-min)) (backward-char 1))
- (and (looking-at tsr)
- (> (- (match-end 0) pos) -1))))))
- (and ans
- (boundp 'org-ts-what)
- (setq org-ts-what
- (cond
- ((= pos (match-beginning 0)) 'bracket)
- ;; Point is considered to be "on the bracket" whether
- ;; it's really on it or right after it.
- ((= pos (1- (match-end 0))) 'bracket)
- ((= pos (match-end 0)) 'after)
- ((org-pos-in-match-range pos 2) 'year)
- ((org-pos-in-match-range pos 3) 'month)
- ((org-pos-in-match-range pos 7) 'hour)
- ((org-pos-in-match-range pos 8) 'minute)
- ((or (org-pos-in-match-range pos 4)
- (org-pos-in-match-range pos 5)) 'day)
- ((and (> pos (or (match-end 8) (match-end 5)))
- (< pos (match-end 0)))
- (- pos (or (match-end 8) (match-end 5))))
- (t 'day))))
- ans))
- (defun org-toggle-timestamp-type ()
- "Toggle the type (<active> or [inactive]) of a time stamp."
- (interactive)
- (when (org-at-timestamp-p t)
- (let ((beg (match-beginning 0)) (end (match-end 0))
- (map '((?\[ . "<") (?\] . ">") (?< . "[") (?> . "]"))))
- (save-excursion
- (goto-char beg)
- (while (re-search-forward "[][<>]" end t)
- (replace-match (cdr (assoc (char-after (match-beginning 0)) map))
- t t)))
- (message "Timestamp is now %sactive"
- (if (equal (char-after beg) ?<) "" "in")))))
- (defun org-at-clock-log-p nil
- "Is the cursor on the clock log line?"
- (save-excursion
- (beginning-of-line)
- (looking-at org-clock-line-re)))
- (defvar org-clock-history) ; defined in org-clock.el
- (defvar org-clock-adjust-closest nil) ; defined in org-clock.el
- (defun org-timestamp-change (n &optional what updown suppress-tmp-delay)
- "Change the date in the time stamp at point.
- The date will be changed by N times WHAT. WHAT can be `day', `month',
- `year', `minute', `second'. If WHAT is not given, the cursor position
- in the timestamp determines what will be changed.
- When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
- (let ((origin (point)) origin-cat
- with-hm inactive
- (dm (max (nth 1 org-time-stamp-rounding-minutes) 1))
- org-ts-what
- extra rem
- ts time time0 fixnext clrgx)
- (unless (org-at-timestamp-p t)
- (user-error "Not at a timestamp"))
- (if (and (not what) (eq org-ts-what 'bracket))
- (org-toggle-timestamp-type)
- ;; Point isn't on brackets. Remember the part of the time-stamp
- ;; the point was in. Indeed, size of time-stamps may change,
- ;; but point must be kept in the same category nonetheless.
- (setq origin-cat org-ts-what)
- (when (and (not what) (not (eq org-ts-what 'day))
- org-display-custom-times
- (get-text-property (point) 'display)
- (not (get-text-property (1- (point)) 'display)))
- (setq org-ts-what 'day))
- (setq org-ts-what (or what org-ts-what)
- inactive (= (char-after (match-beginning 0)) ?\[)
- ts (match-string 0))
- (replace-match "")
- (when (string-match
- "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?-?[-+][0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)*\\)[]>]"
- ts)
- (setq extra (match-string 1 ts))
- (when suppress-tmp-delay
- (setq extra (replace-regexp-in-string " --[0-9]+[hdwmy]" "" extra))))
- (when (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts)
- (setq with-hm t))
- (setq time0 (org-parse-time-string ts))
- (when (and updown
- (eq org-ts-what 'minute)
- (not current-prefix-arg))
- ;; This looks like s-up and s-down. Change by one rounding step.
- (setq n (* dm (cond ((> n 0) 1) ((< n 0) -1) (t 0))))
- (unless (= 0 (setq rem (% (nth 1 time0) dm)))
- (setcar (cdr time0) (+ (nth 1 time0)
- (if (> n 0) (- rem) (- dm rem))))))
- (setq time
- (apply #'encode-time
- (or (car time0) 0)
- (+ (if (eq org-ts-what 'minute) n 0) (nth 1 time0))
- (+ (if (eq org-ts-what 'hour) n 0) (nth 2 time0))
- (+ (if (eq org-ts-what 'day) n 0) (nth 3 time0))
- (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0))
- (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0))
- (nthcdr 6 time0)))
- (when (and (member org-ts-what '(hour minute))
- extra
- (string-match "-\\([012][0-9]\\):\\([0-5][0-9]\\)" extra))
- (setq extra (org-modify-ts-extra
- extra
- (if (eq org-ts-what 'hour) 2 5)
- n dm)))
- (when (integerp org-ts-what)
- (setq extra (org-modify-ts-extra extra org-ts-what n dm)))
- (when (eq what 'calendar)
- (let ((cal-date (org-get-date-from-calendar)))
- (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month
- (setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day
- (setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year
- (setcar time0 (or (car time0) 0))
- (setcar (nthcdr 1 time0) (or (nth 1 time0) 0))
- (setcar (nthcdr 2 time0) (or (nth 2 time0) 0))
- (setq time (apply 'encode-time time0))))
- ;; Insert the new time-stamp, and ensure point stays in the same
- ;; category as before (i.e. not after the last position in that
- ;; category).
- (let ((pos (point)))
- ;; Stay before inserted string. `save-excursion' is of no use.
- (setq org-last-changed-timestamp
- (org-insert-time-stamp time with-hm inactive nil nil extra))
- (goto-char pos))
- (save-match-data
- (looking-at org-ts-regexp3)
- (goto-char
- (pcase origin-cat
- ;; `day' category ends before `hour' if any, or at the end
- ;; of the day name.
- (`day (min (or (match-beginning 7) (1- (match-end 5))) origin))
- (`hour (min (match-end 7) origin))
- (`minute (min (1- (match-end 8)) origin))
- ((pred integerp) (min (1- (match-end 0)) origin))
- ;; Point was right after the time-stamp. However, the
- ;; time-stamp length might have changed, so refer to
- ;; (match-end 0) instead.
- (`after (match-end 0))
- ;; `year' and `month' have both fixed size: point couldn't
- ;; have moved into another part.
- (_ origin))))
- ;; Update clock if on a CLOCK line.
- (org-clock-update-time-maybe)
- ;; Maybe adjust the closest clock in `org-clock-history'
- (when org-clock-adjust-closest
- (if (not (and (org-at-clock-log-p)
- (< 1 (length (delq nil (mapcar 'marker-position
- org-clock-history))))))
- (message "No clock to adjust")
- (cond ((save-excursion ; fix previous clock?
- (re-search-backward org-ts-regexp0 nil t)
- (looking-back (concat org-clock-string " \\[")
- (line-beginning-position)))
- (setq fixnext 1 clrgx (concat org-ts-regexp0 "\\] =>.*$")))
- ((save-excursion ; fix next clock?
- (re-search-backward org-ts-regexp0 nil t)
- (looking-at (concat org-ts-regexp0 "\\] =>")))
- (setq fixnext -1 clrgx (concat org-clock-string " \\[" org-ts-regexp0))))
- (save-window-excursion
- ;; Find closest clock to point, adjust the previous/next one in history
- (let* ((p (save-excursion (org-back-to-heading t)))
- (cl (mapcar (lambda(c) (abs (- (marker-position c) p))) org-clock-history))
- (clfixnth
- (+ fixnext (- (length cl) (or (length (member (apply 'min cl) cl)) 100))))
- (clfixpos (unless (> 0 clfixnth) (nth clfixnth org-clock-history))))
- (if (not clfixpos)
- (message "No clock to adjust")
- (save-excursion
- (org-goto-marker-or-bmk clfixpos)
- (org-show-subtree)
- (when (re-search-forward clrgx nil t)
- (goto-char (match-beginning 1))
- (let (org-clock-adjust-closest)
- (org-timestamp-change n org-ts-what updown))
- (message "Clock adjusted in %s for heading: %s"
- (file-name-nondirectory (buffer-file-name))
- (org-get-heading t t)))))))))
- ;; Try to recenter the calendar window, if any.
- (when (and org-calendar-follow-timestamp-change
- (get-buffer-window "*Calendar*" t)
- (memq org-ts-what '(day month year)))
- (org-recenter-calendar (time-to-days time))))))
- (defun org-modify-ts-extra (s pos n dm)
- "Change the different parts of the lead-time and repeat fields in timestamp."
- (let ((idx '(("d" . 0) ("w" . 1) ("m" . 2) ("y" . 3) ("d" . -1) ("y" . 4)))
- ng h m new rem)
- (when (string-match "\\(-\\([012][0-9]\\):\\([0-5][0-9]\\)\\)?\\( +\\+\\([0-9]+\\)\\([dmwy]\\)\\)?\\( +-\\([0-9]+\\)\\([dmwy]\\)\\)?" s)
- (cond
- ((or (org-pos-in-match-range pos 2)
- (org-pos-in-match-range pos 3))
- (setq m (string-to-number (match-string 3 s))
- h (string-to-number (match-string 2 s)))
- (if (org-pos-in-match-range pos 2)
- (setq h (+ h n))
- (setq n (* dm (with-no-warnings (signum n))))
- (unless (= 0 (setq rem (% m dm)))
- (setq m (+ m (if (> n 0) (- rem) (- dm rem)))))
- (setq m (+ m n)))
- (when (< m 0) (setq m (+ m 60) h (1- h)))
- (when (> m 59) (setq m (- m 60) h (1+ h)))
- (setq h (mod h 24))
- (setq ng 1 new (format "-%02d:%02d" h m)))
- ((org-pos-in-match-range pos 6)
- (setq ng 6 new (car (rassoc (+ n (cdr (assoc (match-string 6 s) idx))) idx))))
- ((org-pos-in-match-range pos 5)
- (setq ng 5 new (format "%d" (max 1 (+ n (string-to-number (match-string 5 s)))))))
- ((org-pos-in-match-range pos 9)
- (setq ng 9 new (car (rassoc (+ n (cdr (assoc (match-string 9 s) idx))) idx))))
- ((org-pos-in-match-range pos 8)
- (setq ng 8 new (format "%d" (max 0 (+ n (string-to-number (match-string 8 s))))))))
- (when ng
- (setq s (concat
- (substring s 0 (match-beginning ng))
- new
- (substring s (match-end ng))))))
- s))
- (defun org-recenter-calendar (d)
- "If the calendar is visible, recenter it to date D."
- (let ((cwin (get-buffer-window "*Calendar*" t)))
- (when cwin
- (let ((calendar-move-hook nil))
- (with-selected-window cwin
- (calendar-goto-date
- (if (listp d) d (calendar-gregorian-from-absolute d))))))))
- (defun org-goto-calendar (&optional arg)
- "Go to the Emacs calendar at the current date.
- If there is a time stamp in the current line, go to that date.
- A prefix ARG can be used to force the current date."
- (interactive "P")
- (let ((tsr org-ts-regexp) diff
- (calendar-move-hook nil)
- (calendar-view-holidays-initially-flag nil)
- (calendar-view-diary-initially-flag nil))
- (when (or (org-at-timestamp-p)
- (save-excursion
- (beginning-of-line 1)
- (looking-at (concat ".*" tsr))))
- (let ((d1 (time-to-days (current-time)))
- (d2 (time-to-days
- (org-time-string-to-time (match-string 1)))))
- (setq diff (- d2 d1))))
- (calendar)
- (calendar-goto-today)
- (when (and diff (not arg)) (calendar-forward-day diff))))
- (defun org-get-date-from-calendar ()
- "Return a list (month day year) of date at point in calendar."
- (with-current-buffer "*Calendar*"
- (save-match-data
- (calendar-cursor-to-date))))
- (defun org-date-from-calendar ()
- "Insert time stamp corresponding to cursor date in *Calendar* buffer.
- If there is already a time stamp at the cursor position, update it."
- (interactive)
- (if (org-at-timestamp-p t)
- (org-timestamp-change 0 'calendar)
- (let ((cal-date (org-get-date-from-calendar)))
- (org-insert-time-stamp
- (encode-time 0 0 0 (nth 1 cal-date) (car cal-date) (nth 2 cal-date))))))
- (defcustom org-effort-durations
- `(("min" . 1)
- ("h" . 60)
- ("d" . ,(* 60 8))
- ("w" . ,(* 60 8 5))
- ("m" . ,(* 60 8 5 4))
- ("y" . ,(* 60 8 5 40)))
- "Conversion factor to minutes for an effort modifier.
- Each entry has the form (MODIFIER . MINUTES).
- In an effort string, a number followed by MODIFIER is multiplied
- by the specified number of MINUTES to obtain an effort in
- minutes.
- For example, if the value of this variable is ((\"hours\" . 60)), then an
- effort string \"2hours\" is equivalent to 120 minutes."
- :group 'org-agenda
- :version "26.1"
- :package-version '(Org . "8.3")
- :type '(alist :key-type (string :tag "Modifier")
- :value-type (number :tag "Minutes")))
- (defun org-minutes-to-clocksum-string (m)
- "Format number of minutes as a clocksum string.
- The format is determined by `org-time-clocksum-format',
- `org-time-clocksum-use-fractional' and
- `org-time-clocksum-fractional-format' and
- `org-time-clocksum-use-effort-durations'."
- (let ((clocksum "")
- (m (round m)) ; Don't allow fractions of minutes
- h d w mo y fmt n)
- (setq h (if org-time-clocksum-use-effort-durations
- (cdr (assoc "h" org-effort-durations)) 60)
- d (if org-time-clocksum-use-effort-durations
- (/ (cdr (assoc "d" org-effort-durations)) h) 24)
- w (if org-time-clocksum-use-effort-durations
- (/ (cdr (assoc "w" org-effort-durations)) (* d h)) 7)
- mo (if org-time-clocksum-use-effort-durations
- (/ (cdr (assoc "m" org-effort-durations)) (* d h)) 30)
- y (if org-time-clocksum-use-effort-durations
- (/ (cdr (assoc "y" org-effort-durations)) (* d h)) 365))
- ;; fractional format
- (if org-time-clocksum-use-fractional
- (cond
- ;; single format string
- ((stringp org-time-clocksum-fractional-format)
- (format org-time-clocksum-fractional-format (/ m (float h))))
- ;; choice of fractional formats for different time units
- ((and (setq fmt (plist-get org-time-clocksum-fractional-format :years))
- (> (/ (truncate m) (* y d h)) 0))
- (format fmt (/ m (* y d (float h)))))
- ((and (setq fmt (plist-get org-time-clocksum-fractional-format :months))
- (> (/ (truncate m) (* mo d h)) 0))
- (format fmt (/ m (* mo d (float h)))))
- ((and (setq fmt (plist-get org-time-clocksum-fractional-format :weeks))
- (> (/ (truncate m) (* w d h)) 0))
- (format fmt (/ m (* w d (float h)))))
- ((and (setq fmt (plist-get org-time-clocksum-fractional-format :days))
- (> (/ (truncate m) (* d h)) 0))
- (format fmt (/ m (* d (float h)))))
- ((and (setq fmt (plist-get org-time-clocksum-fractional-format :hours))
- (> (/ (truncate m) h) 0))
- (format fmt (/ m (float h))))
- ((setq fmt (plist-get org-time-clocksum-fractional-format :minutes))
- (format fmt m))
- ;; fall back to smallest time unit with a format
- ((setq fmt (plist-get org-time-clocksum-fractional-format :hours))
- (format fmt (/ m (float h))))
- ((setq fmt (plist-get org-time-clocksum-fractional-format :days))
- (format fmt (/ m (* d (float h)))))
- ((setq fmt (plist-get org-time-clocksum-fractional-format :weeks))
- (format fmt (/ m (* w d (float h)))))
- ((setq fmt (plist-get org-time-clocksum-fractional-format :months))
- (format fmt (/ m (* mo d (float h)))))
- ((setq fmt (plist-get org-time-clocksum-fractional-format :years))
- (format fmt (/ m (* y d (float h))))))
- ;; standard (non-fractional) format, with single format string
- (if (stringp org-time-clocksum-format)
- (format org-time-clocksum-format (setq n (/ m h)) (- m (* h n)))
- ;; separate formats components
- (and (setq fmt (plist-get org-time-clocksum-format :years))
- (or (> (setq n (/ (truncate m) (* y d h))) 0)
- (plist-get org-time-clocksum-format :require-years))
- (setq clocksum (concat clocksum (format fmt n))
- m (- m (* n y d h))))
- (and (setq fmt (plist-get org-time-clocksum-format :months))
- (or (> (setq n (/ (truncate m) (* mo d h))) 0)
- (plist-get org-time-clocksum-format :require-months))
- (setq clocksum (concat clocksum (format fmt n))
- m (- m (* n mo d h))))
- (and (setq fmt (plist-get org-time-clocksum-format :weeks))
- (or (> (setq n (/ (truncate m) (* w d h))) 0)
- (plist-get org-time-clocksum-format :require-weeks))
- (setq clocksum (concat clocksum (format fmt n))
- m (- m (* n w d h))))
- (and (setq fmt (plist-get org-time-clocksum-format :days))
- (or (> (setq n (/ (truncate m) (* d h))) 0)
- (plist-get org-time-clocksum-format :require-days))
- (setq clocksum (concat clocksum (format fmt n))
- m (- m (* n d h))))
- (and (setq fmt (plist-get org-time-clocksum-format :hours))
- (or (> (setq n (/ (truncate m) h)) 0)
- (plist-get org-time-clocksum-format :require-hours))
- (setq clocksum (concat clocksum (format fmt n))
- m (- m (* n h))))
- (and (setq fmt (plist-get org-time-clocksum-format :minutes))
- (or (> m 0) (plist-get org-time-clocksum-format :require-minutes))
- (setq clocksum (concat clocksum (format fmt m))))
- ;; return formatted time duration
- clocksum))))
- (defun org-hours-to-clocksum-string (n)
- (org-minutes-to-clocksum-string (* n 60)))
- (defun org-hh:mm-string-to-minutes (s)
- "Convert a string H:MM to a number of minutes.
- If the string is just a number, interpret it as minutes.
- In fact, the first hh:mm or number in the string will be taken,
- there can be extra stuff in the string.
- If no number is found, the return value is 0."
- (cond
- ((integerp s) s)
- ((string-match "\\([0-9]+\\):\\([0-9]+\\)" s)
- (+ (* (string-to-number (match-string 1 s)) 60)
- (string-to-number (match-string 2 s))))
- ((string-match "\\([0-9]+\\)" s)
- (string-to-number (match-string 1 s)))
- (t 0)))
- (defcustom org-image-actual-width t
- "Should we use the actual width of images when inlining them?
- When set to t, always use the image width.
- When set to a number, use imagemagick (when available) to set
- the image's width to this value.
- When set to a number in a list, try to get the width from any
- #+ATTR.* keyword if it matches a width specification like
- #+ATTR_HTML: :width 300px
- and fall back on that number if none is found.
- When set to nil, try to get the width from an #+ATTR.* keyword
- and fall back on the original width if none is found.
- This requires Emacs >= 24.1, build with imagemagick support."
- :group 'org-appearance
- :version "24.4"
- :package-version '(Org . "8.0")
- :type '(choice
- (const :tag "Use the image width" t)
- (integer :tag "Use a number of pixels")
- (list :tag "Use #+ATTR* or a number of pixels" (integer))
- (const :tag "Use #+ATTR* or don't resize" nil)))
- (defcustom org-agenda-inhibit-startup nil
- "Inhibit startup when preparing agenda buffers.
- When this variable is t, the initialization of the Org agenda
- buffers is inhibited: e.g. the visibility state is not set, the
- tables are not re-aligned, etc."
- :type 'boolean
- :version "24.3"
- :group 'org-agenda)
- (defcustom org-agenda-ignore-properties nil
- "Avoid updating text properties when building the agenda.
- Properties are used to prepare buffers for effort estimates,
- appointments, statistics and subtree-local categories.
- If you don't use these in the agenda, you can add them to this
- list and agenda building will be a bit faster.
- The value is a list, with zero or more of the symbols `effort', `appt',
- `stats' or `category'."
- :type '(set :greedy t
- (const effort)
- (const appt)
- (const stats)
- (const category))
- :version "26.1"
- :package-version '(Org . "8.3")
- :group 'org-agenda)
- (defun org-duration-string-to-minutes (s &optional output-to-string)
- "Convert a duration string S to minutes.
- A bare number is interpreted as minutes, modifiers can be set by
- customizing `org-effort-durations' (which see).
- Entries containing a colon are interpreted as H:MM by
- `org-hh:mm-string-to-minutes'."
- (let ((result 0)
- (re (concat "\\([0-9.]+\\) *\\("
- (regexp-opt (mapcar 'car org-effort-durations))
- "\\)")))
- (while (string-match re s)
- (cl-incf result (* (cdr (assoc (match-string 2 s) org-effort-durations))
- (string-to-number (match-string 1 s))))
- (setq s (replace-match "" nil t s)))
- (setq result (floor result))
- (cl-incf result (org-hh:mm-string-to-minutes s))
- (if output-to-string (number-to-string result) result)))
- ;;;; Files
- (defun org-save-all-org-buffers ()
- "Save all Org buffers without user confirmation."
- (interactive)
- (message "Saving all Org buffers...")
- (save-some-buffers t (lambda () (derived-mode-p 'org-mode)))
- (when (featurep 'org-id) (org-id-locations-save))
- (message "Saving all Org buffers... done"))
- (defun org-revert-all-org-buffers ()
- "Revert all Org buffers.
- Prompt for confirmation when there are unsaved changes.
- Be sure you know what you are doing before letting this function
- overwrite your changes.
- This function is useful in a setup where one tracks org files
- with a version control system, to revert on one machine after pulling
- changes from another. I believe the procedure must be like this:
- 1. M-x org-save-all-org-buffers
- 2. Pull changes from the other machine, resolve conflicts
- 3. M-x org-revert-all-org-buffers"
- (interactive)
- (unless (yes-or-no-p "Revert all Org buffers from their files? ")
- (user-error "Abort"))
- (save-excursion
- (save-window-excursion
- (dolist (b (buffer-list))
- (when (and (with-current-buffer b (derived-mode-p 'org-mode))
- (with-current-buffer b buffer-file-name))
- (pop-to-buffer-same-window b)
- (revert-buffer t 'no-confirm)))
- (when (and (featurep 'org-id) org-id-track-globally)
- (org-id-locations-load)))))
- ;;;; Agenda files
- ;;;###autoload
- (defun org-switchb (&optional arg)
- "Switch between Org buffers.
- With `\\[universal-argument]' prefix, restrict available buffers to files.
- With `\\[universal-argument] \\[universal-argument]' \
- prefix, restrict available buffers to agenda files."
- (interactive "P")
- (let ((blist (org-buffer-list
- (cond ((equal arg '(4)) 'files)
- ((equal arg '(16)) 'agenda)))))
- (pop-to-buffer-same-window
- (completing-read "Org buffer: "
- (mapcar #'list (mapcar #'buffer-name blist))
- nil t))))
- (defun org-buffer-list (&optional predicate exclude-tmp)
- "Return a list of Org buffers.
- PREDICATE can be `export', `files' or `agenda'.
- export restrict the list to Export buffers.
- files restrict the list to buffers visiting Org files.
- agenda restrict the list to buffers visiting agenda files.
- If EXCLUDE-TMP is non-nil, ignore temporary buffers."
- (let* ((bfn nil)
- (agenda-files (and (eq predicate 'agenda)
- (mapcar 'file-truename (org-agenda-files t))))
- (filter
- (cond
- ((eq predicate 'files)
- (lambda (b) (with-current-buffer b (derived-mode-p 'org-mode))))
- ((eq predicate 'export)
- (lambda (b) (string-match "\\*Org .*Export" (buffer-name b))))
- ((eq predicate 'agenda)
- (lambda (b)
- (with-current-buffer b
- (and (derived-mode-p 'org-mode)
- (setq bfn (buffer-file-name b))
- (member (file-truename bfn) agenda-files)))))
- (t (lambda (b) (with-current-buffer b
- (or (derived-mode-p 'org-mode)
- (string-match "\\*Org .*Export"
- (buffer-name b)))))))))
- (delq nil
- (mapcar
- (lambda(b)
- (if (and (funcall filter b)
- (or (not exclude-tmp)
- (not (string-match "tmp" (buffer-name b)))))
- b
- nil))
- (buffer-list)))))
- (defun org-agenda-files (&optional unrestricted archives)
- "Get the list of agenda files.
- Optional UNRESTRICTED means return the full list even if a restriction
- is currently in place.
- When ARCHIVES is t, include all archive files that are really being
- used by the agenda files. If ARCHIVE is `ifmode', do this only if
- `org-agenda-archives-mode' is t."
- (let ((files
- (cond
- ((and (not unrestricted) (get 'org-agenda-files 'org-restrict)))
- ((stringp org-agenda-files) (org-read-agenda-file-list))
- ((listp org-agenda-files) org-agenda-files)
- (t (error "Invalid value of `org-agenda-files'")))))
- (setq files (apply 'append
- (mapcar (lambda (f)
- (if (file-directory-p f)
- (directory-files
- f t org-agenda-file-regexp)
- (list f)))
- files)))
- (when org-agenda-skip-unavailable-files
- (setq files (delq nil
- (mapcar (function
- (lambda (file)
- (and (file-readable-p file) file)))
- files))))
- (when (or (eq archives t)
- (and (eq archives 'ifmode) (eq org-agenda-archives-mode t)))
- (setq files (org-add-archive-files files)))
- files))
- (defun org-agenda-file-p (&optional file)
- "Return non-nil, if FILE is an agenda file.
- If FILE is omitted, use the file associated with the current
- buffer."
- (let ((fname (or file (buffer-file-name))))
- (and fname
- (member (file-truename fname)
- (mapcar #'file-truename (org-agenda-files t))))))
- (defun org-edit-agenda-file-list ()
- "Edit the list of agenda files.
- Depending on setup, this either uses customize to edit the variable
- `org-agenda-files', or it visits the file that is holding the list. In the
- latter case, the buffer is set up in a way that saving it automatically kills
- the buffer and restores the previous window configuration."
- (interactive)
- (if (stringp org-agenda-files)
- (let ((cw (current-window-configuration)))
- (find-file org-agenda-files)
- (setq-local org-window-configuration cw)
- (add-hook 'after-save-hook
- (lambda ()
- (set-window-configuration
- (prog1 org-window-configuration
- (kill-buffer (current-buffer))))
- (org-install-agenda-files-menu)
- (message "New agenda file list installed"))
- nil 'local)
- (message "%s" (substitute-command-keys
- "Edit list and finish with \\[save-buffer]")))
- (customize-variable 'org-agenda-files)))
- (defun org-store-new-agenda-file-list (list)
- "Set new value for the agenda file list and save it correctly."
- (if (stringp org-agenda-files)
- (let ((fe (org-read-agenda-file-list t)) b u)
- (while (setq b (find-buffer-visiting org-agenda-files))
- (kill-buffer b))
- (with-temp-file org-agenda-files
- (insert
- (mapconcat
- (lambda (f) ;; Keep un-expanded entries.
- (if (setq u (assoc f fe))
- (cdr u)
- f))
- list "\n")
- "\n")))
- (let ((org-mode-hook nil) (org-inhibit-startup t)
- (org-insert-mode-line-in-empty-file nil))
- (setq org-agenda-files list)
- (customize-save-variable 'org-agenda-files org-agenda-files))))
- (defun org-read-agenda-file-list (&optional pair-with-expansion)
- "Read the list of agenda files from a file.
- If PAIR-WITH-EXPANSION is t return pairs with un-expanded
- filenames, used by `org-store-new-agenda-file-list' to write back
- un-expanded file names."
- (when (file-directory-p org-agenda-files)
- (error "`org-agenda-files' cannot be a single directory"))
- (when (stringp org-agenda-files)
- (with-temp-buffer
- (insert-file-contents org-agenda-files)
- (mapcar
- (lambda (f)
- (let ((e (expand-file-name (substitute-in-file-name f)
- org-directory)))
- (if pair-with-expansion
- (cons e f)
- e)))
- (org-split-string (buffer-string) "[ \t\r\n]*?[\r\n][ \t\r\n]*")))))
- ;;;###autoload
- (defun org-cycle-agenda-files ()
- "Cycle through the files in `org-agenda-files'.
- If the current buffer visits an agenda file, find the next one in the list.
- If the current buffer does not, find the first agenda file."
- (interactive)
- (let* ((fs (or (org-agenda-files t)
- (user-error "No agenda files")))
- (files (copy-sequence fs))
- (tcf (and buffer-file-name (file-truename buffer-file-name)))
- file)
- (when tcf
- (while (and (setq file (pop files))
- (not (equal (file-truename file) tcf)))))
- (find-file (car (or files fs)))
- (when (buffer-base-buffer) (pop-to-buffer-same-window (buffer-base-buffer)))))
- (defun org-agenda-file-to-front (&optional to-end)
- "Move/add the current file to the top of the agenda file list.
- If the file is not present in the list, it is added to the front. If it is
- present, it is moved there. With optional argument TO-END, add/move to the
- end of the list."
- (interactive "P")
- (let ((org-agenda-skip-unavailable-files nil)
- (file-alist (mapcar (lambda (x)
- (cons (file-truename x) x))
- (org-agenda-files t)))
- (ctf (file-truename
- (or buffer-file-name
- (user-error "Please save the current buffer to a file"))))
- x had)
- (setq x (assoc ctf file-alist) had x)
- (unless x (setq x (cons ctf (abbreviate-file-name buffer-file-name))))
- (if to-end
- (setq file-alist (append (delq x file-alist) (list x)))
- (setq file-alist (cons x (delq x file-alist))))
- (org-store-new-agenda-file-list (mapcar 'cdr file-alist))
- (org-install-agenda-files-menu)
- (message "File %s to %s of agenda file list"
- (if had "moved" "added") (if to-end "end" "front"))))
- (defun org-remove-file (&optional file)
- "Remove current file from the list of files in variable `org-agenda-files'.
- These are the files which are being checked for agenda entries.
- Optional argument FILE means use this file instead of the current."
- (interactive)
- (let* ((org-agenda-skip-unavailable-files nil)
- (file (or file buffer-file-name
- (user-error "Current buffer does not visit a file")))
- (true-file (file-truename file))
- (afile (abbreviate-file-name file))
- (files (delq nil (mapcar
- (lambda (x)
- (unless (equal true-file
- (file-truename x))
- x))
- (org-agenda-files t)))))
- (if (not (= (length files) (length (org-agenda-files t))))
- (progn
- (org-store-new-agenda-file-list files)
- (org-install-agenda-files-menu)
- (message "Removed from Org Agenda list: %s" afile))
- (message "File was not in list: %s (not removed)" afile))))
- (defun org-file-menu-entry (file)
- (vector file (list 'find-file file) t))
- (defun org-check-agenda-file (file)
- "Make sure FILE exists. If not, ask user what to do."
- (unless (file-exists-p file)
- (message "Non-existent agenda file %s. [R]emove from list or [A]bort?"
- (abbreviate-file-name file))
- (let ((r (downcase (read-char-exclusive))))
- (cond
- ((equal r ?r)
- (org-remove-file file)
- (throw 'nextfile t))
- (t (user-error "Abort"))))))
- (defun org-get-agenda-file-buffer (file)
- "Get an agenda buffer visiting FILE.
- If the buffer needs to be created, add it to the list of buffers
- which might be released later."
- (let ((buf (org-find-base-buffer-visiting file)))
- (if buf
- buf ; just return it
- ;; Make a new buffer and remember it
- (setq buf (find-file-noselect file))
- (when buf (push buf org-agenda-new-buffers))
- buf)))
- (defun org-release-buffers (blist)
- "Release all buffers in list, asking the user for confirmation when needed.
- When a buffer is unmodified, it is just killed. When modified, it is saved
- \(if the user agrees) and then killed."
- (let (file)
- (dolist (buf blist)
- (setq file (buffer-file-name buf))
- (when (and (buffer-modified-p buf)
- file
- (y-or-n-p (format "Save file %s? " file)))
- (with-current-buffer buf (save-buffer)))
- (kill-buffer buf))))
- (defun org-agenda-prepare-buffers (files)
- "Create buffers for all agenda files, protect archived trees and comments."
- (interactive)
- (let ((pa '(:org-archived t))
- (pc '(:org-comment t))
- (pall '(:org-archived t :org-comment t))
- (inhibit-read-only t)
- (org-inhibit-startup org-agenda-inhibit-startup)
- (rea (concat ":" org-archive-tag ":"))
- re pos)
- (setq org-tag-alist-for-agenda nil
- org-tag-groups-alist-for-agenda nil)
- (save-excursion
- (save-restriction
- (dolist (file files)
- (catch 'nextfile
- (if (bufferp file)
- (set-buffer file)
- (org-check-agenda-file file)
- (set-buffer (org-get-agenda-file-buffer file)))
- (widen)
- (org-set-regexps-and-options 'tags-only)
- (setq pos (point))
- (or (memq 'category org-agenda-ignore-properties)
- (org-refresh-category-properties))
- (or (memq 'stats org-agenda-ignore-properties)
- (org-refresh-stats-properties))
- (or (memq 'effort org-agenda-ignore-properties)
- (org-refresh-effort-properties))
- (or (memq 'appt org-agenda-ignore-properties)
- (org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime))
- (setq org-todo-keywords-for-agenda
- (append org-todo-keywords-for-agenda org-todo-keywords-1))
- (setq org-done-keywords-for-agenda
- (append org-done-keywords-for-agenda org-done-keywords))
- (setq org-todo-keyword-alist-for-agenda
- (append org-todo-keyword-alist-for-agenda org-todo-key-alist))
- (setq org-tag-alist-for-agenda
- (org-uniquify
- (append org-tag-alist-for-agenda
- org-current-tag-alist)))
- ;; Merge current file's tag groups into global
- ;; `org-tag-groups-alist-for-agenda'.
- (when org-group-tags
- (dolist (alist org-tag-groups-alist)
- (let ((old (assoc (car alist) org-tag-groups-alist-for-agenda)))
- (if old
- (setcdr old (org-uniquify (append (cdr old) (cdr alist))))
- (push alist org-tag-groups-alist-for-agenda)))))
- (org-with-silent-modifications
- (save-excursion
- (remove-text-properties (point-min) (point-max) pall)
- (when org-agenda-skip-archived-trees
- (goto-char (point-min))
- (while (re-search-forward rea nil t)
- (when (org-at-heading-p t)
- (add-text-properties (point-at-bol) (org-end-of-subtree t) pa))))
- (goto-char (point-min))
- (setq re (format "^\\*+ .*\\<%s\\>" org-comment-string))
- (while (re-search-forward re nil t)
- (when (save-match-data (org-in-commented-heading-p t))
- (add-text-properties
- (match-beginning 0) (org-end-of-subtree t) pc)))))
- (goto-char pos)))))
- (setq org-todo-keywords-for-agenda
- (org-uniquify org-todo-keywords-for-agenda))
- (setq org-todo-keyword-alist-for-agenda
- (org-uniquify org-todo-keyword-alist-for-agenda))))
- ;;;; CDLaTeX minor mode
- (defvar org-cdlatex-mode-map (make-sparse-keymap)
- "Keymap for the minor `org-cdlatex-mode'.")
- (org-defkey org-cdlatex-mode-map "_" 'org-cdlatex-underscore-caret)
- (org-defkey org-cdlatex-mode-map "^" 'org-cdlatex-underscore-caret)
- (org-defkey org-cdlatex-mode-map "`" 'cdlatex-math-symbol)
- (org-defkey org-cdlatex-mode-map "'" 'org-cdlatex-math-modify)
- (org-defkey org-cdlatex-mode-map "\C-c{" 'org-cdlatex-environment-indent)
- (defvar org-cdlatex-texmathp-advice-is-done nil
- "Flag remembering if we have applied the advice to texmathp already.")
- (define-minor-mode org-cdlatex-mode
- "Toggle the minor `org-cdlatex-mode'.
- This mode supports entering LaTeX environment and math in LaTeX fragments
- in Org mode.
- \\{org-cdlatex-mode-map}"
- nil " OCDL" nil
- (when org-cdlatex-mode
- (require 'cdlatex)
- (run-hooks 'cdlatex-mode-hook)
- (cdlatex-compute-tables))
- (unless org-cdlatex-texmathp-advice-is-done
- (setq org-cdlatex-texmathp-advice-is-done t)
- (defadvice texmathp (around org-math-always-on activate)
- "Always return t in Org buffers.
- This is because we want to insert math symbols without dollars even outside
- the LaTeX math segments. If Org mode thinks that point is actually inside
- an embedded LaTeX fragment, let `texmathp' do its job.
- `\\[org-cdlatex-mode-map]'"
- (interactive)
- (let (p)
- (cond
- ((not (derived-mode-p 'org-mode)) ad-do-it)
- ((eq this-command 'cdlatex-math-symbol)
- (setq ad-return-value t
- texmathp-why '("cdlatex-math-symbol in org-mode" . 0)))
- (t
- (let ((p (org-inside-LaTeX-fragment-p)))
- (if (and p (member (car p) (plist-get org-format-latex-options :matchers)))
- (setq ad-return-value t
- texmathp-why '("Org mode embedded math" . 0))
- (when p ad-do-it)))))))))
- (defun turn-on-org-cdlatex ()
- "Unconditionally turn on `org-cdlatex-mode'."
- (org-cdlatex-mode 1))
- (defun org-try-cdlatex-tab ()
- "Check if it makes sense to execute `cdlatex-tab', and do it if yes.
- It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is
- - inside a LaTeX fragment, or
- - after the first word in a line, where an abbreviation expansion could
- insert a LaTeX environment."
- (when org-cdlatex-mode
- (cond
- ;; Before any word on the line: No expansion possible.
- ((save-excursion (skip-chars-backward " \t") (bolp)) nil)
- ;; Just after first word on the line: Expand it. Make sure it
- ;; cannot happen on headlines, though.
- ((save-excursion
- (skip-chars-backward "a-zA-Z0-9*")
- (skip-chars-backward " \t")
- (and (bolp) (not (org-at-heading-p))))
- (cdlatex-tab) t)
- ((org-inside-LaTeX-fragment-p) (cdlatex-tab) t))))
- (defun org-cdlatex-underscore-caret (&optional _arg)
- "Execute `cdlatex-sub-superscript' in LaTeX fragments.
- Revert to the normal definition outside of these fragments."
- (interactive "P")
- (if (org-inside-LaTeX-fragment-p)
- (call-interactively 'cdlatex-sub-superscript)
- (let (org-cdlatex-mode)
- (call-interactively (key-binding (vector last-input-event))))))
- (defun org-cdlatex-math-modify (&optional _arg)
- "Execute `cdlatex-math-modify' in LaTeX fragments.
- Revert to the normal definition outside of these fragments."
- (interactive "P")
- (if (org-inside-LaTeX-fragment-p)
- (call-interactively 'cdlatex-math-modify)
- (let (org-cdlatex-mode)
- (call-interactively (key-binding (vector last-input-event))))))
- (defun org-cdlatex-environment-indent (&optional environment item)
- "Execute `cdlatex-environment' and indent the inserted environment.
- ENVIRONMENT and ITEM are passed to `cdlatex-environment'.
- The inserted environment is indented to current indentation
- unless point is at the beginning of the line, in which the
- environment remains unintended."
- (interactive)
- ;; cdlatex-environment always return nil. Therefore, capture output
- ;; first and determine if an environment was selected.
- (let* ((beg (point-marker))
- (end (copy-marker (point) t))
- (inserted (progn
- (ignore-errors (cdlatex-environment environment item))
- (< beg end)))
- ;; Figure out how many lines to move forward after the
- ;; environment has been inserted.
- (lines (when inserted
- (save-excursion
- (- (cl-loop while (< beg (point))
- with x = 0
- do (forward-line -1)
- (cl-incf x)
- finally return x)
- (if (progn (goto-char beg)
- (and (progn (skip-chars-forward " \t") (eolp))
- (progn (skip-chars-backward " \t") (bolp))))
- 1 0)))))
- (env (org-trim (delete-and-extract-region beg end))))
- (when inserted
- ;; Get indentation of next line unless at column 0.
- (let ((ind (if (bolp) 0
- (save-excursion
- (org-return-indent)
- (prog1 (org-get-indentation)
- (when (progn (skip-chars-forward " \t") (eolp))
- (delete-region beg (point)))))))
- (bol (progn (skip-chars-backward " \t") (bolp))))
- ;; Insert a newline before environment unless at column zero
- ;; to "escape" the current line. Insert a newline if
- ;; something is one the same line as \end{ENVIRONMENT}.
- (insert
- (concat (unless bol "\n") env
- (when (and (skip-chars-forward " \t") (not (eolp))) "\n")))
- (unless (zerop ind)
- (save-excursion
- (goto-char beg)
- (while (< (point) end)
- (unless (eolp) (indent-line-to ind))
- (forward-line))))
- (goto-char beg)
- (forward-line lines)
- (indent-line-to ind)))
- (set-marker beg nil)
- (set-marker end nil)))
- ;;;; LaTeX fragments
- (defun org-inside-LaTeX-fragment-p ()
- "Test if point is inside a LaTeX fragment.
- I.e. after a \\begin, \\(, \\[, $, or $$, without the corresponding closing
- sequence appearing also before point.
- Even though the matchers for math are configurable, this function assumes
- that \\begin, \\(, \\[, and $$ are always used. Only the single dollar
- delimiters are skipped when they have been removed by customization.
- The return value is nil, or a cons cell with the delimiter and the
- position of this delimiter.
- This function does a reasonably good job, but can locally be fooled by
- for example currency specifications. For example it will assume being in
- inline math after \"$22.34\". The LaTeX fragment formatter will only format
- fragments that are properly closed, but during editing, we have to live
- with the uncertainty caused by missing closing delimiters. This function
- looks only before point, not after."
- (catch 'exit
- (let ((pos (point))
- (dodollar (member "$" (plist-get org-format-latex-options :matchers)))
- (lim (save-excursion (org-backward-paragraph) (point)))
- dd-on str (start 0) m re)
- (goto-char pos)
- (when dodollar
- (setq str (concat (buffer-substring lim (point)) "\000 X$.")
- re (nth 1 (assoc "$" org-latex-regexps)))
- (while (string-match re str start)
- (cond
- ((= (match-end 0) (length str))
- (throw 'exit (cons "$" (+ lim (match-beginning 0) 1))))
- ((= (match-end 0) (- (length str) 5))
- (throw 'exit nil))
- (t (setq start (match-end 0))))))
- (when (setq m (re-search-backward "\\(\\\\begin{[^}]*}\\|\\\\(\\|\\\\\\[\\)\\|\\(\\\\end{[^}]*}\\|\\\\)\\|\\\\\\]\\)\\|\\(\\$\\$\\)" lim t))
- (goto-char pos)
- (and (match-beginning 1) (throw 'exit (cons (match-string 1) m)))
- (and (match-beginning 2) (throw 'exit nil))
- ;; count $$
- (while (re-search-backward "\\$\\$" lim t)
- (setq dd-on (not dd-on)))
- (goto-char pos)
- (when dd-on (cons "$$" m))))))
- (defun org-inside-latex-macro-p ()
- "Is point inside a LaTeX macro or its arguments?"
- (save-match-data
- (org-in-regexp
- "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*")))
- (defun org--format-latex-make-overlay (beg end image &optional imagetype)
- "Build an overlay between BEG and END using IMAGE file.
- Argument IMAGETYPE is the extension of the displayed image,
- as a string. It defaults to \"png\"."
- (let ((ov (make-overlay beg end))
- (imagetype (or (intern imagetype) 'png)))
- (overlay-put ov 'org-overlay-type 'org-latex-overlay)
- (overlay-put ov 'evaporate t)
- (overlay-put ov
- 'modification-hooks
- (list (lambda (o _flag _beg _end &optional _l)
- (delete-overlay o))))
- (overlay-put ov
- 'display
- (list 'image :type imagetype :file image :ascent 'center))))
- (defun org--list-latex-overlays (&optional beg end)
- "List all Org LaTeX overlays in current buffer.
- Limit to overlays between BEG and END when those are provided."
- (cl-remove-if-not
- (lambda (o) (eq (overlay-get o 'org-overlay-type) 'org-latex-overlay))
- (overlays-in (or beg (point-min)) (or end (point-max)))))
- (defun org-remove-latex-fragment-image-overlays (&optional beg end)
- "Remove all overlays with LaTeX fragment images in current buffer.
- When optional arguments BEG and END are non-nil, remove all
- overlays between them instead. Return a non-nil value when some
- overlays were removed, nil otherwise."
- (let ((overlays (org--list-latex-overlays beg end)))
- (mapc #'delete-overlay overlays)
- overlays))
- (defun org-toggle-latex-fragment (&optional arg)
- "Preview the LaTeX fragment at point, or all locally or globally.
- If the cursor is on a LaTeX fragment, create the image and overlay
- it over the source code, if there is none. Remove it otherwise.
- If there is no fragment at point, display all fragments in the
- current section.
- With prefix ARG, preview or clear image for all fragments in the
- current subtree or in the whole buffer when used before the first
- headline. With a prefix ARG `\\[universal-argument] \
- \\[universal-argument]' preview or clear images
- for all fragments in the buffer."
- (interactive "P")
- (when (display-graphic-p)
- (catch 'exit
- (save-excursion
- (let (beg end msg)
- (cond
- ((or (equal arg '(16))
- (and (equal arg '(4))
- (org-with-limited-levels (org-before-first-heading-p))))
- (if (org-remove-latex-fragment-image-overlays)
- (progn (message "LaTeX fragments images removed from buffer")
- (throw 'exit nil))
- (setq msg "Creating images for buffer...")))
- ((equal arg '(4))
- (org-with-limited-levels (org-back-to-heading t))
- (setq beg (point))
- (setq end (progn (org-end-of-subtree t) (point)))
- (if (org-remove-latex-fragment-image-overlays beg end)
- (progn
- (message "LaTeX fragment images removed from subtree")
- (throw 'exit nil))
- (setq msg "Creating images for subtree...")))
- ((let ((datum (org-element-context)))
- (when (memq (org-element-type datum)
- '(latex-environment latex-fragment))
- (setq beg (org-element-property :begin datum))
- (setq end (org-element-property :end datum))
- (if (org-remove-latex-fragment-image-overlays beg end)
- (progn (message "LaTeX fragment image removed")
- (throw 'exit nil))
- (setq msg "Creating image...")))))
- (t
- (org-with-limited-levels
- (setq beg (if (org-at-heading-p) (line-beginning-position)
- (outline-previous-heading)
- (point)))
- (setq end (progn (outline-next-heading) (point)))
- (if (org-remove-latex-fragment-image-overlays beg end)
- (progn
- (message "LaTeX fragment images removed from section")
- (throw 'exit nil))
- (setq msg "Creating images for section...")))))
- (let ((file (buffer-file-name (buffer-base-buffer))))
- (org-format-latex
- (concat org-preview-latex-image-directory "org-ltximg")
- beg end
- ;; Emacs cannot overlay images from remote hosts. Create
- ;; it in `temporary-file-directory' instead.
- (if (or (not file) (file-remote-p file))
- temporary-file-directory
- default-directory)
- 'overlays msg 'forbuffer org-preview-latex-default-process))
- (message (concat msg "done")))))))
- (defun org-format-latex
- (prefix &optional beg end dir overlays msg forbuffer processing-type)
- "Replace LaTeX fragments with links to an image.
- The function takes care of creating the replacement image.
- Only consider fragments between BEG and END when those are
- provided.
- When optional argument OVERLAYS is non-nil, display the image on
- top of the fragment instead of replacing it.
- PROCESSING-TYPE is the conversion method to use, as a symbol.
- Some of the options can be changed using the variable
- `org-format-latex-options', which see."
- (when (and overlays (fboundp 'clear-image-cache)) (clear-image-cache))
- (unless (eq processing-type 'verbatim)
- (let* ((math-regexp "\\$\\|\\\\[([]\\|^[ \t]*\\\\begin{[A-Za-z0-9*]+}")
- (cnt 0)
- checkdir-flag)
- (goto-char (or beg (point-min)))
- ;; Optimize overlay creation: (info "(elisp) Managing Overlays").
- (when (and overlays (memq processing-type '(dvipng imagemagick)))
- (overlay-recenter (or end (point-max))))
- (while (re-search-forward math-regexp end t)
- (unless (and overlays
- (eq (get-char-property (point) 'org-overlay-type)
- 'org-latex-overlay))
- (let* ((context (org-element-context))
- (type (org-element-type context)))
- (when (memq type '(latex-environment latex-fragment))
- (let ((block-type (eq type 'latex-environment))
- (value (org-element-property :value context))
- (beg (org-element-property :begin context))
- (end (save-excursion
- (goto-char (org-element-property :end context))
- (skip-chars-backward " \r\t\n")
- (point))))
- (cond
- ((eq processing-type 'mathjax)
- ;; Prepare for MathJax processing.
- (if (not (string-match "\\`\\$\\$?" value))
- (goto-char end)
- (delete-region beg end)
- (if (string= (match-string 0 value) "$$")
- (insert "\\[" (substring value 2 -2) "\\]")
- (insert "\\(" (substring value 1 -1) "\\)"))))
- ((assq processing-type org-preview-latex-process-alist)
- ;; Process to an image.
- (cl-incf cnt)
- (goto-char beg)
- (let* ((processing-info
- (cdr (assq processing-type org-preview-latex-process-alist)))
- (face (face-at-point))
- ;; Get the colors from the face at point.
- (fg
- (let ((color (plist-get org-format-latex-options
- :foreground)))
- (if (and forbuffer (eq color 'auto))
- (face-attribute face :foreground nil 'default)
- color)))
- (bg
- (let ((color (plist-get org-format-latex-options
- :background)))
- (if (and forbuffer (eq color 'auto))
- (face-attribute face :background nil 'default)
- color)))
- (hash (sha1 (prin1-to-string
- (list org-format-latex-header
- org-latex-default-packages-alist
- org-latex-packages-alist
- org-format-latex-options
- forbuffer value fg bg))))
- (imagetype (or (plist-get processing-info :image-output-type) "png"))
- (absprefix (expand-file-name prefix dir))
- (linkfile (format "%s_%s.%s" prefix hash imagetype))
- (movefile (format "%s_%s.%s" absprefix hash imagetype))
- (sep (and block-type "\n\n"))
- (link (concat sep "[[file:" linkfile "]]" sep))
- (options
- (org-combine-plists
- org-format-latex-options
- `(:foreground ,fg :background ,bg))))
- (when msg (message msg cnt))
- (unless checkdir-flag ; Ensure the directory exists.
- (setq checkdir-flag t)
- (let ((todir (file-name-directory absprefix)))
- (unless (file-directory-p todir)
- (make-directory todir t))))
- (unless (file-exists-p movefile)
- (org-create-formula-image
- value movefile options forbuffer processing-type))
- (if overlays
- (progn
- (dolist (o (overlays-in beg end))
- (when (eq (overlay-get o 'org-overlay-type)
- 'org-latex-overlay)
- (delete-overlay o)))
- (org--format-latex-make-overlay beg end movefile imagetype)
- (goto-char end))
- (delete-region beg end)
- (insert
- (org-add-props link
- (list 'org-latex-src
- (replace-regexp-in-string "\"" "" value)
- 'org-latex-src-embed-type
- (if block-type 'paragraph 'character)))))))
- ((eq processing-type 'mathml)
- ;; Process to MathML.
- (unless (org-format-latex-mathml-available-p)
- (user-error "LaTeX to MathML converter not configured"))
- (cl-incf cnt)
- (when msg (message msg cnt))
- (goto-char beg)
- (delete-region beg end)
- (insert (org-format-latex-as-mathml
- value block-type prefix dir)))
- (t
- (error "Unknown conversion process %s for LaTeX fragments"
- processing-type)))))))))))
- (defun org-create-math-formula (latex-frag &optional mathml-file)
- "Convert LATEX-FRAG to MathML and store it in MATHML-FILE.
- Use `org-latex-to-mathml-convert-command'. If the conversion is
- sucessful, return the portion between \"<math...> </math>\"
- elements otherwise return nil. When MATHML-FILE is specified,
- write the results in to that file. When invoked as an
- interactive command, prompt for LATEX-FRAG, with initial value
- set to the current active region and echo the results for user
- inspection."
- (interactive (list (let ((frag (when (org-region-active-p)
- (buffer-substring-no-properties
- (region-beginning) (region-end)))))
- (read-string "LaTeX Fragment: " frag nil frag))))
- (unless latex-frag (user-error "Invalid LaTeX fragment"))
- (let* ((tmp-in-file
- (let ((file (file-relative-name
- (make-temp-name (expand-file-name "ltxmathml-in")))))
- (write-region latex-frag nil file)
- file))
- (tmp-out-file (file-relative-name
- (make-temp-name (expand-file-name "ltxmathml-out"))))
- (cmd (format-spec
- org-latex-to-mathml-convert-command
- `((?j . ,(and org-latex-to-mathml-jar-file
- (shell-quote-argument
- (expand-file-name
- org-latex-to-mathml-jar-file))))
- (?I . ,(shell-quote-argument tmp-in-file))
- (?i . ,latex-frag)
- (?o . ,(shell-quote-argument tmp-out-file)))))
- mathml shell-command-output)
- (when (called-interactively-p 'any)
- (unless (org-format-latex-mathml-available-p)
- (user-error "LaTeX to MathML converter not configured")))
- (message "Running %s" cmd)
- (setq shell-command-output (shell-command-to-string cmd))
- (setq mathml
- (when (file-readable-p tmp-out-file)
- (with-current-buffer (find-file-noselect tmp-out-file t)
- (goto-char (point-min))
- (when (re-search-forward
- (format "<math[^>]*?%s[^>]*?>\\(.\\|\n\\)*</math>"
- (regexp-quote
- "xmlns=\"http://www.w3.org/1998/Math/MathML\""))
- nil t)
- (prog1 (match-string 0) (kill-buffer))))))
- (cond
- (mathml
- (setq mathml
- (concat "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" mathml))
- (when mathml-file
- (write-region mathml nil mathml-file))
- (when (called-interactively-p 'any)
- (message mathml)))
- ((message "LaTeX to MathML conversion failed")
- (message shell-command-output)))
- (delete-file tmp-in-file)
- (when (file-exists-p tmp-out-file)
- (delete-file tmp-out-file))
- mathml))
- (defun org-format-latex-as-mathml (latex-frag latex-frag-type
- prefix &optional dir)
- "Use `org-create-math-formula' but check local cache first."
- (let* ((absprefix (expand-file-name prefix dir))
- (print-length nil) (print-level nil)
- (formula-id (concat
- "formula-"
- (sha1
- (prin1-to-string
- (list latex-frag
- org-latex-to-mathml-convert-command)))))
- (formula-cache (format "%s-%s.mathml" absprefix formula-id))
- (formula-cache-dir (file-name-directory formula-cache)))
- (unless (file-directory-p formula-cache-dir)
- (make-directory formula-cache-dir t))
- (unless (file-exists-p formula-cache)
- (org-create-math-formula latex-frag formula-cache))
- (if (file-exists-p formula-cache)
- ;; Successful conversion. Return the link to MathML file.
- (org-add-props
- (format "[[file:%s]]" (file-relative-name formula-cache dir))
- (list 'org-latex-src (replace-regexp-in-string "\"" "" latex-frag)
- 'org-latex-src-embed-type (if latex-frag-type
- 'paragraph 'character)))
- ;; Failed conversion. Return the LaTeX fragment verbatim
- latex-frag)))
- (defun org--get-display-dpi ()
- "Get the DPI of the display.
- The function assumes that the display has the same pixel width in
- the horizontal and vertical directions."
- (if (display-graphic-p)
- (round (/ (display-pixel-height)
- (/ (display-mm-height) 25.4)))
- (error "Attempt to calculate the dpi of a non-graphic display")))
- (defun org-create-formula-image
- (string tofile options buffer &optional processing-type)
- "Create an image from LaTeX source using external processes.
- The LaTeX STRING is saved to a temporary LaTeX file, then
- converted to an image file by process PROCESSING-TYPE defined in
- `org-preview-latex-process-alist'. A nil value defaults to
- `org-preview-latex-default-process'.
- The generated image file is eventually moved to TOFILE.
- The OPTIONS argument controls the size, foreground color and
- background color of the generated image.
- When BUFFER non-nil, this function is used for LaTeX previewing.
- Otherwise, it is used to deal with LaTeX snippets showed in
- a HTML file."
- (let* ((processing-type (or processing-type
- org-preview-latex-default-process))
- (processing-info
- (cdr (assq processing-type org-preview-latex-process-alist)))
- (programs (plist-get processing-info :programs))
- (error-message (or (plist-get processing-info :message) ""))
- (use-xcolor (plist-get processing-info :use-xcolor))
- (image-input-type (plist-get processing-info :image-input-type))
- (image-output-type (plist-get processing-info :image-output-type))
- (post-clean (or (plist-get processing-info :post-clean)
- '(".dvi" ".xdv" ".pdf" ".tex" ".aux" ".log"
- ".svg" ".png" ".jpg" ".jpeg" ".out")))
- (latex-header
- (or (plist-get processing-info :latex-header)
- (org-latex-make-preamble
- (org-export-get-environment (org-export-get-backend 'latex))
- org-format-latex-header
- 'snippet)))
- (latex-compiler (plist-get processing-info :latex-compiler))
- (image-converter (plist-get processing-info :image-converter))
- (tmpdir temporary-file-directory)
- (texfilebase (make-temp-name
- (expand-file-name "orgtex" tmpdir)))
- (texfile (concat texfilebase ".tex"))
- (image-size-adjust (or (plist-get processing-info :image-size-adjust)
- '(1.0 . 1.0)))
- (scale (* (if buffer (car image-size-adjust) (cdr image-size-adjust))
- (or (plist-get options (if buffer :scale :html-scale)) 1.0)))
- (dpi (* scale (if buffer (org--get-display-dpi) 140.0)))
- (fg (or (plist-get options (if buffer :foreground :html-foreground))
- "Black"))
- (bg (or (plist-get options (if buffer :background :html-background))
- "Transparent"))
- (log-buf (get-buffer-create "*Org Preview LaTeX Output*"))
- (resize-mini-windows nil)) ;Fix Emacs flicker when creating image.
- (dolist (program programs)
- (org-check-external-command program error-message))
- (if use-xcolor
- (progn (if (eq fg 'default)
- (setq fg (org-latex-color :foreground))
- (setq fg (org-latex-color-format fg)))
- (if (eq bg 'default)
- (setq bg (org-latex-color :background))
- (setq bg (org-latex-color-format
- (if (string= bg "Transparent") "white" bg))))
- (with-temp-file texfile
- (insert latex-header)
- (insert "\n\\begin{document}\n"
- "\\definecolor{fg}{rgb}{" fg "}\n"
- "\\definecolor{bg}{rgb}{" bg "}\n"
- "\n\\pagecolor{bg}\n"
- "\n{\\color{fg}\n"
- string
- "\n}\n"
- "\n\\end{document}\n")))
- (if (eq fg 'default)
- (setq fg (org-dvipng-color :foreground))
- (unless (string= fg "Transparent")
- (setq fg (org-dvipng-color-format fg))))
- (if (eq bg 'default)
- (setq bg (org-dvipng-color :background))
- (unless (string= bg "Transparent")
- (setq bg (org-dvipng-color-format bg))))
- (with-temp-file texfile
- (insert latex-header)
- (insert "\n\\begin{document}\n" string "\n\\end{document}\n")))
- (let* ((err-msg (format "Please adjust `%s' part of \
- `org-preview-latex-process-alist'."
- processing-type))
- (image-input-file
- (org-compile-file
- texfile latex-compiler image-input-type err-msg log-buf))
- (image-output-file
- (org-compile-file
- image-input-file image-converter image-output-type err-msg log-buf
- `((?F . ,(shell-quote-argument fg))
- (?B . ,(shell-quote-argument bg))
- (?D . ,(shell-quote-argument (format "%s" dpi)))
- (?S . ,(shell-quote-argument (format "%s" (/ dpi 140.0))))))))
- (copy-file image-output-file tofile 'replace)
- (dolist (e post-clean)
- (when (file-exists-p (concat texfilebase e))
- (delete-file (concat texfilebase e))))
- image-output-file)))
- (defun org-splice-latex-header (tpl def-pkg pkg snippets-p &optional extra)
- "Fill a LaTeX header template TPL.
- In the template, the following place holders will be recognized:
- [DEFAULT-PACKAGES] \\usepackage statements for DEF-PKG
- [NO-DEFAULT-PACKAGES] do not include DEF-PKG
- [PACKAGES] \\usepackage statements for PKG
- [NO-PACKAGES] do not include PKG
- [EXTRA] the string EXTRA
- [NO-EXTRA] do not include EXTRA
- For backward compatibility, if both the positive and the negative place
- holder is missing, the positive one (without the \"NO-\") will be
- assumed to be present at the end of the template.
- DEF-PKG and PKG are assumed to be alists of options/packagename lists.
- EXTRA is a string.
- SNIPPETS-P indicates if this is run to create snippet images for HTML."
- (let (rpl (end ""))
- (if (string-match "^[ \t]*\\[\\(NO-\\)?DEFAULT-PACKAGES\\][ \t]*\n?" tpl)
- (setq rpl (if (or (match-end 1) (not def-pkg))
- "" (org-latex-packages-to-string def-pkg snippets-p t))
- tpl (replace-match rpl t t tpl))
- (when def-pkg (setq end (org-latex-packages-to-string def-pkg snippets-p))))
- (if (string-match "\\[\\(NO-\\)?PACKAGES\\][ \t]*\n?" tpl)
- (setq rpl (if (or (match-end 1) (not pkg))
- "" (org-latex-packages-to-string pkg snippets-p t))
- tpl (replace-match rpl t t tpl))
- (when pkg (setq end
- (concat end "\n"
- (org-latex-packages-to-string pkg snippets-p)))))
- (if (string-match "\\[\\(NO-\\)?EXTRA\\][ \t]*\n?" tpl)
- (setq rpl (if (or (match-end 1) (not extra))
- "" (concat extra "\n"))
- tpl (replace-match rpl t t tpl))
- (when (and extra (string-match "\\S-" extra))
- (setq end (concat end "\n" extra))))
- (if (string-match "\\S-" end)
- (concat tpl "\n" end)
- tpl)))
- (defun org-latex-packages-to-string (pkg &optional snippets-p newline)
- "Turn an alist of packages into a string with the \\usepackage macros."
- (setq pkg (mapconcat (lambda(p)
- (cond
- ((stringp p) p)
- ((and snippets-p (>= (length p) 3) (not (nth 2 p)))
- (format "%% Package %s omitted" (cadr p)))
- ((equal "" (car p))
- (format "\\usepackage{%s}" (cadr p)))
- (t
- (format "\\usepackage[%s]{%s}"
- (car p) (cadr p)))))
- pkg
- "\n"))
- (if newline (concat pkg "\n") pkg))
- (defun org-dvipng-color (attr)
- "Return a RGB color specification for dvipng."
- (org-dvipng-color-format (face-attribute 'default attr nil)))
- (defun org-dvipng-color-format (color-name)
- "Convert COLOR-NAME to a RGB color value for dvipng."
- (apply #'format "rgb %s %s %s"
- (mapcar 'org-normalize-color
- (color-values color-name))))
- (defun org-latex-color (attr)
- "Return a RGB color for the LaTeX color package."
- (org-latex-color-format (face-attribute 'default attr nil)))
- (defun org-latex-color-format (color-name)
- "Convert COLOR-NAME to a RGB color value."
- (apply #'format "%s,%s,%s"
- (mapcar 'org-normalize-color
- (color-values color-name))))
- (defun org-normalize-color (value)
- "Return string to be used as color value for an RGB component."
- (format "%g" (/ value 65535.0)))
- ;; Image display
- (defvar-local org-inline-image-overlays nil)
- (defun org-toggle-inline-images (&optional include-linked)
- "Toggle the display of inline images.
- INCLUDE-LINKED is passed to `org-display-inline-images'."
- (interactive "P")
- (if org-inline-image-overlays
- (progn
- (org-remove-inline-images)
- (when (called-interactively-p 'interactive)
- (message "Inline image display turned off")))
- (org-display-inline-images include-linked)
- (when (called-interactively-p 'interactive)
- (message (if org-inline-image-overlays
- (format "%d images displayed inline"
- (length org-inline-image-overlays))
- "No images to display inline")))))
- (defun org-redisplay-inline-images ()
- "Refresh the display of inline images."
- (interactive)
- (if (not org-inline-image-overlays)
- (org-toggle-inline-images)
- (org-toggle-inline-images)
- (org-toggle-inline-images)))
- (defun org-display-inline-images (&optional include-linked refresh beg end)
- "Display inline images.
- An inline image is a link which follows either of these
- conventions:
- 1. Its path is a file with an extension matching return value
- from `image-file-name-regexp' and it has no contents.
- 2. Its description consists in a single link of the previous
- type.
- When optional argument INCLUDE-LINKED is non-nil, also links with
- a text description part will be inlined. This can be nice for
- a quick look at those images, but it does not reflect what
- exported files will look like.
- When optional argument REFRESH is non-nil, refresh existing
- images between BEG and END. This will create new image displays
- only if necessary. BEG and END default to the buffer
- boundaries."
- (interactive "P")
- (when (display-graphic-p)
- (unless refresh
- (org-remove-inline-images)
- (when (fboundp 'clear-image-cache) (clear-image-cache)))
- (org-with-wide-buffer
- (goto-char (or beg (point-min)))
- (let ((case-fold-search t)
- (file-extension-re (image-file-name-regexp)))
- (while (re-search-forward "[][]\\[\\(?:file\\|[./~]\\)" end t)
- (let ((link (save-match-data (org-element-context))))
- ;; Check if we're at an inline image.
- (when (and (equal (org-element-property :type link) "file")
- (or include-linked
- (not (org-element-property :contents-begin link)))
- (let ((parent (org-element-property :parent link)))
- (or (not (eq (org-element-type parent) 'link))
- (not (cdr (org-element-contents parent)))))
- (string-match-p file-extension-re
- (org-element-property :path link)))
- (let ((file (expand-file-name
- (org-link-unescape
- (org-element-property :path link)))))
- (when (file-exists-p file)
- (let ((width
- ;; Apply `org-image-actual-width' specifications.
- (cond
- ((not (image-type-available-p 'imagemagick)) nil)
- ((eq org-image-actual-width t) nil)
- ((listp org-image-actual-width)
- (or
- ;; First try to find a width among
- ;; attributes associated to the paragraph
- ;; containing link.
- (let ((paragraph
- (let ((e link))
- (while (and (setq e (org-element-property
- :parent e))
- (not (eq (org-element-type e)
- 'paragraph))))
- e)))
- (when paragraph
- (save-excursion
- (goto-char (org-element-property :begin paragraph))
- (when
- (re-search-forward
- "^[ \t]*#\\+attr_.*?: +.*?:width +\\(\\S-+\\)"
- (org-element-property
- :post-affiliated paragraph)
- t)
- (string-to-number (match-string 1))))))
- ;; Otherwise, fall-back to provided number.
- (car org-image-actual-width)))
- ((numberp org-image-actual-width)
- org-image-actual-width)))
- (old (get-char-property-and-overlay
- (org-element-property :begin link)
- 'org-image-overlay)))
- (if (and (car-safe old) refresh)
- (image-refresh (overlay-get (cdr old) 'display))
- (let ((image (create-image file
- (and width 'imagemagick)
- nil
- :width width)))
- (when image
- (let* ((link
- ;; If inline image is the description
- ;; of another link, be sure to
- ;; consider the latter as the one to
- ;; apply the overlay on.
- (let ((parent
- (org-element-property :parent link)))
- (if (eq (org-element-type parent) 'link)
- parent
- link)))
- (ov (make-overlay
- (org-element-property :begin link)
- (progn
- (goto-char
- (org-element-property :end link))
- (skip-chars-backward " \t")
- (point)))))
- (overlay-put ov 'display image)
- (overlay-put ov 'face 'default)
- (overlay-put ov 'org-image-overlay t)
- (overlay-put
- ov 'modification-hooks
- (list 'org-display-inline-remove-overlay))
- (push ov org-inline-image-overlays)))))))))))))))
- (defun org-display-inline-remove-overlay (ov after _beg _end &optional _len)
- "Remove inline-display overlay if a corresponding region is modified."
- (let ((inhibit-modification-hooks t))
- (when (and ov after)
- (delete ov org-inline-image-overlays)
- (delete-overlay ov))))
- (defun org-remove-inline-images ()
- "Remove inline display of images."
- (interactive)
- (mapc #'delete-overlay org-inline-image-overlays)
- (setq org-inline-image-overlays nil))
- ;;;; Key bindings
- ;; Outline functions from `outline-mode-prefix-map'
- ;; that can be remapped in Org:
- (define-key org-mode-map [remap outline-mark-subtree] 'org-mark-subtree)
- (define-key org-mode-map [remap outline-show-subtree] 'org-show-subtree)
- (define-key org-mode-map [remap outline-forward-same-level]
- 'org-forward-heading-same-level)
- (define-key org-mode-map [remap outline-backward-same-level]
- 'org-backward-heading-same-level)
- (define-key org-mode-map [remap outline-show-branches]
- 'org-kill-note-or-show-branches)
- (define-key org-mode-map [remap outline-promote] 'org-promote-subtree)
- (define-key org-mode-map [remap outline-demote] 'org-demote-subtree)
- (define-key org-mode-map [remap outline-insert-heading] 'org-ctrl-c-ret)
- (define-key org-mode-map [remap outline-next-visible-heading]
- 'org-next-visible-heading)
- (define-key org-mode-map [remap outline-previous-visible-heading]
- 'org-previous-visible-heading)
- (define-key org-mode-map [remap show-children] 'org-show-children)
- ;; Outline functions from `outline-mode-prefix-map' that can not
- ;; be remapped in Org:
- ;; - the column "key binding" shows whether the Outline function is still
- ;; available in Org mode on the same key that it has been bound to in
- ;; Outline mode:
- ;; - "overridden": key used for a different functionality in Org mode
- ;; - else: key still bound to the same Outline function in Org mode
- ;; | Outline function | key binding | Org replacement |
- ;; |------------------------------------+-------------+--------------------------|
- ;; | `outline-up-heading' | `C-c C-u' | still same function |
- ;; | `outline-move-subtree-up' | overridden | better: org-shiftup |
- ;; | `outline-move-subtree-down' | overridden | better: org-shiftdown |
- ;; | `show-entry' | overridden | no replacement |
- ;; | `show-branches' | `C-c C-k' | still same function |
- ;; | `show-subtree' | overridden | visibility cycling |
- ;; | `show-all' | overridden | no replacement |
- ;; | `hide-subtree' | overridden | visibility cycling |
- ;; | `hide-body' | overridden | no replacement |
- ;; | `hide-entry' | overridden | visibility cycling |
- ;; | `hide-leaves' | overridden | no replacement |
- ;; | `hide-sublevels' | overridden | no replacement |
- ;; | `hide-other' | overridden | no replacement |
- ;; Make `C-c C-x' a prefix key
- (org-defkey org-mode-map "\C-c\C-x" (make-sparse-keymap))
- ;; TAB key with modifiers
- (org-defkey org-mode-map "\C-i" 'org-cycle)
- (org-defkey org-mode-map [(tab)] 'org-cycle)
- (org-defkey org-mode-map [(control tab)] 'org-force-cycle-archived)
- (org-defkey org-mode-map "\M-\t" #'pcomplete)
- ;; The following line is necessary under Suse GNU/Linux
- (org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab)
- (org-defkey org-mode-map [(shift tab)] 'org-shifttab)
- (define-key org-mode-map [backtab] 'org-shifttab)
- (org-defkey org-mode-map [(shift return)] 'org-table-copy-down)
- (org-defkey org-mode-map [(meta shift return)] 'org-insert-todo-heading)
- (org-defkey org-mode-map [(meta return)] 'org-meta-return)
- ;; Cursor keys with modifiers
- (org-defkey org-mode-map [(meta left)] 'org-metaleft)
- (org-defkey org-mode-map [(meta right)] 'org-metaright)
- (org-defkey org-mode-map [(meta up)] 'org-metaup)
- (org-defkey org-mode-map [(meta down)] 'org-metadown)
- (org-defkey org-mode-map [(control meta shift right)] 'org-increase-number-at-point)
- (org-defkey org-mode-map [(control meta shift left)] 'org-decrease-number-at-point)
- (org-defkey org-mode-map [(meta shift left)] 'org-shiftmetaleft)
- (org-defkey org-mode-map [(meta shift right)] 'org-shiftmetaright)
- (org-defkey org-mode-map [(meta shift up)] 'org-shiftmetaup)
- (org-defkey org-mode-map [(meta shift down)] 'org-shiftmetadown)
- (org-defkey org-mode-map [(shift up)] 'org-shiftup)
- (org-defkey org-mode-map [(shift down)] 'org-shiftdown)
- (org-defkey org-mode-map [(shift left)] 'org-shiftleft)
- (org-defkey org-mode-map [(shift right)] 'org-shiftright)
- (org-defkey org-mode-map [(control shift right)] 'org-shiftcontrolright)
- (org-defkey org-mode-map [(control shift left)] 'org-shiftcontrolleft)
- (org-defkey org-mode-map [(control shift up)] 'org-shiftcontrolup)
- (org-defkey org-mode-map [(control shift down)] 'org-shiftcontroldown)
- ;; Babel keys
- (define-key org-mode-map org-babel-key-prefix org-babel-map)
- (dolist (pair org-babel-key-bindings)
- (define-key org-babel-map (car pair) (cdr pair)))
- ;;; Extra keys for tty access.
- ;; We only set them when really needed because otherwise the
- ;; menus don't show the simple keys
- (when (or org-use-extra-keys (not window-system))
- (org-defkey org-mode-map "\C-c\C-xc" 'org-table-copy-down)
- (org-defkey org-mode-map "\C-c\C-xM" 'org-insert-todo-heading)
- (org-defkey org-mode-map "\C-c\C-xm" 'org-meta-return)
- (org-defkey org-mode-map [?\e (return)] 'org-meta-return)
- (org-defkey org-mode-map [?\e (left)] 'org-metaleft)
- (org-defkey org-mode-map "\C-c\C-xl" 'org-metaleft)
- (org-defkey org-mode-map [?\e (right)] 'org-metaright)
- (org-defkey org-mode-map "\C-c\C-xr" 'org-metaright)
- (org-defkey org-mode-map [?\e (up)] 'org-metaup)
- (org-defkey org-mode-map "\C-c\C-xu" 'org-metaup)
- (org-defkey org-mode-map [?\e (down)] 'org-metadown)
- (org-defkey org-mode-map "\C-c\C-xd" 'org-metadown)
- (org-defkey org-mode-map "\C-c\C-xL" 'org-shiftmetaleft)
- (org-defkey org-mode-map "\C-c\C-xR" 'org-shiftmetaright)
- (org-defkey org-mode-map "\C-c\C-xU" 'org-shiftmetaup)
- (org-defkey org-mode-map "\C-c\C-xD" 'org-shiftmetadown)
- (org-defkey org-mode-map [?\C-c (up)] 'org-shiftup)
- (org-defkey org-mode-map [?\C-c (down)] 'org-shiftdown)
- (org-defkey org-mode-map [?\C-c (left)] 'org-shiftleft)
- (org-defkey org-mode-map [?\C-c (right)] 'org-shiftright)
- (org-defkey org-mode-map [?\C-c ?\C-x (right)] 'org-shiftcontrolright)
- (org-defkey org-mode-map [?\C-c ?\C-x (left)] 'org-shiftcontrolleft)
- (org-defkey org-mode-map [?\e (tab)] #'pcomplete)
- (org-defkey org-mode-map [?\e (shift return)] 'org-insert-todo-heading)
- (org-defkey org-mode-map [?\e (shift left)] 'org-shiftmetaleft)
- (org-defkey org-mode-map [?\e (shift right)] 'org-shiftmetaright)
- (org-defkey org-mode-map [?\e (shift up)] 'org-shiftmetaup)
- (org-defkey org-mode-map [?\e (shift down)] 'org-shiftmetadown))
- ;; All the other keys
- (org-defkey org-mode-map "\C-c\C-a" 'outline-show-all) ; in case allout messed up.
- (org-defkey org-mode-map "\C-c\C-r" 'org-reveal)
- (if (boundp 'narrow-map)
- (org-defkey narrow-map "s" 'org-narrow-to-subtree)
- (org-defkey org-mode-map "\C-xns" 'org-narrow-to-subtree))
- (if (boundp 'narrow-map)
- (org-defkey narrow-map "b" 'org-narrow-to-block)
- (org-defkey org-mode-map "\C-xnb" 'org-narrow-to-block))
- (if (boundp 'narrow-map)
- (org-defkey narrow-map "e" 'org-narrow-to-element)
- (org-defkey org-mode-map "\C-xne" 'org-narrow-to-element))
- (org-defkey org-mode-map "\C-\M-t" 'org-transpose-element)
- (org-defkey org-mode-map "\M-}" 'org-forward-element)
- (org-defkey org-mode-map "\M-{" 'org-backward-element)
- (org-defkey org-mode-map "\C-c\C-^" 'org-up-element)
- (org-defkey org-mode-map "\C-c\C-_" 'org-down-element)
- (org-defkey org-mode-map "\C-c\C-f" 'org-forward-heading-same-level)
- (org-defkey org-mode-map "\C-c\C-b" 'org-backward-heading-same-level)
- (org-defkey org-mode-map "\C-c\M-f" 'org-next-block)
- (org-defkey org-mode-map "\C-c\M-b" 'org-previous-block)
- (org-defkey org-mode-map "\C-c$" 'org-archive-subtree)
- (org-defkey org-mode-map "\C-c\C-x\C-s" 'org-archive-subtree)
- (org-defkey org-mode-map "\C-c\C-x\C-a" 'org-archive-subtree-default)
- (org-defkey org-mode-map "\C-c\C-xd" 'org-insert-drawer)
- (org-defkey org-mode-map "\C-c\C-xa" 'org-toggle-archive-tag)
- (org-defkey org-mode-map "\C-c\C-xA" 'org-archive-to-archive-sibling)
- (org-defkey org-mode-map "\C-c\C-xb" 'org-tree-to-indirect-buffer)
- (org-defkey org-mode-map "\C-c\C-xq" 'org-toggle-tags-groups)
- (org-defkey org-mode-map "\C-c\C-j" 'org-goto)
- (org-defkey org-mode-map "\C-c\C-t" 'org-todo)
- (org-defkey org-mode-map "\C-c\C-q" 'org-set-tags-command)
- (org-defkey org-mode-map "\C-c\C-s" 'org-schedule)
- (org-defkey org-mode-map "\C-c\C-d" 'org-deadline)
- (org-defkey org-mode-map "\C-c;" 'org-toggle-comment)
- (org-defkey org-mode-map "\C-c\C-w" 'org-refile)
- (org-defkey org-mode-map "\C-c\M-w" 'org-copy)
- (org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved
- (org-defkey org-mode-map "\C-c\\" 'org-match-sparse-tree) ; Minor-mode res.
- (org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret)
- (org-defkey org-mode-map "\M-\C-m" 'org-insert-heading)
- (org-defkey org-mode-map "\C-c\C-xc" 'org-clone-subtree-with-time-shift)
- (org-defkey org-mode-map "\C-c\C-xv" 'org-copy-visible)
- (org-defkey org-mode-map [(control return)] 'org-insert-heading-respect-content)
- (org-defkey org-mode-map [(shift control return)] 'org-insert-todo-heading-respect-content)
- (org-defkey org-mode-map "\C-c\C-x\C-n" 'org-next-link)
- (org-defkey org-mode-map "\C-c\C-x\C-p" 'org-previous-link)
- (org-defkey org-mode-map "\C-c\C-l" 'org-insert-link)
- (org-defkey org-mode-map "\C-c\M-l" 'org-insert-last-stored-link)
- (org-defkey org-mode-map "\C-c\C-\M-l" 'org-insert-all-links)
- (org-defkey org-mode-map "\C-c\C-o" 'org-open-at-point)
- (org-defkey org-mode-map "\C-c%" 'org-mark-ring-push)
- (org-defkey org-mode-map "\C-c&" 'org-mark-ring-goto)
- (org-defkey org-mode-map "\C-c\C-z" 'org-add-note) ; Alternative binding
- (org-defkey org-mode-map "\C-c." 'org-time-stamp) ; Minor-mode reserved
- (org-defkey org-mode-map "\C-c!" 'org-time-stamp-inactive) ; Minor-mode r.
- (org-defkey org-mode-map "\C-c," 'org-priority) ; Minor-mode reserved
- (org-defkey org-mode-map "\C-c\C-y" 'org-evaluate-time-range)
- (org-defkey org-mode-map "\C-c>" 'org-goto-calendar)
- (org-defkey org-mode-map "\C-c<" 'org-date-from-calendar)
- (org-defkey org-mode-map [(control ?,)] 'org-cycle-agenda-files)
- (org-defkey org-mode-map [(control ?\')] 'org-cycle-agenda-files)
- (org-defkey org-mode-map "\C-c[" 'org-agenda-file-to-front)
- (org-defkey org-mode-map "\C-c]" 'org-remove-file)
- (org-defkey org-mode-map "\C-c\C-x<" 'org-agenda-set-restriction-lock)
- (org-defkey org-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
- (org-defkey org-mode-map "\C-c-" 'org-ctrl-c-minus)
- (org-defkey org-mode-map "\C-c*" 'org-ctrl-c-star)
- (org-defkey org-mode-map "\C-c^" 'org-sort)
- (org-defkey org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c)
- (org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches)
- (org-defkey org-mode-map "\C-c#" 'org-update-statistics-cookies)
- (org-defkey org-mode-map [remap open-line] 'org-open-line)
- (org-defkey org-mode-map [remap comment-dwim] 'org-comment-dwim)
- (org-defkey org-mode-map [remap forward-paragraph] 'org-forward-paragraph)
- (org-defkey org-mode-map [remap backward-paragraph] 'org-backward-paragraph)
- (org-defkey org-mode-map "\M-^" 'org-delete-indentation)
- (org-defkey org-mode-map "\C-m" 'org-return)
- (org-defkey org-mode-map "\C-j" 'org-return-indent)
- (org-defkey org-mode-map "\C-c?" 'org-table-field-info)
- (org-defkey org-mode-map "\C-c " 'org-table-blank-field)
- (org-defkey org-mode-map "\C-c+" 'org-table-sum)
- (org-defkey org-mode-map "\C-c=" 'org-table-eval-formula)
- (org-defkey org-mode-map "\C-c'" 'org-edit-special)
- (org-defkey org-mode-map "\C-c`" 'org-table-edit-field)
- (org-defkey org-mode-map "\C-c\"a" 'orgtbl-ascii-plot)
- (org-defkey org-mode-map "\C-c\"g" 'org-plot/gnuplot)
- (org-defkey org-mode-map "\C-c|" 'org-table-create-or-convert-from-region)
- (org-defkey org-mode-map [(control ?#)] 'org-table-rotate-recalc-marks)
- (org-defkey org-mode-map "\C-c~" 'org-table-create-with-table.el)
- (org-defkey org-mode-map "\C-c\C-a" 'org-attach)
- (org-defkey org-mode-map "\C-c}" 'org-table-toggle-coordinate-overlays)
- (org-defkey org-mode-map "\C-c{" 'org-table-toggle-formula-debugger)
- (org-defkey org-mode-map "\C-c\C-e" 'org-export-dispatch)
- (org-defkey org-mode-map "\C-c:" 'org-toggle-fixed-width)
- (org-defkey org-mode-map "\C-c\C-x\C-f" 'org-emphasize)
- (org-defkey org-mode-map "\C-c\C-xf" 'org-footnote-action)
- (org-defkey org-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull)
- (org-defkey org-mode-map "\C-c\C-x\C-mp" 'org-mobile-push)
- (org-defkey org-mode-map "\C-c@" 'org-mark-subtree)
- (org-defkey org-mode-map "\M-h" 'org-mark-element)
- (org-defkey org-mode-map [?\C-c (control ?*)] 'org-list-make-subtree)
- ;;(org-defkey org-mode-map [?\C-c (control ?-)] 'org-list-make-list-from-subtree)
- (org-defkey org-mode-map "\C-c\C-x\C-w" 'org-cut-special)
- (org-defkey org-mode-map "\C-c\C-x\M-w" 'org-copy-special)
- (org-defkey org-mode-map "\C-c\C-x\C-y" 'org-paste-special)
- (org-defkey org-mode-map "\C-c\C-x\C-t" 'org-toggle-time-stamp-overlays)
- (org-defkey org-mode-map "\C-c\C-x\C-i" 'org-clock-in)
- (org-defkey org-mode-map "\C-c\C-x\C-x" 'org-clock-in-last)
- (org-defkey org-mode-map "\C-c\C-x\C-z" 'org-resolve-clocks)
- (org-defkey org-mode-map "\C-c\C-x\C-o" 'org-clock-out)
- (org-defkey org-mode-map "\C-c\C-x\C-j" 'org-clock-goto)
- (org-defkey org-mode-map "\C-c\C-x\C-q" 'org-clock-cancel)
- (org-defkey org-mode-map "\C-c\C-x\C-d" 'org-clock-display)
- (org-defkey org-mode-map "\C-c\C-x\C-r" 'org-clock-report)
- (org-defkey org-mode-map "\C-c\C-x\C-u" 'org-dblock-update)
- (org-defkey org-mode-map "\C-c\C-x\C-l" 'org-toggle-latex-fragment)
- (org-defkey org-mode-map "\C-c\C-x\C-v" 'org-toggle-inline-images)
- (org-defkey org-mode-map "\C-c\C-x\C-\M-v" 'org-redisplay-inline-images)
- (org-defkey org-mode-map "\C-c\C-x\\" 'org-toggle-pretty-entities)
- (org-defkey org-mode-map "\C-c\C-x\C-b" 'org-toggle-checkbox)
- (org-defkey org-mode-map "\C-c\C-xp" 'org-set-property)
- (org-defkey org-mode-map "\C-c\C-xP" 'org-set-property-and-value)
- (org-defkey org-mode-map "\C-c\C-xe" 'org-set-effort)
- (org-defkey org-mode-map "\C-c\C-xE" 'org-inc-effort)
- (org-defkey org-mode-map "\C-c\C-xo" 'org-toggle-ordered-property)
- (org-defkey org-mode-map "\C-c\C-xi" 'org-columns-insert-dblock)
- (org-defkey org-mode-map [(control ?c) (control ?x) ?\;] 'org-timer-set-timer)
- (org-defkey org-mode-map "\C-c\C-x." 'org-timer)
- (org-defkey org-mode-map "\C-c\C-x-" 'org-timer-item)
- (org-defkey org-mode-map "\C-c\C-x0" 'org-timer-start)
- (org-defkey org-mode-map "\C-c\C-x_" 'org-timer-stop)
- (org-defkey org-mode-map "\C-c\C-x," 'org-timer-pause-or-continue)
- (define-key org-mode-map "\C-c\C-x\C-c" 'org-columns)
- (define-key org-mode-map "\C-c\C-x!" 'org-reload)
- (define-key org-mode-map "\C-c\C-xg" 'org-feed-update-all)
- (define-key org-mode-map "\C-c\C-xG" 'org-feed-goto-inbox)
- (define-key org-mode-map "\C-c\C-x[" 'org-reftex-citation)
- (defconst org-speed-commands-default
- '(
- ("Outline Navigation")
- ("n" . (org-speed-move-safe 'org-next-visible-heading))
- ("p" . (org-speed-move-safe 'org-previous-visible-heading))
- ("f" . (org-speed-move-safe 'org-forward-heading-same-level))
- ("b" . (org-speed-move-safe 'org-backward-heading-same-level))
- ("F" . org-next-block)
- ("B" . org-previous-block)
- ("u" . (org-speed-move-safe 'outline-up-heading))
- ("j" . org-goto)
- ("g" . (org-refile t))
- ("Outline Visibility")
- ("c" . org-cycle)
- ("C" . org-shifttab)
- (" " . org-display-outline-path)
- ("s" . org-narrow-to-subtree)
- ("=" . org-columns)
- ("Outline Structure Editing")
- ("U" . org-metaup)
- ("D" . org-metadown)
- ("r" . org-metaright)
- ("l" . org-metaleft)
- ("R" . org-shiftmetaright)
- ("L" . org-shiftmetaleft)
- ("i" . (progn (forward-char 1) (call-interactively
- 'org-insert-heading-respect-content)))
- ("^" . org-sort)
- ("w" . org-refile)
- ("a" . org-archive-subtree-default-with-confirmation)
- ("@" . org-mark-subtree)
- ("#" . org-toggle-comment)
- ("Clock Commands")
- ("I" . org-clock-in)
- ("O" . org-clock-out)
- ("Meta Data Editing")
- ("t" . org-todo)
- ("," . (org-priority))
- ("0" . (org-priority ?\ ))
- ("1" . (org-priority ?A))
- ("2" . (org-priority ?B))
- ("3" . (org-priority ?C))
- (":" . org-set-tags-command)
- ("e" . org-set-effort)
- ("E" . org-inc-effort)
- ("W" . (lambda(m) (interactive "sMinutes before warning: ")
- (org-entry-put (point) "APPT_WARNTIME" m)))
- ("Agenda Views etc")
- ("v" . org-agenda)
- ("/" . org-sparse-tree)
- ("Misc")
- ("o" . org-open-at-point)
- ("?" . org-speed-command-help)
- ("<" . (org-agenda-set-restriction-lock 'subtree))
- (">" . (org-agenda-remove-restriction-lock))
- )
- "The default speed commands.")
- (defun org-print-speed-command (e)
- (if (> (length (car e)) 1)
- (progn
- (princ "\n")
- (princ (car e))
- (princ "\n")
- (princ (make-string (length (car e)) ?-))
- (princ "\n"))
- (princ (car e))
- (princ " ")
- (if (symbolp (cdr e))
- (princ (symbol-name (cdr e)))
- (prin1 (cdr e)))
- (princ "\n")))
- (defun org-speed-command-help ()
- "Show the available speed commands."
- (interactive)
- (if (not org-use-speed-commands)
- (user-error "Speed commands are not activated, customize `org-use-speed-commands'")
- (with-output-to-temp-buffer "*Help*"
- (princ "User-defined Speed commands\n===========================\n")
- (mapc #'org-print-speed-command org-speed-commands-user)
- (princ "\n")
- (princ "Built-in Speed commands\n=======================\n")
- (mapc #'org-print-speed-command org-speed-commands-default))
- (with-current-buffer "*Help*"
- (setq truncate-lines t))))
- (defun org-speed-move-safe (cmd)
- "Execute CMD, but make sure that the cursor always ends up in a headline.
- If not, return to the original position and throw an error."
- (interactive)
- (let ((pos (point)))
- (call-interactively cmd)
- (unless (and (bolp) (org-at-heading-p))
- (goto-char pos)
- (error "Boundary reached while executing %s" cmd))))
- (defvar org-self-insert-command-undo-counter 0)
- (defvar org-table-auto-blank-field) ; defined in org-table.el
- (defvar org-speed-command nil)
- (defun org-speed-command-activate (keys)
- "Hook for activating single-letter speed commands.
- `org-speed-commands-default' specifies a minimal command set.
- Use `org-speed-commands-user' for further customization."
- (when (or (and (bolp) (looking-at org-outline-regexp))
- (and (functionp org-use-speed-commands)
- (funcall org-use-speed-commands)))
- (cdr (assoc keys (append org-speed-commands-user
- org-speed-commands-default)))))
- (defun org-babel-speed-command-activate (keys)
- "Hook for activating single-letter code block commands."
- (when (and (bolp) (looking-at org-babel-src-block-regexp))
- (cdr (assoc keys org-babel-key-bindings))))
- (defcustom org-speed-command-hook
- '(org-speed-command-default-hook org-babel-speed-command-hook)
- "Hook for activating speed commands at strategic locations.
- Hook functions are called in sequence until a valid handler is
- found.
- Each hook takes a single argument, a user-pressed command key
- which is also a `self-insert-command' from the global map.
- Within the hook, examine the cursor position and the command key
- and return nil or a valid handler as appropriate. Handler could
- be one of an interactive command, a function, or a form.
- Set `org-use-speed-commands' to non-nil value to enable this
- hook. The default setting is `org-speed-command-activate'."
- :group 'org-structure
- :version "24.1"
- :type 'hook)
- (defun org-self-insert-command (N)
- "Like `self-insert-command', use overwrite-mode for whitespace in tables.
- If the cursor is in a table looking at whitespace, the whitespace is
- overwritten, and the table is not marked as requiring realignment."
- (interactive "p")
- (org-check-before-invisible-edit 'insert)
- (cond
- ((and org-use-speed-commands
- (let ((kv (this-command-keys-vector)))
- (setq org-speed-command
- (run-hook-with-args-until-success
- 'org-speed-command-hook
- (make-string 1 (aref kv (1- (length kv))))))))
- (cond
- ((commandp org-speed-command)
- (setq this-command org-speed-command)
- (call-interactively org-speed-command))
- ((functionp org-speed-command)
- (funcall org-speed-command))
- ((and org-speed-command (listp org-speed-command))
- (eval org-speed-command))
- (t (let (org-use-speed-commands)
- (call-interactively 'org-self-insert-command)))))
- ((and
- (org-at-table-p)
- (progn
- ;; Check if we blank the field, and if that triggers align.
- (and (featurep 'org-table) org-table-auto-blank-field
- (memq last-command
- '(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c))
- (if (or (eq (char-after) ?\s) (looking-at "[^|\n]* |"))
- ;; Got extra space, this field does not determine
- ;; column width.
- (let (org-table-may-need-update) (org-table-blank-field))
- ;; No extra space, this field may determine column
- ;; width.
- (org-table-blank-field)))
- t)
- (eq N 1)
- (looking-at "[^|\n]* \\( \\)|"))
- ;; There is room for insertion without re-aligning the table.
- (delete-region (match-beginning 1) (match-end 1))
- (self-insert-command N))
- (t
- (setq org-table-may-need-update t)
- (self-insert-command N)
- (org-fix-tags-on-the-fly)
- (when org-self-insert-cluster-for-undo
- (if (not (eq last-command 'org-self-insert-command))
- (setq org-self-insert-command-undo-counter 1)
- (if (>= org-self-insert-command-undo-counter 20)
- (setq org-self-insert-command-undo-counter 1)
- (and (> org-self-insert-command-undo-counter 0)
- buffer-undo-list (listp buffer-undo-list)
- (not (cadr buffer-undo-list)) ; remove nil entry
- (setcdr buffer-undo-list (cddr buffer-undo-list)))
- (setq org-self-insert-command-undo-counter
- (1+ org-self-insert-command-undo-counter))))))))
- (defun org-check-before-invisible-edit (kind)
- "Check is editing if kind KIND would be dangerous with invisible text around.
- The detailed reaction depends on the user option `org-catch-invisible-edits'."
- ;; First, try to get out of here as quickly as possible, to reduce overhead
- (when (and org-catch-invisible-edits
- (or (not (boundp 'visible-mode)) (not visible-mode))
- (or (get-char-property (point) 'invisible)
- (get-char-property (max (point-min) (1- (point))) 'invisible)))
- ;; OK, we need to take a closer look. Do not consider
- ;; invisibility obtained through text properties (e.g., link
- ;; fontification), as it cannot be toggled.
- (let* ((invisible-at-point
- (pcase (get-char-property-and-overlay (point) 'invisible)
- (`(,_ . ,(and (pred overlayp) o)) o)))
- ;; Assume that point cannot land in the middle of an
- ;; overlay, or between two overlays.
- (invisible-before-point
- (and (not invisible-at-point)
- (not (bobp))
- (pcase (get-char-property-and-overlay (1- (point)) 'invisible)
- (`(,_ . ,(and (pred overlayp) o)) o))))
- (border-and-ok-direction
- (or
- ;; Check if we are acting predictably before invisible
- ;; text.
- (and invisible-at-point
- (memq kind '(insert delete-backward)))
- ;; Check if we are acting predictably after invisible text
- ;; This works not well, and I have turned it off. It seems
- ;; better to always show and stop after invisible text.
- ;; (and (not invisible-at-point) invisible-before-point
- ;; (memq kind '(insert delete)))
- )))
- (when (or invisible-at-point invisible-before-point)
- (when (eq org-catch-invisible-edits 'error)
- (user-error "Editing in invisible areas is prohibited, make them visible first"))
- (if (and org-custom-properties-overlays
- (y-or-n-p "Display invisible properties in this buffer? "))
- (org-toggle-custom-properties-visibility)
- ;; Make the area visible
- (save-excursion
- (when invisible-before-point
- (goto-char
- (previous-single-char-property-change (point) 'invisible)))
- ;; Remove whatever overlay is currently making yet-to-be
- ;; edited text invisible. Also remove nested invisibility
- ;; related overlays.
- (delete-overlay (or invisible-at-point invisible-before-point))
- (let ((origin (if invisible-at-point (point) (1- (point)))))
- (while (pcase (get-char-property-and-overlay origin 'invisible)
- (`(,_ . ,(and (pred overlayp) o))
- (delete-overlay o)
- t)))))
- (cond
- ((eq org-catch-invisible-edits 'show)
- ;; That's it, we do the edit after showing
- (message
- "Unfolding invisible region around point before editing")
- (sit-for 1))
- ((and (eq org-catch-invisible-edits 'smart)
- border-and-ok-direction)
- (message "Unfolding invisible region around point before editing"))
- (t
- ;; Don't do the edit, make the user repeat it in full visibility
- (user-error "Edit in invisible region aborted, repeat to confirm with text visible"))))))))
- (defun org-fix-tags-on-the-fly ()
- "Align tags in headline at point.
- Unlike to `org-set-tags', it ignores region and sorting."
- (when (and (eq (char-after (line-beginning-position)) ?*) ;short-circuit
- (org-at-heading-p))
- (let ((org-ignore-region t)
- (org-tags-sort-function nil))
- (org-set-tags nil t))))
- (defun org-delete-backward-char (N)
- "Like `delete-backward-char', insert whitespace at field end in tables.
- When deleting backwards, in tables this function will insert whitespace in
- front of the next \"|\" separator, to keep the table aligned. The table will
- still be marked for re-alignment if the field did fill the entire column,
- because, in this case the deletion might narrow the column."
- (interactive "p")
- (save-match-data
- (org-check-before-invisible-edit 'delete-backward)
- (if (and (org-at-table-p)
- (eq N 1)
- (string-match "|" (buffer-substring (point-at-bol) (point)))
- (looking-at ".*?|"))
- (let ((pos (point))
- (noalign (looking-at "[^|\n\r]* |"))
- (c org-table-may-need-update))
- (backward-delete-char N)
- (unless overwrite-mode
- (skip-chars-forward "^|")
- (insert " ")
- (goto-char (1- pos)))
- ;; noalign: if there were two spaces at the end, this field
- ;; does not determine the width of the column.
- (when noalign (setq org-table-may-need-update c)))
- (backward-delete-char N)
- (org-fix-tags-on-the-fly))))
- (defun org-delete-char (N)
- "Like `delete-char', but insert whitespace at field end in tables.
- When deleting characters, in tables this function will insert whitespace in
- front of the next \"|\" separator, to keep the table aligned. The table will
- still be marked for re-alignment if the field did fill the entire column,
- because, in this case the deletion might narrow the column."
- (interactive "p")
- (save-match-data
- (org-check-before-invisible-edit 'delete)
- (if (and (org-at-table-p)
- (not (bolp))
- (not (= (char-after) ?|))
- (eq N 1))
- (if (looking-at ".*?|")
- (let ((pos (point))
- (noalign (looking-at "[^|\n\r]* |"))
- (c org-table-may-need-update))
- (replace-match
- (concat (substring (match-string 0) 1 -1) " |") nil t)
- (goto-char pos)
- ;; noalign: if there were two spaces at the end, this field
- ;; does not determine the width of the column.
- (when noalign (setq org-table-may-need-update c)))
- (delete-char N))
- (delete-char N)
- (org-fix-tags-on-the-fly))))
- ;; Make `delete-selection-mode' work with Org mode and Orgtbl mode
- (put 'org-self-insert-command 'delete-selection
- (lambda ()
- (not (run-hook-with-args-until-success
- 'self-insert-uses-region-functions))))
- (put 'orgtbl-self-insert-command 'delete-selection
- (lambda ()
- (not (run-hook-with-args-until-success
- 'self-insert-uses-region-functions))))
- (put 'org-delete-char 'delete-selection 'supersede)
- (put 'org-delete-backward-char 'delete-selection 'supersede)
- (put 'org-yank 'delete-selection 'yank)
- ;; Make `flyspell-mode' delay after some commands
- (put 'org-self-insert-command 'flyspell-delayed t)
- (put 'orgtbl-self-insert-command 'flyspell-delayed t)
- (put 'org-delete-char 'flyspell-delayed t)
- (put 'org-delete-backward-char 'flyspell-delayed t)
- ;; Make pabbrev-mode expand after Org mode commands
- (put 'org-self-insert-command 'pabbrev-expand-after-command t)
- (put 'orgtbl-self-insert-command 'pabbrev-expand-after-command t)
- (defun org-remap (map &rest commands)
- "In MAP, remap the functions given in COMMANDS.
- COMMANDS is a list of alternating OLDDEF NEWDEF command names."
- (let (new old)
- (while commands
- (setq old (pop commands) new (pop commands))
- (org-defkey map (vector 'remap old) new))))
- (defun org-transpose-words ()
- "Transpose words for Org.
- This uses the `org-mode-transpose-word-syntax-table' syntax
- table, which interprets characters in `org-emphasis-alist' as
- word constituents."
- (interactive)
- (with-syntax-table org-mode-transpose-word-syntax-table
- (call-interactively 'transpose-words)))
- (org-remap org-mode-map 'transpose-words 'org-transpose-words)
- (when (eq org-enable-table-editor 'optimized)
- ;; If the user wants maximum table support, we need to hijack
- ;; some standard editing functions
- (org-remap org-mode-map
- 'self-insert-command 'org-self-insert-command
- 'delete-char 'org-delete-char
- 'delete-backward-char 'org-delete-backward-char)
- (org-defkey org-mode-map "|" 'org-force-self-insert))
- (defvar org-ctrl-c-ctrl-c-hook nil
- "Hook for functions attaching themselves to `C-c C-c'.
- This can be used to add additional functionality to the C-c C-c
- key which executes context-dependent commands. This hook is run
- before any other test, while `org-ctrl-c-ctrl-c-final-hook' is
- run after the last test.
- Each function will be called with no arguments. The function
- must check if the context is appropriate for it to act. If yes,
- it should do its thing and then return a non-nil value. If the
- context is wrong, just do nothing and return nil.")
- (defvar org-ctrl-c-ctrl-c-final-hook nil
- "Hook for functions attaching themselves to `C-c C-c'.
- This can be used to add additional functionality to the C-c C-c
- key which executes context-dependent commands. This hook is run
- after any other test, while `org-ctrl-c-ctrl-c-hook' is run
- before the first test.
- Each function will be called with no arguments. The function
- must check if the context is appropriate for it to act. If yes,
- it should do its thing and then return a non-nil value. If the
- context is wrong, just do nothing and return nil.")
- (defvar org-tab-first-hook nil
- "Hook for functions to attach themselves to TAB.
- See `org-ctrl-c-ctrl-c-hook' for more information.
- This hook runs as the first action when TAB is pressed, even before
- `org-cycle' messes around with the `outline-regexp' to cater for
- inline tasks and plain list item folding.
- If any function in this hook returns t, any other actions that
- would have been caused by TAB (such as table field motion or visibility
- cycling) will not occur.")
- (defvar org-tab-after-check-for-table-hook nil
- "Hook for functions to attach themselves to TAB.
- See `org-ctrl-c-ctrl-c-hook' for more information.
- This hook runs after it has been established that the cursor is not in a
- table, but before checking if the cursor is in a headline or if global cycling
- should be done.
- If any function in this hook returns t, not other actions like visibility
- cycling will be done.")
- (defvar org-tab-after-check-for-cycling-hook nil
- "Hook for functions to attach themselves to TAB.
- See `org-ctrl-c-ctrl-c-hook' for more information.
- This hook runs after it has been established that not table field motion and
- not visibility should be done because of current context. This is probably
- the place where a package like yasnippets can hook in.")
- (defvar org-tab-before-tab-emulation-hook nil
- "Hook for functions to attach themselves to TAB.
- See `org-ctrl-c-ctrl-c-hook' for more information.
- This hook runs after every other options for TAB have been exhausted, but
- before indentation and \t insertion takes place.")
- (defvar org-metaleft-hook nil
- "Hook for functions attaching themselves to `M-left'.
- See `org-ctrl-c-ctrl-c-hook' for more information.")
- (defvar org-metaright-hook nil
- "Hook for functions attaching themselves to `M-right'.
- See `org-ctrl-c-ctrl-c-hook' for more information.")
- (defvar org-metaup-hook nil
- "Hook for functions attaching themselves to `M-up'.
- See `org-ctrl-c-ctrl-c-hook' for more information.")
- (defvar org-metadown-hook nil
- "Hook for functions attaching themselves to `M-down'.
- See `org-ctrl-c-ctrl-c-hook' for more information.")
- (defvar org-shiftmetaleft-hook nil
- "Hook for functions attaching themselves to `M-S-left'.
- See `org-ctrl-c-ctrl-c-hook' for more information.")
- (defvar org-shiftmetaright-hook nil
- "Hook for functions attaching themselves to `M-S-right'.
- See `org-ctrl-c-ctrl-c-hook' for more information.")
- (defvar org-shiftmetaup-hook nil
- "Hook for functions attaching themselves to `M-S-up'.
- See `org-ctrl-c-ctrl-c-hook' for more information.")
- (defvar org-shiftmetadown-hook nil
- "Hook for functions attaching themselves to `M-S-down'.
- See `org-ctrl-c-ctrl-c-hook' for more information.")
- (defvar org-metareturn-hook nil
- "Hook for functions attaching themselves to `M-RET'.
- See `org-ctrl-c-ctrl-c-hook' for more information.")
- (defvar org-shiftup-hook nil
- "Hook for functions attaching themselves to `S-up'.
- See `org-ctrl-c-ctrl-c-hook' for more information.")
- (defvar org-shiftup-final-hook nil
- "Hook for functions attaching themselves to `S-up'.
- This one runs after all other options except shift-select have been excluded.
- See `org-ctrl-c-ctrl-c-hook' for more information.")
- (defvar org-shiftdown-hook nil
- "Hook for functions attaching themselves to `S-down'.
- See `org-ctrl-c-ctrl-c-hook' for more information.")
- (defvar org-shiftdown-final-hook nil
- "Hook for functions attaching themselves to `S-down'.
- This one runs after all other options except shift-select have been excluded.
- See `org-ctrl-c-ctrl-c-hook' for more information.")
- (defvar org-shiftleft-hook nil
- "Hook for functions attaching themselves to `S-left'.
- See `org-ctrl-c-ctrl-c-hook' for more information.")
- (defvar org-shiftleft-final-hook nil
- "Hook for functions attaching themselves to `S-left'.
- This one runs after all other options except shift-select have been excluded.
- See `org-ctrl-c-ctrl-c-hook' for more information.")
- (defvar org-shiftright-hook nil
- "Hook for functions attaching themselves to `S-right'.
- See `org-ctrl-c-ctrl-c-hook' for more information.")
- (defvar org-shiftright-final-hook nil
- "Hook for functions attaching themselves to `S-right'.
- This one runs after all other options except shift-select have been excluded.
- See `org-ctrl-c-ctrl-c-hook' for more information.")
- (defun org-modifier-cursor-error ()
- "Throw an error, a modified cursor command was applied in wrong context."
- (user-error "This command is active in special context like tables, headlines or items"))
- (defun org-shiftselect-error ()
- "Throw an error because Shift-Cursor command was applied in wrong context."
- (if (and (boundp 'shift-select-mode) shift-select-mode)
- (user-error "To use shift-selection with Org mode, customize `org-support-shift-select'")
- (user-error "This command works only in special context like headlines or timestamps")))
- (defun org-call-for-shift-select (cmd)
- (let ((this-command-keys-shift-translated t))
- (call-interactively cmd)))
- (defun org-shifttab (&optional arg)
- "Global visibility cycling or move to previous table field.
- Call `org-table-previous-field' within a table.
- When ARG is nil, cycle globally through visibility states.
- When ARG is a numeric prefix, show contents of this level."
- (interactive "P")
- (cond
- ((org-at-table-p) (call-interactively 'org-table-previous-field))
- ((integerp arg)
- (let ((arg2 (if org-odd-levels-only (1- (* 2 arg)) arg)))
- (message "Content view to level: %d" arg)
- (org-content (prefix-numeric-value arg2))
- (org-cycle-show-empty-lines t)
- (setq org-cycle-global-status 'overview)))
- (t (call-interactively 'org-global-cycle))))
- (defun org-shiftmetaleft ()
- "Promote subtree or delete table column.
- Calls `org-promote-subtree', `org-outdent-item-tree', or
- `org-table-delete-column', depending on context. See the
- individual commands for more information."
- (interactive)
- (cond
- ((run-hook-with-args-until-success 'org-shiftmetaleft-hook))
- ((org-at-table-p) (call-interactively 'org-table-delete-column))
- ((org-at-heading-p) (call-interactively 'org-promote-subtree))
- ((if (not (org-region-active-p)) (org-at-item-p)
- (save-excursion (goto-char (region-beginning))
- (org-at-item-p)))
- (call-interactively 'org-outdent-item-tree))
- (t (org-modifier-cursor-error))))
- (defun org-shiftmetaright ()
- "Demote subtree or insert table column.
- Calls `org-demote-subtree', `org-indent-item-tree', or
- `org-table-insert-column', depending on context. See the
- individual commands for more information."
- (interactive)
- (cond
- ((run-hook-with-args-until-success 'org-shiftmetaright-hook))
- ((org-at-table-p) (call-interactively 'org-table-insert-column))
- ((org-at-heading-p) (call-interactively 'org-demote-subtree))
- ((if (not (org-region-active-p)) (org-at-item-p)
- (save-excursion (goto-char (region-beginning))
- (org-at-item-p)))
- (call-interactively 'org-indent-item-tree))
- (t (org-modifier-cursor-error))))
- (defun org-shiftmetaup (&optional _arg)
- "Drag the line at point up.
- In a table, kill the current row.
- On a clock timestamp, update the value of the timestamp like `S-<up>'
- but also adjust the previous clocked item in the clock history.
- Everywhere else, drag the line at point up."
- (interactive "P")
- (cond
- ((run-hook-with-args-until-success 'org-shiftmetaup-hook))
- ((org-at-table-p) (call-interactively 'org-table-kill-row))
- ((org-at-clock-log-p) (let ((org-clock-adjust-closest t))
- (call-interactively 'org-timestamp-up)))
- (t (call-interactively 'org-drag-line-backward))))
- (defun org-shiftmetadown (&optional _arg)
- "Drag the line at point down.
- In a table, insert an empty row at the current line.
- On a clock timestamp, update the value of the timestamp like `S-<down>'
- but also adjust the previous clocked item in the clock history.
- Everywhere else, drag the line at point down."
- (interactive "P")
- (cond
- ((run-hook-with-args-until-success 'org-shiftmetadown-hook))
- ((org-at-table-p) (call-interactively 'org-table-insert-row))
- ((org-at-clock-log-p) (let ((org-clock-adjust-closest t))
- (call-interactively 'org-timestamp-down)))
- (t (call-interactively 'org-drag-line-forward))))
- (defsubst org-hidden-tree-error ()
- (user-error
- "Hidden subtree, open with TAB or use subtree command M-S-<left>/<right>"))
- (defun org-metaleft (&optional _arg)
- "Promote heading, list item at point or move table column left.
- Calls `org-do-promote', `org-outdent-item' or `org-table-move-column',
- depending on context. With no specific context, calls the Emacs
- default `backward-word'. See the individual commands for more
- information.
- This function runs the hook `org-metaleft-hook' as a first step,
- and returns at first non-nil value."
- (interactive "P")
- (cond
- ((run-hook-with-args-until-success 'org-metaleft-hook))
- ((org-at-table-p) (org-call-with-arg 'org-table-move-column 'left))
- ((org-with-limited-levels
- (or (org-at-heading-p)
- (and (org-region-active-p)
- (save-excursion
- (goto-char (region-beginning))
- (org-at-heading-p)))))
- (when (org-check-for-hidden 'headlines) (org-hidden-tree-error))
- (call-interactively 'org-do-promote))
- ;; At an inline task.
- ((org-at-heading-p)
- (call-interactively 'org-inlinetask-promote))
- ((or (org-at-item-p)
- (and (org-region-active-p)
- (save-excursion
- (goto-char (region-beginning))
- (org-at-item-p))))
- (when (org-check-for-hidden 'items) (org-hidden-tree-error))
- (call-interactively 'org-outdent-item))
- (t (call-interactively 'backward-word))))
- (defun org-metaright (&optional _arg)
- "Demote heading, list item at point or move table column right.
- In front of a drawer or a block keyword, indent it correctly.
- Calls `org-do-demote', `org-indent-item', `org-table-move-column',
- `org-indent-drawer' or `org-indent-block' depending on context.
- With no specific context, calls the Emacs default `forward-word'.
- See the individual commands for more information.
- This function runs the hook `org-metaright-hook' as a first step,
- and returns at first non-nil value."
- (interactive "P")
- (cond
- ((run-hook-with-args-until-success 'org-metaright-hook))
- ((org-at-table-p) (call-interactively 'org-table-move-column))
- ((org-at-drawer-p) (call-interactively 'org-indent-drawer))
- ((org-at-block-p) (call-interactively 'org-indent-block))
- ((org-with-limited-levels
- (or (org-at-heading-p)
- (and (org-region-active-p)
- (save-excursion
- (goto-char (region-beginning))
- (org-at-heading-p)))))
- (when (org-check-for-hidden 'headlines) (org-hidden-tree-error))
- (call-interactively 'org-do-demote))
- ;; At an inline task.
- ((org-at-heading-p)
- (call-interactively 'org-inlinetask-demote))
- ((or (org-at-item-p)
- (and (org-region-active-p)
- (save-excursion
- (goto-char (region-beginning))
- (org-at-item-p))))
- (when (org-check-for-hidden 'items) (org-hidden-tree-error))
- (call-interactively 'org-indent-item))
- (t (call-interactively 'forward-word))))
- (defun org-check-for-hidden (what)
- "Check if there are hidden headlines/items in the current visual line.
- WHAT can be either `headlines' or `items'. If the current line is
- an outline or item heading and it has a folded subtree below it,
- this function returns t, nil otherwise."
- (let ((re (cond
- ((eq what 'headlines) org-outline-regexp-bol)
- ((eq what 'items) (org-item-beginning-re))
- (t (error "This should not happen"))))
- beg end)
- (save-excursion
- (catch 'exit
- (unless (org-region-active-p)
- (setq beg (point-at-bol))
- (beginning-of-line 2)
- (while (and (not (eobp)) ;; this is like `next-line'
- (get-char-property (1- (point)) 'invisible))
- (beginning-of-line 2))
- (setq end (point))
- (goto-char beg)
- (goto-char (point-at-eol))
- (setq end (max end (point)))
- (while (re-search-forward re end t)
- (when (get-char-property (match-beginning 0) 'invisible)
- (throw 'exit t))))
- nil))))
- (defun org-metaup (&optional _arg)
- "Move subtree up or move table row up.
- Calls `org-move-subtree-up' or `org-table-move-row' or
- `org-move-item-up', depending on context. See the individual commands
- for more information."
- (interactive "P")
- (cond
- ((run-hook-with-args-until-success 'org-metaup-hook))
- ((org-region-active-p)
- (let* ((a (min (region-beginning) (region-end)))
- (b (1- (max (region-beginning) (region-end))))
- (c (save-excursion (goto-char a)
- (move-beginning-of-line 0)))
- (d (save-excursion (goto-char a)
- (move-end-of-line 0) (point))))
- (transpose-regions a b c d)
- (goto-char c)))
- ((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up))
- ((org-at-heading-p) (call-interactively 'org-move-subtree-up))
- ((org-at-item-p) (call-interactively 'org-move-item-up))
- (t (org-drag-element-backward))))
- (defun org-metadown (&optional _arg)
- "Move subtree down or move table row down.
- Calls `org-move-subtree-down' or `org-table-move-row' or
- `org-move-item-down', depending on context. See the individual
- commands for more information."
- (interactive "P")
- (cond
- ((run-hook-with-args-until-success 'org-metadown-hook))
- ((org-region-active-p)
- (let* ((a (min (region-beginning) (region-end)))
- (b (max (region-beginning) (region-end)))
- (c (save-excursion (goto-char b)
- (move-beginning-of-line 1)))
- (d (save-excursion (goto-char b)
- (move-end-of-line 1) (1+ (point)))))
- (transpose-regions a b c d)
- (goto-char d)))
- ((org-at-table-p) (call-interactively 'org-table-move-row))
- ((org-at-heading-p) (call-interactively 'org-move-subtree-down))
- ((org-at-item-p) (call-interactively 'org-move-item-down))
- (t (org-drag-element-forward))))
- (defun org-shiftup (&optional arg)
- "Increase item in timestamp or increase priority of current headline.
- Calls `org-timestamp-up' or `org-priority-up', or `org-previous-item',
- depending on context. See the individual commands for more information."
- (interactive "P")
- (cond
- ((run-hook-with-args-until-success 'org-shiftup-hook))
- ((and org-support-shift-select (org-region-active-p))
- (org-call-for-shift-select 'previous-line))
- ((org-at-timestamp-p t)
- (call-interactively (if org-edit-timestamp-down-means-later
- 'org-timestamp-down 'org-timestamp-up)))
- ((and (not (eq org-support-shift-select 'always))
- org-enable-priority-commands
- (org-at-heading-p))
- (call-interactively 'org-priority-up))
- ((and (not org-support-shift-select) (org-at-item-p))
- (call-interactively 'org-previous-item))
- ((org-clocktable-try-shift 'up arg))
- ((run-hook-with-args-until-success 'org-shiftup-final-hook))
- (org-support-shift-select
- (org-call-for-shift-select 'previous-line))
- (t (org-shiftselect-error))))
- (defun org-shiftdown (&optional arg)
- "Decrease item in timestamp or decrease priority of current headline.
- Calls `org-timestamp-down' or `org-priority-down', or `org-next-item'
- depending on context. See the individual commands for more information."
- (interactive "P")
- (cond
- ((run-hook-with-args-until-success 'org-shiftdown-hook))
- ((and org-support-shift-select (org-region-active-p))
- (org-call-for-shift-select 'next-line))
- ((org-at-timestamp-p t)
- (call-interactively (if org-edit-timestamp-down-means-later
- 'org-timestamp-up 'org-timestamp-down)))
- ((and (not (eq org-support-shift-select 'always))
- org-enable-priority-commands
- (org-at-heading-p))
- (call-interactively 'org-priority-down))
- ((and (not org-support-shift-select) (org-at-item-p))
- (call-interactively 'org-next-item))
- ((org-clocktable-try-shift 'down arg))
- ((run-hook-with-args-until-success 'org-shiftdown-final-hook))
- (org-support-shift-select
- (org-call-for-shift-select 'next-line))
- (t (org-shiftselect-error))))
- (defun org-shiftright (&optional arg)
- "Cycle the thing at point or in the current line, depending on context.
- Depending on context, this does one of the following:
- - switch a timestamp at point one day into the future
- - on a headline, switch to the next TODO keyword.
- - on an item, switch entire list to the next bullet type
- - on a property line, switch to the next allowed value
- - on a clocktable definition line, move time block into the future"
- (interactive "P")
- (cond
- ((run-hook-with-args-until-success 'org-shiftright-hook))
- ((and org-support-shift-select (org-region-active-p))
- (org-call-for-shift-select 'forward-char))
- ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day))
- ((and (not (eq org-support-shift-select 'always))
- (org-at-heading-p))
- (let ((org-inhibit-logging
- (not org-treat-S-cursor-todo-selection-as-state-change))
- (org-inhibit-blocking
- (not org-treat-S-cursor-todo-selection-as-state-change)))
- (org-call-with-arg 'org-todo 'right)))
- ((or (and org-support-shift-select
- (not (eq org-support-shift-select 'always))
- (org-at-item-bullet-p))
- (and (not org-support-shift-select) (org-at-item-p)))
- (org-call-with-arg 'org-cycle-list-bullet nil))
- ((and (not (eq org-support-shift-select 'always))
- (org-at-property-p))
- (call-interactively 'org-property-next-allowed-value))
- ((org-clocktable-try-shift 'right arg))
- ((run-hook-with-args-until-success 'org-shiftright-final-hook))
- (org-support-shift-select
- (org-call-for-shift-select 'forward-char))
- (t (org-shiftselect-error))))
- (defun org-shiftleft (&optional arg)
- "Cycle the thing at point or in the current line, depending on context.
- Depending on context, this does one of the following:
- - switch a timestamp at point one day into the past
- - on a headline, switch to the previous TODO keyword.
- - on an item, switch entire list to the previous bullet type
- - on a property line, switch to the previous allowed value
- - on a clocktable definition line, move time block into the past"
- (interactive "P")
- (cond
- ((run-hook-with-args-until-success 'org-shiftleft-hook))
- ((and org-support-shift-select (org-region-active-p))
- (org-call-for-shift-select 'backward-char))
- ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day))
- ((and (not (eq org-support-shift-select 'always))
- (org-at-heading-p))
- (let ((org-inhibit-logging
- (not org-treat-S-cursor-todo-selection-as-state-change))
- (org-inhibit-blocking
- (not org-treat-S-cursor-todo-selection-as-state-change)))
- (org-call-with-arg 'org-todo 'left)))
- ((or (and org-support-shift-select
- (not (eq org-support-shift-select 'always))
- (org-at-item-bullet-p))
- (and (not org-support-shift-select) (org-at-item-p)))
- (org-call-with-arg 'org-cycle-list-bullet 'previous))
- ((and (not (eq org-support-shift-select 'always))
- (org-at-property-p))
- (call-interactively 'org-property-previous-allowed-value))
- ((org-clocktable-try-shift 'left arg))
- ((run-hook-with-args-until-success 'org-shiftleft-final-hook))
- (org-support-shift-select
- (org-call-for-shift-select 'backward-char))
- (t (org-shiftselect-error))))
- (defun org-shiftcontrolright ()
- "Switch to next TODO set."
- (interactive)
- (cond
- ((and org-support-shift-select (org-region-active-p))
- (org-call-for-shift-select 'forward-word))
- ((and (not (eq org-support-shift-select 'always))
- (org-at-heading-p))
- (org-call-with-arg 'org-todo 'nextset))
- (org-support-shift-select
- (org-call-for-shift-select 'forward-word))
- (t (org-shiftselect-error))))
- (defun org-shiftcontrolleft ()
- "Switch to previous TODO set."
- (interactive)
- (cond
- ((and org-support-shift-select (org-region-active-p))
- (org-call-for-shift-select 'backward-word))
- ((and (not (eq org-support-shift-select 'always))
- (org-at-heading-p))
- (org-call-with-arg 'org-todo 'previousset))
- (org-support-shift-select
- (org-call-for-shift-select 'backward-word))
- (t (org-shiftselect-error))))
- (defun org-shiftcontrolup (&optional n)
- "Change timestamps synchronously up in CLOCK log lines.
- Optional argument N tells to change by that many units."
- (interactive "P")
- (if (and (org-at-clock-log-p) (org-at-timestamp-p t))
- (let (org-support-shift-select)
- (org-clock-timestamps-up n))
- (user-error "Not at a clock log")))
- (defun org-shiftcontroldown (&optional n)
- "Change timestamps synchronously down in CLOCK log lines.
- Optional argument N tells to change by that many units."
- (interactive "P")
- (if (and (org-at-clock-log-p) (org-at-timestamp-p t))
- (let (org-support-shift-select)
- (org-clock-timestamps-down n))
- (user-error "Not at a clock log")))
- (defun org-increase-number-at-point (&optional inc)
- "Increment the number at point.
- With an optional prefix numeric argument INC, increment using
- this numeric value."
- (interactive "p")
- (if (not (number-at-point))
- (user-error "Not on a number")
- (unless inc (setq inc 1))
- (let ((pos (point))
- (beg (skip-chars-backward "-+^/*0-9eE."))
- (end (skip-chars-forward "-+^/*0-9eE^.")) nap)
- (setq nap (buffer-substring-no-properties
- (+ pos beg) (+ pos beg end)))
- (delete-region (+ pos beg) (+ pos beg end))
- (insert (calc-eval (concat (number-to-string inc) "+" nap))))
- (when (org-at-table-p)
- (org-table-align)
- (org-table-end-of-field 1))))
- (defun org-decrease-number-at-point (&optional inc)
- "Decrement the number at point.
- With an optional prefix numeric argument INC, decrement using
- this numeric value."
- (interactive "p")
- (org-increase-number-at-point (- (or inc 1))))
- (defun org-ctrl-c-ret ()
- "Call `org-table-hline-and-move' or `org-insert-heading' dep. on context."
- (interactive)
- (cond
- ((org-at-table-p) (call-interactively 'org-table-hline-and-move))
- (t (call-interactively 'org-insert-heading))))
- (defun org-find-visible ()
- (let ((s (point)))
- (while (and (not (= (point-max) (setq s (next-overlay-change s))))
- (get-char-property s 'invisible)))
- s))
- (defun org-find-invisible ()
- (let ((s (point)))
- (while (and (not (= (point-max) (setq s (next-overlay-change s))))
- (not (get-char-property s 'invisible))))
- s))
- (defun org-copy-visible (beg end)
- "Copy the visible parts of the region."
- (interactive "r")
- (let (snippets s)
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (setq s (goto-char (point-min)))
- (while (not (= (point) (point-max)))
- (goto-char (org-find-invisible))
- (push (buffer-substring s (point)) snippets)
- (setq s (goto-char (org-find-visible))))))
- (kill-new (apply 'concat (nreverse snippets)))))
- (defun org-copy-special ()
- "Copy region in table or copy current subtree.
- Calls `org-table-copy-region' or `org-copy-subtree', depending on
- context. See the individual commands for more information."
- (interactive)
- (call-interactively
- (if (org-at-table-p) #'org-table-copy-region #'org-copy-subtree)))
- (defun org-cut-special ()
- "Cut region in table or cut current subtree.
- Calls `org-table-cut-region' or `org-cut-subtree', depending on
- context. See the individual commands for more information."
- (interactive)
- (call-interactively
- (if (org-at-table-p) #'org-table-cut-region #'org-cut-subtree)))
- (defun org-paste-special (arg)
- "Paste rectangular region into table, or past subtree relative to level.
- Calls `org-table-paste-rectangle' or `org-paste-subtree', depending on context.
- See the individual commands for more information."
- (interactive "P")
- (if (org-at-table-p)
- (org-table-paste-rectangle)
- (org-paste-subtree arg)))
- (defun org-edit-special (&optional arg)
- "Call a special editor for the element at point.
- When at a table, call the formula editor with `org-table-edit-formulas'.
- When in a source code block, call `org-edit-src-code'.
- When in a fixed-width region, call `org-edit-fixed-width-region'.
- When in an export block, call `org-edit-export-block'.
- When at an #+INCLUDE keyword, visit the included file.
- When at a footnote reference, call `org-edit-footnote-reference'
- On a link, call `ffap' to visit the link at point.
- Otherwise, return a user error."
- (interactive "P")
- (let ((element (org-element-at-point)))
- (barf-if-buffer-read-only)
- (pcase (org-element-type element)
- (`src-block
- (if (not arg) (org-edit-src-code)
- (let* ((info (org-babel-get-src-block-info))
- (lang (nth 0 info))
- (params (nth 2 info))
- (session (cdr (assq :session params))))
- (if (not session) (org-edit-src-code)
- ;; At a src-block with a session and function called with
- ;; an ARG: switch to the buffer related to the inferior
- ;; process.
- (switch-to-buffer
- (funcall (intern (concat "org-babel-prep-session:" lang))
- session params))))))
- (`keyword
- (if (member (org-element-property :key element) '("INCLUDE" "SETUPFILE"))
- (org-open-link-from-string
- (format "[[%s]]"
- (expand-file-name
- (let ((value (org-element-property :value element)))
- (cond ((not (org-string-nw-p value))
- (user-error "No file to edit"))
- ((string-match "\\`\"\\(.*?\\)\"" value)
- (match-string 1 value))
- ((string-match "\\`[^ \t\"]\\S-*" value)
- (match-string 0 value))
- (t (user-error "No valid file specified")))))))
- (user-error "No special environment to edit here")))
- (`table
- (if (eq (org-element-property :type element) 'table.el)
- (org-edit-table.el)
- (call-interactively 'org-table-edit-formulas)))
- ;; Only Org tables contain `table-row' type elements.
- (`table-row (call-interactively 'org-table-edit-formulas))
- (`example-block (org-edit-src-code))
- (`export-block (org-edit-export-block))
- (`fixed-width (org-edit-fixed-width-region))
- (_
- ;; No notable element at point. Though, we may be at a link or
- ;; a footnote reference, which are objects. Thus, scan deeper.
- (let ((context (org-element-context element)))
- (pcase (org-element-type context)
- (`footnote-reference (org-edit-footnote-reference))
- (`inline-src-block (org-edit-inline-src-code))
- (`link (call-interactively #'ffap))
- (_ (user-error "No special environment to edit here"))))))))
- (defvar org-table-coordinate-overlays) ; defined in org-table.el
- (defun org-ctrl-c-ctrl-c (&optional arg)
- "Set tags in headline, or update according to changed information at point.
- This command does many different things, depending on context:
- - If a function in `org-ctrl-c-ctrl-c-hook' recognizes this location,
- this is what we do.
- - If the cursor is on a statistics cookie, update it.
- - If the cursor is in a headline, prompt for tags and insert them
- into the current line, aligned to `org-tags-column'. When called
- with prefix arg, realign all tags in the current buffer.
- - If the cursor is in one of the special #+KEYWORD lines, this
- triggers scanning the buffer for these lines and updating the
- information.
- - If the cursor is inside a table, realign the table. This command
- works even if the automatic table editor has been turned off.
- - If the cursor is on a #+TBLFM line, re-apply the formulas to
- the entire table.
- - If the cursor is at a footnote reference or definition, jump to
- the corresponding definition or references, respectively.
- - If the cursor is a the beginning of a dynamic block, update it.
- - If the current buffer is a capture buffer, close note and file it.
- - If the cursor is on a <<<target>>>, update radio targets and
- corresponding links in this buffer.
- - If the cursor is on a numbered item in a plain list, renumber the
- ordered list.
- - If the cursor is on a checkbox, toggle it.
- - If the cursor is on a code block, evaluate it. The variable
- `org-confirm-babel-evaluate' can be used to control prompting
- before code block evaluation, by default every code block
- evaluation requires confirmation. Code block evaluation can be
- inhibited by setting `org-babel-no-eval-on-ctrl-c-ctrl-c'."
- (interactive "P")
- (cond
- ((or (bound-and-true-p org-clock-overlays) org-occur-highlights)
- (when (boundp 'org-clock-overlays) (org-clock-remove-overlays))
- (org-remove-occur-highlights)
- (message "Temporary highlights/overlays removed from current buffer"))
- ((and (local-variable-p 'org-finish-function)
- (fboundp org-finish-function))
- (funcall org-finish-function))
- ((org-babel-hash-at-point))
- ((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook))
- (t
- (let* ((context
- (org-element-lineage
- (org-element-context)
- ;; Limit to supported contexts.
- '(babel-call clock dynamic-block footnote-definition
- footnote-reference inline-babel-call inline-src-block
- inlinetask item keyword node-property paragraph
- plain-list property-drawer radio-target src-block
- statistics-cookie table table-cell table-row
- timestamp)
- t))
- (type (org-element-type context)))
- ;; For convenience: at the first line of a paragraph on the same
- ;; line as an item, apply function on that item instead.
- (when (eq type 'paragraph)
- (let ((parent (org-element-property :parent context)))
- (when (and (eq (org-element-type parent) 'item)
- (= (line-beginning-position)
- (org-element-property :begin parent)))
- (setq context parent)
- (setq type 'item))))
- ;; Act according to type of element or object at point.
- ;;
- ;; Do nothing on a blank line, except if it is contained in
- ;; a src block. Hence, we first check if point is in such
- ;; a block and then if it is at a blank line.
- (pcase type
- ((or `inline-src-block `src-block)
- (unless org-babel-no-eval-on-ctrl-c-ctrl-c
- (org-babel-eval-wipe-error-buffer)
- (org-babel-execute-src-block
- current-prefix-arg (org-babel-get-src-block-info nil context))))
- ((guard (org-match-line "[ \t]*$"))
- (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook)
- (user-error
- (substitute-command-keys
- "`\\[org-ctrl-c-ctrl-c]' can do nothing useful here"))))
- ((or `babel-call `inline-babel-call)
- (let ((info (org-babel-lob-get-info context)))
- (when info (org-babel-execute-src-block nil info))))
- (`clock (org-clock-update-time-maybe))
- (`dynamic-block
- (save-excursion
- (goto-char (org-element-property :post-affiliated context))
- (org-update-dblock)))
- (`footnote-definition
- (goto-char (org-element-property :post-affiliated context))
- (call-interactively 'org-footnote-action))
- (`footnote-reference (call-interactively #'org-footnote-action))
- ((or `headline `inlinetask)
- (save-excursion (goto-char (org-element-property :begin context))
- (call-interactively #'org-set-tags)))
- (`item
- ;; At an item: `C-u C-u' sets checkbox to "[-]"
- ;; unconditionally, whereas `C-u' will toggle its presence.
- ;; Without a universal argument, if the item has a checkbox,
- ;; toggle it. Otherwise repair the list.
- (let* ((box (org-element-property :checkbox context))
- (struct (org-element-property :structure context))
- (old-struct (copy-tree struct))
- (parents (org-list-parents-alist struct))
- (prevs (org-list-prevs-alist struct))
- (orderedp (org-not-nil (org-entry-get nil "ORDERED"))))
- (org-list-set-checkbox
- (org-element-property :begin context) struct
- (cond ((equal arg '(16)) "[-]")
- ((and (not box) (equal arg '(4))) "[ ]")
- ((or (not box) (equal arg '(4))) nil)
- ((eq box 'on) "[ ]")
- (t "[X]")))
- ;; Mimic `org-list-write-struct' but with grabbing a return
- ;; value from `org-list-struct-fix-box'.
- (org-list-struct-fix-ind struct parents 2)
- (org-list-struct-fix-item-end struct)
- (org-list-struct-fix-bul struct prevs)
- (org-list-struct-fix-ind struct parents)
- (let ((block-item
- (org-list-struct-fix-box struct parents prevs orderedp)))
- (if (and box (equal struct old-struct))
- (if (equal arg '(16))
- (message "Checkboxes already reset")
- (user-error "Cannot toggle this checkbox: %s"
- (if (eq box 'on)
- "all subitems checked"
- "unchecked subitems")))
- (org-list-struct-apply-struct struct old-struct)
- (org-update-checkbox-count-maybe))
- (when block-item
- (message "Checkboxes were removed due to empty box at line %d"
- (org-current-line block-item))))))
- (`keyword
- (let ((org-inhibit-startup-visibility-stuff t)
- (org-startup-align-all-tables nil))
- (when (boundp 'org-table-coordinate-overlays)
- (mapc #'delete-overlay org-table-coordinate-overlays)
- (setq org-table-coordinate-overlays nil))
- (org-save-outline-visibility 'use-markers (org-mode-restart)))
- (message "Local setup has been refreshed"))
- (`plain-list
- ;; At a plain list, with a double C-u argument, set
- ;; checkboxes of each item to "[-]", whereas a single one
- ;; will toggle their presence according to the state of the
- ;; first item in the list. Without an argument, repair the
- ;; list.
- (let* ((begin (org-element-property :contents-begin context))
- (beginm (move-marker (make-marker) begin))
- (struct (org-element-property :structure context))
- (old-struct (copy-tree struct))
- (first-box (save-excursion
- (goto-char begin)
- (looking-at org-list-full-item-re)
- (match-string-no-properties 3)))
- (new-box (cond ((equal arg '(16)) "[-]")
- ((equal arg '(4)) (unless first-box "[ ]"))
- ((equal first-box "[X]") "[ ]")
- (t "[X]"))))
- (cond
- (arg
- (dolist (pos
- (org-list-get-all-items
- begin struct (org-list-prevs-alist struct)))
- (org-list-set-checkbox pos struct new-box)))
- ((and first-box (eq (point) begin))
- ;; For convenience, when point is at bol on the first
- ;; item of the list and no argument is provided, simply
- ;; toggle checkbox of that item, if any.
- (org-list-set-checkbox begin struct new-box)))
- (org-list-write-struct
- struct (org-list-parents-alist struct) old-struct)
- (org-update-checkbox-count-maybe)
- (save-excursion (goto-char beginm) (org-list-send-list 'maybe))))
- ((or `property-drawer `node-property)
- (call-interactively #'org-property-action))
- (`radio-target
- (call-interactively #'org-update-radio-target-regexp))
- (`statistics-cookie
- (call-interactively #'org-update-statistics-cookies))
- ((or `table `table-cell `table-row)
- ;; At a table, recalculate every field and align it. Also
- ;; send the table if necessary. If the table has
- ;; a `table.el' type, just give up. At a table row or cell,
- ;; maybe recalculate line but always align table.
- (if (eq (org-element-property :type context) 'table.el)
- (message "%s" (substitute-command-keys "\\<org-mode-map>\
- Use `\\[org-edit-special]' to edit table.el tables"))
- (let ((org-enable-table-editor t))
- (if (or (eq type 'table)
- ;; Check if point is at a TBLFM line.
- (and (eq type 'table-row)
- (= (point) (org-element-property :end context))))
- (save-excursion
- (if (org-at-TBLFM-p)
- (progn (require 'org-table)
- (org-table-calc-current-TBLFM))
- (goto-char (org-element-property :contents-begin context))
- (org-call-with-arg 'org-table-recalculate (or arg t))
- (orgtbl-send-table 'maybe)))
- (org-table-maybe-eval-formula)
- (cond (arg (call-interactively #'org-table-recalculate))
- ((org-table-maybe-recalculate-line))
- (t (org-table-align)))))))
- (`timestamp (org-timestamp-change 0 'day))
- ((and `nil (guard (org-at-heading-p)))
- ;; When point is on an unsupported object type, we can miss
- ;; the fact that it also is at a heading. Handle it here.
- (call-interactively #'org-set-tags))
- ((guard
- (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook)))
- (_
- (user-error
- (substitute-command-keys
- "`\\[org-ctrl-c-ctrl-c]' can do nothing useful here"))))))))
- (defun org-mode-restart ()
- (interactive)
- (let ((indent-status (bound-and-true-p org-indent-mode)))
- (funcall major-mode)
- (hack-local-variables)
- (when (and indent-status (not (bound-and-true-p org-indent-mode)))
- (org-indent-mode -1)))
- (message "%s restarted" major-mode))
- (defun org-kill-note-or-show-branches ()
- "Abort storing current note, or call `outline-show-branches'."
- (interactive)
- (if (not org-finish-function)
- (progn
- (outline-hide-subtree)
- (call-interactively 'outline-show-branches))
- (let ((org-note-abort t))
- (funcall org-finish-function))))
- (defun org-delete-indentation (&optional arg)
- "Join current line to previous and fix whitespace at join.
- If previous line is a headline add to headline title. Otherwise
- the function calls `delete-indentation'.
- With a non-nil optional argument, join it to the following one."
- (interactive "*P")
- (if (save-excursion
- (beginning-of-line (if arg 1 0))
- (let ((case-fold-search nil))
- (looking-at org-complex-heading-regexp)))
- ;; At headline.
- (let ((tags-column (when (match-beginning 5)
- (save-excursion (goto-char (match-beginning 5))
- (current-column))))
- (string (concat " " (progn (when arg (forward-line 1))
- (org-trim (delete-and-extract-region
- (line-beginning-position)
- (line-end-position)))))))
- (unless (bobp) (delete-region (point) (1- (point))))
- (goto-char (or (match-end 4)
- (match-beginning 5)
- (match-end 0)))
- (skip-chars-backward " \t")
- (save-excursion (insert string))
- ;; Adjust alignment of tags.
- (cond
- ((not tags-column)) ;no tags
- (org-auto-align-tags (org-set-tags nil t))
- (t (org--align-tags-here tags-column)))) ;preserve tags column
- (delete-indentation arg)))
- (defun org-open-line (n)
- "Insert a new row in tables, call `open-line' elsewhere.
- If `org-special-ctrl-o' is nil, just call `open-line' everywhere.
- As a special case, when a document starts with a table, allow to
- call `open-line' on the very first character."
- (interactive "*p")
- (if (and org-special-ctrl-o (/= (point) 1) (org-at-table-p))
- (org-table-insert-row)
- (open-line n)))
- (defun org-return (&optional indent)
- "Goto next table row or insert a newline.
- Calls `org-table-next-row' or `newline', depending on context.
- When optional INDENT argument is non-nil, call
- `newline-and-indent' instead of `newline'.
- When `org-return-follows-link' is non-nil and point is on
- a timestamp or a link, call `org-open-at-point'. However, it
- will not happen if point is in a table or on a \"dead\"
- object (e.g., within a comment). In these case, you need to use
- `org-open-at-point' directly."
- (interactive)
- (let ((context (if org-return-follows-link (org-element-context)
- (org-element-at-point))))
- (cond
- ;; In a table, call `org-table-next-row'.
- ((or (and (eq (org-element-type context) 'table)
- (>= (point) (org-element-property :contents-begin context))
- (< (point) (org-element-property :contents-end context)))
- (org-element-lineage context '(table-row table-cell) t))
- (org-table-justify-field-maybe)
- (call-interactively #'org-table-next-row))
- ;; On a link or a timestamp, call `org-open-at-point' if
- ;; `org-return-follows-link' allows it. Tolerate fuzzy
- ;; locations, e.g., in a comment, as `org-open-at-point'.
- ((and org-return-follows-link
- (or (org-in-regexp org-ts-regexp-both nil t)
- (org-in-regexp org-tsr-regexp-both nil t)
- (org-in-regexp org-any-link-re nil t)))
- (call-interactively #'org-open-at-point))
- ;; Insert newline in heading, but preserve tags.
- ((and (not (bolp))
- (save-excursion (beginning-of-line)
- (let ((case-fold-search nil))
- (looking-at org-complex-heading-regexp))))
- ;; At headline. Split line. However, if point is on keyword,
- ;; priority cookie or tags, do not break any of them: add
- ;; a newline after the headline instead.
- (let ((tags-column (and (match-beginning 5)
- (save-excursion (goto-char (match-beginning 5))
- (current-column))))
- (string
- (when (and (match-end 4) (org-point-in-group (point) 4))
- (delete-and-extract-region (point) (match-end 4)))))
- ;; Adjust tag alignment.
- (cond
- ((not (and tags-column string)))
- (org-auto-align-tags (org-set-tags nil t))
- (t (org--align-tags-here tags-column))) ;preserve tags column
- (end-of-line)
- (org-show-entry)
- (if indent (newline-and-indent) (newline))
- (when string (save-excursion (insert (org-trim string))))))
- ;; In a list, make sure indenting keeps trailing text within.
- ((and indent
- (not (eolp))
- (org-element-lineage context '(item)))
- (let ((trailing-data
- (delete-and-extract-region (point) (line-end-position))))
- (newline-and-indent)
- (save-excursion (insert trailing-data))))
- (t (if indent (newline-and-indent) (newline))))))
- (defun org-return-indent ()
- "Goto next table row or insert a newline and indent.
- Calls `org-table-next-row' or `newline-and-indent', depending on
- context. See the individual commands for more information."
- (interactive)
- (org-return t))
- (defun org-ctrl-c-star ()
- "Compute table, or change heading status of lines.
- Calls `org-table-recalculate' or `org-toggle-heading',
- depending on context."
- (interactive)
- (cond
- ((org-at-table-p)
- (call-interactively 'org-table-recalculate))
- (t
- ;; Convert all lines in region to list items
- (call-interactively 'org-toggle-heading))))
- (defun org-ctrl-c-minus ()
- "Insert separator line in table or modify bullet status of line.
- Also turns a plain line or a region of lines into list items.
- Calls `org-table-insert-hline', `org-toggle-item', or
- `org-cycle-list-bullet', depending on context."
- (interactive)
- (cond
- ((org-at-table-p)
- (call-interactively 'org-table-insert-hline))
- ((org-region-active-p)
- (call-interactively 'org-toggle-item))
- ((org-in-item-p)
- (call-interactively 'org-cycle-list-bullet))
- (t
- (call-interactively 'org-toggle-item))))
- (defun org-toggle-heading (&optional nstars)
- "Convert headings to normal text, or items or text to headings.
- If there is no active region, only convert the current line.
- With a `\\[universal-argument]' prefix, convert the whole list at
- point into heading.
- In a region:
- - If the first non blank line is a headline, remove the stars
- from all headlines in the region.
- - If it is a normal line, turn each and every normal line (i.e.,
- not an heading or an item) in the region into headings. If you
- want to convert only the first line of this region, use one
- universal prefix argument.
- - If it is a plain list item, turn all plain list items into headings.
- When converting a line into a heading, the number of stars is chosen
- such that the lines become children of the current entry. However,
- when a numeric prefix argument is given, its value determines the
- number of stars to add."
- (interactive "P")
- (let ((skip-blanks
- (function
- ;; Return beginning of first non-blank line, starting from
- ;; line at POS.
- (lambda (pos)
- (save-excursion
- (goto-char pos)
- (while (org-at-comment-p) (forward-line))
- (skip-chars-forward " \r\t\n")
- (point-at-bol)))))
- beg end toggled)
- ;; Determine boundaries of changes. If a universal prefix has
- ;; been given, put the list in a region. If region ends at a bol,
- ;; do not consider the last line to be in the region.
- (when (and current-prefix-arg (org-at-item-p))
- (when (listp current-prefix-arg) (setq current-prefix-arg 1))
- (org-mark-element))
- (if (org-region-active-p)
- (setq beg (funcall skip-blanks (region-beginning))
- end (copy-marker (save-excursion
- (goto-char (region-end))
- (if (bolp) (point) (point-at-eol)))))
- (setq beg (funcall skip-blanks (point-at-bol))
- end (copy-marker (point-at-eol))))
- ;; Ensure inline tasks don't count as headings.
- (org-with-limited-levels
- (save-excursion
- (goto-char beg)
- (cond
- ;; Case 1. Started at an heading: de-star headings.
- ((org-at-heading-p)
- (while (< (point) end)
- (when (org-at-heading-p t)
- (looking-at org-outline-regexp) (replace-match "")
- (setq toggled t))
- (forward-line)))
- ;; Case 2. Started at an item: change items into headlines.
- ;; One star will be added by `org-list-to-subtree'.
- ((org-at-item-p)
- (while (< (point) end)
- (when (org-at-item-p)
- ;; Pay attention to cases when region ends before list.
- (let* ((struct (org-list-struct))
- (list-end
- (min (org-list-get-bottom-point struct) (1+ end))))
- (save-restriction
- (narrow-to-region (point) list-end)
- (insert (org-list-to-subtree (org-list-to-lisp t)) "\n")))
- (setq toggled t))
- (forward-line)))
- ;; Case 3. Started at normal text: make every line an heading,
- ;; skipping headlines and items.
- (t (let* ((stars
- (make-string
- (if (numberp nstars) nstars (or (org-current-level) 0)) ?*))
- (add-stars
- (cond (nstars "") ; stars from prefix only
- ((equal stars "") "*") ; before first heading
- (org-odd-levels-only "**") ; inside heading, odd
- (t "*"))) ; inside heading, oddeven
- (rpl (concat stars add-stars " "))
- (lend (when (listp nstars) (save-excursion (end-of-line) (point)))))
- (while (< (point) (if (equal nstars '(4)) lend end))
- (when (and (not (or (org-at-heading-p) (org-at-item-p) (org-at-comment-p)))
- (looking-at "\\([ \t]*\\)\\(\\S-\\)"))
- (replace-match (concat rpl (match-string 2))) (setq toggled t))
- (forward-line)))))))
- (unless toggled (message "Cannot toggle heading from here"))))
- (defun org-meta-return (&optional _arg)
- "Insert a new heading or wrap a region in a table.
- Calls `org-insert-heading' or `org-table-wrap-region', depending
- on context. See the individual commands for more information."
- (interactive)
- (org-check-before-invisible-edit 'insert)
- (or (run-hook-with-args-until-success 'org-metareturn-hook)
- (call-interactively (if (org-at-table-p) #'org-table-wrap-region
- #'org-insert-heading))))
- ;;; Menu entries
- (defsubst org-in-subtree-not-table-p ()
- "Are we in a subtree and not in a table?"
- (and (not (org-before-first-heading-p))
- (not (org-at-table-p))))
- ;; Define the Org mode menus
- (easy-menu-define org-tbl-menu org-mode-map "Tbl menu"
- '("Tbl"
- ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p)]
- ["Next Field" org-cycle (org-at-table-p)]
- ["Previous Field" org-shifttab (org-at-table-p)]
- ["Next Row" org-return (org-at-table-p)]
- "--"
- ["Blank Field" org-table-blank-field (org-at-table-p)]
- ["Edit Field" org-table-edit-field (org-at-table-p)]
- ["Copy Field from Above" org-table-copy-down (org-at-table-p)]
- "--"
- ("Column"
- ["Move Column Left" org-metaleft (org-at-table-p)]
- ["Move Column Right" org-metaright (org-at-table-p)]
- ["Delete Column" org-shiftmetaleft (org-at-table-p)]
- ["Insert Column" org-shiftmetaright (org-at-table-p)])
- ("Row"
- ["Move Row Up" org-metaup (org-at-table-p)]
- ["Move Row Down" org-metadown (org-at-table-p)]
- ["Delete Row" org-shiftmetaup (org-at-table-p)]
- ["Insert Row" org-shiftmetadown (org-at-table-p)]
- ["Sort lines in region" org-table-sort-lines (org-at-table-p)]
- "--"
- ["Insert Hline" org-ctrl-c-minus (org-at-table-p)])
- ("Rectangle"
- ["Copy Rectangle" org-copy-special (org-at-table-p)]
- ["Cut Rectangle" org-cut-special (org-at-table-p)]
- ["Paste Rectangle" org-paste-special (org-at-table-p)]
- ["Fill Rectangle" org-table-wrap-region (org-at-table-p)])
- "--"
- ("Calculate"
- ["Set Column Formula" org-table-eval-formula (org-at-table-p)]
- ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]
- ["Edit Formulas" org-edit-special (org-at-table-p)]
- "--"
- ["Recalculate line" org-table-recalculate (org-at-table-p)]
- ["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"]
- ["Iterate all" (lambda () (interactive) (org-table-recalculate '(16))) :active (org-at-table-p) :keys "C-u C-u C-c *"]
- "--"
- ["Toggle Recalculate Mark" org-table-rotate-recalc-marks (org-at-table-p)]
- "--"
- ["Sum Column/Rectangle" org-table-sum
- (or (org-at-table-p) (org-region-active-p))]
- ["Which Column?" org-table-current-column (org-at-table-p)])
- ["Debug Formulas"
- org-table-toggle-formula-debugger
- :style toggle :selected (bound-and-true-p org-table-formula-debug)]
- ["Show Col/Row Numbers"
- org-table-toggle-coordinate-overlays
- :style toggle
- :selected (bound-and-true-p org-table-overlay-coordinates)]
- "--"
- ["Create" org-table-create (and (not (org-at-table-p))
- org-enable-table-editor)]
- ["Convert Region" org-table-convert-region (not (org-at-table-p 'any))]
- ["Import from File" org-table-import (not (org-at-table-p))]
- ["Export to File" org-table-export (org-at-table-p)]
- "--"
- ["Create/Convert from/to table.el" org-table-create-with-table.el t]
- "--"
- ("Plot"
- ["Ascii plot" orgtbl-ascii-plot :active (org-at-table-p) :keys "C-c \" a"]
- ["Gnuplot" org-plot/gnuplot :active (org-at-table-p) :keys "C-c \" g"])))
- (easy-menu-define org-org-menu org-mode-map "Org menu"
- '("Org"
- ("Show/Hide"
- ["Cycle Visibility" org-cycle :active (or (bobp) (outline-on-heading-p))]
- ["Cycle Global Visibility" org-shifttab :active (not (org-at-table-p))]
- ["Sparse Tree..." org-sparse-tree t]
- ["Reveal Context" org-reveal t]
- ["Show All" outline-show-all t]
- "--"
- ["Subtree to indirect buffer" org-tree-to-indirect-buffer t])
- "--"
- ["New Heading" org-insert-heading t]
- ("Navigate Headings"
- ["Up" outline-up-heading t]
- ["Next" outline-next-visible-heading t]
- ["Previous" outline-previous-visible-heading t]
- ["Next Same Level" outline-forward-same-level t]
- ["Previous Same Level" outline-backward-same-level t]
- "--"
- ["Jump" org-goto t])
- ("Edit Structure"
- ["Refile Subtree" org-refile (org-in-subtree-not-table-p)]
- "--"
- ["Move Subtree Up" org-metaup (org-at-heading-p)]
- ["Move Subtree Down" org-metadown (org-at-heading-p)]
- "--"
- ["Copy Subtree" org-copy-special (org-in-subtree-not-table-p)]
- ["Cut Subtree" org-cut-special (org-in-subtree-not-table-p)]
- ["Paste Subtree" org-paste-special (not (org-at-table-p))]
- "--"
- ["Clone subtree, shift time" org-clone-subtree-with-time-shift t]
- "--"
- ["Copy visible text" org-copy-visible t]
- "--"
- ["Promote Heading" org-metaleft (org-in-subtree-not-table-p)]
- ["Promote Subtree" org-shiftmetaleft (org-in-subtree-not-table-p)]
- ["Demote Heading" org-metaright (org-in-subtree-not-table-p)]
- ["Demote Subtree" org-shiftmetaright (org-in-subtree-not-table-p)]
- "--"
- ["Sort Region/Children" org-sort t]
- "--"
- ["Convert to odd levels" org-convert-to-odd-levels t]
- ["Convert to odd/even levels" org-convert-to-oddeven-levels t])
- ("Editing"
- ["Emphasis..." org-emphasize t]
- ["Edit Source Example" org-edit-special t]
- "--"
- ["Footnote new/jump" org-footnote-action t]
- ["Footnote extra" (org-footnote-action t) :active t :keys "C-u C-c C-x f"])
- ("Archive"
- ["Archive (default method)" org-archive-subtree-default (org-in-subtree-not-table-p)]
- "--"
- ["Move Subtree to Archive file" org-archive-subtree (org-in-subtree-not-table-p)]
- ["Toggle ARCHIVE tag" org-toggle-archive-tag (org-in-subtree-not-table-p)]
- ["Move subtree to Archive sibling" org-archive-to-archive-sibling (org-in-subtree-not-table-p)]
- )
- "--"
- ("Hyperlinks"
- ["Store Link (Global)" org-store-link t]
- ["Find existing link to here" org-occur-link-in-agenda-files t]
- ["Insert Link" org-insert-link t]
- ["Follow Link" org-open-at-point t]
- "--"
- ["Next link" org-next-link t]
- ["Previous link" org-previous-link t]
- "--"
- ["Descriptive Links"
- org-toggle-link-display
- :style radio
- :selected org-descriptive-links
- ]
- ["Literal Links"
- org-toggle-link-display
- :style radio
- :selected (not org-descriptive-links)])
- "--"
- ("TODO Lists"
- ["TODO/DONE/-" org-todo t]
- ("Select keyword"
- ["Next keyword" org-shiftright (org-at-heading-p)]
- ["Previous keyword" org-shiftleft (org-at-heading-p)]
- ["Complete Keyword" pcomplete (assq :todo-keyword (org-context))]
- ["Next keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-at-heading-p))]
- ["Previous keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-at-heading-p))])
- ["Show TODO Tree" org-show-todo-tree :active t :keys "C-c / t"]
- ["Global TODO list" org-todo-list :active t :keys "C-c a t"]
- "--"
- ["Enforce dependencies" (customize-variable 'org-enforce-todo-dependencies)
- :selected org-enforce-todo-dependencies :style toggle :active t]
- "Settings for tree at point"
- ["Do Children sequentially" org-toggle-ordered-property :style radio
- :selected (org-entry-get nil "ORDERED")
- :active org-enforce-todo-dependencies :keys "C-c C-x o"]
- ["Do Children parallel" org-toggle-ordered-property :style radio
- :selected (not (org-entry-get nil "ORDERED"))
- :active org-enforce-todo-dependencies :keys "C-c C-x o"]
- "--"
- ["Set Priority" org-priority t]
- ["Priority Up" org-shiftup t]
- ["Priority Down" org-shiftdown t]
- "--"
- ["Get news from all feeds" org-feed-update-all t]
- ["Go to the inbox of a feed..." org-feed-goto-inbox t]
- ["Customize feeds" (customize-variable 'org-feed-alist) t])
- ("TAGS and Properties"
- ["Set Tags" org-set-tags-command (not (org-before-first-heading-p))]
- ["Change tag in region" org-change-tag-in-region (org-region-active-p)]
- "--"
- ["Set property" org-set-property (not (org-before-first-heading-p))]
- ["Column view of properties" org-columns t]
- ["Insert Column View DBlock" org-columns-insert-dblock t])
- ("Dates and Scheduling"
- ["Timestamp" org-time-stamp (not (org-before-first-heading-p))]
- ["Timestamp (inactive)" org-time-stamp-inactive (not (org-before-first-heading-p))]
- ("Change Date"
- ["1 Day Later" org-shiftright (org-at-timestamp-p)]
- ["1 Day Earlier" org-shiftleft (org-at-timestamp-p)]
- ["1 ... Later" org-shiftup (org-at-timestamp-p)]
- ["1 ... Earlier" org-shiftdown (org-at-timestamp-p)])
- ["Compute Time Range" org-evaluate-time-range t]
- ["Schedule Item" org-schedule (not (org-before-first-heading-p))]
- ["Deadline" org-deadline (not (org-before-first-heading-p))]
- "--"
- ["Custom time format" org-toggle-time-stamp-overlays
- :style radio :selected org-display-custom-times]
- "--"
- ["Goto Calendar" org-goto-calendar t]
- ["Date from Calendar" org-date-from-calendar t]
- "--"
- ["Start/Restart Timer" org-timer-start t]
- ["Pause/Continue Timer" org-timer-pause-or-continue t]
- ["Stop Timer" org-timer-pause-or-continue :active t :keys "C-u C-c C-x ,"]
- ["Insert Timer String" org-timer t]
- ["Insert Timer Item" org-timer-item t])
- ("Logging work"
- ["Clock in" org-clock-in :active t :keys "C-c C-x C-i"]
- ["Switch task" (lambda () (interactive) (org-clock-in '(4))) :active t :keys "C-u C-c C-x C-i"]
- ["Clock out" org-clock-out t]
- ["Clock cancel" org-clock-cancel t]
- "--"
- ["Mark as default task" org-clock-mark-default-task t]
- ["Clock in, mark as default" (lambda () (interactive) (org-clock-in '(16))) :active t :keys "C-u C-u C-c C-x C-i"]
- ["Goto running clock" org-clock-goto t]
- "--"
- ["Display times" org-clock-display t]
- ["Create clock table" org-clock-report t]
- "--"
- ["Record DONE time"
- (progn (setq org-log-done (not org-log-done))
- (message "Switching to %s will %s record a timestamp"
- (car org-done-keywords)
- (if org-log-done "automatically" "not")))
- :style toggle :selected org-log-done])
- "--"
- ["Agenda Command..." org-agenda t]
- ["Set Restriction Lock" org-agenda-set-restriction-lock t]
- ("File List for Agenda")
- ("Special views current file"
- ["TODO Tree" org-show-todo-tree t]
- ["Check Deadlines" org-check-deadlines t]
- ["Timeline" org-timeline t]
- ["Tags/Property tree" org-match-sparse-tree t])
- "--"
- ["Export/Publish..." org-export-dispatch t]
- ("LaTeX"
- ["Org CDLaTeX mode" org-cdlatex-mode :style toggle
- :selected org-cdlatex-mode]
- ["Insert Environment" cdlatex-environment (fboundp 'cdlatex-environment)]
- ["Insert math symbol" cdlatex-math-symbol (fboundp 'cdlatex-math-symbol)]
- ["Modify math symbol" org-cdlatex-math-modify
- (org-inside-LaTeX-fragment-p)]
- ["Insert citation" org-reftex-citation t])
- "--"
- ("MobileOrg"
- ["Push Files and Views" org-mobile-push t]
- ["Get Captured and Flagged" org-mobile-pull t]
- ["Find FLAGGED Tasks" (org-agenda nil "?") :active t :keys "C-c a ?"]
- "--"
- ["Setup" (progn (require 'org-mobile) (customize-group 'org-mobile)) t])
- "--"
- ("Documentation"
- ["Show Version" org-version t]
- ["Info Documentation" org-info t])
- ("Customize"
- ["Browse Org Group" org-customize t]
- "--"
- ["Expand This Menu" org-create-customize-menu
- (fboundp 'customize-menu-create)])
- ["Send bug report" org-submit-bug-report t]
- "--"
- ("Refresh/Reload"
- ["Refresh setup current buffer" org-mode-restart t]
- ["Reload Org (after update)" org-reload t]
- ["Reload Org uncompiled" (org-reload t) :active t :keys "C-u C-c C-x !"])
- ))
- (defun org-info (&optional node)
- "Read documentation for Org in the info system.
- With optional NODE, go directly to that node."
- (interactive)
- (info (format "(org)%s" (or node ""))))
- ;;;###autoload
- (defun org-submit-bug-report ()
- "Submit a bug report on Org via mail.
- Don't hesitate to report any problems or inaccurate documentation.
- If you don't have setup sending mail from (X)Emacs, please copy the
- output buffer into your mail program, as it gives us important
- information about your Org version and configuration."
- (interactive)
- (require 'reporter)
- (defvar reporter-prompt-for-summary-p)
- (org-load-modules-maybe)
- (org-require-autoloaded-modules)
- (let ((reporter-prompt-for-summary-p "Bug report subject: "))
- (reporter-submit-bug-report
- "emacs-orgmode@gnu.org"
- (org-version nil 'full)
- (let (list)
- (save-window-excursion
- (pop-to-buffer-same-window (get-buffer-create "*Warn about privacy*"))
- (delete-other-windows)
- (erase-buffer)
- (insert "You are about to submit a bug report to the Org mailing list.
- We would like to add your full Org and Outline configuration to the
- bug report. This greatly simplifies the work of the maintainer and
- other experts on the mailing list.
- HOWEVER, some variables you have customized may contain private
- information. The names of customers, colleagues, or friends, might
- appear in the form of file names, tags, todo states, or search strings.
- If you answer yes to the prompt, you might want to check and remove
- such private information before sending the email.")
- (add-text-properties (point-min) (point-max) '(face org-warning))
- (when (yes-or-no-p "Include your Org configuration ")
- (mapatoms
- (lambda (v)
- (and (boundp v)
- (string-match "\\`\\(org-\\|outline-\\)" (symbol-name v))
- (or (and (symbol-value v)
- (string-match "\\(-hook\\|-function\\)\\'" (symbol-name v)))
- (and
- (get v 'custom-type) (get v 'standard-value)
- (not (equal (symbol-value v) (eval (car (get v 'standard-value)))))))
- (push v list)))))
- (kill-buffer (get-buffer "*Warn about privacy*"))
- list))
- nil nil
- "Remember to cover the basics, that is, what you expected to happen and
- what in fact did happen. You don't know how to make a good report? See
- http://orgmode.org/manual/Feedback.html#Feedback
- Your bug report will be posted to the Org mailing list.
- ------------------------------------------------------------------------")
- (save-excursion
- (when (re-search-backward "^\\(Subject: \\)Org mode version \\(.*?\\);[ \t]*\\(.*\\)" nil t)
- (replace-match "\\1Bug: \\3 [\\2]")))))
- (defun org-install-agenda-files-menu ()
- (let ((bl (buffer-list)))
- (save-excursion
- (while bl
- (set-buffer (pop bl))
- (when (derived-mode-p 'org-mode) (setq bl nil)))
- (when (derived-mode-p 'org-mode)
- (easy-menu-change
- '("Org") "File List for Agenda"
- (append
- (list
- ["Edit File List" (org-edit-agenda-file-list) t]
- ["Add/Move Current File to Front of List" org-agenda-file-to-front t]
- ["Remove Current File from List" org-remove-file t]
- ["Cycle through agenda files" org-cycle-agenda-files t]
- ["Occur in all agenda files" org-occur-in-agenda-files t]
- "--")
- (mapcar 'org-file-menu-entry (org-agenda-files t))))))))
- ;;;; Documentation
- (defun org-require-autoloaded-modules ()
- (interactive)
- (mapc #'require
- '(org-agenda org-archive org-attach org-clock org-colview org-id
- org-table org-timer)))
- ;;;###autoload
- (defun org-reload (&optional uncompiled)
- "Reload all org lisp files.
- With prefix arg UNCOMPILED, load the uncompiled versions."
- (interactive "P")
- (require 'loadhist)
- (let* ((org-dir (org-find-library-dir "org"))
- (contrib-dir (or (org-find-library-dir "org-contribdir") org-dir))
- (feature-re "^\\(org\\|ob\\|ox\\)\\(-.*\\)?")
- (remove-re (format "\\`%s\\'"
- (regexp-opt '("org" "org-loaddefs" "org-version"))))
- (feats (delete-dups
- (mapcar 'file-name-sans-extension
- (mapcar 'file-name-nondirectory
- (delq nil
- (mapcar 'feature-file
- features))))))
- (lfeat (append
- (sort
- (setq feats
- (delq nil (mapcar
- (lambda (f)
- (if (and (string-match feature-re f)
- (not (string-match remove-re f)))
- f nil))
- feats)))
- 'string-lessp)
- (list "org-version" "org")))
- (load-suffixes (when (boundp 'load-suffixes) load-suffixes))
- (load-suffixes (if uncompiled (reverse load-suffixes) load-suffixes))
- load-uncore load-misses)
- (setq load-misses
- (delq 't
- (mapcar (lambda (f)
- (or (org-load-noerror-mustsuffix (concat org-dir f))
- (and (string= org-dir contrib-dir)
- (org-load-noerror-mustsuffix (concat contrib-dir f)))
- (and (org-load-noerror-mustsuffix (concat (org-find-library-dir f) f))
- (add-to-list 'load-uncore f 'append)
- 't)
- f))
- lfeat)))
- (when load-uncore
- (message "The following feature%s found in load-path, please check if that's correct:\n%s"
- (if (> (length load-uncore) 1) "s were" " was") load-uncore))
- (if load-misses
- (message "Some error occurred while reloading Org feature%s\n%s\nPlease check *Messages*!\n%s"
- (if (> (length load-misses) 1) "s" "") load-misses (org-version nil 'full))
- (message "Successfully reloaded Org\n%s" (org-version nil 'full)))))
- ;;;###autoload
- (defun org-customize ()
- "Call the customize function with org as argument."
- (interactive)
- (org-load-modules-maybe)
- (org-require-autoloaded-modules)
- (customize-browse 'org))
- (defun org-create-customize-menu ()
- "Create a full customization menu for Org mode, insert it into the menu."
- (interactive)
- (org-load-modules-maybe)
- (org-require-autoloaded-modules)
- (if (fboundp 'customize-menu-create)
- (progn
- (easy-menu-change
- '("Org") "Customize"
- `(["Browse Org group" org-customize t]
- "--"
- ,(customize-menu-create 'org)
- ["Set" Custom-set t]
- ["Save" Custom-save t]
- ["Reset to Current" Custom-reset-current t]
- ["Reset to Saved" Custom-reset-saved t]
- ["Reset to Standard Settings" Custom-reset-standard t]))
- (message "\"Org\"-menu now contains full customization menu"))
- (error "Cannot expand menu (outdated version of cus-edit.el)")))
- ;;;; Miscellaneous stuff
- ;;; Generally useful functions
- (defun org-get-at-eol (property n)
- "Get text property PROPERTY at the end of line less N characters."
- (get-text-property (- (point-at-eol) n) property))
- (defun org-find-text-property-in-string (prop s)
- "Return the first non-nil value of property PROP in string S."
- (or (get-text-property 0 prop s)
- (get-text-property (or (next-single-property-change 0 prop s) 0)
- prop s)))
- (defun org-display-warning (message)
- "Display the given MESSAGE as a warning."
- (display-warning 'org message :warning))
- (defun org-eval (form)
- "Eval FORM and return result."
- (condition-case error
- (eval form)
- (error (format "%%![Error: %s]" error))))
- (defun org-in-clocktable-p ()
- "Check if the cursor is in a clocktable."
- (let ((pos (point)) start)
- (save-excursion
- (end-of-line 1)
- (and (re-search-backward "^[ \t]*#\\+BEGIN:[ \t]+clocktable" nil t)
- (setq start (match-beginning 0))
- (re-search-forward "^[ \t]*#\\+END:.*" nil t)
- (>= (match-end 0) pos)
- start))))
- (defun org-in-verbatim-emphasis ()
- (save-match-data
- (and (org-in-regexp org-emph-re 2)
- (>= (point) (match-beginning 3))
- (<= (point) (match-end 4))
- (member (match-string 3) '("=" "~")))))
- (defun org-overlay-display (ovl text &optional face evap)
- "Make overlay OVL display TEXT with face FACE."
- (overlay-put ovl 'display text)
- (if face (overlay-put ovl 'face face))
- (if evap (overlay-put ovl 'evaporate t)))
- (defun org-overlay-before-string (ovl text &optional face evap)
- "Make overlay OVL display TEXT with face FACE."
- (if face (org-add-props text nil 'face face))
- (overlay-put ovl 'before-string text)
- (if evap (overlay-put ovl 'evaporate t)))
- (defun org-find-overlays (prop &optional pos delete)
- "Find all overlays specifying PROP at POS or point.
- If DELETE is non-nil, delete all those overlays."
- (let (found)
- (dolist (ov (overlays-at (or pos (point))) found)
- (cond ((not (overlay-get ov prop)))
- (delete (delete-overlay ov))
- (t (push ov found))))))
- (defun org-goto-marker-or-bmk (marker &optional bookmark)
- "Go to MARKER, widen if necessary. When marker is not live, try BOOKMARK."
- (if (and marker (marker-buffer marker)
- (buffer-live-p (marker-buffer marker)))
- (progn
- (pop-to-buffer-same-window (marker-buffer marker))
- (when (or (> marker (point-max)) (< marker (point-min)))
- (widen))
- (goto-char marker)
- (org-show-context 'org-goto))
- (if bookmark
- (bookmark-jump bookmark)
- (error "Cannot find location"))))
- (defun org-quote-csv-field (s)
- "Quote field for inclusion in CSV material."
- (if (string-match "[\",]" s)
- (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"")
- s))
- (defun org-force-self-insert (N)
- "Needed to enforce self-insert under remapping."
- (interactive "p")
- (self-insert-command N))
- (defun org-string-width (s)
- "Compute width of string, ignoring invisible characters.
- This ignores character with invisibility property `org-link', and also
- characters with property `org-cwidth', because these will become invisible
- upon the next fontification round."
- (let (b l)
- (when (or (eq t buffer-invisibility-spec)
- (assq 'org-link buffer-invisibility-spec))
- (while (setq b (text-property-any 0 (length s)
- 'invisible 'org-link s))
- (setq s (concat (substring s 0 b)
- (substring s (or (next-single-property-change
- b 'invisible s)
- (length s)))))))
- (while (setq b (text-property-any 0 (length s) 'org-cwidth t s))
- (setq s (concat (substring s 0 b)
- (substring s (or (next-single-property-change
- b 'org-cwidth s)
- (length s))))))
- (setq l (string-width s) b -1)
- (while (setq b (text-property-any (1+ b) (length s) 'org-dwidth t s))
- (setq l (- l (get-text-property b 'org-dwidth-n s))))
- l))
- (defun org-shorten-string (s maxlength)
- "Shorten string S so that it is no longer than MAXLENGTH characters.
- If the string is shorter or has length MAXLENGTH, just return the
- original string. If it is longer, the functions finds a space in the
- string, breaks this string off at that locations and adds three dots
- as ellipsis. Including the ellipsis, the string will not be longer
- than MAXLENGTH. If finding a good breaking point in the string does
- not work, the string is just chopped off in the middle of a word
- if necessary."
- (if (<= (length s) maxlength)
- s
- (let* ((n (max (- maxlength 4) 1))
- (re (concat "\\`\\(.\\{1," (int-to-string n) "\\}[^ ]\\)\\([ ]\\|\\'\\)")))
- (if (string-match re s)
- (concat (match-string 1 s) "...")
- (concat (substring s 0 (max (- maxlength 3) 0)) "...")))))
- (defun org-get-indentation (&optional line)
- "Get the indentation of the current line, interpreting tabs.
- When LINE is given, assume it represents a line and compute its indentation."
- (if line
- (when (string-match "^ *" (org-remove-tabs line))
- (match-end 0))
- (save-excursion
- (beginning-of-line 1)
- (skip-chars-forward " \t")
- (current-column))))
- (defun org-get-string-indentation (s)
- "What indentation has S due to SPACE and TAB at the beginning of the string?"
- (let ((n -1) (i 0) (w tab-width) c)
- (catch 'exit
- (while (< (setq n (1+ n)) (length s))
- (setq c (aref s n))
- (cond ((= c ?\ ) (setq i (1+ i)))
- ((= c ?\t) (setq i (* (/ (+ w i) w) w)))
- (t (throw 'exit t)))))
- i))
- (defun org-remove-tabs (s &optional width)
- "Replace tabulators in S with spaces.
- Assumes that s is a single line, starting in column 0."
- (setq width (or width tab-width))
- (while (string-match "\t" s)
- (setq s (replace-match
- (make-string
- (- (* width (/ (+ (match-beginning 0) width) width))
- (match-beginning 0)) ?\ )
- t t s)))
- s)
- (defun org-fix-indentation (line ind)
- "Fix indentation in LINE.
- IND is a cons cell with target and minimum indentation.
- If the current indentation in LINE is smaller than the minimum,
- leave it alone. If it is larger than ind, set it to the target."
- (let* ((l (org-remove-tabs line))
- (i (org-get-indentation l))
- (i1 (car ind)) (i2 (cdr ind)))
- (when (>= i i2) (setq l (substring line i2)))
- (if (> i1 0)
- (concat (make-string i1 ?\ ) l)
- l)))
- (defun org-remove-indentation (code &optional n)
- "Remove maximum common indentation in string CODE and return it.
- N may optionally be the number of columns to remove. Return CODE
- as-is if removal failed."
- (with-temp-buffer
- (insert code)
- (if (org-do-remove-indentation n) (buffer-string) code)))
- (defun org-do-remove-indentation (&optional n)
- "Remove the maximum common indentation from the buffer.
- When optional argument N is a positive integer, remove exactly
- that much characters from indentation, if possible. Return nil
- if it fails."
- (catch :exit
- (goto-char (point-min))
- ;; Find maximum common indentation, if not specified.
- (let ((n (or n
- (let ((min-ind (point-max)))
- (save-excursion
- (while (re-search-forward "^[ \t]*\\S-" nil t)
- (let ((ind (1- (current-column))))
- (if (zerop ind) (throw :exit nil)
- (setq min-ind (min min-ind ind))))))
- min-ind))))
- (if (zerop n) (throw :exit nil)
- ;; Remove exactly N indentation, but give up if not possible.
- (while (not (eobp))
- (let ((ind (progn (skip-chars-forward " \t") (current-column))))
- (cond ((eolp) (delete-region (line-beginning-position) (point)))
- ((< ind n) (throw :exit nil))
- (t (indent-line-to (- ind n))))
- (forward-line)))
- ;; Signal success.
- t))))
- (defun org-fill-template (template alist)
- "Find each %key of ALIST in TEMPLATE and replace it."
- (let ((case-fold-search nil))
- (dolist (entry (sort (copy-sequence alist)
- (lambda (a b) (< (length (car a)) (length (car b))))))
- (setq template
- (replace-regexp-in-string
- (concat "%" (regexp-quote (car entry)))
- (or (cdr entry) "") template t t)))
- template))
- (defun org-base-buffer (buffer)
- "Return the base buffer of BUFFER, if it has one. Else return the buffer."
- (if (not buffer)
- buffer
- (or (buffer-base-buffer buffer)
- buffer)))
- (defun org-wrap (string &optional width lines)
- "Wrap string to either a number of lines, or a width in characters.
- If WIDTH is non-nil, the string is wrapped to that width, however many lines
- that costs. If there is a word longer than WIDTH, the text is actually
- wrapped to the length of that word.
- IF WIDTH is nil and LINES is non-nil, the string is forced into at most that
- many lines, whatever width that takes.
- The return value is a list of lines, without newlines at the end."
- (let* ((words (org-split-string string "[ \t\n]+"))
- (maxword (apply 'max (mapcar 'org-string-width words)))
- w ll)
- (cond (width
- (org-do-wrap words (max maxword width)))
- (lines
- (setq w maxword)
- (setq ll (org-do-wrap words maxword))
- (if (<= (length ll) lines)
- ll
- (setq ll words)
- (while (> (length ll) lines)
- (setq w (1+ w))
- (setq ll (org-do-wrap words w)))
- ll))
- (t (error "Cannot wrap this")))))
- (defun org-do-wrap (words width)
- "Create lines of maximum width WIDTH (in characters) from word list WORDS."
- (let (lines line)
- (while words
- (setq line (pop words))
- (while (and words (< (+ (length line) (length (car words))) width))
- (setq line (concat line " " (pop words))))
- (setq lines (push line lines)))
- (nreverse lines)))
- (defun org-split-string (string &optional separators)
- "Splits STRING into substrings at SEPARATORS.
- SEPARATORS is a regular expression.
- No empty strings are returned if there are matches at the beginning
- and end of string."
- ;; FIXME: why not use (split-string STRING SEPARATORS t)?
- (let ((start 0) notfirst list)
- (while (and (string-match (or separators "[ \f\t\n\r\v]+") string
- (if (and notfirst
- (= start (match-beginning 0))
- (< start (length string)))
- (1+ start) start))
- (< (match-beginning 0) (length string)))
- (setq notfirst t)
- (or (eq (match-beginning 0) 0)
- (and (eq (match-beginning 0) (match-end 0))
- (eq (match-beginning 0) start))
- (push (substring string start (match-beginning 0)) list))
- (setq start (match-end 0)))
- (or (eq start (length string))
- (push (substring string start) list))
- (nreverse list)))
- (defun org-quote-vert (s)
- "Replace \"|\" with \"\\vert\"."
- (while (string-match "|" s)
- (setq s (replace-match "\\vert" t t s)))
- s)
- (defun org-uuidgen-p (s)
- "Is S an ID created by UUIDGEN?"
- (string-match "\\`[0-9a-f]\\{8\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{12\\}\\'" (downcase s)))
- (defun org-in-src-block-p (&optional inside)
- "Whether point is in a code source block.
- When INSIDE is non-nil, don't consider we are within a src block
- when point is at #+BEGIN_SRC or #+END_SRC."
- (let ((case-fold-search t))
- (or (and (eq (get-char-property (point) 'src-block) t))
- (and (not inside)
- (save-match-data
- (save-excursion
- (beginning-of-line)
- (looking-at ".*#\\+\\(begin\\|end\\)_src")))))))
- (defun org-context ()
- "Return a list of contexts of the current cursor position.
- If several contexts apply, all are returned.
- Each context entry is a list with a symbol naming the context, and
- two positions indicating start and end of the context. Possible
- contexts are:
- :headline anywhere in a headline
- :headline-stars on the leading stars in a headline
- :todo-keyword on a TODO keyword (including DONE) in a headline
- :tags on the TAGS in a headline
- :priority on the priority cookie in a headline
- :item on the first line of a plain list item
- :item-bullet on the bullet/number of a plain list item
- :checkbox on the checkbox in a plain list item
- :table in an Org table
- :table-special on a special filed in a table
- :table-table in a table.el table
- :clocktable in a clocktable
- :src-block in a source block
- :link on a hyperlink
- :keyword on a keyword: SCHEDULED, DEADLINE, CLOSE, COMMENT.
- :target on a <<target>>
- :radio-target on a <<<radio-target>>>
- :latex-fragment on a LaTeX fragment
- :latex-preview on a LaTeX fragment with overlaid preview image
- This function expects the position to be visible because it uses font-lock
- faces as a help to recognize the following contexts: :table-special, :link,
- and :keyword."
- (let* ((f (get-text-property (point) 'face))
- (faces (if (listp f) f (list f)))
- (case-fold-search t)
- (p (point)) clist o)
- ;; First the large context
- (cond
- ((org-at-heading-p t)
- (push (list :headline (point-at-bol) (point-at-eol)) clist)
- (when (progn
- (beginning-of-line 1)
- (looking-at org-todo-line-tags-regexp))
- (push (org-point-in-group p 1 :headline-stars) clist)
- (push (org-point-in-group p 2 :todo-keyword) clist)
- (push (org-point-in-group p 4 :tags) clist))
- (goto-char p)
- (skip-chars-backward "^[\n\r \t") (or (bobp) (backward-char 1))
- (when (looking-at "\\[#[A-Z0-9]\\]")
- (push (org-point-in-group p 0 :priority) clist)))
- ((org-at-item-p)
- (push (org-point-in-group p 2 :item-bullet) clist)
- (push (list :item (point-at-bol)
- (save-excursion (org-end-of-item) (point)))
- clist)
- (and (org-at-item-checkbox-p)
- (push (org-point-in-group p 0 :checkbox) clist)))
- ((org-at-table-p)
- (push (list :table (org-table-begin) (org-table-end)) clist)
- (when (memq 'org-formula faces)
- (push (list :table-special
- (previous-single-property-change p 'face)
- (next-single-property-change p 'face)) clist)))
- ((org-at-table-p 'any)
- (push (list :table-table) clist)))
- (goto-char p)
- (let ((case-fold-search t))
- ;; New the "medium" contexts: clocktables, source blocks
- (cond ((org-in-clocktable-p)
- (push (list :clocktable
- (and (or (looking-at "[ \t]*\\(#\\+BEGIN: clocktable\\)")
- (re-search-backward "[ \t]*\\(#+BEGIN: clocktable\\)" nil t))
- (match-beginning 1))
- (and (re-search-forward "[ \t]*#\\+END:?" nil t)
- (match-end 0))) clist))
- ((org-in-src-block-p)
- (push (list :src-block
- (and (or (looking-at "[ \t]*\\(#\\+BEGIN_SRC\\)")
- (re-search-backward "[ \t]*\\(#+BEGIN_SRC\\)" nil t))
- (match-beginning 1))
- (and (search-forward "#+END_SRC" nil t)
- (match-beginning 0))) clist))))
- (goto-char p)
- ;; Now the small context
- (cond
- ((org-at-timestamp-p)
- (push (org-point-in-group p 0 :timestamp) clist))
- ((memq 'org-link faces)
- (push (list :link
- (previous-single-property-change p 'face)
- (next-single-property-change p 'face)) clist))
- ((memq 'org-special-keyword faces)
- (push (list :keyword
- (previous-single-property-change p 'face)
- (next-single-property-change p 'face)) clist))
- ((org-at-target-p)
- (push (org-point-in-group p 0 :target) clist)
- (goto-char (1- (match-beginning 0)))
- (when (looking-at org-radio-target-regexp)
- (push (org-point-in-group p 0 :radio-target) clist))
- (goto-char p))
- ((setq o (cl-some
- (lambda (o)
- (and (eq (overlay-get o 'org-overlay-type) 'org-latex-overlay)
- o))
- (overlays-at (point))))
- (push (list :latex-fragment
- (overlay-start o) (overlay-end o)) clist)
- (push (list :latex-preview
- (overlay-start o) (overlay-end o)) clist))
- ((org-inside-LaTeX-fragment-p)
- ;; FIXME: positions wrong.
- (push (list :latex-fragment (point) (point)) clist)))
- (setq clist (nreverse (delq nil clist)))
- clist))
- (defun org-in-regexp (regexp &optional nlines visually)
- "Check if point is inside a match of REGEXP.
- Normally only the current line is checked, but you can include
- NLINES extra lines around point into the search. If VISUALLY is
- set, require that the cursor is not after the match but really
- on, so that the block visually is on the match.
- Return nil or a cons cell (BEG . END) where BEG and END are,
- respectively, the positions at the beginning and the end of the
- match."
- (catch :exit
- (let ((pos (point))
- (eol (line-end-position (if nlines (1+ nlines) 1))))
- (save-excursion
- (beginning-of-line (- 1 (or nlines 0)))
- (while (and (re-search-forward regexp eol t)
- (<= (match-beginning 0) pos))
- (let ((end (match-end 0)))
- (when (or (> end pos) (and (= end pos) (not visually)))
- (throw :exit (cons (match-beginning 0) (match-end 0))))))))))
- (defun org-between-regexps-p (start-re end-re &optional lim-up lim-down)
- "Non-nil when point is between matches of START-RE and END-RE.
- Also return a non-nil value when point is on one of the matches.
- Optional arguments LIM-UP and LIM-DOWN bound the search; they are
- buffer positions. Default values are the positions of headlines
- surrounding the point.
- The functions returns a cons cell whose car (resp. cdr) is the
- position before START-RE (resp. after END-RE)."
- (save-match-data
- (let ((pos (point))
- (limit-up (or lim-up (save-excursion (outline-previous-heading))))
- (limit-down (or lim-down (save-excursion (outline-next-heading))))
- beg end)
- (save-excursion
- ;; Point is on a block when on START-RE or if START-RE can be
- ;; found before it...
- (and (or (org-in-regexp start-re)
- (re-search-backward start-re limit-up t))
- (setq beg (match-beginning 0))
- ;; ... and END-RE after it...
- (goto-char (match-end 0))
- (re-search-forward end-re limit-down t)
- (> (setq end (match-end 0)) pos)
- ;; ... without another START-RE in-between.
- (goto-char (match-beginning 0))
- (not (re-search-backward start-re (1+ beg) t))
- ;; Return value.
- (cons beg end))))))
- (defun org-in-block-p (names)
- "Non-nil when point belongs to a block whose name belongs to NAMES.
- NAMES is a list of strings containing names of blocks.
- Return first block name matched, or nil. Beware that in case of
- nested blocks, the returned name may not belong to the closest
- block from point."
- (save-match-data
- (catch 'exit
- (let ((case-fold-search t)
- (lim-up (save-excursion (outline-previous-heading)))
- (lim-down (save-excursion (outline-next-heading))))
- (dolist (name names)
- (let ((n (regexp-quote name)))
- (when (org-between-regexps-p
- (concat "^[ \t]*#\\+begin_" n)
- (concat "^[ \t]*#\\+end_" n)
- lim-up lim-down)
- (throw 'exit n)))))
- nil)))
- (defun org-occur-in-agenda-files (regexp &optional _nlines)
- "Call `multi-occur' with buffers for all agenda files."
- (interactive "sOrg-files matching: ")
- (let* ((files (org-agenda-files))
- (tnames (mapcar #'file-truename files))
- (extra org-agenda-text-search-extra-files))
- (when (eq (car extra) 'agenda-archives)
- (setq extra (cdr extra))
- (setq files (org-add-archive-files files)))
- (dolist (f extra)
- (unless (member (file-truename f) tnames)
- (unless (member f files) (setq files (append files (list f))))
- (setq tnames (append tnames (list (file-truename f))))))
- (multi-occur
- (mapcar (lambda (x)
- (with-current-buffer
- ;; FIXME: Why not just (find-file-noselect x)?
- ;; Is it to avoid the "revert buffer" prompt?
- (or (get-file-buffer x) (find-file-noselect x))
- (widen)
- (current-buffer)))
- files)
- regexp)))
- (add-hook 'occur-mode-find-occurrence-hook
- (lambda () (when (derived-mode-p 'org-mode) (org-reveal))))
- (defun org-occur-link-in-agenda-files ()
- "Create a link and search for it in the agendas.
- The link is not stored in `org-stored-links', it is just created
- for the search purpose."
- (interactive)
- (let ((link (condition-case nil
- (org-store-link nil)
- (error "Unable to create a link to here"))))
- (org-occur-in-agenda-files (regexp-quote link))))
- (defun org-reverse-string (string)
- "Return the reverse of STRING."
- (apply 'string (reverse (string-to-list string))))
- ;; defsubst org-uniquify must be defined before first use
- (defun org-uniquify-alist (alist)
- "Merge elements of ALIST with the same key.
- For example, in this alist:
- \(org-uniquify-alist \\='((a 1) (b 2) (a 3)))
- => \\='((a 1 3) (b 2))
- merge (a 1) and (a 3) into (a 1 3).
- The function returns the new ALIST."
- (let (rtn)
- (dolist (e alist rtn)
- (let (n)
- (if (not (assoc (car e) rtn))
- (push e rtn)
- (setq n (cons (car e) (append (cdr (assoc (car e) rtn)) (cdr e))))
- (setq rtn (assq-delete-all (car e) rtn))
- (push n rtn))))))
- (defun org-delete-all (elts list)
- "Remove all elements in ELTS from LIST.
- Comparison is done with `equal'. It is a destructive operation
- that may remove elements by altering the list structure."
- (while elts
- (setq list (delete (pop elts) list)))
- list)
- (defun org-back-over-empty-lines ()
- "Move backwards over whitespace, to the beginning of the first empty line.
- Returns the number of empty lines passed."
- (let ((pos (point)))
- (if (cdr (assq 'heading org-blank-before-new-entry))
- (skip-chars-backward " \t\n\r")
- (unless (eobp)
- (forward-line -1)))
- (beginning-of-line 2)
- (goto-char (min (point) pos))
- (count-lines (point) pos)))
- (defun org-skip-whitespace ()
- (skip-chars-forward " \t\n\r"))
- (defun org-point-in-group (point group &optional context)
- "Check if POINT is in match-group GROUP.
- If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the
- match. If the match group does not exist or point is not inside it,
- return nil."
- (and (match-beginning group)
- (>= point (match-beginning group))
- (<= point (match-end group))
- (if context
- (list context (match-beginning group) (match-end group))
- t)))
- (defun org-switch-to-buffer-other-window (&rest args)
- "Switch to buffer in a second window on the current frame.
- In particular, do not allow pop-up frames.
- Returns the newly created buffer."
- (org-no-popups
- (apply 'switch-to-buffer-other-window args)))
- (defun org-combine-plists (&rest plists)
- "Create a single property list from all plists in PLISTS.
- The process starts by copying the first list, and then setting properties
- from the other lists. Settings in the last list are the most significant
- ones and overrule settings in the other lists."
- (let ((rtn (copy-sequence (pop plists)))
- p v ls)
- (while plists
- (setq ls (pop plists))
- (while ls
- (setq p (pop ls) v (pop ls))
- (setq rtn (plist-put rtn p v))))
- rtn))
- (defun org-replace-escapes (string table)
- "Replace %-escapes in STRING with values in TABLE.
- TABLE is an association list with keys like \"%a\" and string values.
- The sequences in STRING may contain normal field width and padding information,
- for example \"%-5s\". Replacements happen in the sequence given by TABLE,
- so values can contain further %-escapes if they are define later in TABLE."
- (let ((tbl (copy-alist table))
- (case-fold-search nil)
- (pchg 0)
- re rpl)
- (dolist (e tbl)
- (setq re (concat "%-?[0-9.]*" (substring (car e) 1)))
- (when (and (cdr e) (string-match re (cdr e)))
- (let ((sref (substring (cdr e) (match-beginning 0) (match-end 0)))
- (safe "SREF"))
- (add-text-properties 0 3 (list 'sref sref) safe)
- (setcdr e (replace-match safe t t (cdr e)))))
- (while (string-match re string)
- (setq rpl (format (concat (substring (match-string 0 string) 0 -1) "s")
- (cdr e)))
- (setq string (replace-match rpl t t string))))
- (while (setq pchg (next-property-change pchg string))
- (let ((sref (get-text-property pchg 'sref string)))
- (when (and sref (string-match "SREF" string pchg))
- (setq string (replace-match sref t t string)))))
- string))
- (defun org-find-base-buffer-visiting (file)
- "Like `find-buffer-visiting' but always return the base buffer and
- not an indirect buffer."
- (let ((buf (or (get-file-buffer file)
- (find-buffer-visiting file))))
- (if buf
- (or (buffer-base-buffer buf) buf)
- nil)))
- ;;; TODO: Only called once, from ox-odt which should probably use
- ;;; org-export-inline-image-p or something.
- (defun org-file-image-p (file)
- "Return non-nil if FILE is an image."
- (save-match-data
- (string-match (image-file-name-regexp) file)))
- (defun org-get-cursor-date (&optional with-time)
- "Return the date at cursor in as a time.
- This works in the calendar and in the agenda, anywhere else it just
- returns the current time.
- If WITH-TIME is non-nil, returns the time of the event at point (in
- the agenda) or the current time of the day."
- (let (date day defd tp hod mod)
- (when with-time
- (setq tp (get-text-property (point) 'time))
- (when (and tp (string-match "\\([0-9][0-9]\\):\\([0-9][0-9]\\)" tp))
- (setq hod (string-to-number (match-string 1 tp))
- mod (string-to-number (match-string 2 tp))))
- (or tp (let ((now (decode-time)))
- (setq hod (nth 2 now)
- mod (nth 1 now)))))
- (cond
- ((eq major-mode 'calendar-mode)
- (setq date (calendar-cursor-to-date)
- defd (encode-time 0 (or mod 0) (or hod 0)
- (nth 1 date) (nth 0 date) (nth 2 date))))
- ((eq major-mode 'org-agenda-mode)
- (setq day (get-text-property (point) 'day))
- (when day
- (setq date (calendar-gregorian-from-absolute day)
- defd (encode-time 0 (or mod 0) (or hod 0)
- (nth 1 date) (nth 0 date) (nth 2 date))))))
- (or defd (current-time))))
- (defun org-mark-subtree (&optional up)
- "Mark the current subtree.
- This puts point at the start of the current subtree, and mark at
- the end. If a numeric prefix UP is given, move up into the
- hierarchy of headlines by UP levels before marking the subtree."
- (interactive "P")
- (org-with-limited-levels
- (cond ((org-at-heading-p) (beginning-of-line))
- ((org-before-first-heading-p) (user-error "Not in a subtree"))
- (t (outline-previous-visible-heading 1))))
- (when up (while (and (> up 0) (org-up-heading-safe)) (cl-decf up)))
- (if (called-interactively-p 'any)
- (call-interactively 'org-mark-element)
- (org-mark-element)))
- (defun org-file-newer-than-p (file time)
- "Non-nil if FILE is newer than TIME.
- FILE is a filename, as a string, TIME is a list of integers, as
- returned by, e.g., `current-time'."
- (and (file-exists-p file)
- ;; Only compare times up to whole seconds as some file-systems
- ;; (e.g. HFS+) do not retain any finer granularity. As
- ;; a consequence, make sure we return non-nil when the two
- ;; times are equal.
- (not (time-less-p (cl-subseq (nth 5 (file-attributes file)) 0 2)
- (cl-subseq time 0 2)))))
- (defun org-compile-file (source process ext &optional err-msg log-buf spec)
- "Compile a SOURCE file using PROCESS.
- PROCESS is either a function or a list of shell commands, as
- strings. EXT is a file extension, without the leading dot, as
- a string. It is used to check if the process actually succeeded.
- PROCESS must create a file with the same base name and directory
- as SOURCE, but ending with EXT. The function then returns its
- filename. Otherwise, it raises an error. The error message can
- then be refined by providing string ERR-MSG, which is appended to
- the standard message.
- If PROCESS is a function, it is called with a single argument:
- the SOURCE file.
- If it is a list of commands, each of them is called using
- `shell-command'. By default, in each command, %b, %f, %F, %o and
- %O are replaced with, respectively, SOURCE base name, name, full
- name, directory and absolute output file name. It is possible,
- however, to use more place-holders by specifying them in optional
- argument SPEC, as an alist following the pattern
- (CHARACTER . REPLACEMENT-STRING).
- When PROCESS is a list of commands, optional argument LOG-BUF can
- be set to a buffer or a buffer name. `shell-command' then uses
- it for output."
- (let* ((base-name (file-name-base source))
- (full-name (file-truename source))
- (out-dir (or (file-name-directory source) "./"))
- (output (expand-file-name (concat base-name "." ext) out-dir))
- (time (current-time))
- (err-msg (if (stringp err-msg) (concat ". " err-msg) "")))
- (save-window-excursion
- (pcase process
- ((pred functionp) (funcall process (shell-quote-argument source)))
- ((pred consp)
- (let ((log-buf (and log-buf (get-buffer-create log-buf)))
- (spec (append spec
- `((?b . ,(shell-quote-argument base-name))
- (?f . ,(shell-quote-argument source))
- (?F . ,(shell-quote-argument full-name))
- (?o . ,(shell-quote-argument out-dir))
- (?O . ,(shell-quote-argument output))))))
- (dolist (command process)
- (shell-command (format-spec command spec) log-buf))))
- (_ (error "No valid command to process %S%s" source err-msg))))
- ;; Check for process failure. Output file is expected to be
- ;; located in the same directory as SOURCE.
- (unless (org-file-newer-than-p output time)
- (error (format "File %S wasn't produced%s" output err-msg)))
- output))
- ;;; Indentation
- (defvar org-element-greater-elements)
- (defun org--get-expected-indentation (element contentsp)
- "Expected indentation column for current line, according to ELEMENT.
- ELEMENT is an element containing point. CONTENTSP is non-nil
- when indentation is to be computed according to contents of
- ELEMENT."
- (let ((type (org-element-type element))
- (start (org-element-property :begin element))
- (post-affiliated (org-element-property :post-affiliated element)))
- (org-with-wide-buffer
- (cond
- (contentsp
- (cl-case type
- ((diary-sexp footnote-definition) 0)
- ((headline inlinetask nil)
- (if (not org-adapt-indentation) 0
- (let ((level (org-current-level)))
- (if level (1+ level) 0))))
- ((item plain-list) (org-list-item-body-column post-affiliated))
- (t
- (goto-char start)
- (org-get-indentation))))
- ((memq type '(headline inlinetask nil))
- (if (org-match-line "[ \t]*$")
- (org--get-expected-indentation element t)
- 0))
- ((memq type '(diary-sexp footnote-definition)) 0)
- ;; First paragraph of a footnote definition or an item.
- ;; Indent like parent.
- ((< (line-beginning-position) start)
- (org--get-expected-indentation
- (org-element-property :parent element) t))
- ;; At first line: indent according to previous sibling, if any,
- ;; ignoring footnote definitions and inline tasks, or parent's
- ;; contents.
- ((= (line-beginning-position) start)
- (catch 'exit
- (while t
- (if (= (point-min) start) (throw 'exit 0)
- (goto-char (1- start))
- (let* ((previous (org-element-at-point))
- (parent previous))
- (while (and parent (<= (org-element-property :end parent) start))
- (setq previous parent
- parent (org-element-property :parent parent)))
- (cond
- ((not previous) (throw 'exit 0))
- ((> (org-element-property :end previous) start)
- (throw 'exit (org--get-expected-indentation previous t)))
- ((memq (org-element-type previous)
- '(footnote-definition inlinetask))
- (setq start (org-element-property :begin previous)))
- (t (goto-char (org-element-property :begin previous))
- (throw 'exit
- (if (bolp) (org-get-indentation)
- ;; At first paragraph in an item or
- ;; a footnote definition.
- (org--get-expected-indentation
- (org-element-property :parent previous) t))))))))))
- ;; Otherwise, move to the first non-blank line above.
- (t
- (beginning-of-line)
- (let ((pos (point)))
- (skip-chars-backward " \r\t\n")
- (cond
- ;; Two blank lines end a footnote definition or a plain
- ;; list. When we indent an empty line after them, the
- ;; containing list or footnote definition is over, so it
- ;; qualifies as a previous sibling. Therefore, we indent
- ;; like its first line.
- ((and (memq type '(footnote-definition plain-list))
- (> (count-lines (point) pos) 2))
- (goto-char start)
- (org-get-indentation))
- ;; Line above is the first one of a paragraph at the
- ;; beginning of an item or a footnote definition. Indent
- ;; like parent.
- ((< (line-beginning-position) start)
- (org--get-expected-indentation
- (org-element-property :parent element) t))
- ;; Line above is the beginning of an element, i.e., point
- ;; was originally on the blank lines between element's start
- ;; and contents.
- ((= (line-beginning-position) post-affiliated)
- (org--get-expected-indentation element t))
- ;; POS is after contents in a greater element. Indent like
- ;; the beginning of the element.
- ((and (memq type org-element-greater-elements)
- (let ((cend (org-element-property :contents-end element)))
- (and cend (<= cend pos))))
- ;; As a special case, if point is at the end of a footnote
- ;; definition or an item, indent like the very last element
- ;; within. If that last element is an item, indent like
- ;; its contents.
- (if (memq type '(footnote-definition item plain-list))
- (let ((last (org-element-at-point)))
- (goto-char pos)
- (org--get-expected-indentation
- last (eq (org-element-type last) 'item)))
- (goto-char start)
- (org-get-indentation)))
- ;; In any other case, indent like the current line.
- (t (org-get-indentation)))))))))
- (defun org--align-node-property ()
- "Align node property at point.
- Alignment is done according to `org-property-format', which see."
- (when (save-excursion
- (beginning-of-line)
- (looking-at org-property-re))
- (replace-match
- (concat (match-string 4)
- (org-trim
- (format org-property-format (match-string 1) (match-string 3))))
- t t)))
- (defun org-indent-line ()
- "Indent line depending on context.
- Indentation is done according to the following rules:
- - Footnote definitions, diary sexps, headlines and inline tasks
- have to start at column 0.
- - On the very first line of an element, consider, in order, the
- next rules until one matches:
- 1. If there's a sibling element before, ignoring footnote
- definitions and inline tasks, indent like its first line.
- 2. If element has a parent, indent like its contents. More
- precisely, if parent is an item, indent after the
- description part, if any, or the bullet (see
- `org-list-description-max-indent'). Else, indent like
- parent's first line.
- 3. Otherwise, indent relatively to current level, if
- `org-adapt-indentation' is non-nil, or to left margin.
- - On a blank line at the end of an element, indent according to
- the type of the element. More precisely
- 1. If element is a plain list, an item, or a footnote
- definition, indent like the very last element within.
- 2. If element is a paragraph, indent like its last non blank
- line.
- 3. Otherwise, indent like its very first line.
- - In the code part of a source block, use language major mode
- to indent current line if `org-src-tab-acts-natively' is
- non-nil. If it is nil, do nothing.
- - Otherwise, indent like the first non-blank line above.
- The function doesn't indent an item as it could break the whole
- list structure. Instead, use \\<org-mode-map>`\\[org-shiftmetaleft]' or \
- `\\[org-shiftmetaright]'.
- Also align node properties according to `org-property-format'."
- (interactive)
- (cond
- (orgstruct-is-++
- (let ((indent-line-function
- (cl-cadadr (assq 'indent-line-function org-fb-vars))))
- (indent-according-to-mode)))
- ((org-at-heading-p) 'noindent)
- (t
- (let* ((element (save-excursion (beginning-of-line) (org-element-at-point)))
- (type (org-element-type element)))
- (cond ((and (memq type '(plain-list item))
- (= (line-beginning-position)
- (org-element-property :post-affiliated element)))
- 'noindent)
- ((and (eq type 'latex-environment)
- (>= (point) (org-element-property :post-affiliated element))
- (< (point) (org-with-wide-buffer
- (goto-char (org-element-property :end element))
- (skip-chars-backward " \r\t\n")
- (line-beginning-position 2))))
- 'noindent)
- ((and (eq type 'src-block)
- org-src-tab-acts-natively
- (> (line-beginning-position)
- (org-element-property :post-affiliated element))
- (< (line-beginning-position)
- (org-with-wide-buffer
- (goto-char (org-element-property :end element))
- (skip-chars-backward " \r\t\n")
- (line-beginning-position))))
- (org-babel-do-key-sequence-in-edit-buffer (kbd "TAB")))
- (t
- (let ((column (org--get-expected-indentation element nil)))
- ;; Preserve current column.
- (if (<= (current-column) (current-indentation))
- (indent-line-to column)
- (save-excursion (indent-line-to column))))
- ;; Align node property. Also preserve current column.
- (when (eq type 'node-property)
- (let ((column (current-column)))
- (org--align-node-property)
- (org-move-to-column column)))))))))
- (defun org-indent-region (start end)
- "Indent each non-blank line in the region.
- Called from a program, START and END specify the region to
- indent. The function will not indent contents of example blocks,
- verse blocks and export blocks as leading white spaces are
- assumed to be significant there."
- (interactive "r")
- (save-excursion
- (goto-char start)
- (skip-chars-forward " \r\t\n")
- (unless (eobp) (beginning-of-line))
- (let ((indent-to
- (lambda (ind pos)
- ;; Set IND as indentation for all lines between point and
- ;; POS. Blank lines are ignored. Leave point after POS
- ;; once done.
- (let ((limit (copy-marker pos)))
- (while (< (point) limit)
- (unless (looking-at-p "[ \t]*$") (indent-line-to ind))
- (forward-line))
- (set-marker limit nil))))
- (end (copy-marker end)))
- (while (< (point) end)
- (if (or (looking-at-p " \r\t\n") (org-at-heading-p)) (forward-line)
- (let* ((element (org-element-at-point))
- (type (org-element-type element))
- (element-end (copy-marker (org-element-property :end element)))
- (ind (org--get-expected-indentation element nil)))
- (cond
- ;; Element indented as a single block. Example blocks
- ;; preserving indentation are a special case since the
- ;; "contents" must not be indented whereas the block
- ;; boundaries can.
- ((or (memq type '(export-block latex-environment))
- (and (eq type 'example-block)
- (not
- (or org-src-preserve-indentation
- (org-element-property :preserve-indent element)))))
- (let ((offset (- ind (org-get-indentation))))
- (unless (zerop offset)
- (indent-rigidly (org-element-property :begin element)
- (org-element-property :end element)
- offset)))
- (goto-char element-end))
- ;; Elements indented line wise. Be sure to exclude
- ;; example blocks (preserving indentation) and source
- ;; blocks from this category as they are treated
- ;; specially later.
- ((or (memq type '(paragraph table table-row))
- (not (or (org-element-property :contents-begin element)
- (memq type '(example-block src-block)))))
- (when (eq type 'node-property)
- (org--align-node-property)
- (beginning-of-line))
- (funcall indent-to ind (min element-end end)))
- ;; Elements consisting of three parts: before the
- ;; contents, the contents, and after the contents. The
- ;; contents are treated specially, according to the
- ;; element type, or not indented at all. Other parts are
- ;; indented as a single block.
- (t
- (let* ((post (copy-marker
- (org-element-property :post-affiliated element)))
- (cbeg
- (copy-marker
- (cond
- ((not (org-element-property :contents-begin element))
- ;; Fake contents for source blocks.
- (org-with-wide-buffer
- (goto-char post)
- (line-beginning-position 2)))
- ((memq type '(footnote-definition item plain-list))
- ;; Contents in these elements could start on
- ;; the same line as the beginning of the
- ;; element. Make sure we start indenting
- ;; from the second line.
- (org-with-wide-buffer
- (goto-char post)
- (end-of-line)
- (skip-chars-forward " \r\t\n")
- (if (eobp) (point) (line-beginning-position))))
- (t (org-element-property :contents-begin element)))))
- (cend (copy-marker
- (or (org-element-property :contents-end element)
- ;; Fake contents for source blocks.
- (org-with-wide-buffer
- (goto-char element-end)
- (skip-chars-backward " \r\t\n")
- (line-beginning-position)))
- t)))
- ;; Do not change items indentation individually as it
- ;; might break the list as a whole. On the other
- ;; hand, when at a plain list, indent it as a whole.
- (cond ((eq type 'plain-list)
- (let ((offset (- ind (org-get-indentation))))
- (unless (zerop offset)
- (indent-rigidly (org-element-property :begin element)
- (org-element-property :end element)
- offset))
- (goto-char cbeg)))
- ((eq type 'item) (goto-char cbeg))
- (t (funcall indent-to ind (min cbeg end))))
- (when (< (point) end)
- (cl-case type
- ((example-block verse-block))
- (src-block
- ;; In a source block, indent source code
- ;; according to language major mode, but only if
- ;; `org-src-tab-acts-natively' is non-nil.
- (when (and (< (point) end) org-src-tab-acts-natively)
- (ignore-errors
- (org-babel-do-in-edit-buffer
- (indent-region (point-min) (point-max))))))
- (t (org-indent-region (point) (min cend end))))
- (goto-char (min cend end))
- (when (< (point) end)
- (funcall indent-to ind (min element-end end))))
- (set-marker post nil)
- (set-marker cbeg nil)
- (set-marker cend nil))))
- (set-marker element-end nil))))
- (set-marker end nil))))
- (defun org-indent-drawer ()
- "Indent the drawer at point."
- (interactive)
- (unless (save-excursion
- (beginning-of-line)
- (looking-at-p org-drawer-regexp))
- (user-error "Not at a drawer"))
- (let ((element (org-element-at-point)))
- (unless (memq (org-element-type element) '(drawer property-drawer))
- (user-error "Not at a drawer"))
- (org-with-wide-buffer
- (org-indent-region (org-element-property :begin element)
- (org-element-property :end element))))
- (message "Drawer at point indented"))
- (defun org-indent-block ()
- "Indent the block at point."
- (interactive)
- (unless (save-excursion
- (beginning-of-line)
- (let ((case-fold-search t))
- (looking-at-p "[ \t]*#\\+\\(begin\\|end\\)_")))
- (user-error "Not at a block"))
- (let ((element (org-element-at-point)))
- (unless (memq (org-element-type element)
- '(comment-block center-block dynamic-block example-block
- export-block quote-block special-block
- src-block verse-block))
- (user-error "Not at a block"))
- (org-with-wide-buffer
- (org-indent-region (org-element-property :begin element)
- (org-element-property :end element))))
- (message "Block at point indented"))
- ;;; Filling
- ;; We use our own fill-paragraph and auto-fill functions.
- ;; `org-fill-paragraph' relies on adaptive filling and context
- ;; checking. Appropriate `fill-prefix' is computed with
- ;; `org-adaptive-fill-function'.
- ;; `org-auto-fill-function' takes care of auto-filling. It calls
- ;; `do-auto-fill' only on valid areas with `fill-prefix' shadowed with
- ;; `org-adaptive-fill-function' value. Internally,
- ;; `org-comment-line-break-function' breaks the line.
- ;; `org-setup-filling' installs filling and auto-filling related
- ;; variables during `org-mode' initialization.
- (defvar org-element-paragraph-separate) ; org-element.el
- (defun org-setup-filling ()
- (require 'org-element)
- ;; Prevent auto-fill from inserting unwanted new items.
- (when (boundp 'fill-nobreak-predicate)
- (setq-local
- fill-nobreak-predicate
- (org-uniquify
- (append fill-nobreak-predicate
- '(org-fill-line-break-nobreak-p
- org-fill-paragraph-with-timestamp-nobreak-p)))))
- (let ((paragraph-ending (substring org-element-paragraph-separate 1)))
- (setq-local paragraph-start paragraph-ending)
- (setq-local paragraph-separate paragraph-ending))
- (setq-local fill-paragraph-function 'org-fill-paragraph)
- (setq-local auto-fill-inhibit-regexp nil)
- (setq-local adaptive-fill-function 'org-adaptive-fill-function)
- (setq-local normal-auto-fill-function 'org-auto-fill-function)
- (setq-local comment-line-break-function 'org-comment-line-break-function))
- (defun org-fill-line-break-nobreak-p ()
- "Non-nil when a new line at point would create an Org line break."
- (save-excursion
- (skip-chars-backward "[ \t]")
- (skip-chars-backward "\\\\")
- (looking-at "\\\\\\\\\\($\\|[^\\\\]\\)")))
- (defun org-fill-paragraph-with-timestamp-nobreak-p ()
- "Non-nil when a new line at point would split a timestamp."
- (and (org-at-timestamp-p t)
- (not (looking-at org-ts-regexp-both))))
- (declare-function message-in-body-p "message" ())
- (defvar orgtbl-line-start-regexp) ; From org-table.el
- (defun org-adaptive-fill-function ()
- "Compute a fill prefix for the current line.
- Return fill prefix, as a string, or nil if current line isn't
- meant to be filled. For convenience, if `adaptive-fill-regexp'
- matches in paragraphs or comments, use it."
- (catch 'exit
- (when (derived-mode-p 'message-mode)
- (save-excursion
- (beginning-of-line)
- (cond ((not (message-in-body-p)) (throw 'exit nil))
- ((looking-at-p org-table-line-regexp) (throw 'exit nil))
- ((looking-at message-cite-prefix-regexp)
- (throw 'exit (match-string-no-properties 0)))
- ((looking-at org-outline-regexp)
- (throw 'exit (make-string (length (match-string 0)) ?\s))))))
- (org-with-wide-buffer
- (unless (org-at-heading-p)
- (let* ((p (line-beginning-position))
- (element (save-excursion
- (beginning-of-line)
- (org-element-at-point)))
- (type (org-element-type element))
- (post-affiliated (org-element-property :post-affiliated element)))
- (unless (< p post-affiliated)
- (cl-case type
- (comment
- (save-excursion
- (beginning-of-line)
- (looking-at "[ \t]*")
- (concat (match-string 0) "# ")))
- (footnote-definition "")
- ((item plain-list)
- (make-string (org-list-item-body-column post-affiliated) ?\s))
- (paragraph
- ;; Fill prefix is usually the same as the current line,
- ;; unless the paragraph is at the beginning of an item.
- (let ((parent (org-element-property :parent element)))
- (save-excursion
- (beginning-of-line)
- (cond ((eq (org-element-type parent) 'item)
- (make-string (org-list-item-body-column
- (org-element-property :begin parent))
- ?\s))
- ((and adaptive-fill-regexp
- ;; Locally disable
- ;; `adaptive-fill-function' to let
- ;; `fill-context-prefix' handle
- ;; `adaptive-fill-regexp' variable.
- (let (adaptive-fill-function)
- (fill-context-prefix
- post-affiliated
- (org-element-property :end element)))))
- ((looking-at "[ \t]+") (match-string 0))
- (t "")))))
- (comment-block
- ;; Only fill contents if P is within block boundaries.
- (let* ((cbeg (save-excursion (goto-char post-affiliated)
- (forward-line)
- (point)))
- (cend (save-excursion
- (goto-char (org-element-property :end element))
- (skip-chars-backward " \r\t\n")
- (line-beginning-position))))
- (when (and (>= p cbeg) (< p cend))
- (if (save-excursion (beginning-of-line) (looking-at "[ \t]+"))
- (match-string 0)
- "")))))))))))
- (declare-function message-goto-body "message" ())
- (defvar message-cite-prefix-regexp) ; From message.el
- (defun org-fill-paragraph (&optional justify)
- "Fill element at point, when applicable.
- This function only applies to comment blocks, comments, example
- blocks and paragraphs. Also, as a special case, re-align table
- when point is at one.
- If JUSTIFY is non-nil (interactively, with prefix argument),
- justify as well. If `sentence-end-double-space' is non-nil, then
- period followed by one space does not end a sentence, so don't
- break a line there. The variable `fill-column' controls the
- width for filling.
- For convenience, when point is at a plain list, an item or
- a footnote definition, try to fill the first paragraph within."
- (interactive)
- (if (and (derived-mode-p 'message-mode)
- (or (not (message-in-body-p))
- (save-excursion (move-beginning-of-line 1)
- (looking-at message-cite-prefix-regexp))))
- ;; First ensure filling is correct in message-mode.
- (let ((fill-paragraph-function
- (cl-cadadr (assq 'fill-paragraph-function org-fb-vars)))
- (fill-prefix (cl-cadadr (assq 'fill-prefix org-fb-vars)))
- (paragraph-start (cl-cadadr (assq 'paragraph-start org-fb-vars)))
- (paragraph-separate
- (cl-cadadr (assq 'paragraph-separate org-fb-vars))))
- (fill-paragraph nil))
- (with-syntax-table org-mode-transpose-word-syntax-table
- ;; Move to end of line in order to get the first paragraph
- ;; within a plain list or a footnote definition.
- (let ((element (save-excursion
- (end-of-line)
- (or (ignore-errors (org-element-at-point))
- (user-error "An element cannot be parsed line %d"
- (line-number-at-pos (point)))))))
- ;; First check if point is in a blank line at the beginning of
- ;; the buffer. In that case, ignore filling.
- (cl-case (org-element-type element)
- ;; Use major mode filling function is src blocks.
- (src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q")))
- ;; Align Org tables, leave table.el tables as-is.
- (table-row (org-table-align) t)
- (table
- (when (eq (org-element-property :type element) 'org)
- (save-excursion
- (goto-char (org-element-property :post-affiliated element))
- (org-table-align)))
- t)
- (paragraph
- ;; Paragraphs may contain `line-break' type objects.
- (let ((beg (max (point-min)
- (org-element-property :contents-begin element)))
- (end (min (point-max)
- (org-element-property :contents-end element))))
- ;; Do nothing if point is at an affiliated keyword.
- (if (< (line-end-position) beg) t
- (when (derived-mode-p 'message-mode)
- ;; In `message-mode', do not fill following citation
- ;; in current paragraph nor text before message body.
- (let ((body-start (save-excursion (message-goto-body))))
- (when body-start (setq beg (max body-start beg))))
- (when (save-excursion
- (re-search-forward
- (concat "^" message-cite-prefix-regexp) end t))
- (setq end (match-beginning 0))))
- ;; Fill paragraph, taking line breaks into account.
- (save-excursion
- (goto-char beg)
- (let ((cuts (list beg)))
- (while (re-search-forward "\\\\\\\\[ \t]*\n" end t)
- (when (eq 'line-break
- (org-element-type
- (save-excursion (backward-char)
- (org-element-context))))
- (push (point) cuts)))
- (dolist (c (delq end cuts))
- (fill-region-as-paragraph c end justify)
- (setq end c))))
- t)))
- ;; Contents of `comment-block' type elements should be
- ;; filled as plain text, but only if point is within block
- ;; markers.
- (comment-block
- (let* ((case-fold-search t)
- (beg (save-excursion
- (goto-char (org-element-property :begin element))
- (re-search-forward "^[ \t]*#\\+begin_comment" nil t)
- (forward-line)
- (point)))
- (end (save-excursion
- (goto-char (org-element-property :end element))
- (re-search-backward "^[ \t]*#\\+end_comment" nil t)
- (line-beginning-position))))
- (if (or (< (point) beg) (> (point) end)) t
- (fill-region-as-paragraph
- (save-excursion (end-of-line)
- (re-search-backward "^[ \t]*$" beg 'move)
- (line-beginning-position))
- (save-excursion (beginning-of-line)
- (re-search-forward "^[ \t]*$" end 'move)
- (line-beginning-position))
- justify))))
- ;; Fill comments.
- (comment
- (let ((begin (org-element-property :post-affiliated element))
- (end (org-element-property :end element)))
- (when (and (>= (point) begin) (<= (point) end))
- (let ((begin (save-excursion
- (end-of-line)
- (if (re-search-backward "^[ \t]*#[ \t]*$" begin t)
- (progn (forward-line) (point))
- begin)))
- (end (save-excursion
- (end-of-line)
- (if (re-search-forward "^[ \t]*#[ \t]*$" end 'move)
- (1- (line-beginning-position))
- (skip-chars-backward " \r\t\n")
- (line-end-position)))))
- ;; Do not fill comments when at a blank line.
- (when (> end begin)
- (let ((fill-prefix
- (save-excursion
- (beginning-of-line)
- (looking-at "[ \t]*#")
- (let ((comment-prefix (match-string 0)))
- (goto-char (match-end 0))
- (if (looking-at adaptive-fill-regexp)
- (concat comment-prefix (match-string 0))
- (concat comment-prefix " "))))))
- (save-excursion
- (fill-region-as-paragraph begin end justify))))))
- t))
- ;; Ignore every other element.
- (otherwise t))))))
- (defun org-auto-fill-function ()
- "Auto-fill function."
- ;; Check if auto-filling is meaningful.
- (let ((fc (current-fill-column)))
- (when (and fc (> (current-column) fc))
- (let* ((fill-prefix (org-adaptive-fill-function))
- ;; Enforce empty fill prefix, if required. Otherwise, it
- ;; will be computed again.
- (adaptive-fill-mode (not (equal fill-prefix ""))))
- (when fill-prefix (do-auto-fill))))))
- (defun org-comment-line-break-function (&optional soft)
- "Break line at point and indent, continuing comment if within one.
- The inserted newline is marked hard if variable
- `use-hard-newlines' is true, unless optional argument SOFT is
- non-nil."
- (if soft (insert-and-inherit ?\n) (newline 1))
- (save-excursion (forward-char -1) (delete-horizontal-space))
- (delete-horizontal-space)
- (indent-to-left-margin)
- (insert-before-markers-and-inherit fill-prefix))
- ;;; Fixed Width Areas
- (defun org-toggle-fixed-width ()
- "Toggle fixed-width markup.
- Add or remove fixed-width markup on current line, whenever it
- makes sense. Return an error otherwise.
- If a region is active and if it contains only fixed-width areas
- or blank lines, remove all fixed-width markup in it. If the
- region contains anything else, convert all non-fixed-width lines
- to fixed-width ones.
- Blank lines at the end of the region are ignored unless the
- region only contains such lines."
- (interactive)
- (if (not (org-region-active-p))
- ;; No region:
- ;;
- ;; Remove fixed width marker only in a fixed-with element.
- ;;
- ;; Add fixed width maker in paragraphs, in blank lines after
- ;; elements or at the beginning of a headline or an inlinetask,
- ;; and before any one-line elements (e.g., a clock).
- (progn
- (beginning-of-line)
- (let* ((element (org-element-at-point))
- (type (org-element-type element)))
- (cond
- ((and (eq type 'fixed-width)
- (looking-at "[ \t]*\\(:\\(?: \\|$\\)\\)"))
- (replace-match
- "" nil nil nil (if (= (line-end-position) (match-end 0)) 0 1)))
- ((and (memq type '(babel-call clock comment diary-sexp headline
- horizontal-rule keyword paragraph
- planning))
- (<= (org-element-property :post-affiliated element) (point)))
- (skip-chars-forward " \t")
- (insert ": "))
- ((and (looking-at-p "[ \t]*$")
- (or (eq type 'inlinetask)
- (save-excursion
- (skip-chars-forward " \r\t\n")
- (<= (org-element-property :end element) (point)))))
- (delete-region (point) (line-end-position))
- (org-indent-line)
- (insert ": "))
- (t (user-error "Cannot insert a fixed-width line here")))))
- ;; Region active.
- (let* ((begin (save-excursion
- (goto-char (region-beginning))
- (line-beginning-position)))
- (end (copy-marker
- (save-excursion
- (goto-char (region-end))
- (unless (eolp) (beginning-of-line))
- (if (save-excursion (re-search-backward "\\S-" begin t))
- (progn (skip-chars-backward " \r\t\n") (point))
- (point)))))
- (all-fixed-width-p
- (catch 'not-all-p
- (save-excursion
- (goto-char begin)
- (skip-chars-forward " \r\t\n")
- (when (eobp) (throw 'not-all-p nil))
- (while (< (point) end)
- (let ((element (org-element-at-point)))
- (if (eq (org-element-type element) 'fixed-width)
- (goto-char (org-element-property :end element))
- (throw 'not-all-p nil))))
- t))))
- (if all-fixed-width-p
- (save-excursion
- (goto-char begin)
- (while (< (point) end)
- (when (looking-at "[ \t]*\\(:\\(?: \\|$\\)\\)")
- (replace-match
- "" nil nil nil
- (if (= (line-end-position) (match-end 0)) 0 1)))
- (forward-line)))
- (let ((min-ind (point-max)))
- ;; Find minimum indentation across all lines.
- (save-excursion
- (goto-char begin)
- (if (not (save-excursion (re-search-forward "\\S-" end t)))
- (setq min-ind 0)
- (catch 'zerop
- (while (< (point) end)
- (unless (looking-at-p "[ \t]*$")
- (let ((ind (org-get-indentation)))
- (setq min-ind (min min-ind ind))
- (when (zerop ind) (throw 'zerop t))))
- (forward-line)))))
- ;; Loop over all lines and add fixed-width markup everywhere
- ;; but in fixed-width lines.
- (save-excursion
- (goto-char begin)
- (while (< (point) end)
- (cond
- ((org-at-heading-p)
- (insert ": ")
- (forward-line)
- (while (and (< (point) end) (looking-at-p "[ \t]*$"))
- (insert ":")
- (forward-line)))
- ((looking-at-p "[ \t]*:\\( \\|$\\)")
- (let* ((element (org-element-at-point))
- (element-end (org-element-property :end element)))
- (if (eq (org-element-type element) 'fixed-width)
- (progn (goto-char element-end)
- (skip-chars-backward " \r\t\n")
- (forward-line))
- (let ((limit (min end element-end)))
- (while (< (point) limit)
- (org-move-to-column min-ind t)
- (insert ": ")
- (forward-line))))))
- (t
- (org-move-to-column min-ind t)
- (insert ": ")
- (forward-line)))))))
- (set-marker end nil))))
- ;;; Comments
- ;; Org comments syntax is quite complex. It requires the entire line
- ;; to be just a comment. Also, even with the right syntax at the
- ;; beginning of line, some some elements (i.e. verse-block or
- ;; example-block) don't accept comments. Usual Emacs comment commands
- ;; cannot cope with those requirements. Therefore, Org replaces them.
- ;; Org still relies on `comment-dwim', but cannot trust
- ;; `comment-only-p'. So, `comment-region-function' and
- ;; `uncomment-region-function' both point
- ;; to`org-comment-or-uncomment-region'. Eventually,
- ;; `org-insert-comment' takes care of insertion of comments at the
- ;; beginning of line.
- ;; `org-setup-comments-handling' install comments related variables
- ;; during `org-mode' initialization.
- (defun org-setup-comments-handling ()
- (interactive)
- (setq-local comment-use-syntax nil)
- (setq-local comment-start "# ")
- (setq-local comment-start-skip "^\\s-*#\\(?: \\|$\\)")
- (setq-local comment-insert-comment-function 'org-insert-comment)
- (setq-local comment-region-function 'org-comment-or-uncomment-region)
- (setq-local uncomment-region-function 'org-comment-or-uncomment-region))
- (defun org-insert-comment ()
- "Insert an empty comment above current line.
- If the line is empty, insert comment at its beginning. When
- point is within a source block, comment according to the related
- major mode."
- (if (let ((element (org-element-at-point)))
- (and (eq (org-element-type element) 'src-block)
- (< (save-excursion
- (goto-char (org-element-property :post-affiliated element))
- (line-end-position))
- (point))
- (> (save-excursion
- (goto-char (org-element-property :end element))
- (skip-chars-backward " \r\t\n")
- (line-beginning-position))
- (point))))
- (org-babel-do-in-edit-buffer (call-interactively 'comment-dwim))
- (beginning-of-line)
- (if (looking-at "\\s-*$") (delete-region (point) (point-at-eol))
- (open-line 1))
- (org-indent-line)
- (insert "# ")))
- (defvar comment-empty-lines) ; From newcomment.el.
- (defun org-comment-or-uncomment-region (beg end &rest _)
- "Comment or uncomment each non-blank line in the region.
- Uncomment each non-blank line between BEG and END if it only
- contains commented lines. Otherwise, comment them. If region is
- strictly within a source block, use appropriate comment syntax."
- (if (let ((element (org-element-at-point)))
- (and (eq (org-element-type element) 'src-block)
- (< (save-excursion
- (goto-char (org-element-property :post-affiliated element))
- (line-end-position))
- beg)
- (>= (save-excursion
- (goto-char (org-element-property :end element))
- (skip-chars-backward " \r\t\n")
- (line-beginning-position))
- end)))
- ;; Translate region boundaries for the Org buffer to the source
- ;; buffer.
- (let ((offset (- end beg)))
- (save-excursion
- (goto-char beg)
- (org-babel-do-in-edit-buffer
- (comment-or-uncomment-region (point) (+ offset (point))))))
- (save-restriction
- ;; Restrict region
- (narrow-to-region (save-excursion (goto-char beg)
- (skip-chars-forward " \r\t\n" end)
- (line-beginning-position))
- (save-excursion (goto-char end)
- (skip-chars-backward " \r\t\n" beg)
- (line-end-position)))
- (let ((uncommentp
- ;; UNCOMMENTP is non-nil when every non blank line between
- ;; BEG and END is a comment.
- (save-excursion
- (goto-char (point-min))
- (while (and (not (eobp))
- (let ((element (org-element-at-point)))
- (and (eq (org-element-type element) 'comment)
- (goto-char (min (point-max)
- (org-element-property
- :end element)))))))
- (eobp))))
- (if uncommentp
- ;; Only blank lines and comments in region: uncomment it.
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (when (looking-at "[ \t]*\\(#\\(?: \\|$\\)\\)")
- (replace-match "" nil nil nil 1))
- (forward-line)))
- ;; Comment each line in region.
- (let ((min-indent (point-max)))
- ;; First find the minimum indentation across all lines.
- (save-excursion
- (goto-char (point-min))
- (while (and (not (eobp)) (not (zerop min-indent)))
- (unless (looking-at "[ \t]*$")
- (setq min-indent (min min-indent (current-indentation))))
- (forward-line)))
- ;; Then loop over all lines.
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (unless (and (not comment-empty-lines) (looking-at "[ \t]*$"))
- ;; Don't get fooled by invisible text (e.g. link path)
- ;; when moving to column MIN-INDENT.
- (let ((buffer-invisibility-spec nil))
- (org-move-to-column min-indent t))
- (insert comment-start))
- (forward-line)))))))))
- (defun org-comment-dwim (_arg)
- "Call `comment-dwim' within a source edit buffer if needed."
- (interactive "*P")
- (if (org-in-src-block-p)
- (org-babel-do-in-edit-buffer (call-interactively 'comment-dwim))
- (call-interactively 'comment-dwim)))
- ;;; Timestamps API
- ;; This section contains tools to operate on timestamp objects, as
- ;; returned by, e.g. `org-element-context'.
- (defun org-timestamp--to-internal-time (timestamp &optional end)
- "Encode TIMESTAMP object into Emacs internal time.
- Use end of date range or time range when END is non-nil."
- (apply #'encode-time
- (cons 0
- (mapcar
- (lambda (prop) (or (org-element-property prop timestamp) 0))
- (if end '(:minute-end :hour-end :day-end :month-end :year-end)
- '(:minute-start :hour-start :day-start :month-start
- :year-start))))))
- (defun org-timestamp-has-time-p (timestamp)
- "Non-nil when TIMESTAMP has a time specified."
- (org-element-property :hour-start timestamp))
- (defun org-timestamp-format (timestamp format &optional end utc)
- "Format a TIMESTAMP object into a string.
- FORMAT is a format specifier to be passed to
- `format-time-string'.
- When optional argument END is non-nil, use end of date-range or
- time-range, if possible.
- When optional argument UTC is non-nil, time will be expressed as
- Universal Time."
- (format-time-string
- format (org-timestamp--to-internal-time timestamp end)
- (and utc t)))
- (defun org-timestamp-split-range (timestamp &optional end)
- "Extract a TIMESTAMP object from a date or time range.
- END, when non-nil, means extract the end of the range.
- Otherwise, extract its start.
- Return a new timestamp object."
- (let ((type (org-element-property :type timestamp)))
- (if (memq type '(active inactive diary)) timestamp
- (let ((split-ts (org-element-copy timestamp)))
- ;; Set new type.
- (org-element-put-property
- split-ts :type (if (eq type 'active-range) 'active 'inactive))
- ;; Copy start properties over end properties if END is
- ;; non-nil. Otherwise, copy end properties over `start' ones.
- (let ((p-alist '((:minute-start . :minute-end)
- (:hour-start . :hour-end)
- (:day-start . :day-end)
- (:month-start . :month-end)
- (:year-start . :year-end))))
- (dolist (p-cell p-alist)
- (org-element-put-property
- split-ts
- (funcall (if end #'car #'cdr) p-cell)
- (org-element-property
- (funcall (if end #'cdr #'car) p-cell) split-ts)))
- ;; Eventually refresh `:raw-value'.
- (org-element-put-property split-ts :raw-value nil)
- (org-element-put-property
- split-ts :raw-value (org-element-interpret-data split-ts)))))))
- (defun org-timestamp-translate (timestamp &optional boundary)
- "Translate TIMESTAMP object to custom format.
- Format string is defined in `org-time-stamp-custom-formats',
- which see.
- When optional argument BOUNDARY is non-nil, it is either the
- symbol `start' or `end'. In this case, only translate the
- starting or ending part of TIMESTAMP if it is a date or time
- range. Otherwise, translate both parts.
- Return timestamp as-is if `org-display-custom-times' is nil or if
- it has a `diary' type."
- (let ((type (org-element-property :type timestamp)))
- (if (or (not org-display-custom-times) (eq type 'diary))
- (org-element-interpret-data timestamp)
- (let ((fmt (funcall (if (org-timestamp-has-time-p timestamp) #'cdr #'car)
- org-time-stamp-custom-formats)))
- (if (and (not boundary) (memq type '(active-range inactive-range)))
- (concat (org-timestamp-format timestamp fmt)
- "--"
- (org-timestamp-format timestamp fmt t))
- (org-timestamp-format timestamp fmt (eq boundary 'end)))))))
- ;;; Other stuff.
- (defvar reftex-docstruct-symbol)
- (defvar org--rds)
- (defun org-reftex-citation ()
- "Use reftex-citation to insert a citation into the buffer.
- This looks for a line like
- #+BIBLIOGRAPHY: foo plain option:-d
- and derives from it that foo.bib is the bibliography file relevant
- for this document. It then installs the necessary environment for RefTeX
- to work in this buffer and calls `reftex-citation' to insert a citation
- into the buffer.
- Export of such citations to both LaTeX and HTML is handled by the contributed
- package ox-bibtex by Taru Karttunen."
- (interactive)
- (let ((reftex-docstruct-symbol 'org--rds)
- org--rds bib)
- (org-with-wide-buffer
- (let ((case-fold-search t)
- (re "^[ \t]*#\\+BIBLIOGRAPHY:[ \t]+\\([^ \t\n]+\\)"))
- (if (not (save-excursion
- (or (re-search-forward re nil t)
- (re-search-backward re nil t))))
- (user-error "No bibliography defined in file")
- (setq bib (concat (match-string 1) ".bib")
- org--rds (list (list 'bib bib))))))
- (call-interactively 'reftex-citation)))
- ;;;; Functions extending outline functionality
- (defun org-beginning-of-line (&optional n)
- "Go to the beginning of the current visible line.
- If this is a headline, and `org-special-ctrl-a/e' is set, ignore
- tags on the first attempt, and only move to after the tags when
- the cursor is already beyond the end of the headline.
- With argument N not nil or 1, move forward N - 1 lines first."
- (interactive "^p")
- (let ((origin (point))
- (special (pcase org-special-ctrl-a/e
- (`(,C-a . ,_) C-a) (_ org-special-ctrl-a/e)))
- deactivate-mark)
- ;; First move to a visible line.
- (if (bound-and-true-p visual-line-mode)
- (beginning-of-visual-line n)
- (move-beginning-of-line n)
- ;; `move-beginning-of-line' may leave point after invisible
- ;; characters if line starts with such of these (e.g., with
- ;; a link at column 0). Really move to the beginning of the
- ;; current visible line.
- (beginning-of-line))
- (cond
- ;; No special behavior. Point is already at the beginning of
- ;; a line, logical or visual.
- ((not special))
- ;; `beginning-of-visual-line' left point before logical beginning
- ;; of line: point is at the beginning of a visual line. Bail
- ;; out.
- ((and (bound-and-true-p visual-line-mode) (not (bolp))))
- ((let ((case-fold-search nil)) (looking-at org-complex-heading-regexp))
- ;; At a headline, special position is before the title, but
- ;; after any TODO keyword or priority cookie.
- (let ((refpos (min (1+ (or (match-end 3) (match-end 2) (match-end 1)))
- (line-end-position)))
- (bol (point)))
- (if (eq special 'reversed)
- (when (and (= origin bol) (eq last-command this-command))
- (goto-char refpos))
- (when (or (> origin refpos) (= origin bol))
- (goto-char refpos)))))
- ((and (looking-at org-list-full-item-re)
- (memq (org-element-type (save-match-data (org-element-at-point)))
- '(item plain-list)))
- ;; Set special position at first white space character after
- ;; bullet, and check-box, if any.
- (let ((after-bullet
- (let ((box (match-end 3)))
- (cond ((not box) (match-end 1))
- ((eq (char-after box) ?\s) (1+ box))
- (t box)))))
- (if (eq special 'reversed)
- (when (and (= (point) origin) (eq last-command this-command))
- (goto-char after-bullet))
- (when (or (> origin after-bullet) (= (point) origin))
- (goto-char after-bullet)))))
- ;; No special context. Point is already at beginning of line.
- (t nil))))
- (defun org-end-of-line (&optional n)
- "Go to the end of the line, but before ellipsis, if any.
- If this is a headline, and `org-special-ctrl-a/e' is set, ignore
- tags on the first attempt, and only move to after the tags when
- the cursor is already beyond the end of the headline.
- With argument N not nil or 1, move forward N - 1 lines first."
- (interactive "^p")
- (let ((origin (point))
- (special (pcase org-special-ctrl-a/e
- (`(,_ . ,C-e) C-e) (_ org-special-ctrl-a/e)))
- deactivate-mark)
- ;; First move to a visible line.
- (if (bound-and-true-p visual-line-mode)
- (beginning-of-visual-line n)
- (move-beginning-of-line n))
- (cond
- ;; At a headline, with tags.
- ((and special
- (save-excursion
- (beginning-of-line)
- (let ((case-fold-search nil))
- (looking-at org-complex-heading-regexp)))
- (match-end 5))
- (let ((tags (save-excursion
- (goto-char (match-beginning 5))
- (skip-chars-backward " \t")
- (point)))
- (visual-end (and (bound-and-true-p visual-line-mode)
- (save-excursion
- (end-of-visual-line)
- (point)))))
- ;; If `end-of-visual-line' brings us before end of line or
- ;; even tags, i.e., the headline spans over multiple visual
- ;; lines, move there.
- (cond ((and visual-end
- (< visual-end tags)
- (<= origin visual-end))
- (goto-char visual-end))
- ((eq special 'reversed)
- (if (and (= origin (line-end-position))
- (eq this-command last-command))
- (goto-char tags)
- (end-of-line)))
- (t
- (if (or (< origin tags) (= origin (line-end-position)))
- (goto-char tags)
- (end-of-line))))))
- ((bound-and-true-p visual-line-mode)
- (let ((bol (line-beginning-position)))
- (end-of-visual-line)
- ;; If `end-of-visual-line' gets us past the ellipsis at the
- ;; end of a line, backtrack and use `end-of-line' instead.
- (when (/= bol (line-beginning-position))
- (goto-char bol)
- (end-of-line))))
- (t (end-of-line)))))
- (define-key org-mode-map "\C-a" 'org-beginning-of-line)
- (define-key org-mode-map "\C-e" 'org-end-of-line)
- (defun org-backward-sentence (&optional _arg)
- "Go to beginning of sentence, or beginning of table field.
- This will call `backward-sentence' or `org-table-beginning-of-field',
- depending on context."
- (interactive)
- (let* ((element (org-element-at-point))
- (contents-begin (org-element-property :contents-begin element))
- (table (org-element-lineage element '(table) t)))
- (if (and table
- (> (point) contents-begin)
- (<= (point) (org-element-property :contents-end table)))
- (call-interactively #'org-table-beginning-of-field)
- (save-restriction
- (when (and contents-begin
- (< (point-min) contents-begin)
- (> (point) contents-begin))
- (narrow-to-region contents-begin
- (org-element-property :contents-end element)))
- (call-interactively #'backward-sentence)))))
- (defun org-forward-sentence (&optional _arg)
- "Go to end of sentence, or end of table field.
- This will call `forward-sentence' or `org-table-end-of-field',
- depending on context."
- (interactive)
- (let* ((element (org-element-at-point))
- (contents-end (org-element-property :contents-end element))
- (table (org-element-lineage element '(table) t)))
- (if (and table
- (>= (point) (org-element-property :contents-begin table))
- (< (point) contents-end))
- (call-interactively #'org-table-end-of-field)
- (save-restriction
- (when (and contents-end
- (> (point-max) contents-end)
- ;; Skip blank lines between elements.
- (< (org-element-property :end element)
- (save-excursion (goto-char contents-end)
- (skip-chars-forward " \r\t\n"))))
- (narrow-to-region (org-element-property :contents-begin element)
- contents-end))
- (call-interactively #'forward-sentence)))))
- (define-key org-mode-map "\M-a" 'org-backward-sentence)
- (define-key org-mode-map "\M-e" 'org-forward-sentence)
- (defun org-kill-line (&optional _arg)
- "Kill line, to tags or end of line."
- (interactive)
- (cond
- ((or (not org-special-ctrl-k)
- (bolp)
- (not (org-at-heading-p)))
- (when (and (get-char-property (min (point-max) (point-at-eol)) 'invisible)
- org-ctrl-k-protect-subtree
- (or (eq org-ctrl-k-protect-subtree 'error)
- (not (y-or-n-p "Kill hidden subtree along with headline? "))))
- (user-error "C-k aborted as it would kill a hidden subtree"))
- (call-interactively
- (if (bound-and-true-p visual-line-mode) 'kill-visual-line 'kill-line)))
- ((looking-at ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$")
- (kill-region (point) (match-beginning 1))
- (org-set-tags nil t))
- (t (kill-region (point) (point-at-eol)))))
- (define-key org-mode-map "\C-k" 'org-kill-line)
- (defun org-yank (&optional arg)
- "Yank. If the kill is a subtree, treat it specially.
- This command will look at the current kill and check if is a single
- subtree, or a series of subtrees[1]. If it passes the test, and if the
- cursor is at the beginning of a line or after the stars of a currently
- empty headline, then the yank is handled specially. How exactly depends
- on the value of the following variables.
- `org-yank-folded-subtrees'
- By default, this variable is non-nil, which results in
- subtree(s) being folded after insertion, except if doing so
- would swallow text after the yanked text.
- `org-yank-adjusted-subtrees'
- When non-nil (the default value is nil), the subtree will be
- promoted or demoted in order to fit into the local outline tree
- structure, which means that the level will be adjusted so that it
- becomes the smaller one of the two *visible* surrounding headings.
- Any prefix to this command will cause `yank' to be called directly with
- no special treatment. In particular, a simple `\\[universal-argument]' prefix \
- will just
- plainly yank the text as it is.
- \[1] The test checks if the first non-white line is a heading
- and if there are no other headings with fewer stars."
- (interactive "P")
- (org-yank-generic 'yank arg))
- (defun org-yank-generic (command arg)
- "Perform some yank-like command.
- This function implements the behavior described in the `org-yank'
- documentation. However, it has been generalized to work for any
- interactive command with similar behavior."
- ;; pretend to be command COMMAND
- (setq this-command command)
- (if arg
- (call-interactively command)
- (let ((subtreep ; is kill a subtree, and the yank position appropriate?
- (and (org-kill-is-subtree-p)
- (or (bolp)
- (and (looking-at "[ \t]*$")
- (string-match
- "\\`\\*+\\'"
- (buffer-substring (point-at-bol) (point)))))))
- swallowp)
- (cond
- ((and subtreep org-yank-folded-subtrees)
- (let ((beg (point))
- end)
- (if (and subtreep org-yank-adjusted-subtrees)
- (org-paste-subtree nil nil 'for-yank)
- (call-interactively command))
- (setq end (point))
- (goto-char beg)
- (when (and (bolp) subtreep
- (not (setq swallowp
- (org-yank-folding-would-swallow-text beg end))))
- (org-with-limited-levels
- (or (looking-at org-outline-regexp)
- (re-search-forward org-outline-regexp-bol end t))
- (while (and (< (point) end) (looking-at org-outline-regexp))
- (outline-hide-subtree)
- (org-cycle-show-empty-lines 'folded)
- (condition-case nil
- (outline-forward-same-level 1)
- (error (goto-char end))))))
- (when swallowp
- (message
- "Inserted text not folded because that would swallow text"))
- (goto-char end)
- (skip-chars-forward " \t\n\r")
- (beginning-of-line 1)
- (push-mark beg 'nomsg)))
- ((and subtreep org-yank-adjusted-subtrees)
- (let ((beg (point-at-bol)))
- (org-paste-subtree nil nil 'for-yank)
- (push-mark beg 'nomsg)))
- (t
- (call-interactively command))))))
- (defun org-yank-folding-would-swallow-text (beg end)
- "Would hide-subtree at BEG swallow any text after END?"
- (let (level)
- (org-with-limited-levels
- (save-excursion
- (goto-char beg)
- (when (or (looking-at org-outline-regexp)
- (re-search-forward org-outline-regexp-bol end t))
- (setq level (org-outline-level)))
- (goto-char end)
- (skip-chars-forward " \t\r\n\v\f")
- (not (or (eobp)
- (and (bolp) (looking-at-p org-outline-regexp)
- (<= (org-outline-level) level))))))))
- (define-key org-mode-map "\C-y" 'org-yank)
- (defun org-truely-invisible-p ()
- "Check if point is at a character currently not visible.
- This version does not only check the character property, but also
- `visible-mode'."
- (unless (bound-and-true-p visible-mode)
- (org-invisible-p)))
- (defun org-invisible-p2 ()
- "Check if point is at a character currently not visible.
- If the point is at EOL (and not at the beginning of a buffer too),
- move it back by one char before doing this check."
- (save-excursion
- (when (and (eolp) (not (bobp)))
- (backward-char 1))
- (org-invisible-p)))
- (defun org-back-to-heading (&optional invisible-ok)
- "Call `outline-back-to-heading', but provide a better error message."
- (condition-case nil
- (outline-back-to-heading invisible-ok)
- (error (error "Before first headline at position %d in buffer %s"
- (point) (current-buffer)))))
- (defun org-before-first-heading-p ()
- "Before first heading?"
- (save-excursion
- (end-of-line)
- (null (re-search-backward org-outline-regexp-bol nil t))))
- (defun org-at-heading-p (&optional ignored)
- (outline-on-heading-p t))
- (defun org-in-commented-heading-p (&optional no-inheritance)
- "Non-nil if point is under a commented heading.
- This function also checks ancestors of the current headline,
- unless optional argument NO-INHERITANCE is non-nil."
- (cond
- ((org-before-first-heading-p) nil)
- ((let ((headline (nth 4 (org-heading-components))))
- (and headline
- (let ((case-fold-search nil))
- (string-match-p (concat "^" org-comment-string "\\(?: \\|$\\)")
- headline)))))
- (no-inheritance nil)
- (t
- (save-excursion (and (org-up-heading-safe) (org-in-commented-heading-p))))))
- (defun org-at-comment-p nil
- "Is cursor in a commented line?"
- (save-excursion
- (save-match-data
- (beginning-of-line)
- (looking-at "^[ \t]*# "))))
- (defun org-at-drawer-p nil
- "Is cursor at a drawer keyword?"
- (save-excursion
- (move-beginning-of-line 1)
- (looking-at org-drawer-regexp)))
- (defun org-at-block-p nil
- "Is cursor at a block keyword?"
- (save-excursion
- (move-beginning-of-line 1)
- (looking-at org-block-regexp)))
- (defun org-point-at-end-of-empty-headline ()
- "If point is at the end of an empty headline, return t, else nil.
- If the heading only contains a TODO keyword, it is still still considered
- empty."
- (let ((case-fold-search nil))
- (and (looking-at "[ \t]*$")
- org-todo-line-regexp
- (save-excursion
- (beginning-of-line)
- (looking-at org-todo-line-regexp)
- (string= (match-string 3) "")))))
- (defun org-at-heading-or-item-p ()
- (or (org-at-heading-p) (org-at-item-p)))
- (defun org-at-target-p ()
- (or (org-in-regexp org-radio-target-regexp)
- (org-in-regexp org-target-regexp)))
- ;; Compatibility alias with Org versions < 7.8.03
- (defalias 'org-on-target-p 'org-at-target-p)
- (defun org-up-heading-all (arg)
- "Move to the heading line of which the present line is a subheading.
- This function considers both visible and invisible heading lines.
- With argument, move up ARG levels."
- (outline-up-heading arg t))
- (defun org-up-heading-safe ()
- "Move to the heading line of which the present line is a subheading.
- This version will not throw an error. It will return the level of the
- headline found, or nil if no higher level is found.
- Also, this function will be a lot faster than `outline-up-heading',
- because it relies on stars being the outline starters. This can really
- make a significant difference in outlines with very many siblings."
- (when (ignore-errors (org-back-to-heading t))
- (let ((level-up (1- (funcall outline-level))))
- (and (> level-up 0)
- (re-search-backward (format "^\\*\\{1,%d\\} " level-up) nil t)
- (funcall outline-level)))))
- (defun org-first-sibling-p ()
- "Is this heading the first child of its parents?"
- (interactive)
- (let ((re org-outline-regexp-bol)
- level l)
- (unless (org-at-heading-p t)
- (user-error "Not at a heading"))
- (setq level (funcall outline-level))
- (save-excursion
- (if (not (re-search-backward re nil t))
- t
- (setq l (funcall outline-level))
- (< l level)))))
- (defun org-goto-sibling (&optional previous)
- "Goto the next sibling, even if it is invisible.
- When PREVIOUS is set, go to the previous sibling instead. Returns t
- when a sibling was found. When none is found, return nil and don't
- move point."
- (let ((fun (if previous 're-search-backward 're-search-forward))
- (pos (point))
- (re org-outline-regexp-bol)
- level l)
- (when (ignore-errors (org-back-to-heading t))
- (setq level (funcall outline-level))
- (catch 'exit
- (or previous (forward-char 1))
- (while (funcall fun re nil t)
- (setq l (funcall outline-level))
- (when (< l level) (goto-char pos) (throw 'exit nil))
- (when (= l level) (goto-char (match-beginning 0)) (throw 'exit t)))
- (goto-char pos)
- nil))))
- (defun org-show-siblings ()
- "Show all siblings of the current headline."
- (save-excursion
- (while (org-goto-sibling) (org-flag-heading nil)))
- (save-excursion
- (while (org-goto-sibling 'previous)
- (org-flag-heading nil))))
- (defun org-goto-first-child ()
- "Goto the first child, even if it is invisible.
- Return t when a child was found. Otherwise don't move point and
- return nil."
- (let (level (pos (point)) (re org-outline-regexp-bol))
- (when (ignore-errors (org-back-to-heading t))
- (setq level (outline-level))
- (forward-char 1)
- (if (and (re-search-forward re nil t) (> (outline-level) level))
- (progn (goto-char (match-beginning 0)) t)
- (goto-char pos) nil))))
- (defun org-show-hidden-entry ()
- "Show an entry where even the heading is hidden."
- (save-excursion
- (org-show-entry)))
- (defun org-flag-heading (flag &optional entry)
- "Flag the current heading. FLAG non-nil means make invisible.
- When ENTRY is non-nil, show the entire entry."
- (save-excursion
- (org-back-to-heading t)
- ;; Check if we should show the entire entry
- (if entry
- (progn
- (org-show-entry)
- (save-excursion
- (and (outline-next-heading)
- (org-flag-heading nil))))
- (outline-flag-region (max (point-min) (1- (point)))
- (save-excursion (outline-end-of-heading) (point))
- flag))))
- (defun org-get-next-sibling ()
- "Move to next heading of the same level, and return point.
- If there is no such heading, return nil.
- This is like outline-next-sibling, but invisible headings are ok."
- (let ((level (funcall outline-level)))
- (outline-next-heading)
- (while (and (not (eobp)) (> (funcall outline-level) level))
- (outline-next-heading))
- (unless (or (eobp) (< (funcall outline-level) level))
- (point))))
- (defun org-get-last-sibling ()
- "Move to previous heading of the same level, and return point.
- If there is no such heading, return nil."
- (let ((opoint (point))
- (level (funcall outline-level)))
- (outline-previous-heading)
- (when (and (/= (point) opoint) (outline-on-heading-p t))
- (while (and (> (funcall outline-level) level)
- (not (bobp)))
- (outline-previous-heading))
- (unless (< (funcall outline-level) level)
- (point)))))
- (defun org-end-of-subtree (&optional invisible-ok to-heading)
- "Goto to the end of a subtree."
- ;; This contains an exact copy of the original function, but it uses
- ;; `org-back-to-heading', to make it work also in invisible
- ;; trees. And is uses an invisible-ok argument.
- ;; Under Emacs this is not needed, but the old outline.el needs this fix.
- ;; Furthermore, when used inside Org, finding the end of a large subtree
- ;; with many children and grandchildren etc, this can be much faster
- ;; than the outline version.
- (org-back-to-heading invisible-ok)
- (let ((first t)
- (level (funcall outline-level)))
- (if (and (derived-mode-p 'org-mode) (< level 1000))
- ;; A true heading (not a plain list item), in Org
- ;; This means we can easily find the end by looking
- ;; only for the right number of stars. Using a regexp to do
- ;; this is so much faster than using a Lisp loop.
- (let ((re (concat "^\\*\\{1," (int-to-string level) "\\} ")))
- (forward-char 1)
- (and (re-search-forward re nil 'move) (beginning-of-line 1)))
- ;; something else, do it the slow way
- (while (and (not (eobp))
- (or first (> (funcall outline-level) level)))
- (setq first nil)
- (outline-next-heading)))
- (unless to-heading
- (when (memq (preceding-char) '(?\n ?\^M))
- ;; Go to end of line before heading
- (forward-char -1)
- (when (memq (preceding-char) '(?\n ?\^M))
- ;; leave blank line before heading
- (forward-char -1)))))
- (point))
- (defun org-end-of-meta-data (&optional full)
- "Skip planning line and properties drawer in current entry.
- When optional argument FULL is non-nil, also skip empty lines,
- clocking lines and regular drawers at the beginning of the
- entry."
- (org-back-to-heading t)
- (forward-line)
- (when (looking-at-p org-planning-line-re) (forward-line))
- (when (looking-at org-property-drawer-re)
- (goto-char (match-end 0))
- (forward-line))
- (when (and full (not (org-at-heading-p)))
- (catch 'exit
- (let ((end (save-excursion (outline-next-heading) (point)))
- (re (concat "[ \t]*$" "\\|" org-clock-line-re)))
- (while (not (eobp))
- (cond ((looking-at-p org-drawer-regexp)
- (if (re-search-forward "^[ \t]*:END:[ \t]*$" end t)
- (forward-line)
- (throw 'exit t)))
- ((looking-at-p re) (forward-line))
- (t (throw 'exit t))))))))
- (defun org-forward-heading-same-level (arg &optional invisible-ok)
- "Move forward to the ARG'th subheading at same level as this one.
- Stop at the first and last subheadings of a superior heading.
- Normally this only looks at visible headings, but when INVISIBLE-OK is
- non-nil it will also look at invisible ones."
- (interactive "p")
- (let ((backward? (and arg (< arg 0))))
- (if (org-before-first-heading-p)
- (if backward? (goto-char (point-min)) (outline-next-heading))
- (org-back-to-heading invisible-ok)
- (unless backward? (end-of-line)) ;do not match current headline
- (let ((level (- (match-end 0) (match-beginning 0) 1))
- (f (if backward? #'re-search-backward #'re-search-forward))
- (count (if arg (abs arg) 1))
- (result (point)))
- (while (and (> count 0)
- (funcall f org-outline-regexp-bol nil 'move))
- (let ((l (- (match-end 0) (match-beginning 0) 1)))
- (cond ((< l level) (setq count 0))
- ((and (= l level)
- (or invisible-ok
- (not (org-invisible-p
- (line-beginning-position)))))
- (cl-decf count)
- (when (= l level) (setq result (point)))))))
- (goto-char result))
- (beginning-of-line))))
- (defun org-backward-heading-same-level (arg &optional invisible-ok)
- "Move backward to the ARG'th subheading at same level as this one.
- Stop at the first and last subheadings of a superior heading."
- (interactive "p")
- (org-forward-heading-same-level (if arg (- arg) -1) invisible-ok))
- (defun org-next-visible-heading (arg)
- "Move to the next visible heading.
- This function wraps `outline-next-visible-heading' with
- `org-with-limited-levels' in order to skip over inline tasks and
- respect customization of `org-odd-levels-only'."
- (interactive "p")
- (org-with-limited-levels
- (outline-next-visible-heading arg)))
- (defun org-previous-visible-heading (arg)
- "Move to the previous visible heading.
- This function wraps `outline-previous-visible-heading' with
- `org-with-limited-levels' in order to skip over inline tasks and
- respect customization of `org-odd-levels-only'."
- (interactive "p")
- (org-with-limited-levels
- (outline-previous-visible-heading arg)))
- (defun org-next-block (arg &optional backward block-regexp)
- "Jump to the next block.
- With a prefix argument ARG, jump forward ARG many blocks.
- When BACKWARD is non-nil, jump to the previous block.
- When BLOCK-REGEXP is non-nil, use this regexp to find blocks.
- Match data is set according to this regexp when the function
- returns.
- Return point at beginning of the opening line of found block.
- Throw an error if no block is found."
- (interactive "p")
- (let ((re (or block-regexp "^[ \t]*#\\+BEGIN"))
- (case-fold-search t)
- (search-fn (if backward #'re-search-backward #'re-search-forward))
- (count (or arg 1))
- (origin (point))
- last-element)
- (if backward (beginning-of-line) (end-of-line))
- (while (and (> count 0) (funcall search-fn re nil t))
- (let ((element (save-excursion
- (goto-char (match-beginning 0))
- (save-match-data (org-element-at-point)))))
- (when (and (memq (org-element-type element)
- '(center-block comment-block dynamic-block
- example-block export-block quote-block
- special-block src-block verse-block))
- (<= (match-beginning 0)
- (org-element-property :post-affiliated element)))
- (setq last-element element)
- (cl-decf count))))
- (if (= count 0)
- (prog1 (goto-char (org-element-property :post-affiliated last-element))
- (save-match-data (org-show-context)))
- (goto-char origin)
- (user-error "No %s code blocks" (if backward "previous" "further")))))
- (defun org-previous-block (arg &optional block-regexp)
- "Jump to the previous block.
- With a prefix argument ARG, jump backward ARG many source blocks.
- When BLOCK-REGEXP is non-nil, use this regexp to find blocks."
- (interactive "p")
- (org-next-block arg t block-regexp))
- (defun org-forward-paragraph ()
- "Move forward to beginning of next paragraph or equivalent.
- The function moves point to the beginning of the next visible
- structural element, which can be a paragraph, a table, a list
- item, etc. It also provides some special moves for convenience:
- - On an affiliated keyword, jump to the beginning of the
- relative element.
- - On an item or a footnote definition, move to the second
- element inside, if any.
- - On a table or a property drawer, jump after it.
- - On a verse or source block, stop after blank lines."
- (interactive)
- (when (eobp) (user-error "Cannot move further down"))
- (let* ((deactivate-mark nil)
- (element (org-element-at-point))
- (type (org-element-type element))
- (post-affiliated (org-element-property :post-affiliated element))
- (contents-begin (org-element-property :contents-begin element))
- (contents-end (org-element-property :contents-end element))
- (end (let ((end (org-element-property :end element)) (parent element))
- (while (and (setq parent (org-element-property :parent parent))
- (= (org-element-property :contents-end parent) end))
- (setq end (org-element-property :end parent)))
- end)))
- (cond ((not element)
- (skip-chars-forward " \r\t\n")
- (or (eobp) (beginning-of-line)))
- ;; On affiliated keywords, move to element's beginning.
- ((< (point) post-affiliated)
- (goto-char post-affiliated))
- ;; At a table row, move to the end of the table. Similarly,
- ;; at a node property, move to the end of the property
- ;; drawer.
- ((memq type '(node-property table-row))
- (goto-char (org-element-property
- :end (org-element-property :parent element))))
- ((memq type '(property-drawer table)) (goto-char end))
- ;; Consider blank lines as separators in verse and source
- ;; blocks to ease editing.
- ((memq type '(src-block verse-block))
- (when (eq type 'src-block)
- (setq contents-end
- (save-excursion (goto-char end)
- (skip-chars-backward " \r\t\n")
- (line-beginning-position))))
- (beginning-of-line)
- (when (looking-at "[ \t]*$") (skip-chars-forward " \r\t\n"))
- (if (not (re-search-forward "^[ \t]*$" contents-end t))
- (goto-char end)
- (skip-chars-forward " \r\t\n")
- (if (= (point) contents-end) (goto-char end)
- (beginning-of-line))))
- ;; With no contents, just skip element.
- ((not contents-begin) (goto-char end))
- ;; If contents are invisible, skip the element altogether.
- ((org-invisible-p (line-end-position))
- (cl-case type
- (headline
- (org-with-limited-levels (outline-next-visible-heading 1)))
- ;; At a plain list, make sure we move to the next item
- ;; instead of skipping the whole list.
- (plain-list (forward-char)
- (org-forward-paragraph))
- (otherwise (goto-char end))))
- ((>= (point) contents-end) (goto-char end))
- ((>= (point) contents-begin)
- ;; This can only happen on paragraphs and plain lists.
- (cl-case type
- (paragraph (goto-char end))
- ;; At a plain list, try to move to second element in
- ;; first item, if possible.
- (plain-list (end-of-line)
- (org-forward-paragraph))))
- ;; When contents start on the middle of a line (e.g. in
- ;; items and footnote definitions), try to reach first
- ;; element starting after current line.
- ((> (line-end-position) contents-begin)
- (end-of-line)
- (org-forward-paragraph))
- (t (goto-char contents-begin)))))
- (defun org-backward-paragraph ()
- "Move backward to start of previous paragraph or equivalent.
- The function moves point to the beginning of the current
- structural element, which can be a paragraph, a table, a list
- item, etc., or to the beginning of the previous visible one if
- point is already there. It also provides some special moves for
- convenience:
- - On an affiliated keyword, jump to the first one.
- - On a table or a property drawer, move to its beginning.
- - On a verse or source block, stop before blank lines."
- (interactive)
- (when (bobp) (user-error "Cannot move further up"))
- (let* ((deactivate-mark nil)
- (element (org-element-at-point))
- (type (org-element-type element))
- (contents-begin (org-element-property :contents-begin element))
- (contents-end (org-element-property :contents-end element))
- (post-affiliated (org-element-property :post-affiliated element))
- (begin (org-element-property :begin element)))
- (cond
- ((not element) (goto-char (point-min)))
- ((= (point) begin)
- (backward-char)
- (org-backward-paragraph))
- ((<= (point) post-affiliated) (goto-char begin))
- ((memq type '(node-property table-row))
- (goto-char (org-element-property
- :post-affiliated (org-element-property :parent element))))
- ((memq type '(property-drawer table)) (goto-char begin))
- ((memq type '(src-block verse-block))
- (when (eq type 'src-block)
- (setq contents-begin
- (save-excursion (goto-char begin) (forward-line) (point))))
- (if (= (point) contents-begin) (goto-char post-affiliated)
- ;; Inside a verse block, see blank lines as paragraph
- ;; separators.
- (let ((origin (point)))
- (skip-chars-backward " \r\t\n" contents-begin)
- (when (re-search-backward "^[ \t]*$" contents-begin 'move)
- (skip-chars-forward " \r\t\n" origin)
- (if (= (point) origin) (goto-char contents-begin)
- (beginning-of-line))))))
- ((not contents-begin) (goto-char (or post-affiliated begin)))
- ((eq type 'paragraph)
- (goto-char contents-begin)
- ;; When at first paragraph in an item or a footnote definition,
- ;; move directly to beginning of line.
- (let ((parent-contents
- (org-element-property
- :contents-begin (org-element-property :parent element))))
- (when (and parent-contents (= parent-contents contents-begin))
- (beginning-of-line))))
- ;; At the end of a greater element, move to the beginning of the
- ;; last element within.
- ((>= (point) contents-end)
- (goto-char (1- contents-end))
- (org-backward-paragraph))
- (t (goto-char (or post-affiliated begin))))
- ;; Ensure we never leave point invisible.
- (when (org-invisible-p (point)) (beginning-of-visual-line))))
- (defun org-forward-element ()
- "Move forward by one element.
- Move to the next element at the same level, when possible."
- (interactive)
- (cond ((eobp) (user-error "Cannot move further down"))
- ((org-with-limited-levels (org-at-heading-p))
- (let ((origin (point)))
- (goto-char (org-end-of-subtree nil t))
- (unless (org-with-limited-levels (org-at-heading-p))
- (goto-char origin)
- (user-error "Cannot move further down"))))
- (t
- (let* ((elem (org-element-at-point))
- (end (org-element-property :end elem))
- (parent (org-element-property :parent elem)))
- (cond ((and parent (= (org-element-property :contents-end parent) end))
- (goto-char (org-element-property :end parent)))
- ((integer-or-marker-p end) (goto-char end))
- (t (message "No element at point")))))))
- (defun org-backward-element ()
- "Move backward by one element.
- Move to the previous element at the same level, when possible."
- (interactive)
- (cond ((bobp) (user-error "Cannot move further up"))
- ((org-with-limited-levels (org-at-heading-p))
- ;; At a headline, move to the previous one, if any, or stay
- ;; here.
- (let ((origin (point)))
- (org-with-limited-levels (org-backward-heading-same-level 1))
- ;; When current headline has no sibling above, move to its
- ;; parent.
- (when (= (point) origin)
- (or (org-with-limited-levels (org-up-heading-safe))
- (progn (goto-char origin)
- (user-error "Cannot move further up"))))))
- (t
- (let* ((elem (org-element-at-point))
- (beg (org-element-property :begin elem)))
- (cond
- ;; Move to beginning of current element if point isn't
- ;; there already.
- ((null beg) (message "No element at point"))
- ((/= (point) beg) (goto-char beg))
- (t (goto-char beg)
- (skip-chars-backward " \r\t\n")
- (unless (bobp)
- (let ((prev (org-element-at-point)))
- (goto-char (org-element-property :begin prev))
- (while (and (setq prev (org-element-property :parent prev))
- (<= (org-element-property :end prev) beg))
- (goto-char (org-element-property :begin prev)))))))))))
- (defun org-up-element ()
- "Move to upper element."
- (interactive)
- (if (org-with-limited-levels (org-at-heading-p))
- (unless (org-up-heading-safe) (user-error "No surrounding element"))
- (let* ((elem (org-element-at-point))
- (parent (org-element-property :parent elem)))
- (if parent (goto-char (org-element-property :begin parent))
- (if (org-with-limited-levels (org-before-first-heading-p))
- (user-error "No surrounding element")
- (org-with-limited-levels (org-back-to-heading)))))))
- (defun org-down-element ()
- "Move to inner element."
- (interactive)
- (let ((element (org-element-at-point)))
- (cond
- ((memq (org-element-type element) '(plain-list table))
- (goto-char (org-element-property :contents-begin element))
- (forward-char))
- ((memq (org-element-type element) org-element-greater-elements)
- ;; If contents are hidden, first disclose them.
- (when (org-invisible-p (line-end-position)) (org-cycle))
- (goto-char (or (org-element-property :contents-begin element)
- (user-error "No content for this element"))))
- (t (user-error "No inner element")))))
- (defun org-drag-element-backward ()
- "Move backward element at point."
- (interactive)
- (let ((elem (or (org-element-at-point)
- (user-error "No element at point"))))
- (if (eq (org-element-type elem) 'headline)
- ;; Preserve point when moving a whole tree, even if point was
- ;; on blank lines below the headline.
- (let ((offset (skip-chars-backward " \t\n")))
- (unwind-protect (org-move-subtree-up)
- (forward-char (- offset))))
- (let ((prev-elem
- (save-excursion
- (goto-char (org-element-property :begin elem))
- (skip-chars-backward " \r\t\n")
- (unless (bobp)
- (let* ((beg (org-element-property :begin elem))
- (prev (org-element-at-point))
- (up prev))
- (while (and (setq up (org-element-property :parent up))
- (<= (org-element-property :end up) beg))
- (setq prev up))
- prev)))))
- ;; Error out if no previous element or previous element is
- ;; a parent of the current one.
- (if (or (not prev-elem) (org-element-nested-p elem prev-elem))
- (user-error "Cannot drag element backward")
- (let ((pos (point)))
- (org-element-swap-A-B prev-elem elem)
- (goto-char (+ (org-element-property :begin prev-elem)
- (- pos (org-element-property :begin elem))))))))))
- (defun org-drag-element-forward ()
- "Move forward element at point."
- (interactive)
- (let* ((pos (point))
- (elem (or (org-element-at-point)
- (user-error "No element at point"))))
- (when (= (point-max) (org-element-property :end elem))
- (user-error "Cannot drag element forward"))
- (goto-char (org-element-property :end elem))
- (let ((next-elem (org-element-at-point)))
- (when (or (org-element-nested-p elem next-elem)
- (and (eq (org-element-type next-elem) 'headline)
- (not (eq (org-element-type elem) 'headline))))
- (goto-char pos)
- (user-error "Cannot drag element forward"))
- ;; Compute new position of point: it's shifted by NEXT-ELEM
- ;; body's length (without final blanks) and by the length of
- ;; blanks between ELEM and NEXT-ELEM.
- (let ((size-next (- (save-excursion
- (goto-char (org-element-property :end next-elem))
- (skip-chars-backward " \r\t\n")
- (forward-line)
- ;; Small correction if buffer doesn't end
- ;; with a newline character.
- (if (and (eolp) (not (bolp))) (1+ (point)) (point)))
- (org-element-property :begin next-elem)))
- (size-blank (- (org-element-property :end elem)
- (save-excursion
- (goto-char (org-element-property :end elem))
- (skip-chars-backward " \r\t\n")
- (forward-line)
- (point)))))
- (org-element-swap-A-B elem next-elem)
- (goto-char (+ pos size-next size-blank))))))
- (defun org-drag-line-forward (arg)
- "Drag the line at point ARG lines forward."
- (interactive "p")
- (dotimes (_ (abs arg))
- (let ((c (current-column)))
- (if (< 0 arg)
- (progn
- (beginning-of-line 2)
- (transpose-lines 1)
- (beginning-of-line 0))
- (transpose-lines 1)
- (beginning-of-line -1))
- (org-move-to-column c))))
- (defun org-drag-line-backward (arg)
- "Drag the line at point ARG lines backward."
- (interactive "p")
- (org-drag-line-forward (- arg)))
- (defun org-mark-element ()
- "Put point at beginning of this element, mark at end.
- Interactively, if this command is repeated or (in Transient Mark
- mode) if the mark is active, it marks the next element after the
- ones already marked."
- (interactive)
- (let (deactivate-mark)
- (if (and (called-interactively-p 'any)
- (or (and (eq last-command this-command) (mark t))
- (and transient-mark-mode mark-active)))
- (set-mark
- (save-excursion
- (goto-char (mark))
- (goto-char (org-element-property :end (org-element-at-point)))))
- (let ((element (org-element-at-point)))
- (end-of-line)
- (push-mark (org-element-property :end element) t t)
- (goto-char (org-element-property :begin element))))))
- (defun org-narrow-to-element ()
- "Narrow buffer to current element."
- (interactive)
- (let ((elem (org-element-at-point)))
- (cond
- ((eq (car elem) 'headline)
- (narrow-to-region
- (org-element-property :begin elem)
- (org-element-property :end elem)))
- ((memq (car elem) org-element-greater-elements)
- (narrow-to-region
- (org-element-property :contents-begin elem)
- (org-element-property :contents-end elem)))
- (t
- (narrow-to-region
- (org-element-property :begin elem)
- (org-element-property :end elem))))))
- (defun org-transpose-element ()
- "Transpose current and previous elements, keeping blank lines between.
- Point is moved after both elements."
- (interactive)
- (org-skip-whitespace)
- (let ((end (org-element-property :end (org-element-at-point))))
- (org-drag-element-backward)
- (goto-char end)))
- (defun org-unindent-buffer ()
- "Un-indent the visible part of the buffer.
- Relative indentation (between items, inside blocks, etc.) isn't
- modified."
- (interactive)
- (unless (eq major-mode 'org-mode)
- (user-error "Cannot un-indent a buffer not in Org mode"))
- (letrec ((parse-tree (org-element-parse-buffer 'greater-element))
- (unindent-tree
- (lambda (contents)
- (dolist (element (reverse contents))
- (if (memq (org-element-type element) '(headline section))
- (funcall unindent-tree (org-element-contents element))
- (save-excursion
- (save-restriction
- (narrow-to-region
- (org-element-property :begin element)
- (org-element-property :end element))
- (org-do-remove-indentation))))))))
- (funcall unindent-tree (org-element-contents parse-tree))))
- (defun org-show-children (&optional level)
- "Show all direct subheadings of this heading.
- Prefix arg LEVEL is how many levels below the current level
- should be shown. Default is enough to cause the following
- heading to appear."
- (interactive "p")
- ;; If `orgstruct-mode' is active, use the slower version.
- (if orgstruct-mode (call-interactively #'outline-show-children)
- (save-excursion
- (org-back-to-heading t)
- (let* ((current-level (funcall outline-level))
- (max-level (org-get-valid-level
- current-level
- (if level (prefix-numeric-value level) 1)))
- (end (save-excursion (org-end-of-subtree t t)))
- (regexp-fmt "^\\*\\{%d,%s\\}\\(?: \\|$\\)")
- (past-first-child nil)
- ;; Make sure to skip inlinetasks.
- (re (format regexp-fmt
- current-level
- (cond
- ((not (featurep 'org-inlinetask)) "")
- (org-odd-levels-only (- (* 2 org-inlinetask-min-level)
- 3))
- (t (1- org-inlinetask-min-level))))))
- ;; Display parent heading.
- (outline-flag-region (line-end-position 0) (line-end-position) nil)
- (forward-line)
- ;; Display children. First child may be deeper than expected
- ;; MAX-LEVEL. Since we want to display it anyway, adjust
- ;; MAX-LEVEL accordingly.
- (while (re-search-forward re end t)
- (unless past-first-child
- (setq re (format regexp-fmt
- current-level
- (max (funcall outline-level) max-level)))
- (setq past-first-child t))
- (outline-flag-region
- (line-end-position 0) (line-end-position) nil))))))
- (defun org-show-subtree ()
- "Show everything after this heading at deeper levels."
- (interactive)
- (outline-flag-region
- (point)
- (save-excursion
- (org-end-of-subtree t t))
- nil))
- (defun org-show-entry ()
- "Show the body directly following this heading.
- Show the heading too, if it is currently invisible."
- (interactive)
- (save-excursion
- (ignore-errors
- (org-back-to-heading t)
- (outline-flag-region
- (max (point-min) (1- (point)))
- (save-excursion
- (if (re-search-forward
- (concat "[\r\n]\\(" org-outline-regexp "\\)") nil t)
- (match-beginning 1)
- (point-max)))
- nil)
- (org-cycle-hide-drawers 'children))))
- (defun org-make-options-regexp (kwds &optional extra)
- "Make a regular expression for keyword lines.
- KWDS is a list of keywords, as strings. Optional argument EXTRA,
- when non-nil, is a regexp matching keywords names."
- (concat "^[ \t]*#\\+\\("
- (regexp-opt kwds)
- (and extra (concat (and kwds "\\|") extra))
- "\\):[ \t]*\\(.*\\)"))
- ;;;; Integration with and fixes for other packages
- ;;; Imenu support
- (defvar-local org-imenu-markers nil
- "All markers currently used by Imenu.")
- (defun org-imenu-new-marker (&optional pos)
- "Return a new marker for use by Imenu, and remember the marker."
- (let ((m (make-marker)))
- (move-marker m (or pos (point)))
- (push m org-imenu-markers)
- m))
- (defun org-imenu-get-tree ()
- "Produce the index for Imenu."
- (dolist (x org-imenu-markers) (move-marker x nil))
- (setq org-imenu-markers nil)
- (let* ((case-fold-search nil)
- (n org-imenu-depth)
- (re (concat "^" (org-get-limited-outline-regexp)))
- (subs (make-vector (1+ n) nil))
- (last-level 0)
- m level head0 head)
- (org-with-wide-buffer
- (goto-char (point-max))
- (while (re-search-backward re nil t)
- (setq level (org-reduced-level (funcall outline-level)))
- (when (and (<= level n)
- (looking-at org-complex-heading-regexp)
- (setq head0 (match-string-no-properties 4)))
- (setq head (org-link-display-format head0)
- m (org-imenu-new-marker))
- (org-add-props head nil 'org-imenu-marker m 'org-imenu t)
- (if (>= level last-level)
- (push (cons head m) (aref subs level))
- (push (cons head (aref subs (1+ level))) (aref subs level))
- (cl-loop for i from (1+ level) to n do (aset subs i nil)))
- (setq last-level level))))
- (aref subs 1)))
- (eval-after-load "imenu"
- '(progn
- (add-hook 'imenu-after-jump-hook
- (lambda ()
- (when (derived-mode-p 'org-mode)
- (org-show-context 'org-goto))))))
- (defun org-link-display-format (s)
- "Replace links in string S with their description.
- If there is no description, use the link target."
- (save-match-data
- (replace-regexp-in-string
- org-bracket-link-analytic-regexp
- (lambda (m)
- (if (match-end 5) (match-string 5 m)
- (concat (match-string 1 m) (match-string 3 m))))
- s nil t)))
- (defun org-toggle-link-display ()
- "Toggle the literal or descriptive display of links."
- (interactive)
- (if org-descriptive-links
- (progn (org-remove-from-invisibility-spec '(org-link))
- (org-restart-font-lock)
- (setq org-descriptive-links nil))
- (progn (add-to-invisibility-spec '(org-link))
- (org-restart-font-lock)
- (setq org-descriptive-links t))))
- ;; Speedbar support
- (defvar org-speedbar-restriction-lock-overlay (make-overlay 1 1)
- "Overlay marking the agenda restriction line in speedbar.")
- (overlay-put org-speedbar-restriction-lock-overlay
- 'face 'org-agenda-restriction-lock)
- (overlay-put org-speedbar-restriction-lock-overlay
- 'help-echo "Agendas are currently limited to this item.")
- (delete-overlay org-speedbar-restriction-lock-overlay)
- (defun org-speedbar-set-agenda-restriction ()
- "Restrict future agenda commands to the location at point in speedbar.
- To get rid of the restriction, use `\\[org-agenda-remove-restriction-lock]'."
- (interactive)
- (require 'org-agenda)
- (let (p m tp np dir txt)
- (cond
- ((setq p (text-property-any (point-at-bol) (point-at-eol)
- 'org-imenu t))
- (setq m (get-text-property p 'org-imenu-marker))
- (with-current-buffer (marker-buffer m)
- (goto-char m)
- (org-agenda-set-restriction-lock 'subtree)))
- ((setq p (text-property-any (point-at-bol) (point-at-eol)
- 'speedbar-function 'speedbar-find-file))
- (setq tp (previous-single-property-change
- (1+ p) 'speedbar-function)
- np (next-single-property-change
- tp 'speedbar-function)
- dir (speedbar-line-directory)
- txt (buffer-substring-no-properties (or tp (point-min))
- (or np (point-max))))
- (with-current-buffer (find-file-noselect
- (let ((default-directory dir))
- (expand-file-name txt)))
- (unless (derived-mode-p 'org-mode)
- (user-error "Cannot restrict to non-Org mode file"))
- (org-agenda-set-restriction-lock 'file)))
- (t (user-error "Don't know how to restrict Org mode agenda")))
- (move-overlay org-speedbar-restriction-lock-overlay
- (point-at-bol) (point-at-eol))
- (setq current-prefix-arg nil)
- (org-agenda-maybe-redo)))
- (defvar speedbar-file-key-map)
- (declare-function speedbar-add-supported-extension "speedbar" (extension))
- (eval-after-load "speedbar"
- '(progn
- (speedbar-add-supported-extension ".org")
- (define-key speedbar-file-key-map "<" 'org-speedbar-set-agenda-restriction)
- (define-key speedbar-file-key-map "\C-c\C-x<" 'org-speedbar-set-agenda-restriction)
- (define-key speedbar-file-key-map ">" 'org-agenda-remove-restriction-lock)
- (define-key speedbar-file-key-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
- (add-hook 'speedbar-visiting-tag-hook
- (lambda () (and (derived-mode-p 'org-mode) (org-show-context 'org-goto))))))
- ;;; Fixes and Hacks for problems with other packages
- (defun org--flyspell-object-check-p (element)
- "Non-nil when Flyspell can check object at point.
- ELEMENT is the element at point."
- (let ((object (save-excursion
- (when (looking-at-p "\\>") (backward-char))
- (org-element-context element))))
- (cl-case (org-element-type object)
- ;; Prevent checks in links due to keybinding conflict with
- ;; Flyspell.
- ((code entity export-snippet inline-babel-call
- inline-src-block line-break latex-fragment link macro
- statistics-cookie target timestamp verbatim)
- nil)
- (footnote-reference
- ;; Only in inline footnotes, within the definition.
- (and (eq (org-element-property :type object) 'inline)
- (< (save-excursion
- (goto-char (org-element-property :begin object))
- (search-forward ":" nil t 2))
- (point))))
- (otherwise t))))
- (defun org-mode-flyspell-verify ()
- "Function used for `flyspell-generic-check-word-predicate'."
- (if (org-at-heading-p)
- ;; At a headline or an inlinetask, check title only. This is
- ;; faster than relying on `org-element-at-point'.
- (and (save-excursion (beginning-of-line)
- (and (let ((case-fold-search t))
- (not (looking-at-p "\\*+ END[ \t]*$")))
- (let ((case-fold-search nil))
- (looking-at org-complex-heading-regexp))))
- (match-beginning 4)
- (>= (point) (match-beginning 4))
- (or (not (match-beginning 5))
- (< (point) (match-beginning 5))))
- (let* ((element (org-element-at-point))
- (post-affiliated (org-element-property :post-affiliated element)))
- (cond
- ;; Ignore checks in all affiliated keywords but captions.
- ((< (point) post-affiliated)
- (and (save-excursion
- (beginning-of-line)
- (let ((case-fold-search t)) (looking-at "[ \t]*#\\+CAPTION:")))
- (> (point) (match-end 0))
- (org--flyspell-object-check-p element)))
- ;; Ignore checks in LOGBOOK (or equivalent) drawer.
- ((let ((log (org-log-into-drawer)))
- (and log
- (let ((drawer (org-element-lineage element '(drawer))))
- (and drawer
- (eq (compare-strings
- log nil nil
- (org-element-property :drawer-name drawer) nil nil t)
- t)))))
- nil)
- (t
- (cl-case (org-element-type element)
- ((comment quote-section) t)
- (comment-block
- ;; Allow checks between block markers, not on them.
- (and (> (line-beginning-position) post-affiliated)
- (save-excursion
- (end-of-line)
- (skip-chars-forward " \r\t\n")
- (< (point) (org-element-property :end element)))))
- ;; Arbitrary list of keywords where checks are meaningful.
- ;; Make sure point is on the value part of the element.
- (keyword
- (and (member (org-element-property :key element)
- '("DESCRIPTION" "TITLE"))
- (save-excursion
- (search-backward ":" (line-beginning-position) t))))
- ;; Check is globally allowed in paragraphs verse blocks and
- ;; table rows (after affiliated keywords) but some objects
- ;; must not be affected.
- ((paragraph table-row verse-block)
- (let ((cbeg (org-element-property :contents-begin element))
- (cend (org-element-property :contents-end element)))
- (and cbeg (>= (point) cbeg) (< (point) cend)
- (org--flyspell-object-check-p element))))))))))
- (put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify)
- (defun org-remove-flyspell-overlays-in (beg end)
- "Remove flyspell overlays in region."
- (and (bound-and-true-p flyspell-mode)
- (fboundp 'flyspell-delete-region-overlays)
- (flyspell-delete-region-overlays beg end)))
- (defvar flyspell-delayed-commands)
- (eval-after-load "flyspell"
- '(add-to-list 'flyspell-delayed-commands 'org-self-insert-command))
- ;; Make `bookmark-jump' shows the jump location if it was hidden.
- (eval-after-load "bookmark"
- '(if (boundp 'bookmark-after-jump-hook)
- ;; We can use the hook
- (add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide)
- ;; Hook not available, use advice
- (defadvice bookmark-jump (after org-make-visible activate)
- "Make the position visible."
- (org-bookmark-jump-unhide))))
- ;; Make sure saveplace shows the location if it was hidden
- (eval-after-load "saveplace"
- '(defadvice save-place-find-file-hook (after org-make-visible activate)
- "Make the position visible."
- (org-bookmark-jump-unhide)))
- ;; Make sure ecb shows the location if it was hidden
- (eval-after-load "ecb"
- '(defadvice ecb-method-clicked (after esf/org-show-context activate)
- "Make hierarchy visible when jumping into location from ECB tree buffer."
- (when (derived-mode-p 'org-mode)
- (org-show-context))))
- (defun org-bookmark-jump-unhide ()
- "Unhide the current position, to show the bookmark location."
- (and (derived-mode-p 'org-mode)
- (or (org-invisible-p)
- (save-excursion (goto-char (max (point-min) (1- (point))))
- (org-invisible-p)))
- (org-show-context 'bookmark-jump)))
- (defun org-mark-jump-unhide ()
- "Make the point visible with `org-show-context' after jumping to the mark."
- (when (and (derived-mode-p 'org-mode)
- (org-invisible-p))
- (org-show-context 'mark-goto)))
- (eval-after-load "simple"
- '(defadvice pop-to-mark-command (after org-make-visible activate)
- "Make the point visible with `org-show-context'."
- (org-mark-jump-unhide)))
- (eval-after-load "simple"
- '(defadvice exchange-point-and-mark (after org-make-visible activate)
- "Make the point visible with `org-show-context'."
- (org-mark-jump-unhide)))
- (eval-after-load "simple"
- '(defadvice pop-global-mark (after org-make-visible activate)
- "Make the point visible with `org-show-context'."
- (org-mark-jump-unhide)))
- ;; Make session.el ignore our circular variable
- (defvar session-globals-exclude)
- (eval-after-load "session"
- '(add-to-list 'session-globals-exclude 'org-mark-ring))
- ;;;; Finish up
- (provide 'org)
- (run-hooks 'org-load-hook)
- ;;; org.el ends here
|