Repository: ndwarshuis/om.el Branch: master Commit: e348f446746b Files: 25 Total size: 1.0 MB Directory structure: gitextract_xakltvns/ ├── .emacs/ │ ├── 28.2/ │ │ └── straight/ │ │ └── versions/ │ │ └── default.el │ ├── 29.3/ │ │ └── straight/ │ │ └── versions/ │ │ └── default.el │ └── 30.1/ │ └── straight/ │ └── versions/ │ └── default.el ├── .github/ │ └── workflows/ │ └── test.yml ├── .gitignore ├── CHANGELOG.md ├── LICENSE ├── Makefile ├── README.md ├── bench/ │ ├── org-ml-bench-fw.el │ └── org-ml-benchmarks.el ├── dev/ │ ├── org-ml-cookbook.el │ ├── org-ml-docs.el │ ├── org-ml-examples.el │ ├── org-ml-test-common.el │ ├── org-ml-test-external.el │ └── org-ml-test-internal.el ├── docs/ │ ├── api-reference.md │ └── cookbook.md ├── env-28.2.yml ├── env-29.3.yml ├── env-30.1.yml ├── init.el ├── org-ml-macs.el └── org-ml.el ================================================ FILE CONTENTS ================================================ ================================================ FILE: .emacs/28.2/straight/versions/default.el ================================================ (("dash.el" . "721436b04da4e2795387cb48a98ac6de37ece0fd") ("el-get" . "f220df34333fdb363b84b28f4ed4a5575341bf45") ("emacs-buttercup" . "e4fb7cd560d27d8879a2c7739ee96946adec2df8") ("emacsmirror-mirror" . "d9919dfe6eede6ff668614b23f64cfef0f954c48") ("gnu-elpa-mirror" . "e59499eeb86979ef2b41f004b11c0e712f6354b3") ("melpa" . "fd3bb4b191bf416dd419c5c76d510c7f5890e673") ("nongnu-elpa" . "c7b774608a8b17b5e95a096317d12fae7dc31b68") ("org" . "233a0ced97366090c31ef94562879bb2f729b120") ("s.el" . "dda84d38fffdaf0c9b12837b504b402af910d01d") ("straight.el" . "b3760f5829dba37e855add7323304561eb57a3d4")) :gamma ================================================ FILE: .emacs/29.3/straight/versions/default.el ================================================ (("dash.el" . "721436b04da4e2795387cb48a98ac6de37ece0fd") ("el-get" . "f220df34333fdb363b84b28f4ed4a5575341bf45") ("emacs-buttercup" . "e4fb7cd560d27d8879a2c7739ee96946adec2df8") ("emacsmirror-mirror" . "d9919dfe6eede6ff668614b23f64cfef0f954c48") ("gnu-elpa-mirror" . "e59499eeb86979ef2b41f004b11c0e712f6354b3") ("melpa" . "fd3bb4b191bf416dd419c5c76d510c7f5890e673") ("nongnu-elpa" . "c7b774608a8b17b5e95a096317d12fae7dc31b68") ("org" . "233a0ced97366090c31ef94562879bb2f729b120") ("s.el" . "dda84d38fffdaf0c9b12837b504b402af910d01d") ("straight.el" . "b3760f5829dba37e855add7323304561eb57a3d4")) :gamma ================================================ FILE: .emacs/30.1/straight/versions/default.el ================================================ (("dash.el" . "721436b04da4e2795387cb48a98ac6de37ece0fd") ("el-get" . "f220df34333fdb363b84b28f4ed4a5575341bf45") ("emacs-buttercup" . "c0764a764cf088dcb5132c44d5864b22d7723765") ("emacsmirror-mirror" . "d9919dfe6eede6ff668614b23f64cfef0f954c48") ("gnu-elpa-mirror" . "e59499eeb86979ef2b41f004b11c0e712f6354b3") ("melpa" . "fd3bb4b191bf416dd419c5c76d510c7f5890e673") ("nongnu-elpa" . "c7b774608a8b17b5e95a096317d12fae7dc31b68") ("org" . "233a0ced97366090c31ef94562879bb2f729b120") ("s.el" . "dda84d38fffdaf0c9b12837b504b402af910d01d") ("straight.el" . "b3760f5829dba37e855add7323304561eb57a3d4")) :gamma ================================================ FILE: .github/workflows/test.yml ================================================ name: CI on: [push] jobs: build: runs-on: ubuntu-latest strategy: matrix: emacs_version: - '28.2' - '29.3' - '30.1' steps: - uses: actions/checkout@v2 - uses: purcell/setup-emacs@master with: version: ${{ matrix.emacs_version }} - name: Run tests run: | make install make ================================================ FILE: .gitignore ================================================ *.elc .emacs/*/straight/build .emacs/*/straight/repos .emacs/*/straight/build-cache.el ================================================ FILE: CHANGELOG.md ================================================ # Changelog ## 6.0.2 - fix org-ml-match-do* form bug ## 6.0.1 - add tests for emacs 30.1 ## 6.0.0 This is a major update for org 9.7, which has been heavily optimized with a new syntax tree API. This new version of org-ml takes advantage of this new API (which is much faster) but also breaks several things. summary of breaking changes - `org-ml-planning-*` functions have been removed (they are no longer necessary) - the supercontents data structure (for `org-ml-headline-get/set/map-supercontents) has been updated and rewritten. See docstring for `org-ml-headline-get-supercontents` for details. TLDR is that it now handles planning and node properties. This was done partly to better handle whitespace (which was not done correctly previously) and also to take advantage of performance improvements in the headline node type (see below for `org-ml-update-supercontents`) - all previous depreciated functions have been removed - and `org-ml-timestamp-get/set-range` have been renamed to `org-ml-timestamp-get/set-length` - `org-ml-parse-habits` has been removed, this is now elegantly handled by org-element itself. See `org-ml-timestamp-get/set/map-deadline` instead. - `org-ml-headline-get/set/map-node-properties` now use a list of string pairs like `(KEY VAL)` instead of raw node-property nodes. - `org-ml-timestamp-set-length` now takes a unit argument - `org-ml-clone-node` has been removed - `org-ml-unixtime-to-time-long/short` have been combined into `org-ml-unixtime-to-timelist` which takes a flag to determine if the hours and minutes should be included summary of added features - added higher-level timestamp-diary functions for start and end time manipulation (new in org 9.7) - `org-ml-timestamp-get/set/map-deadline` which manipulates what is commonly called "habits" (new in org 9.7) - `org-ml-update-supercontents` and `org-ml-update-supersection` which are two heavily-optimized functions which take advantage of the new lazy evalulation in org 9.7; use these to update headline contents without touching the headline itself - memoization for builder functions - ability to switch between pure and impure evaluation (the latter is faster but less safe); see `org-ml-use-impure` bug fixes and refactorizations - added missing tests for purity - fixed many whitespace handling errors - use conda to pin exact emacs version for local development - use straight to pin exact versions of all dependencies - remove lispy dependency ## 5.8.8 - fix list-like syntax in secondary string parsing ## 5.8.7 - use strings for `org-ml-build-property-drawer!` arguments ## 5.8.6 - bugfixes ## 5.8.5 - make docstring clearer ## 5.8.4 - don't parse bold text as a headline ## 5.8.3 - fix typo in README.md ## 5.8.2 - fix blank table cell bug ## 5.8.1 - fix typo ## 5.8.0 - make myers diff algorithm use linear space - fix a bunch of compiler warnings for emacs 28+ ## 5.7.3 - fix leaky abtraction bug ## 5.7.2 - fix incompatibility with org v9.5 (note: 9.5 not fully tested yet) ## 5.7.1 - add `org-ml-remove-parent(s)` ## 5.7.0 - add functions/checks for `org-data` nodes ## 5.6.2 - add explicit test path for emacs 27.2/org-mode 9.4 ## 5.6.1 - make `org-ml-from-string` work correctly with all types and inputs ## 5.6.0 - add get/set/map functions for timestamp repeaters and warnings - add optional switch for habit parsing ## 5.5.4 - fix `org-ml-headline-set-node-property` nil property bug ## 5.5.3 - fix missing zero-length ending timestamps ## 5.5.2 - fix compile warnings for `org-ml-macs.el` ## 5.5.1 - fix potential merge sort stack overflow ## 5.5.0 - reorganized headline/subtree batch functions (and depreciated old names) ## 5.4.3 - fixed nested headline parsing for `org-ml-get-headlines` et al ## 5.4.2 - make indent/outdent/promote/demote functions more accurate/faster - further optimizations and additional benchmarks ## 5.4.1 - improve performance of string insertion and headline batch updating ## 5.4.0 - add pattern memoization to match function family - numerous performance enhancements including: - remove majority of closures in anaphoric forms (eg `make-byte-code`) - implement faster macros for plists - improve timestamp processing - remove equality checking from `org-ml~update` - streamline headline batch functions (eg `org-ml-do-headlines` et al) ## 5.3.0 - add `org-ml-get-properties` - add `org-ml-item-get/set/map-paragraph` - make `org-ml-get-all-properties` public - numerous bug fixes and performance enhancments ## 5.2.0 - add benchmark framework - add intermediate functions to control Myers diff algorithm application - fix potential infinite loop using native `equal` function for node comparison ## 5.1.0 - fixed array overflow error in myers diff code - add affiliated keywords to polymorphic property interface and builder functions ## 5.0.2 - fixed active timestamp bug for closed planning nodes - use Myers diff algorithm for update functions ## 5.0.1 - rearrange reference files - use buttercup for testing ## 5.0.0 - add robust headline logbook and contents function - rename indent/unindent functions to better reflect native org function naming conventions - add `org-ml-from-string` - improve subtree parsing performance - fix whitespace errors for `org-ml-headline-set-planning/node-properties/supercontents` functions ## 4.0.1 - fix `org-ml-parse-this-table-row` and `org-ml-parse-table-row-at` beyond first row of table ## 4.0.0 - add `org-ml-get-parents` - add `org-ml-headline-get-logbook-loose` and `org-ml-headline-get-contents` - removed old `org-ml-headline-X-logbook` functions and replaced them with `org-ml-headline-X-logbook-drawer` which can be made aware of other drawers other than "LOGBOOK" or nothing - add `org-ml-clone-n` ## 3.0.2 - Update dependencies - Fix bugs ## 3.0.1 - Fix bugs - Don't use `nreverse` unless needed - Don't crash when `org-ml-headline-get-node-property` should return nil ## 3.0.0 - Update for org-mode 9.3 ## 2.0.1 - Fixed byte compile - Clean up docstrings ## 2.0.0 - Renamed from `om.el` to `org-ml` (org-metalanguage) - Renamed functions to be more consistent - `org-ml-get-headlines` and friends to `org-ml-parse-headlines` - `org-ml-do-headlines` and friends to `org-ml-update-headlines` - Add POSIX ERE-like regexp syntax to `org-ml-match` and friends - Add affiliated keyword support - Numerous bug fixes ================================================ FILE: LICENSE ================================================ GNU GENERAL PUBLIC LICENSE Version 3, 29 June 2007 Copyright (C) 2007 Free Software Foundation, Inc. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The GNU General Public License is a free, copyleft license for software and other kinds of works. The licenses for most software and other practical works are designed to take away your freedom to share and change the works. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change all versions of a program--to make sure it remains free software for all its users. We, the Free Software Foundation, use the GNU General Public License for most of our software; it applies also to any other work released this way by its authors. You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for them if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs, and that you know you can do these things. To protect your rights, we need to prevent others from denying you these rights or asking you to surrender the rights. Therefore, you have certain responsibilities if you distribute copies of the software, or if you modify it: responsibilities to respect the freedom of others. For example, if you distribute copies of such a program, whether gratis or for a fee, you must pass on to the recipients the same freedoms that you received. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. Developers that use the GNU GPL protect your rights with two steps: (1) assert copyright on the software, and (2) offer you this License giving you legal permission to copy, distribute and/or modify it. For the developers' and authors' protection, the GPL clearly explains that there is no warranty for this free software. For both users' and authors' sake, the GPL requires that modified versions be marked as changed, so that their problems will not be attributed erroneously to authors of previous versions. Some devices are designed to deny users access to install or run modified versions of the software inside them, although the manufacturer can do so. This is fundamentally incompatible with the aim of protecting users' freedom to change the software. The systematic pattern of such abuse occurs in the area of products for individuals to use, which is precisely where it is most unacceptable. Therefore, we have designed this version of the GPL to prohibit the practice for those products. If such problems arise substantially in other domains, we stand ready to extend this provision to those domains in future versions of the GPL, as needed to protect the freedom of users. Finally, every program is threatened constantly by software patents. States should not allow patents to restrict development and use of software on general-purpose computers, but in those that do, we wish to avoid the special danger that patents applied to a free program could make it effectively proprietary. To prevent this, the GPL assures that patents cannot be used to render the program non-free. The precise terms and conditions for copying, distribution and modification follow. TERMS AND CONDITIONS 0. Definitions. "This License" refers to version 3 of the GNU General Public License. "Copyright" also means copyright-like laws that apply to other kinds of works, such as semiconductor masks. "The Program" refers to any copyrightable work licensed under this License. Each licensee is addressed as "you". "Licensees" and "recipients" may be individuals or organizations. To "modify" a work means to copy from or adapt all or part of the work in a fashion requiring copyright permission, other than the making of an exact copy. The resulting work is called a "modified version" of the earlier work or a work "based on" the earlier work. A "covered work" means either the unmodified Program or a work based on the Program. To "propagate" a work means to do anything with it that, without permission, would make you directly or secondarily liable for infringement under applicable copyright law, except executing it on a computer or modifying a private copy. Propagation includes copying, distribution (with or without modification), making available to the public, and in some countries other activities as well. To "convey" a work means any kind of propagation that enables other parties to make or receive copies. Mere interaction with a user through a computer network, with no transfer of a copy, is not conveying. An interactive user interface displays "Appropriate Legal Notices" to the extent that it includes a convenient and prominently visible feature that (1) displays an appropriate copyright notice, and (2) tells the user that there is no warranty for the work (except to the extent that warranties are provided), that licensees may convey the work under this License, and how to view a copy of this License. If the interface presents a list of user commands or options, such as a menu, a prominent item in the list meets this criterion. 1. Source Code. The "source code" for a work means the preferred form of the work for making modifications to it. "Object code" means any non-source form of a work. A "Standard Interface" means an interface that either is an official standard defined by a recognized standards body, or, in the case of interfaces specified for a particular programming language, one that is widely used among developers working in that language. The "System Libraries" of an executable work include anything, other than the work as a whole, that (a) is included in the normal form of packaging a Major Component, but which is not part of that Major Component, and (b) serves only to enable use of the work with that Major Component, or to implement a Standard Interface for which an implementation is available to the public in source code form. A "Major Component", in this context, means a major essential component (kernel, window system, and so on) of the specific operating system (if any) on which the executable work runs, or a compiler used to produce the work, or an object code interpreter used to run it. The "Corresponding Source" for a work in object code form means all the source code needed to generate, install, and (for an executable work) run the object code and to modify the work, including scripts to control those activities. However, it does not include the work's System Libraries, or general-purpose tools or generally available free programs which are used unmodified in performing those activities but which are not part of the work. For example, Corresponding Source includes interface definition files associated with source files for the work, and the source code for shared libraries and dynamically linked subprograms that the work is specifically designed to require, such as by intimate data communication or control flow between those subprograms and other parts of the work. The Corresponding Source need not include anything that users can regenerate automatically from other parts of the Corresponding Source. The Corresponding Source for a work in source code form is that same work. 2. Basic Permissions. All rights granted under this License are granted for the term of copyright on the Program, and are irrevocable provided the stated conditions are met. This License explicitly affirms your unlimited permission to run the unmodified Program. The output from running a covered work is covered by this License only if the output, given its content, constitutes a covered work. This License acknowledges your rights of fair use or other equivalent, as provided by copyright law. You may make, run and propagate covered works that you do not convey, without conditions so long as your license otherwise remains in force. You may convey covered works to others for the sole purpose of having them make modifications exclusively for you, or provide you with facilities for running those works, provided that you comply with the terms of this License in conveying all material for which you do not control copyright. Those thus making or running the covered works for you must do so exclusively on your behalf, under your direction and control, on terms that prohibit them from making any copies of your copyrighted material outside their relationship with you. Conveying under any other circumstances is permitted solely under the conditions stated below. Sublicensing is not allowed; section 10 makes it unnecessary. 3. Protecting Users' Legal Rights From Anti-Circumvention Law. No covered work shall be deemed part of an effective technological measure under any applicable law fulfilling obligations under article 11 of the WIPO copyright treaty adopted on 20 December 1996, or similar laws prohibiting or restricting circumvention of such measures. When you convey a covered work, you waive any legal power to forbid circumvention of technological measures to the extent such circumvention is effected by exercising rights under this License with respect to the covered work, and you disclaim any intention to limit operation or modification of the work as a means of enforcing, against the work's users, your or third parties' legal rights to forbid circumvention of technological measures. 4. Conveying Verbatim Copies. You may convey verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice; keep intact all notices stating that this License and any non-permissive terms added in accord with section 7 apply to the code; keep intact all notices of the absence of any warranty; and give all recipients a copy of this License along with the Program. You may charge any price or no price for each copy that you convey, and you may offer support or warranty protection for a fee. 5. Conveying Modified Source Versions. You may convey a work based on the Program, or the modifications to produce it from the Program, in the form of source code under the terms of section 4, provided that you also meet all of these conditions: a) The work must carry prominent notices stating that you modified it, and giving a relevant date. b) The work must carry prominent notices stating that it is released under this License and any conditions added under section 7. This requirement modifies the requirement in section 4 to "keep intact all notices". c) You must license the entire work, as a whole, under this License to anyone who comes into possession of a copy. This License will therefore apply, along with any applicable section 7 additional terms, to the whole of the work, and all its parts, regardless of how they are packaged. This License gives no permission to license the work in any other way, but it does not invalidate such permission if you have separately received it. d) If the work has interactive user interfaces, each must display Appropriate Legal Notices; however, if the Program has interactive interfaces that do not display Appropriate Legal Notices, your work need not make them do so. A compilation of a covered work with other separate and independent works, which are not by their nature extensions of the covered work, and which are not combined with it such as to form a larger program, in or on a volume of a storage or distribution medium, is called an "aggregate" if the compilation and its resulting copyright are not used to limit the access or legal rights of the compilation's users beyond what the individual works permit. Inclusion of a covered work in an aggregate does not cause this License to apply to the other parts of the aggregate. 6. Conveying Non-Source Forms. You may convey a covered work in object code form under the terms of sections 4 and 5, provided that you also convey the machine-readable Corresponding Source under the terms of this License, in one of these ways: a) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by the Corresponding Source fixed on a durable physical medium customarily used for software interchange. b) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by a written offer, valid for at least three years and valid for as long as you offer spare parts or customer support for that product model, to give anyone who possesses the object code either (1) a copy of the Corresponding Source for all the software in the product that is covered by this License, on a durable physical medium customarily used for software interchange, for a price no more than your reasonable cost of physically performing this conveying of source, or (2) access to copy the Corresponding Source from a network server at no charge. c) Convey individual copies of the object code with a copy of the written offer to provide the Corresponding Source. This alternative is allowed only occasionally and noncommercially, and only if you received the object code with such an offer, in accord with subsection 6b. d) Convey the object code by offering access from a designated place (gratis or for a charge), and offer equivalent access to the Corresponding Source in the same way through the same place at no further charge. You need not require recipients to copy the Corresponding Source along with the object code. If the place to copy the object code is a network server, the Corresponding Source may be on a different server (operated by you or a third party) that supports equivalent copying facilities, provided you maintain clear directions next to the object code saying where to find the Corresponding Source. Regardless of what server hosts the Corresponding Source, you remain obligated to ensure that it is available for as long as needed to satisfy these requirements. e) Convey the object code using peer-to-peer transmission, provided you inform other peers where the object code and Corresponding Source of the work are being offered to the general public at no charge under subsection 6d. A separable portion of the object code, whose source code is excluded from the Corresponding Source as a System Library, need not be included in conveying the object code work. A "User Product" is either (1) a "consumer product", which means any tangible personal property which is normally used for personal, family, or household purposes, or (2) anything designed or sold for incorporation into a dwelling. In determining whether a product is a consumer product, doubtful cases shall be resolved in favor of coverage. For a particular product received by a particular user, "normally used" refers to a typical or common use of that class of product, regardless of the status of the particular user or of the way in which the particular user actually uses, or expects or is expected to use, the product. A product is a consumer product regardless of whether the product has substantial commercial, industrial or non-consumer uses, unless such uses represent the only significant mode of use of the product. "Installation Information" for a User Product means any methods, procedures, authorization keys, or other information required to install and execute modified versions of a covered work in that User Product from a modified version of its Corresponding Source. The information must suffice to ensure that the continued functioning of the modified object code is in no case prevented or interfered with solely because modification has been made. If you convey an object code work under this section in, or with, or specifically for use in, a User Product, and the conveying occurs as part of a transaction in which the right of possession and use of the User Product is transferred to the recipient in perpetuity or for a fixed term (regardless of how the transaction is characterized), the Corresponding Source conveyed under this section must be accompanied by the Installation Information. But this requirement does not apply if neither you nor any third party retains the ability to install modified object code on the User Product (for example, the work has been installed in ROM). The requirement to provide Installation Information does not include a requirement to continue to provide support service, warranty, or updates for a work that has been modified or installed by the recipient, or for the User Product in which it has been modified or installed. Access to a network may be denied when the modification itself materially and adversely affects the operation of the network or violates the rules and protocols for communication across the network. Corresponding Source conveyed, and Installation Information provided, in accord with this section must be in a format that is publicly documented (and with an implementation available to the public in source code form), and must require no special password or key for unpacking, reading or copying. 7. Additional Terms. "Additional permissions" are terms that supplement the terms of this License by making exceptions from one or more of its conditions. Additional permissions that are applicable to the entire Program shall be treated as though they were included in this License, to the extent that they are valid under applicable law. If additional permissions apply only to part of the Program, that part may be used separately under those permissions, but the entire Program remains governed by this License without regard to the additional permissions. When you convey a copy of a covered work, you may at your option remove any additional permissions from that copy, or from any part of it. (Additional permissions may be written to require their own removal in certain cases when you modify the work.) You may place additional permissions on material, added by you to a covered work, for which you have or can give appropriate copyright permission. Notwithstanding any other provision of this License, for material you add to a covered work, you may (if authorized by the copyright holders of that material) supplement the terms of this License with terms: a) Disclaiming warranty or limiting liability differently from the terms of sections 15 and 16 of this License; or b) Requiring preservation of specified reasonable legal notices or author attributions in that material or in the Appropriate Legal Notices displayed by works containing it; or c) Prohibiting misrepresentation of the origin of that material, or requiring that modified versions of such material be marked in reasonable ways as different from the original version; or d) Limiting the use for publicity purposes of names of licensors or authors of the material; or e) Declining to grant rights under trademark law for use of some trade names, trademarks, or service marks; or f) Requiring indemnification of licensors and authors of that material by anyone who conveys the material (or modified versions of it) with contractual assumptions of liability to the recipient, for any liability that these contractual assumptions directly impose on those licensors and authors. All other non-permissive additional terms are considered "further restrictions" within the meaning of section 10. If the Program as you received it, or any part of it, contains a notice stating that it is governed by this License along with a term that is a further restriction, you may remove that term. If a license document contains a further restriction but permits relicensing or conveying under this License, you may add to a covered work material governed by the terms of that license document, provided that the further restriction does not survive such relicensing or conveying. If you add terms to a covered work in accord with this section, you must place, in the relevant source files, a statement of the additional terms that apply to those files, or a notice indicating where to find the applicable terms. Additional terms, permissive or non-permissive, may be stated in the form of a separately written license, or stated as exceptions; the above requirements apply either way. 8. Termination. You may not propagate or modify a covered work except as expressly provided under this License. Any attempt otherwise to propagate or modify it is void, and will automatically terminate your rights under this License (including any patent licenses granted under the third paragraph of section 11). However, if you cease all violation of this License, then your license from a particular copyright holder is reinstated (a) provisionally, unless and until the copyright holder explicitly and finally terminates your license, and (b) permanently, if the copyright holder fails to notify you of the violation by some reasonable means prior to 60 days after the cessation. Moreover, your license from a particular copyright holder is reinstated permanently if the copyright holder notifies you of the violation by some reasonable means, this is the first time you have received notice of violation of this License (for any work) from that copyright holder, and you cure the violation prior to 30 days after your receipt of the notice. Termination of your rights under this section does not terminate the licenses of parties who have received copies or rights from you under this License. If your rights have been terminated and not permanently reinstated, you do not qualify to receive new licenses for the same material under section 10. 9. Acceptance Not Required for Having Copies. You are not required to accept this License in order to receive or run a copy of the Program. Ancillary propagation of a covered work occurring solely as a consequence of using peer-to-peer transmission to receive a copy likewise does not require acceptance. However, nothing other than this License grants you permission to propagate or modify any covered work. These actions infringe copyright if you do not accept this License. Therefore, by modifying or propagating a covered work, you indicate your acceptance of this License to do so. 10. Automatic Licensing of Downstream Recipients. Each time you convey a covered work, the recipient automatically receives a license from the original licensors, to run, modify and propagate that work, subject to this License. You are not responsible for enforcing compliance by third parties with this License. An "entity transaction" is a transaction transferring control of an organization, or substantially all assets of one, or subdividing an organization, or merging organizations. If propagation of a covered work results from an entity transaction, each party to that transaction who receives a copy of the work also receives whatever licenses to the work the party's predecessor in interest had or could give under the previous paragraph, plus a right to possession of the Corresponding Source of the work from the predecessor in interest, if the predecessor has it or can get it with reasonable efforts. You may not impose any further restrictions on the exercise of the rights granted or affirmed under this License. For example, you may not impose a license fee, royalty, or other charge for exercise of rights granted under this License, and you may not initiate litigation (including a cross-claim or counterclaim in a lawsuit) alleging that any patent claim is infringed by making, using, selling, offering for sale, or importing the Program or any portion of it. 11. Patents. A "contributor" is a copyright holder who authorizes use under this License of the Program or a work on which the Program is based. The work thus licensed is called the contributor's "contributor version". A contributor's "essential patent claims" are all patent claims owned or controlled by the contributor, whether already acquired or hereafter acquired, that would be infringed by some manner, permitted by this License, of making, using, or selling its contributor version, but do not include claims that would be infringed only as a consequence of further modification of the contributor version. For purposes of this definition, "control" includes the right to grant patent sublicenses in a manner consistent with the requirements of this License. Each contributor grants you a non-exclusive, worldwide, royalty-free patent license under the contributor's essential patent claims, to make, use, sell, offer for sale, import and otherwise run, modify and propagate the contents of its contributor version. In the following three paragraphs, a "patent license" is any express agreement or commitment, however denominated, not to enforce a patent (such as an express permission to practice a patent or covenant not to sue for patent infringement). To "grant" such a patent license to a party means to make such an agreement or commitment not to enforce a patent against the party. If you convey a covered work, knowingly relying on a patent license, and the Corresponding Source of the work is not available for anyone to copy, free of charge and under the terms of this License, through a publicly available network server or other readily accessible means, then you must either (1) cause the Corresponding Source to be so available, or (2) arrange to deprive yourself of the benefit of the patent license for this particular work, or (3) arrange, in a manner consistent with the requirements of this License, to extend the patent license to downstream recipients. "Knowingly relying" means you have actual knowledge that, but for the patent license, your conveying the covered work in a country, or your recipient's use of the covered work in a country, would infringe one or more identifiable patents in that country that you have reason to believe are valid. If, pursuant to or in connection with a single transaction or arrangement, you convey, or propagate by procuring conveyance of, a covered work, and grant a patent license to some of the parties receiving the covered work authorizing them to use, propagate, modify or convey a specific copy of the covered work, then the patent license you grant is automatically extended to all recipients of the covered work and works based on it. A patent license is "discriminatory" if it does not include within the scope of its coverage, prohibits the exercise of, or is conditioned on the non-exercise of one or more of the rights that are specifically granted under this License. You may not convey a covered work if you are a party to an arrangement with a third party that is in the business of distributing software, under which you make payment to the third party based on the extent of your activity of conveying the work, and under which the third party grants, to any of the parties who would receive the covered work from you, a discriminatory patent license (a) in connection with copies of the covered work conveyed by you (or copies made from those copies), or (b) primarily for and in connection with specific products or compilations that contain the covered work, unless you entered into that arrangement, or that patent license was granted, prior to 28 March 2007. Nothing in this License shall be construed as excluding or limiting any implied license or other defenses to infringement that may otherwise be available to you under applicable patent law. 12. No Surrender of Others' Freedom. If conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot convey a covered work so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not convey it at all. For example, if you agree to terms that obligate you to collect a royalty for further conveying from those to whom you convey the Program, the only way you could satisfy both those terms and this License would be to refrain entirely from conveying the Program. 13. Use with the GNU Affero General Public License. Notwithstanding any other provision of this License, you have permission to link or combine any covered work with a work licensed under version 3 of the GNU Affero General Public License into a single combined work, and to convey the resulting work. The terms of this License will continue to apply to the part which is the covered work, but the special requirements of the GNU Affero General Public License, section 13, concerning interaction through a network will apply to the combination as such. 14. Revised Versions of this License. The Free Software Foundation may publish revised and/or new versions of the GNU General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies that a certain numbered version of the GNU General Public License "or any later version" applies to it, you have the option of following the terms and conditions either of that numbered version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the GNU General Public License, you may choose any version ever published by the Free Software Foundation. If the Program specifies that a proxy can decide which future versions of the GNU General Public License can be used, that proxy's public statement of acceptance of a version permanently authorizes you to choose that version for the Program. Later license versions may give you additional or different permissions. However, no additional obligations are imposed on any author or copyright holder as a result of your choosing to follow a later version. 15. Disclaimer of Warranty. THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. Limitation of Liability. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 17. Interpretation of Sections 15 and 16. If the disclaimer of warranty and limitation of liability provided above cannot be given local legal effect according to their terms, reviewing courts shall apply local law that most closely approximates an absolute waiver of all civil liability in connection with the Program, unless a warranty or assumption of liability accompanies a copy of the Program in return for a fee. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively state the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . Also add information on how to contact you by electronic and paper mail. If the program does terminal interaction, make it output a short notice like this when it starts in an interactive mode: Copyright (C) This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, your program's commands might be different; for a GUI interface, you would use an "about box". You should also get your employer (if you work as a programmer) or school, if any, to sign a "copyright disclaimer" for the program, if necessary. For more information on this, and how to apply and follow the GNU GPL, see . The GNU General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. But first, please read . ================================================ FILE: Makefile ================================================ EMACS ?= emacs -Q --batch --load init.el -L . RM ?= rm -f all: test # run all tests with both interpreted and compiled org-ml functions test: ${MAKE} unit ${MAKE} compile # build docs for org-ml docs: ${EMACS} -L dev \ -l dev/org-ml-docs.el \ -f create-docs-files # run internal (stateless) tests with interpreted org-ml functions internal: ${EMACS} -L dev \ -l dev/org-ml-test-internal.el \ -f buttercup-run-discover # run external (stateful) tests with interpreted org-ml functions external: ${EMACS} -L dev \ -l dev/org-ml-test-external.el \ -f buttercup-run-discover # run tests with interpreted org-ml functions unit: ${EMACS} -L dev \ -l dev/org-ml-test-external.el \ -l dev/org-ml-test-internal.el \ -f buttercup-run-discover # run tests with compiled org-ml functions compile: ${MAKE} build ${MAKE} unit ${MAKE} clean-elc # run and print benchmark results using compile org-ml functions benchmark: ${EMACS} build ${EMACS} -L bench \ -l bench/org-ml-benchmarks.el \ -f org-ml-bench-run ${MAKE} clean-elc # remove compiled lisp files clean-elc: ${RM} *.elc # byte-compile all org-ml lisp files build: ${EMACS} -f compile-target # install all development packages for the current version install: ${EMACS} --eval '(print "Install finished")' # write lockfile for current emacs version given each repo dependency freeze: ${EMACS} -f straight-freeze-versions thaw: ${EMACS} -f straight-thaw-versions .PHONY: all test docs unit ================================================ FILE: README.md ================================================ # org-ml ![CI](https://github.com/ndwarshuis/org-ml/actions/workflows/test.yml/badge.svg) ![MELPA VERSION](https://melpa.org/packages/org-ml-badge.svg) A functional API for org-mode inspired by [@magnars](https://github.com/magnars)'s [dash.el](https://github.com/magnars/dash.el) and [s.el](https://github.com/magnars/s.el) libraries. # Installation Install from MELPA: ``` M-x package-install RET org-ml RET ``` Alternatively, clone this repository to somewhere in your load path: ``` git clone https://github.com/ndwarshuis/org-ml ~/somewhere/in/load/path ``` Then require in your emacs config: ``` (require 'org-ml) ``` ## Dependencies - emacs (28.2, 29.3, 30.1) - org-mode (9.7.9) - dash (2.17.0) - s (1.13.0) Explicit versions noted above have been tested. Other versions may work but are not currently supported. Notably, *only* org 9.7.x and above will work (9.6 and below will absolutely break). # Motivation Org-mode comes with a powerful, built-in parse-tree generator specified in `org-element.el`. The generated parse-tree is simply a heavily-nested list which can be easily manipulated using (mostly pure) functional code. This contrasts the majority of functions normally used to interface with org-mode files, which are imperative in nature (`org-insert-headine`, `outline-next-heading`, etc) as they depend on the mutable state of Emacs buffers. In general, functional code is ([arguably](https://en.wikipedia.org/wiki/Functional_programming#Comparison_to_imperative_programming)) more robust, readable, and testable, especially in use-cases such as this where a stateless abstract data structure is being transformed and queried. The `org-element.el` provides a minimal API for handling this parse-tree in a functional manner, but does not provide higher-level functions necessary for intuitive, large-scale use. The `org-ml` package is designed to provide this API. Furthermore, it is highly compatible with the `dash.el` package, which is a generalized functional library for emacs-lisp. # Org-Element Overview Parsing a buffer with the function `org-element-parse-buffer` will yield a parse tree composed of nodes. Nodes have types and properties associated with them. See [the org-element API documentation](https://orgmode.org/worg/dev/org-element-api.html#attributes) for a list of all node types and their properties (also see the [terminology conventions](#terminology) and [property omissions](#properties) used in this package). Each node is represented by a list where the first member is the type and the second member is a plist describing the node's properties: ``` emacs-lisp (type (:prop1 value1 :prop2 value2 ...)) ``` Node types may be either leaves or branches, where branches may have zero or more child nodes and leaves may not have child nodes at all. Leaves will always have lists of the form shown above. Branches, on the other hand, have their children appended to the end: ``` emacs-lisp (type (:prop1 value1 :prop2 value2) child1 child2 ...) ``` In addition to leaves and branches, node types can belong to one of two classes: - Objects: roughly correspond to raw, possibly-formatted text - Elements: more complex structures which may be built from objects Within the branch node types, there are restrictions of which class is allowed to be a child depending on the type. There are three of these restrictions: - Branch element with child elements (aka 'greater elements'): these are element types that are generally nestable inside one another (eg headlines, plain-lists, items) - Branch elements with child objects (aka 'object containers'): these are element types that hold textual information (eg paragraph) - Branch objects with child objects (aka 'recursive objects'): these are object types used primarily for text formating (bold, italic, underline, etc) Note: it is never allowed for an element type to be a child of a branch object type. # Conventions ## Terminology - 'node' is a vertex in the parse tree, where 'element' and 'object' are two classes used to describe said vertex - 'child' and 'children' are used here instead of 'content' and 'contents' - 'branch' is a node that has or can have other nodes in it (`org-element` mostly uses 'container' to describe these) - 'leaf' is a node without other nodes in it (opposite of branch) ## Properties All properties specified by `org-element.el` are readable by this API (eg one can query them with functions like `org-ml-get-property`). The properties `:begin`, `:end`, `:contents-begin`, `:contents-end`, `:parent`, and `post-affiliated` are not settable by this API as they are not necessary for manipulating the textual representation of the parse tree. In addition to these, some properties unique to certain types are not settable for the same reason. Each type's build function (`org-ml-build-X`) describes the properties that are settable. See `org-ml-remove-parent` and `org-ml-remove-parents` for specific information and functions regarding the `:parent` property, why it can be annoying, and when you would want to remove it. ## Threading Each function that operates on an element/object will take the element/object as its right-most argument. This allows convenient function chaining using `dash.el`'s right-threading operators (`->>` and `-some->>`). The examples in the [API reference](docs/api-reference.md) almost exclusively demonstrate this pattern. Additionally, the right-argument convention also allows convenient partial application using `-partial` from `dash.el`. ## Higher-order functions Higher-order functions (functions that take other functions as arguments) have two forms. The first takes a (usually unary) function and applies it: ``` emacs-lisp (org-ml-map-property :value (lambda (s) (concat "foo" s)) node) (org-ml-map-property :value (-partial concat "foo") node) ``` This can equivalently be written using an anaphoric form where the original function name is appended with `*`. The symbol `it` carries the value of the unary argument (unless otherwise specified): ``` emacs-lisp (org-ml-map-property* :value (concat "foo" it) node) ``` ## Side effect functions All functions that read and write from buffers are named like `org-ml-OPERATION-THING-at` where `OPERATION` is some operation to be performed on `THING` in the current buffer. All these functions take `point` as one of their arguments to denote where in the buffer to perform `OPERATION`. All of these functions have current-point convenience analogues that are named as `org-ml-OPERATION-this-THING` where `OPERATION` and `THING` carry the same meaning, but `OPERATION` is done at the current point and `point` is not an argument to the function. For the sake of brevity, only the former form of these functions are given in the [API reference](docs/api-reference.md). # Usage For comprehensive documentation of all available functions see the [API reference](docs/api-reference.md). ## Habits Since org 9.7, habits are stored in `:repeater-deadline-unit` and `:repeater-deadline-value` of `timestamp` nodes. "Deadline" refers to the last bit in the repeater of a timestamp (ie the "3d" in "[2019-01-01 Tue 12:00 +1d/3d]"). See `org-ml-timestamp-get/set/map-deadline` to access and manipulate these. # Performance Benchmarking this library is still in the early stages. Intuitively, the most costly operations are going to be those that go back-and-forth between raw buffer text (here called "buffer space") and its node representations (here called "node space") since those involve complicated string formating, regular expressions, buffer searching, etc (examples: `org-ml-parse-this-THING`, `org-ml-update-this-THING` and friends). Once the data is in node space, execution should be very fast since nodes are just lists. Thus if you have performance-intensive code that requires many small edits to org-mode files, it might be better to use org-mode's built-in functions. On the other hand, if most of the complicated processing can be done in node space while limiting the number of conversions to/from buffer space, `org-ml` will be much faster. To be more scientific, the current tests in the suite (see [here](bench/org-ml-benchmarks.el)) seem to support the following conclusions when comparing `org-ml` to equivalent code written using built-in org-mode functions (in line with the intuitions above): * reading data (a one way conversion from buffer to node space) is up to an order of magnitude slower, specifically when the data to be obtained isn't very large (eg, reading the TODO state from a headline) * text manipulations can be update to 10x slower *or faster* depending on what they are: * large edits like headline level changing are slower in `org-ml` * updating headline todo and tags are faster in `org-ml` * complex operations that involve lots of different functions tend to be faster in `org-ml` (since there are more list operations vs buffer edits) * changing the contents of headlines can be as fast or faster in `org-ml`, especially when using memoization and `org-ml-update-supercontents` (see below). To run the benchmark suite: ``` sh make benchmark ``` ## Deferred Properties ### Overview Starting with org 9.7, `org-element`'s abstract syntax tree uses lazy evaluation for several text-heavy operations. Thus the tree that `org-ml` consumes may have unevaluated (aka "deferred") properties in it. For the most part, this will not affect user experience, but understanding this will help in optimizing performance, as preventing lazy properties from being unnecessarily resolved will lead to significant performance gains. As of version 9.7.9, the properties which are deferred are: * most properties in headlines (all except for :pre-blank and the properties in `org-element--standard-properties`) * the :value property for code and verbatim nodes Since most of the deferred properties are in headlines, and because headlines are so prevalent, the remainder of this discussion will focus on headlines. Accessing any deferred property in a headline will trigger that property to be resolved, which is slow (as of 9.7.9 this often results in multiple properties being resolved at once due to the interconnected nature of how a headilne is parsed). In `org-ml` this means using `org-ml-get-property` or similar, as well as `org-ml-to-string` which necessarily needs to read all properties to create a string. Setting a property will resolve all properties, since (as noted above) many deferred headline properties depend on others. ### Optimizations in org-ml With regard to buffer editing (ie `org-ml-update-X` functions) this also means that any operation that does *not* edit the headline itself can be much faster under this new lazy paradigm. Examples of this include updating CLOSED or SCHEDULED timestamps, editing the logbook, adding properties like Effort, or adding other contents between these and the next headline. Unlike previous versions of `org-ml` and `org` manipulating these would have involved parsing the headline, parsing the stuff inside the headline, editing the stuff inside the headline, then writing out a new headline. In 9.7, we can bypass most of the headline parsing in this situation. The functions to do this are `org-ml-update-supercontents` and `org-ml-update-supersection`. Both are only meant to edit the section underneath the headlines in the buffer, and will not touch the headline itself. This takes advantage of the new lazy evaluation system. These functions create an abstraction over the contents of the headline that can be manipulated in a sane way (see their docstrings for details). There is one important caveat; if one changes the whitespace immediately after the headline, this likely will change the :pre-blank property of the headline which will require the headline to be rewritten (and resolved) which negates this performance benefit. However, these functions are smart enough to figure out when :pre-blank is changed. ### Other Considerations Because lazy evaluation defers parsing the buffer, this assumes that the buffer will not be edited in between the time the org-element syntax tree is created and accessing any deferred properties. By extension it assumes the buffer is not entirely destroyed (which is probably when dealing with temp buffers). If one expects that the buffer will not retain state prior to accessing deferred properties, use `org-element-properties-resolve` (which will resolve deferred properties in place) or either `org-element-copy` or `org-ml-copy` which will resolve deferred properties and copy the entire node (see more below). ## Node Copying To maintain functional purity, all public-facing functions in `org-ml` that modify nodes should return a copy. This way, modifications to the returned node will not "go backward" to the original input node. However, making copies can be slow. It also might be unnecessary within a pipeline (usually with the threading macros `->` and `->>` from `dash.el`) since the intermediate values are not bound to any variable, which leaves no opportunity for accidental side-effect leakage. To solve this use-case, `org-ml` has the following specialized threading macros: - `org-ml->` - `org-ml->>` - `org-ml-->` - `org-ml-some->` - `org-ml-some->>` - `org-ml-some-->` These correspond to the sans-`org-ml` macros from `dash.el` The `org-ml` versions will set `org-ml-use-impure` to t, which will turn off all copying within the pipeline. (see `org-ml-copy` which is a thin wrapper around `org-element-copy` with this switch built-in). Note that the performance benefits of this are significant but modest (5-10% depending on the complexity of the operation), and this comes with a significant cost of reduced safety since it breaks the functional paradigm. Weight this accordingly. ## Memoization ### Build Functions Node building (functions like `org-ml-build-*`) is a pure operation (ie the result only depends on the inputs). Furthermore, it is used in many places, including internally to `org-ml` itself. Therefore, memoizing these functions can produce significant performance gains. To turn this on globally, set `org-ml-memoize-builders` to `t`. This will memoize all leaf node builders by default (as it is assumed that any branch nodes will be sufficiently complicated that most will be unique and therefore miss the cache). For more fine-grained control over which nodes are memoized, see `org-ml-memoize-builder-types`. #### Shorthand Builders There is an analogous optimization for 'shorthand' builders (functions like `org-ml-build-*`) which use simplified inputs. These are controled by `org-ml-memoize-shorthand-builders` and `org-ml-memoize-shorthand-builder-types`. These will by default memoize all shorthand builders except those for item and headline, for similar reasons to above. ### Match Patterns For all pattern-matching functions (eg `org-ml-match` and `org-ml-match-X`), the `PATTERN` parameter is processed into a lambda function which computationally carries out the pattern matching. If there are many calls using the same or a few unique patterns, this lambda-generation overhead may be memoized by setting `org-ml-memoize-match-patterns`. See this varible's documentation for details. ## Other potential optimizations These are some ideas that may be implemented later depending on how much they matter. ### Tree-based Diff Algorithm It makes sense to only update the parts of a buffer that actually change. However, this is complicated to do in practice. Current versions of `org-ml` can use the Myers Diff Algorithm (the thing that powers the `diff` program) to only edit the buffer contents that change (see `org~ml-update`). This can have some speedup since buffer editing is somewhat expensive. The obvious tradeoff is the algorithm itself needs to be performed prior to the edit, and its complexity is quadratic. The problem with this algorithm is that it only works on strings, thus the org-element tree needs to be interpreted for this to be used. Not only is this inherently expensive, it also negates any of the defferred property enhancements that come with 9.7. The (potential) solution is to implement a tree-based version of the Myers Diff algorithm that works directly on the org-element tree. The result would be a list of nodes to be inserted/deleted at a given position. This would potentially have a huge benefit for deeply-nested edits, which often happen in property drawers, logbooks, clocking entries, lists, etc. ### Lazy Evaluation for Supercontents Functions The functions `org-ml-get/set/map-supercontents` (and related) all operate on a complicated abstraction over a headline's section nodes. While this makes many operations easy and convenient, it has the drawback of converting the entire section even if only a small part needs to be changed. Making some parts of this data structure lazy could make this faster. This most obviously matters for cases where one wants to edit the planning or property nodes of a headline which also has a massive logbook or a lot of clocks. Currently the entire logbook, clocks, etc, will be processed, despite a tiny unrelated node actually being updated. # Development For most stable results, make sure you have a working conda or mamba installation. Conda is not strictly needed, but reproducible testing results are not guaranteed. Begin by creating a testing environment using the provided env* files (with the desired version): ``` mamba env create -f env-XX.Y.yml conda activate org-ml-XX.Y ``` Install all dependencies: ``` make install ``` Run all tests: ``` make unit ``` Run all tests with compilation: ``` make compile ``` To update a dependency, navidate to the `.emacs/XX.Y/straight/repos/` directory (after installation) and run `git reset --hard ` (after fetch if needed) to pull the desired git state. Then run: ``` make freeze ``` Which will update `.emacs/XX.Y/straight/versions/default.el` If any of the above make commands fail with: `undefined symbol: malloc_set_state` or similar, try the following: ``` export LD_PRELOAD=/usr/lib/libc_malloc_debug.so ``` # Version History See [changelog](CHANGELOG.md). # Acknowledgments - Ihor Radchenko: author or `org-element-ast.el` - Nicolas Goaziou: author of `org-element.el` - [@magnars](https://github.com/magnars): [dash.el](https://github.com/magnars/dash.el) and [s.el](https://github.com/magnars/s.el) ================================================ FILE: bench/org-ml-bench-fw.el ================================================ ;;; org-ml-bench-fw.el --- Benchmark framework for org-ml -*- lexical-binding: t; -*- ;; Copyright (C) 2020 Free Software Foundation, Inc. ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; This framework provides a macro `org-ml-defbench' which is used to define ;; the default benchmarks as part of this library, and can also be used by end ;; users to define their own benchmarks. ;;; Code: (require 's) (require 'dash) (require 'org-ml) (defvar org-ml-benchmarks '() "All defined benchmarks in the org-ml benchmark suite.") (defun org-ml-bench-get-sys-info () (let ((cpumodel (if (eq system-type 'gnu/linux) (->> (shell-command-to-string "lscpu | grep 'Model name:'") (s-chop-prefix "Model name:") (s-trim)) "unknown")) (memtotal (if (eq system-type 'gnu/linux) (->> (shell-command-to-string "grep MemTotal /proc/meminfo") (s-chop-prefix "MemTotal:") (s-trim)) "unknown")) (org-ver (org-version)) (emacs-ver (s-replace "\n" "" (emacs-version)))) (s-join "\n" (list (format "CPU: %s" cpumodel) (format "Total Memory: %s" memtotal) (format "Org Version: %s" org-ver) (format "Emacs Version: %s" emacs-ver))))) (defmacro org-ml-bench-time-call (&rest body) `(let ((start-time (float-time))) ,@body (- (float-time) start-time))) (defmacro org-ml-bench-with-org-file (repeated-pattern n &rest body) (declare (indent 2)) `(let ((inhibit-message t)) (with-temp-buffer (org-mode) (insert (s-repeat ,n ,repeated-pattern)) (goto-char (point-min)) (garbage-collect) (let ((time (org-ml-bench-time-call ,@body)) (res (buffer-string))) (list res time))))) (defun org-ml-bench-compare (repeated-pattern n form1 form2) (declare (indent 2)) `(-let (((res1 time1) (org-ml-bench-with-org-file ,repeated-pattern ,n ,form1)) ((res2 time2) (org-ml-bench-with-org-file ,repeated-pattern ,n ,form2))) (unless (equal res1 res2) (print "WARNING: forms produced different buffer strings") (print (cadr (s-lines res1))) (print (cadr (s-lines res2)))) (list time1 time2))) (defun org-ml-bench-format-result-row (title n time1 time2) (format "| %-40s | %6s | %10.5f | %10.5f | %10.2f |" title n time1 time2 (/ time2 time1))) (defmacro org-ml-defbench (title n pattern form1 form2) "Define a benchmark. TITLE is a short string that will be used to identify the benchmark (uniqueness isn't enforced but makes sense). FORM1 and FORM2 are the two forms to be compared; by convention the first is a function composed of built-in org commands and the second is one composed of org-ml commands. FORM1 and FORM2 will be applied to a buffer with PATTERN repeated N times. Note the both forms will only be called once and thus must contain the code for iterating across PATTERN as desired. Calling `org-ml-bench-run' will execute all benchmarks in the order they are defined with this macro." (declare (indent 2)) (let ((p (format "%s\n" (if (listp pattern) (s-join "\n" (eval pattern)) pattern)))) `(add-to-list 'org-ml-benchmarks (lambda () (print (format "Starting benchmark: %s" ,title)) (-let (((time1 time2) ,(org-ml-bench-compare p n form1 form2))) (org-ml-bench-format-result-row ,title ,n time1 time2)))))) (defun org-ml-bench-run () "Run and print all defined benchmarks." (let ((test-rows (--map (funcall it) (reverse org-ml-benchmarks)))) (print (s-join "\n" (append (list "" (org-ml-bench-get-sys-info) "" (format "| %-40s | %6s | %10s | %10s | %10s |" "Test name" "N" "Native" "org-ml" "X Increase")) test-rows (list "")))))) (provide 'org-ml-bench-fw) ;;; org-ml-bench-fw.el ends here ================================================ FILE: bench/org-ml-benchmarks.el ================================================ ;;; org-ml-benchmarks.el --- Benchmarks for org-ml -*- lexical-binding: t; -*- ;; Copyright (C) 2020 Free Software Foundation, Inc. ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;;; Code: (require 'org-ml-bench-fw) (org-ml-defbench "read TODO" 10000 "* TODO headline" (let ((next t)) (while next (org-get-todo-state) (setq next (outline-next-heading)))) (->> (org-ml-parse-headlines 'all) (--map (org-ml-get-property :todo-keyword it)))) (org-ml-defbench "read SCHEDULED epoch time" 2500 (list "* TODO headline" "SCHEDULED: <2020-01-01 Tue>") (let ((next t)) (while next (org-2ft (org-entry-get (point) "SCHEDULED")) (setq next (outline-next-heading)))) (--each (org-ml-parse-headlines 'all) (->> (plist-get (org-ml-headline-get-planning it) :scheduled) (org-ml-timelist-to-unixtime)))) (org-ml-defbench "TODO -> DONE" 1000 "* TODO headline" (let ((org-log-done 'time) (org-todo-keywords '((sequence "TODO" "|" "DONE"))) (org-adapt-indentation nil) (next t)) (while next (org-todo 'done) (setq next (outline-next-heading)))) (let ((planning `(:closed ,(org-ml-unixtime-to-timelist t (float-time))))) (org-ml-wrap-impure (org-ml-update-headlines* 'all (->> (org-ml-set-property :todo-keyword "DONE" it) (org-ml-headline-set-planning planning)))))) (org-ml-defbench "demote headlines" 2500 "* headline" (let ((org-adapt-indentation nil) (next t)) (while next (org-do-demote) (setq next (outline-next-heading)))) (org-ml-wrap-impure (org-ml-update-headlines* 'all (org-ml-shift-property :level 1 it)))) (org-ml-defbench "demote subtrees" 2500 (list "* headline" "** subheadline") (let ((org-adapt-indentation nil) (next t)) (while next (org-demote) (setq next (outline-next-heading)))) (org-ml-wrap-impure (org-ml-update-subtrees* 'all (org-ml--headline-subtree-shift-level 1 it)))) (org-ml-defbench "tag headline" 1000 "* headline" (let ((next t)) (while next (org-set-tags '("A" "B" "C")) (setq next (outline-next-heading)))) (org-ml-wrap-impure (org-ml-update-headlines* 'all (org-ml-set-property :tags '("A" "B" "C") it)))) ;; TODO a better test for this would be to put a logbook underneath the ;; planning ts since in that case we need to also parse the logbook (org-ml-defbench "schedule headline" 1000 (list "* headline") ;; ":LOGGING:" ;; "- Note taken on [2024-08-07 Wed 20:07] \\" ;; "thingy" ;; ":END:") (let ((org-adapt-indentation nil) (next t)) (while next (org-schedule nil "2000-01-01") (setq next (outline-next-heading)))) (let ((pl '(:scheduled (2000 1 1)))) (org-ml-wrap-impure (org-ml-update-supercontents* nil 'all (org-ml-supercontents-set-planning pl it))))) (org-ml-defbench "schedule headline (memoized)" 1000 (list "* headline") ;; ":LOGGING:" ;; "- Note taken on [2024-08-07 Wed 20:07] \\" ;; "thingy" ;; ":END:") (let ((org-adapt-indentation nil) (next t)) (while next (org-schedule nil "2000-01-01") (setq next (outline-next-heading)))) (let ((pl '(:scheduled (2000 1 1)))) (let ((org-ml-memoize-shorthand-builders t)) (org-ml-wrap-impure (org-ml-update-supercontents* nil 'all (org-ml-supercontents-set-planning pl it)))))) (org-ml-defbench "reschedule headline" 1000 (list "* headline" "SCHEDULED: <2020-01-01 Wed>") (let ((org-adapt-indentation nil) (next t)) (while next (->> (org-get-scheduled-time (point)) (float-time) ;; shift up one day (+ (* 24 60 60)) (format-time-string "%Y-%m-%d") (org-schedule nil)) (setq next (outline-next-heading)))) (org-ml-wrap-impure (org-ml-update-supercontents* nil 'all (org-ml-supercontents-set-planning (list :scheduled (org-ml-timelist-shift 1 'day (plist-get (org-ml-supercontents-get-planning it) :scheduled))) it)))) (org-ml-defbench "reschedule headline (memoized)" 1000 (list "* headline" "SCHEDULED: <2020-01-01 Wed>") (let ((org-adapt-indentation nil) (next t)) (while next (->> (org-get-scheduled-time (point)) (float-time) ;; shift up one day (+ (* 24 60 60)) (format-time-string "%Y-%m-%d") (org-schedule nil)) (setq next (outline-next-heading)))) (org-ml-wrap-impure (let ((org-ml-memoize-shorthand-builders t)) (org-ml-update-supercontents* nil 'all (org-ml-supercontents-set-planning (list :scheduled (org-ml-timelist-shift 1 'day (plist-get (org-ml-supercontents-get-planning it) :scheduled))) it))))) (org-ml-defbench "set headline effort" 1000 "* headline" (let ((org-adapt-indentation nil) (next t)) (while next (org-set-property "Effort" "0:05") (setq next (outline-next-heading)))) (org-ml-wrap-impure (org-ml-update-supercontents* nil 'all (org-ml-supercontents-set-node-properties '(("Effort" "0:05")) it)))) (org-ml-defbench "set headline effort (memoized)" 1000 "* headline" (let ((org-adapt-indentation nil) (next t)) (while next (org-set-property "Effort" "0:05") (setq next (outline-next-heading)))) (org-ml-wrap-impure (let ((org-ml-memoize-shorthand-builders t)) (org-ml-update-supercontents* nil 'all (org-ml-supercontents-set-node-properties '(("Effort" "0:05")) it))))) (org-ml-defbench "insert headline text" 2500 "* headline" (let ((org-adapt-indentation nil) (next t)) (while next (save-excursion (org-end-of-subtree) (insert "\n~some text~")) (setq next (outline-next-heading)))) (org-ml-wrap-impure (org-ml-update-supercontents* nil 'all (-> (org-ml-build-paragraph! "~some text~") (list) (org-ml-supercontents-set-contents it))))) (org-ml-defbench "insert headline text (memoized)" 2500 "* headline" (let ((org-adapt-indentation nil) (next t)) (while next (save-excursion (org-end-of-subtree) (insert "\n~some text~")) (setq next (outline-next-heading)))) (org-ml-wrap-impure (let ((org-ml-memoize-shorthand-builders t)) (org-ml-update-supercontents* nil 'all (-> (org-ml-build-paragraph! "~some text~") (list) (org-ml-supercontents-set-contents it)))))) (org-ml-defbench "set checkboxes" 1000 (list "* headline [0/0]" "- [ ] one" "- [ ] two") (let ((org-adapt-indentation nil) (next t)) (while next (org-toggle-checkbox) (setq next (outline-next-heading)))) (let ((org-ml-memoize-match-patterns 'compiled)) (org-ml-update-headlines* 'all (org-ml->> (org-ml-match-map '(section plain-list item) #'org-ml-item-toggle-checkbox it) (org-ml-headline-update-item-statistics))))) (org-ml-defbench "set headline effort/TODO/scheduled" 1000 "* headline" (let ((org-log-done 'time) (org-todo-keywords '((sequence "TODO" "|" "DONE"))) (org-adapt-indentation nil) (next t)) (while next (org-schedule nil "2000-01-01") (org-set-property "Effort" "0:05") (org-todo 'todo) (setq next (outline-next-heading)))) (let ((pl '(:scheduled (2000 1 1)))) (let ((org-ml-memoize-shorthand-builders t)) (org-ml-update-headlines* 'all (org-ml->> (org-ml-set-property :todo-keyword "TODO" it) (org-ml-headline-set-node-property "Effort" "0:05") (org-ml-headline-set-planning pl)))))) (provide 'org-ml-benchmarks) ;;; org-ml-benchmarks.el ends here ================================================ FILE: dev/org-ml-cookbook.el ================================================ ;;; org-ml-cookbook.el --- Common patterns for org.el's -*- lexical-binding: t -*- ;; Copyright (C) 2015 Free Software Foundation, Inc. ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;;; Code: (require 's) (require 'dash) (require 'org-ml) (defrecipe "Adding created time" "This will add a property called CREATED with a timestamp (which could be modified to hold the current time).." ("* headine") (let ((ts (org-ml-to-string (org-ml-build-timestamp! '(2020 1 1 0 0))))) (->> (org-ml-parse-this-headline) (org-ml-headline-set-node-property "CREATED" ts) (org-ml-to-string))) => (:result "* headline" ":PROPERTIES:" ":CREATED: [2020-01-01 Wed 00:00]" ":END:")) (provide 'org-ml-cookbook) ;;; org-ml-cookbook.el ends here ================================================ FILE: dev/org-ml-docs.el ================================================ ;;; org-ml-docs.el --- Extract org-ml's docs -*- lexical-binding: t; -*- ;; Copyright (C) 2015 Free Software Foundation, Inc. ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;;; Code: (require 's) (require 'dash) (require 'help-fns) (require 'package) (setq text-quoting-style 'grave) (defvar org-ml-dev-examples-list '()) (defvar org-ml-dev-recipe-list '()) (defconst org-ml-elem--fill-column 80) (defun org-ml-get-package-version () "Get version of om package." (with-current-buffer (find-file-noselect "org-ml.el") (mapconcat 'number-to-string (package-desc-version (package-buffer-info)) version-separator))) (defun format-multiline (s &optional ident) (let ((ident (or ident 2))) (cl-labels ((go (x i) (let ((test (format "%S" x))) (if (< (+ (length test) i) 80) test (if (not (consp x)) test (-let* (((fun . rest) x) (sfun (format "%S" fun)) (ws (concat "\n" (s-repeat i " "))) (srest (--map (go it (+ i ident)) rest))) (if (null srest) test (-let (((r . rs) srest)) (if (< (+ (length sfun) (length r) 2) 80) (format "(%S %s)" fun (s-join ws srest)) (format "(%s)" (s-join ws `(,sfun ,r ,@rs)))))))))))) (go s ident)))) (defun format-actual (actual) (format-multiline actual)) (defun format-expected (sym expected) (let* ((s (s-lines (format "%S" expected))) (header (format " ;; %S %s" sym (car s))) (rest (--map (if (stringp expected) (s-prepend " ; " it) (s-prepend " ; " it)) (-drop 1 s)))) (s-join "\n" (cons header rest)))) (defun example-to-string (example) (-let* (((actual sym expected) example) (expected (if (eq (and (listp expected) (car expected)) :result) (s-join "\n" (cdr expected)) expected)) (actual (format-actual actual)) (comment (cond ((eq sym '=>) (format-expected sym expected)) ;; ((eq sym '~>) (format-expected sym expected)) ((eq sym '$>) (concat " ;; Output these buffer contents\n" (format-expected sym expected))) ((eq sym '!!>) (format "Error")) (t (error "Invalid test case: %s" `(,actual ,sym ,expected)))))) (--> comment (format "%s\n%s\n" actual it) (replace-regexp-in-string "\\\\\\?" "?" it) ;; (replace-regexp-in-string "\n" "\\n" it t t) ;; (replace-regexp-in-string "\t" "\\t" it t t) (replace-regexp-in-string "\r" "\\r" it t t)))) ;; (format "```el\n%s\n```\n" it)))) (defun docs--signature (function) "Given FUNCTION (a symbol), return its argument list. FUNCTION may reference an elisp function, alias, macro or a subr." (let* ((function-value (indirect-function function)) (is-alias (not (eq function-value (symbol-function function)))) ;; if FUNCTION isn't an alias, function-symbol is simply FUNCTION (function-symbol function)) (when is-alias ;; find the last symbol in the alias chain (while (symbolp (symbol-function function-symbol)) (setq function-symbol (symbol-function function-symbol)))) (or (-some->> (help-split-fundoc (documentation function-value) function-symbol) (car) (downcase) (read) (cdr)) (help-function-arglist function-symbol)))) ;; (if (subrp function-value) ;; ;; read the docstring to find the signature for subrs ;; (let* ((docstring-args (car (help-split-fundoc ;; (documentation function-value) ;; function-symbol))) ;; (fun-with-args (read (downcase docstring-args)))) ;; (cdr fun-with-args)) ;; ;; otherwise get the signature directly ;; (help-function-arglist function-symbol)))) (defun format-doc (cmd) ;; remove extra signature for cl-defun org-ml-dev-examples-list ;; TODO this is hacky but it works (let ((doc (documentation cmd))) (unless doc (error "No docstring set for %s" cmd)) (if (not (s-matches? "(fn .*)" doc)) doc (->> (s-lines doc) (-drop-last 2) (s-join "\n"))))) (defun filter-hidden (args) (->> (--split-when (eq it :end-hidden) args) (--mapcat (--take-while (not (eq it :begin-hidden)) it)))) (defmacro defexamples (cmd &rest examples) `(add-to-list 'org-ml-dev-examples-list (list ',cmd (docs--signature ',cmd) (format-doc ',cmd) (->> ',examples (filter-hidden) (-partition 3) (-map 'example-to-string))))) (defun format-buffer-contents (list) (->> (--map (format "; %s" it) list) (s-join "\n") (format ";; Given the following contents:\n%s\n"))) (defmacro defexamples-content (cmd docstring &rest args) `(cl-flet ((formatted-string? (list) (memq (and (listp list) (car list)) '(:buffer :comment))) (format-content (list) (->> (car list) (-drop 1) (format-buffer-contents))) ;; (--map (format "; %s" it)) ;; (s-join "\n") ;; (format ";; Given the following contents:\n%s\n"))) (format-comment (list) (let ((comment (->> (car list) (-drop 1) (s-join " ") (format ";; %s")))) (with-temp-buffer (emacs-lisp-mode) (insert comment) (let ((fill-column org-ml-elem--fill-column)) (fill-paragraph)) (buffer-string))))) (let* ((doc (or ,docstring (format-doc ',cmd))) (example (->> (filter-hidden ',args) (-partition-by #'formatted-string?) (--map (cond ((eq :comment (car (car it))) (format-comment it)) ((eq :buffer (car (car it))) (format-content it)) (t (-some->> (-partition 3 it) (-map #'example-to-string) (s-join "\n")))))))) (add-to-list 'org-ml-dev-examples-list (list ',cmd (docs--signature ',cmd) doc (or example '("no examples :("))))))) (defmacro defrecipe (header description contents form operator result) `(let ((example (example-to-string (list ',form ',operator ',result))) (contents* (format-buffer-contents ',contents))) (add-to-list 'org-ml-dev-recipe-list (format "## %s\n\n%s\n\n```el\n%s\n%s```\n" ,header ,description contents* example)))) (defmacro def-example-subgroup (group desc &rest examples) `(progn ;; (add-to-list 'org-ml-dev-examples-list ,(concat "### " group)) (setq org-ml-dev-examples-list (cons ,(concat "### " group) org-ml-dev-examples-list)) (when ,desc ;; (add-to-list 'org-ml-dev-examples-list ,desc)) (setq org-ml-dev-examples-list (cons ,desc org-ml-dev-examples-list))) ,@examples)) (defmacro def-example-group (group desc &rest examples) `(progn ;; (add-to-list 'org-ml-dev-examples-list ,(concat "## " group)) (setq org-ml-dev-examples-list (cons ,(concat "## " group) org-ml-dev-examples-list)) (when ,desc ;; (add-to-list 'org-ml-dev-examples-list ,desc)) (setq org-ml-dev-examples-list (cons ,desc org-ml-dev-examples-list))) ,@examples)) (defun format-link (string-name) (-let* ((name (intern string-name)) ((_ signature _ _) (assoc name org-ml-dev-examples-list))) (if signature (format "[`%s`](#%s)" name (github-id name signature)) (format "`%s`" name)))) (defun format-docstring-forms (docstring) (cl-labels ((find-matching-right (p) ;; return point of matching ")" or nil if not found (ignore-errors (save-excursion (goto-char p) (forward-sexp) (1- (point))))) (has-leading-function? (string) (->> (s-replace-regexp "(+" "" string) (s-split " ") (car) (intern) (fboundp))) (has-all-cap-syms? (string) (->> (s-replace-regexp "[().,]" "" string) (s-replace "[" "") (s-replace "]" "") (s-split " ") (--remove (equal it "")) (--all? (or (member it '("t" "nil" "|" "*" "?")) (s-matches? "^[A-Z0-9\\-]+$" it) (s-matches? "^\\(:\\|&\\)[a-z0-9-]+$" it))))) (is-form? (string) (or ;; (has-leading-function? string) (has-all-cap-syms? string)))) (let (case-fold-search) (with-temp-buffer (insert docstring) (goto-char (point-min)) (while (and (< (point) (point-max)) (search-forward "(" nil t)) (-when-let (e (find-matching-right (1- (point)))) (when (is-form? (buffer-substring (point) e)) (downcase-region (point) e) (goto-char (1- (point))) (insert "`") (goto-char (+ 2 e)) (insert "`"))) (unless (= (point) (point-max)) (forward-char))) (buffer-string))))) (defun format-docstring-args (signature docstring) (let ((sig-args (->> signature (--remove (memq it '(&optional &key &rest))) (--map (if (consp it) (car it) it)) (-map #'symbol-name)))) (cl-flet ((quote-and-downcase (string) ;; hack to work around % not being part of word boundaries (let ((s (s-chop-suffix "%" (downcase string)))) (if (member s sig-args) (format "**`%s`**" s) (format "`%s`" s))))) (replace-regexp-in-string "\\b\\(?3:[A-Z][A-Z-]*[0-9*]*\\)\\(\\*\\|%\\|\\b\\)" ;; "[^A-Z0-9-]\\([A-Z0-9-]+\\)[^A-Z0-9-]" #'quote-and-downcase docstring t nil 3)))) (defun format-docstring-backquoted (docstring) (cl-flet ((unquote-and-link (string) (format-link (substring string 1 -1)))) (replace-regexp-in-string "`\\([^ \n]+\\)'" #'unquote-and-link docstring t))) (defun format-docstring-indent (docstring) (replace-regexp-in-string "^ " " " docstring)) (defun format-docstring-strings (docstring) (cl-flet ((quote-string (string) (format "`%s`" string))) (s-replace-regexp "\"[[:ascii:]]*?\"" #'quote-string docstring))) (defun format-docstring (signature docstring) (let (case-fold-search) (->> docstring (format-docstring-strings) (format-docstring-forms) (format-docstring-args signature) (format-docstring-backquoted) (format-docstring-indent)))) (defun function-to-md (function) (if (stringp function) (concat "\n" (s-replace "### " "### " function) "\n") (-let [(command-name signature docstring examples) function] (unless docstring (error "No docstring supplied for %s" command-name)) (format "#### %s `%S`\n\n%s\n\n```el\n%s\n```\n" ;; (format "### %s `%s`\n\n%s\n\n%s" command-name signature (format-docstring signature docstring) ;; (mapconcat 'identity (-take 3 examples) "\n"))))) (mapconcat 'identity examples "\n"))))) ;; (defun docs--chop-prefix (prefix s) ;; "Remove PREFIX if it is at the start of S." ;; (let ((pos (length prefix))) ;; (if (and (>= (length s) (length prefix)) ;; (string= prefix (substring s 0 pos))) ;; (substring s pos) ;; s))) ;; (defun docs--chop-suffix (suffix s) ;; "Remove SUFFIX if it is at end of S." ;; (let ((pos (- (length suffix)))) ;; (if (and (>= (length s) (length suffix)) ;; (string= suffix (substring s pos))) ;; (substring s 0 pos) ;; s))) (defun github-id (command-name signature) (->> (format "%S-%S" command-name signature) (s-downcase) (s-replace-regexp "[^a-zA-Z0-9- ]+" "") (s-replace " " "-"))) (defun s-replace (old new s) "Replace OLD with NEW in S." (replace-regexp-in-string (regexp-quote old) new s t t)) (defun function-summary (function) (if (stringp function) (concat "\n" function "\n") (let ((command-name (car function)) (signature (cadr function))) (format "* [%s](#%s) `%S`" command-name (github-id command-name signature) signature)))) (defun simplify-quotes () (goto-char (point-min)) (while (search-forward "(quote nil)" nil t) (replace-match "'()")) (goto-char (point-min)) (while (search-forward "(quote " nil t) (forward-char -7) (let ((p (point))) (forward-sexp 1) (delete-char -1) (goto-char p) (delete-char 7) (insert "'")))) (defun goto-and-remove (s) (goto-char (point-min)) (search-forward s) (delete-char (- (length s)))) (defun goto-and-replace-all (s replacement) (while (progn (goto-char (point-min)) (search-forward s nil t)) (delete-char (- (length s))) (insert replacement))) (defun create-cookbook () (with-temp-file "./docs/cookbook.md" (insert "# org-ml cookbook\n\n") (insert (concat "The following are a list of common use cases and formulations" "for `org-ml`. If a function is not available straight from the" "API it may be here.\n\n")) (insert (s-join "\n" org-ml-dev-recipe-list)))) (defun create-api-ref () (let ((org-ml-dev-examples-list (nreverse org-ml-dev-examples-list))) (with-temp-file "./docs/api-reference.md" (insert "# API Reference\n") (insert (mapconcat 'function-summary org-ml-dev-examples-list "\n")) (insert (mapconcat 'function-to-md org-ml-dev-examples-list "\n")) (insert (format "Version: %s" (org-ml-get-package-version))) (simplify-quotes)))) (defun create-docs-files () (create-cookbook) (create-api-ref)) ;; require the examples (require 'org-ml-examples) (require 'org-ml-cookbook) ;; tell user how many functions have no examples (defconst org-ml-dev-defined-names nil "Alist of all functions/macros defined in `org-ml.el'. The two cells in the alist are 'private' and 'public'.") (mapatoms (lambda (x) (when (and (fboundp x) (s-starts-with-p "org-ml-" (symbol-name x))) (push x org-ml-dev-defined-names)))) (setq org-ml-dev-defined-names (--group-by (if (s-starts-with-p "org-ml--" (symbol-name it)) 'private 'public) org-ml-dev-defined-names)) (let ((public-syms (alist-get 'public org-ml-dev-defined-names)) (example-syms (->> (-remove #'stringp org-ml-dev-examples-list) (-map #'car)))) (-some->> (-difference public-syms example-syms) (-map #'symbol-name) (--remove (s-ends-with? "*" it)) (--remove (s-starts-with? "org-ml-update-this-" it)) (--remove (s-starts-with? "org-ml-parse-this-" it)) (--map (format " %s" it)) (s-join "\n") (format "The following functions don't have examples:\n%s") (print))) (provide 'org-ml-docs) ;;; org-ml-docs.el ends here ================================================ FILE: dev/org-ml-examples.el ================================================ ;;; org-ml-examples.el --- Examples for org.el's API -*- lexical-binding: t -*- ;; Copyright (C) 2015 Free Software Foundation, Inc. ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;;; Code: (require 's) (require 'dash) (require 'org-ml) (def-example-group "String Conversion" "Convert nodes to strings." ;; these are more thoroughly tested in `org-ml-test-internal.el' (defexamples org-ml-to-string (org-ml-to-string '(bold (:begin 1 :end 5 :parent nil :post-blank 0 :post-affiliated nil) "text")) => "*text*" (org-ml-to-string '(bold (:begin 1 :end 5 :parent nil :post-blank 3 :post-affiliated nil) "text")) => "*text* " (org-ml-to-string nil) => "") (defexamples org-ml-to-trimmed-string (org-ml-to-trimmed-string '(bold (:begin 1 :end 5 :parent nil :post-blank 0 :post-affiliated nil) "text")) => "*text*" (org-ml-to-trimmed-string '(bold (:begin 1 :end 5 :parent nil :post-blank 3 :post-affiliated nil) "text")) => "*text*" (org-ml-to-trimmed-string nil) => "") (defexamples org-ml-from-string (->> (org-ml-from-string 'bold "*text*") (org-ml-get-type)) => 'bold (->> (org-ml-from-string 'bold "*text*") (org-ml-get-property :begin)) => 1 (->> (org-ml-from-string 'bold "*text*") (org-ml-get-property :end)) => 7 (->> (org-ml-from-string 'bold "*text*") (org-ml-get-property :post-blank)) => 0 (->> (org-ml-from-string 'bold "*text*") (org-ml-get-property :contents-begin)) => 2 (->> (org-ml-from-string 'bold "*text*") (org-ml-get-property :contents-end)) => 6 (org-ml-from-string 'italic "*text*") => nil)) (def-example-group "Buffer Parsing" "Parse buffers to trees." ;; these are more thoroughly tested in `org-ml-dev-test.el' (defexamples-content org-ml-parse-this-buffer nil (:buffer "text") (->> (org-ml-parse-this-buffer) (org-ml-get-property :begin)) => 1 (->> (org-ml-parse-this-buffer) (org-ml-get-property :end)) => 5) (defexamples-content org-ml-parse-object-at nil (:buffer "*text*") (->> (org-ml-parse-object-at 1) (car)) => 'bold (:buffer "[2019-01-01 Tue]") (->> (org-ml-parse-object-at 1) (car)) => 'timestamp (:buffer "- notme") (:comment "Return nil when parsing an element") (org-ml-parse-object-at 1) => nil) (defexamples-content org-ml-parse-element-at nil (:buffer "#+call: ktulu()") (->> (org-ml-parse-element-at 1) (car)) => 'babel-call (:buffer "- plain-list") (:comment "Give the plain-list, not the item for this function") (->> (org-ml-parse-element-at 1) (car)) => 'plain-list (:buffer "| R | A |" "| G | E |") (:comment "Return a table, not the table-row for this function") (->> (org-ml-parse-element-at 1) (car)) => 'table) (defexamples-content org-ml-parse-table-row-at nil (:buffer "| bow | stroke |" "|-----+--------|" "| wob | ekorts |") (:comment "Return the row itself") (->> (org-ml-parse-table-row-at 1) (car)) => 'table-row (->> (org-ml-parse-table-row-at 20) (car)) => 'table-row (->> (org-ml-parse-table-row-at 40) (car)) => 'table-row (:comment "Also return the row when not at beginning of line") (->> (org-ml-parse-table-row-at 5) (car)) => 'table-row (:buffer "- bow and arrow choke") (:comment "Return nil if not a table-row") (->> (org-ml-parse-table-row-at 1) (car)) => nil) (defexamples-content org-ml-parse-headline-at nil (:buffer "* headline") (:comment "Return the headline itself") (->> (org-ml-parse-headline-at 1) (org-ml-to-trimmed-string)) => "* headline" (:buffer "* headline" "section crap") (:comment "Return headline and section") (->> (org-ml-parse-headline-at 1) (org-ml-to-trimmed-string)) => (:result "* headline" "section crap") (:comment "Return headline when point is in the section") (->> (org-ml-parse-headline-at 12) (org-ml-to-trimmed-string)) => (:result "* headline" "section crap") (:buffer "* headline" "section crap" "** not parsed") (:comment "Don't parse any subheadlines") (->> (org-ml-parse-headline-at 1) (org-ml-to-trimmed-string)) => (:result "* headline" "section crap") (:buffer "nothing nowhere") (:comment "Return nil if not under a headline") (->> (org-ml-parse-headline-at 1) (org-ml-to-trimmed-string)) => "") (defexamples-content org-ml-parse-subtree-at nil (:buffer "* headline") (:comment "Return the headline itself") (->> (org-ml-parse-subtree-at 1) (org-ml-to-trimmed-string)) => "* headline" (:buffer "* headline" "section crap") (:comment "Return headline and section") (->> (org-ml-parse-subtree-at 1) (org-ml-to-trimmed-string)) => (:result "* headline" "section crap") (:comment "Return headline when point is in the section") (->> (org-ml-parse-subtree-at 12) (org-ml-to-trimmed-string)) => (:result "* headline" "section crap") (:buffer "* headline" "section crap" "** parsed") (:comment "Return all the subheadlines") (->> (org-ml-parse-subtree-at 1) (org-ml-to-trimmed-string)) => (:result "* headline" "section crap" "** parsed") (:buffer "nothing nowhere") (:comment "Return nil if not under a headline") (->> (org-ml-parse-subtree-at 1) (org-ml-to-trimmed-string)) => "") (defexamples-content org-ml-parse-item-at nil (:buffer "- item") (:comment "Return the item itself") (->> (org-ml-parse-item-at 1) (org-ml-to-trimmed-string)) => "- item" (:comment "Also return the item when not at beginning of line") (->> (org-ml-parse-item-at 5) (org-ml-to-trimmed-string)) => "- item" (:buffer "- item" " - item 2") (:comment "Return item and its subitems") (->> (org-ml-parse-item-at 1) (org-ml-to-trimmed-string)) => (:result "- item" " - item 2") (:buffer "* not item") (:comment "Return nil if not an item") (->> (org-ml-parse-item-at 1) (org-ml-to-trimmed-string)) => "") (defexamples-content org-ml-parse-section-at nil (:buffer "over headline" "* headline" "under headline") (:comment "Return the section above the headline") (->> (org-ml-parse-section-at 1) (org-ml-to-trimmed-string)) => "over headline" (:comment "Return the section under headline") (->> (org-ml-parse-section-at 25) (org-ml-to-trimmed-string)) => "under headline" (:buffer "* headline" "** subheadline") (:comment "Return nil if no section under headline") (->> (org-ml-parse-section-at 1) (org-ml-to-trimmed-string)) => "" (:buffer "") (:comment "Return nil if no section at all") (->> (org-ml-parse-section-at 1) (org-ml-to-trimmed-string)) => "") (defexamples-content org-ml-parse-this-toplevel-section nil (:buffer "over headline" "* headline" "under headline") (->> (org-ml-parse-this-toplevel-section) (org-ml-to-trimmed-string)) => "over headline" (:buffer "* headline" "under headline") (->> (org-ml-parse-this-toplevel-section) (org-ml-to-trimmed-string)) => "") (defexamples-content org-ml-this-buffer-has-headlines nil (:buffer "not headline" "* headline") (org-ml-this-buffer-has-headlines) => t (:buffer "not headline") (org-ml-this-buffer-has-headlines) => nil) (defexamples-content org-ml-parse-headlines nil (:buffer "not headline" "* one" "* two" "* three") (->> (org-ml-parse-headlines 'all) (-map #'org-ml-to-string) (s-join "")) => (:result "* one" "* two" "* three" "") (:buffer "not headline") (->> (org-ml-parse-headlines 'all) (-map #'org-ml-to-string) (s-join "")) => "" (:buffer "not headline" "* one" "** two" "*** three") (->> (org-ml-parse-headlines 'all) (-map #'org-ml-to-trimmed-string)) => '("* one\n** two\n*** three" "** two\n*** three" "*** three") (:buffer "not headline" "*ignore this*" "* one" "* two" "* three") (->> (org-ml-parse-headlines 0) (-map #'org-ml-to-string) (s-join "")) => "* one\n" (->> (org-ml-parse-headlines '(0 1)) (-map #'org-ml-to-string) (s-join "")) => (:result "* one" "* two\n") (->> (org-ml-parse-headlines [23 38]) (-map #'org-ml-to-string) (s-join "")) => (:result "* one" "* two\n")) (defexamples-content org-ml-parse-subtrees nil (:buffer "not headline" "* one" "** _one" "* two" "** _two" "* three" "** _three") (->> (org-ml-parse-subtrees 'all) (-map #'org-ml-to-string) (s-join "")) => (:result "* one" "** _one" "* two" "** _two" "* three" "** _three\n") (:buffer "not headline") (->> (org-ml-parse-subtrees 'all) (-map #'org-ml-to-string) (s-join "")) => "" (:buffer "not headline" "* one" "** _one" "* two" "** _two" "* three" "** _three") (->> (org-ml-parse-subtrees 0) (-map #'org-ml-to-string) (s-join "")) => (:result "* one" "** _one\n") (->> (org-ml-parse-subtrees '(0 1)) (-map #'org-ml-to-string) (s-join "")) => (:result "* one" "** _one" "* two" "** _two\n") (->> (org-ml-parse-subtrees [10 30]) (-map #'org-ml-to-string) (s-join "")) => (:result "* one" "** _one" "* two" "** _two\n"))) (def-example-group "Building" "Build new nodes." (def-example-subgroup "Leaf Object Nodes" nil (defexamples org-ml-build-code (->> (org-ml-build-code "text") (org-ml-to-string)) => "~text~") (defexamples org-ml-build-entity (->> (org-ml-build-entity "gamma") (org-ml-to-string)) => "\\gamma") (defexamples org-ml-build-export-snippet (->> (org-ml-build-export-snippet "back" "value") (org-ml-to-string)) => "@@back:value@@") (defexamples org-ml-build-inline-babel-call (->> (org-ml-build-inline-babel-call "name") (org-ml-to-string)) => "call_name()" (->> (org-ml-build-inline-babel-call "name" :arguments '("n=4")) (org-ml-to-string)) => "call_name(n=4)" (->> (org-ml-build-inline-babel-call "name" :inside-header '(:key val)) (org-ml-to-string)) => "call_name[:key val]()" (->> (org-ml-build-inline-babel-call "name" :end-header '(:key val)) (org-ml-to-string)) => "call_name()[:key val]") (defexamples org-ml-build-inline-src-block (->> (org-ml-build-inline-src-block "lang") (org-ml-to-string)) => "src_lang{}" (->> (org-ml-build-inline-src-block "lang" :value "value") (org-ml-to-string)) => "src_lang{value}" (->> (org-ml-build-inline-src-block "lang" :value "value" :parameters '(:key val)) (org-ml-to-string)) => "src_lang[:key val]{value}") (defexamples org-ml-build-line-break (->> (org-ml-build-line-break) (org-ml-to-string)) => "\\\\\n") (defexamples org-ml-build-latex-fragment (->> (org-ml-build-latex-fragment "$2+2=5$") (org-ml-to-string)) => "$2+2=5$") (defexamples org-ml-build-macro (->> (org-ml-build-macro "economics") (org-ml-to-string)) => "{{{economics}}}" (->> (org-ml-build-macro "economics" :args '("s=d")) (org-ml-to-string)) => "{{{economics(s=d)}}}") (defexamples org-ml-build-statistics-cookie (->> (org-ml-build-statistics-cookie '(nil)) (org-ml-to-string)) => "[%]" (->> (org-ml-build-statistics-cookie '(nil nil)) (org-ml-to-string)) => "[/]" (->> (org-ml-build-statistics-cookie '(50)) (org-ml-to-string)) => "[50%]" (->> (org-ml-build-statistics-cookie '(1 3)) (org-ml-to-string)) => "[1/3]") (defexamples org-ml-build-target (->> (org-ml-build-target "text") (org-ml-to-string)) => "<>") (defexamples org-ml-build-timestamp (->> (org-ml-build-timestamp 'inactive 2019 1 15 2019 1 15) (org-ml-to-string)) => "[2019-01-15 Tue]" (->> (org-ml-build-timestamp 'active-range 2019 1 15 2019 1 16) (org-ml-to-string)) => "<2019-01-15 Tue>--<2019-01-16 Wed>" (->> (org-ml-build-timestamp 'inactive 2019 1 15 2019 1 15 :warning-type 'all :warning-unit 'day :warning-value 1) (org-ml-to-string)) => "[2019-01-15 Tue -1d]") (defexamples org-ml-build-verbatim (->> (org-ml-build-verbatim "text") (org-ml-to-string)) => "=text=")) (def-example-subgroup "Branch Object Nodes" nil (defexamples org-ml-build-bold (->> (org-ml-build-bold "text") (org-ml-to-string)) => "*text*") (defexamples org-ml-build-footnote-reference (->> (org-ml-build-footnote-reference) (org-ml-to-string)) => "[fn:]" (->> (org-ml-build-footnote-reference :label "label") (org-ml-to-string)) => "[fn:label]" (->> (org-ml-build-footnote-reference :label "label" "content") (org-ml-to-string)) => "[fn:label:content]") (defexamples org-ml-build-italic (->> (org-ml-build-italic "text") (org-ml-to-string)) => "/text/") (defexamples org-ml-build-link (->> (org-ml-build-link "target") (org-ml-to-string)) => "[[target]]" (->> (org-ml-build-link "target" :type "file") (org-ml-to-string)) => "[[file:target]]" (->> (org-ml-build-link "target" "desc") (org-ml-to-string)) => "[[target][desc]]") (defexamples org-ml-build-radio-target (->> (org-ml-build-radio-target "text") (org-ml-to-string)) => "<<>>") (defexamples org-ml-build-strike-through (->> (org-ml-build-strike-through "text") (org-ml-to-string)) => "+text+") (defexamples org-ml-build-superscript (->> (org-ml-build-superscript "text") (org-ml-to-string)) => "^text") (defexamples org-ml-build-subscript (->> (org-ml-build-subscript "text") (org-ml-to-string)) => "_text") (defexamples org-ml-build-table-cell (->> (org-ml-build-table-cell "text") (org-ml-to-string)) => " text |") (defexamples org-ml-build-underline (->> (org-ml-build-underline "text") (org-ml-to-string)) => "_text_")) (def-example-subgroup "Leaf Element Nodes" nil (defexamples org-ml-build-babel-call (->> (org-ml-build-babel-call "name") (org-ml-to-trimmed-string)) => "#+call: name()" (->> (org-ml-build-babel-call "name" :arguments '("arg=x")) (org-ml-to-trimmed-string)) => "#+call: name(arg=x)" (->> (org-ml-build-babel-call "name" :inside-header '(:key val)) (org-ml-to-trimmed-string)) => "#+call: name[:key val]()" (->> (org-ml-build-babel-call "name" :end-header '(:key val)) (org-ml-to-trimmed-string)) => "#+call: name() :key val") (defexamples org-ml-build-clock (->> (org-ml-build-clock (org-ml-build-timestamp! '(2019 1 1 0 0))) (org-ml-to-trimmed-string)) => "CLOCK: [2019-01-01 Tue 00:00]" (->> (org-ml-build-timestamp! '(2019 1 1 0 0) :end '(2019 1 1 1 0)) ;; TODO this is sloppy but also kinda a bad example anyways since ;; the shortcut function exists (org-ml-set-property :type 'inactive-range) (org-ml-build-clock) (org-ml-to-trimmed-string)) => "CLOCK: [2019-01-01 Tue 00:00]--[2019-01-01 Tue 01:00] => 1:00") (defexamples org-ml-build-comment ;; TODO there is a bug that makes a blank string return a ;; blank string (it should return a "# ") (->> (org-ml-build-comment "text") (org-ml-to-trimmed-string)) => "# text" (->> (org-ml-build-comment "text\nless") (org-ml-to-trimmed-string)) => "# text\n# less") (defexamples org-ml-build-comment-block (->> (org-ml-build-comment-block) (org-ml-to-trimmed-string)) => (:result "#+begin_comment" "#+end_comment") (->> (org-ml-build-comment-block :value "text") (org-ml-to-trimmed-string)) => (:result "#+begin_comment" "text" "#+end_comment")) (defexamples org-ml-build-diary-sexp (->> (org-ml-build-diary-sexp) (org-ml-to-trimmed-string)) => "%%()" (->> (org-ml-build-diary-sexp :value '(text)) (org-ml-to-trimmed-string)) => "%%(text)") (defexamples org-ml-build-example-block (->> (org-ml-build-example-block) (org-ml-to-trimmed-string)) => (:result "#+begin_example" "#+end_example") (->> (org-ml-build-example-block :value "text") (org-ml-to-trimmed-string)) => (:result "#+begin_example" " text" "#+end_example") (->> (org-ml-build-example-block :value "text" :switches '("switches")) (org-ml-to-trimmed-string)) => (:result "#+begin_example switches" " text" "#+end_example")) (defexamples org-ml-build-export-block (->> (org-ml-build-export-block "type" "value\n") (org-ml-to-trimmed-string)) => (:result "#+begin_export type" "value" "#+end_export")) (defexamples org-ml-build-fixed-width (->> (org-ml-build-fixed-width "text") (org-ml-to-trimmed-string)) => ": text") (defexamples org-ml-build-horizontal-rule (->> (org-ml-build-horizontal-rule) (org-ml-to-trimmed-string)) => "-----") (defexamples org-ml-build-keyword (->> (org-ml-build-keyword "FILETAGS" "tmsu") (org-ml-to-trimmed-string)) => "#+filetags: tmsu") (defexamples org-ml-build-latex-environment (->> (org-ml-build-latex-environment '("env" "text")) (org-ml-to-trimmed-string)) => (:result "\\begin{env}" "text" "\\end{env}")) (defexamples org-ml-build-node-property (->> (org-ml-build-node-property "key" "val") (org-ml-to-trimmed-string)) => ":key: val") (defexamples org-ml-build-planning (->> (org-ml-build-planning :closed (org-ml-build-timestamp! '(2019 1 1) :active nil)) (org-ml-to-trimmed-string)) => "CLOSED: [2019-01-01 Tue]" (->> (org-ml-build-planning :scheduled (org-ml-build-timestamp! '(2019 1 1) :active t)) (org-ml-to-trimmed-string)) => "SCHEDULED: <2019-01-01 Tue>" (->> (org-ml-build-planning :deadline (org-ml-build-timestamp! '(2019 1 1) :active t)) (org-ml-to-trimmed-string)) => "DEADLINE: <2019-01-01 Tue>") (defexamples org-ml-build-src-block (->> (org-ml-build-src-block) (org-ml-to-trimmed-string)) => (:result "#+begin_src" "#+end_src") (->> (org-ml-build-src-block :value "body") (org-ml-to-trimmed-string)) => (:result "#+begin_src" " body" "#+end_src") (->> (org-ml-build-src-block :value "body" :language "emacs-lisp") (org-ml-to-trimmed-string)) => (:result "#+begin_src emacs-lisp" " body" "#+end_src") ;; TODO pretty sure this makes no sense... (->> (org-ml-build-src-block :value "body" :switches '("-n 20" "-r")) (org-ml-to-trimmed-string)) => (:result "#+begin_src -n 20 -r" " body" "#+end_src") ;; TODO and this... (->> (org-ml-build-src-block :value "body" :parameters '(:key val)) (org-ml-to-trimmed-string)) => (:result "#+begin_src :key val" " body" "#+end_src"))) (def-example-subgroup "Branch Element Nodes with Child Object Nodes" nil (defexamples org-ml-build-paragraph (->> (org-ml-build-paragraph "text") (org-ml-to-trimmed-string)) => "text") (defexamples org-ml-build-table-row (->> (org-ml-build-table-cell "a") (org-ml-build-table-row) (org-ml-to-trimmed-string)) => "| a |") ;; TODO should add a comment here to explain that newlines are necessary (defexamples org-ml-build-verse-block (->> (org-ml-build-verse-block "text\n") (org-ml-to-trimmed-string)) => (:result "#+begin_verse" "text" "#+end_verse"))) (def-example-subgroup "Branch Element Nodes with Child Element Nodes" nil (defexamples org-ml-build-org-data (->> (org-ml-build-headline :title '("dummy")) (org-ml-build-org-data) (org-ml-to-trimmed-string)) => "* dummy") (defexamples org-ml-build-center-block (->> (org-ml-build-center-block) (org-ml-to-trimmed-string)) => (:result "#+begin_center" "#+end_center") (->> (org-ml-build-paragraph "text") (org-ml-build-center-block) (org-ml-to-trimmed-string)) => (:result "#+begin_center" "text" "#+end_center")) (defexamples org-ml-build-drawer (->> (org-ml-build-drawer "NAME") (org-ml-to-trimmed-string)) => (:result ":NAME:" ":END:") (->> (org-ml-build-paragraph "text") (org-ml-build-drawer "NAME") (org-ml-to-trimmed-string)) => (:result ":NAME:" "text" ":END:")) (defexamples org-ml-build-dynamic-block (->> (org-ml-build-dynamic-block "empty") (org-ml-to-trimmed-string)) => (:result "#+begin: empty" "#+end:") (->> (org-ml-build-comment "I'm in here") (org-ml-build-dynamic-block "notempty") (org-ml-to-trimmed-string)) => (:result "#+begin: notempty" "# I'm in here" "#+end:")) (defexamples org-ml-build-footnote-definition (->> (org-ml-build-paragraph "footnote contents") (org-ml-build-footnote-definition "label") (org-ml-to-trimmed-string)) => "[fn:label] footnote contents") (defexamples org-ml-build-headline (->> (org-ml-build-headline) (org-ml-to-trimmed-string)) => "*" (->> (org-ml-build-headline :level 2 :title '("dummy") :tags '("tmsu")) (org-ml-to-trimmed-string)) => "** dummy :tmsu:" (->> (org-ml-build-headline :todo-keyword "TODO" :archivedp t :commentedp t :priority ?A) (org-ml-to-trimmed-string)) => "* TODO COMMENT [#A] :ARCHIVE:" :begin-hidden (->> (org-ml-build-headline :level 2) (org-ml-to-trimmed-string)) => "**" (->> (org-ml-build-headline :title '("dummy")) (org-ml-to-trimmed-string)) => "* dummy" (->> (org-ml-build-headline :tags '("tmsu")) (org-ml-to-trimmed-string)) => "* :tmsu:" (->> (org-ml-build-headline :todo-keyword "DONE") (org-ml-to-trimmed-string)) => "* DONE" (->> (org-ml-build-headline :priority ?A) (org-ml-to-trimmed-string)) => "* [#A]" (->> (org-ml-build-headline :footnote-section-p t) (org-ml-to-trimmed-string)) => "* Footnotes" (->> (org-ml-build-headline :commentedp t) (org-ml-to-trimmed-string)) => "* COMMENT" (->> (org-ml-build-headline :archivedp t) (org-ml-to-trimmed-string)) => "* :ARCHIVE:" :end-hidden) (defexamples org-ml-build-item (->> (org-ml-build-paragraph "item contents") (org-ml-build-item) (org-ml-to-trimmed-string)) => "- item contents" (->> (org-ml-build-paragraph "item contents") (org-ml-build-item :bullet 1) (org-ml-to-trimmed-string)) => "1. item contents" (->> (org-ml-build-paragraph "item contents") (org-ml-build-item :checkbox 'on) (org-ml-to-trimmed-string)) => "- [X] item contents" (->> (org-ml-build-paragraph "item contents") (org-ml-build-item :tag '("tmsu")) (org-ml-to-trimmed-string)) => "- tmsu :: item contents" (->> (org-ml-build-paragraph "item contents") (org-ml-build-item :counter 10) (org-ml-to-trimmed-string)) => "- [@10] item contents") (defexamples org-ml-build-plain-list (->> (org-ml-build-paragraph "item contents") (org-ml-build-item) (org-ml-build-plain-list) (org-ml-to-trimmed-string)) => "- item contents") (defexamples org-ml-build-property-drawer (->> (org-ml-build-property-drawer) (org-ml-to-trimmed-string)) => (:result ":PROPERTIES:" ":END:") (->> (org-ml-build-node-property "key" "val") (org-ml-build-property-drawer) (org-ml-to-trimmed-string)) => (:result ":PROPERTIES:" ":key: val" ":END:")) (defexamples org-ml-build-quote-block (->> (org-ml-build-quote-block) (org-ml-to-trimmed-string)) => (:result "#+begin_quote" "#+end_quote") (->> (org-ml-build-paragraph "quoted stuff") (org-ml-build-quote-block) (org-ml-to-trimmed-string)) => (:result "#+begin_quote" "quoted stuff" "#+end_quote")) (defexamples org-ml-build-section (->> (org-ml-build-paragraph "text") (org-ml-build-section) (org-ml-to-trimmed-string)) => "text") ;; TODO add :parameters to test (defexamples org-ml-build-special-block (->> (org-ml-build-special-block "monad") (org-ml-to-trimmed-string)) => (:result "#+begin_monad" "#+end_monad") (->> (org-ml-build-comment "Launch missiles") (org-ml-build-special-block "monad") (org-ml-to-trimmed-string)) => (:result "#+begin_monad" "# Launch missiles" "#+end_monad")) (defexamples org-ml-build-table (->> (org-ml-build-table-cell "cell") (org-ml-build-table-row) (org-ml-build-table) (org-ml-to-trimmed-string)) => "| cell |")) (def-example-subgroup "Miscellaneous Builders" nil ;; (defexamples-content org-ml-clone-node ;; nil ;; (:buffer "dolly") ;; (let* ((node1 (org-ml-parse-this-element)) ;; (node2 (org-ml-clone-node node1))) ;; (equal node1 node2)) ;; => t ;; (let* ((node1 (org-ml-parse-this-element)) ;; (node2 (org-ml-clone-node node1))) ;; (eq node1 node2)) ;; => nil) ;; (defexamples-content org-ml-clone-node-n ;; nil ;; (:buffer "dolly") ;; (-let* ((node1 (org-ml-parse-this-element)) ;; ((node2 node3) (org-ml-clone-node-n 2 node1))) ;; (or (equal node1 node2) ;; (equal node1 node3) ;; (equal node2 node3))) ;; => t ;; (-let* ((node1 (org-ml-parse-this-element)) ;; ((node2 node3) (org-ml-clone-node-n 2 node1))) ;; (or (eq node1 node2) ;; (eq node1 node3) ;; (eq node2 node3))) ;; => nil) (defexamples org-ml-build-secondary-string! (->> (org-ml-build-secondary-string! "I'm plain") (-map #'org-ml-get-type)) => '(plain-text) (->> (org-ml-build-secondary-string! "I'm *not* plain") (-map #'org-ml-get-type)) => '(plain-text bold plain-text) (->> (org-ml-build-secondary-string! "1. I'm *not* a plain list") (-map #'org-ml-get-type)) => '(plain-text bold plain-text) (->> (org-ml-build-secondary-string! "* I'm not an object") (-map #'org-ml-get-type)) => '(plain-text)) (defexamples org-ml-build-table-row-hline (->> (org-ml-build-table (org-ml-build-table-row (org-ml-build-table-cell "text")) (org-ml-build-table-row-hline)) (org-ml-to-trimmed-string)) => (:result "| text |" "|------|")) (defexamples org-ml-build-timestamp-diary (->> (org-ml-build-timestamp-diary '(diary-float t 4 2)) (org-ml-to-string)) => "<%%(diary-float t 4 2)>" (->> (org-ml-build-timestamp-diary '(diary-float t 4 2) :start '(0 0)) (org-ml-to-string)) => "<%%(diary-float t 4 2) 00:00>" (->> (org-ml-build-timestamp-diary '(diary-float t 4 2) :start '(0 0) :end '(1 0)) (org-ml-to-string)) => "<%%(diary-float t 4 2) 00:00-01:00>" :begin-hidden (->> (org-ml-build-timestamp-diary '(diary-float t 4 2) :end '(1 0)) (org-ml-to-string)) !!> arg-type-error :end-hidden)) (def-example-subgroup "Shorthand Builders" "Build nodes with more convenient/shorter syntax." (defexamples org-ml-build-timestamp! (->> (org-ml-build-timestamp! '(2019 1 1)) (org-ml-to-string)) => "[2019-01-01 Tue]" (->> (org-ml-build-timestamp! '(2019 1 1 12 0) :active t :warning '(all 1 day) :repeater '(cumulate 1 month)) (org-ml-to-string)) => "<2019-01-01 Tue 12:00 +1m -1d>" (->> (org-ml-build-timestamp! '(2019 1 1) :end '(2019 1 2)) (org-ml-to-string)) => "[2019-01-01 Tue]--[2019-01-02 Wed]") (defexamples org-ml-build-clock! (->> (org-ml-build-clock! '(2019 1 1)) (org-ml-to-trimmed-string)) => "CLOCK: [2019-01-01 Tue]" (->> (org-ml-build-clock! '(2019 1 1 12 0)) (org-ml-to-trimmed-string)) => "CLOCK: [2019-01-01 Tue 12:00]" (->> (org-ml-build-clock! '(2019 1 1 12 0) :end '(2019 1 1 13 0)) (org-ml-to-trimmed-string)) => "CLOCK: [2019-01-01 Tue 12:00]--[2019-01-01 Tue 13:00] => 1:00") (defexamples org-ml-build-planning! (->> (org-ml-build-planning! :closed '(2019 1 1)) (org-ml-to-trimmed-string)) => "CLOSED: [2019-01-01 Tue]" (->> (org-ml-build-planning! :closed '(2019 1 1) :scheduled '(2018 1 1)) (org-ml-to-trimmed-string)) => "SCHEDULED: <2018-01-01 Mon> CLOSED: [2019-01-01 Tue]" (->> (org-ml-build-planning! :scheduled '(2019 1 1 &warning all 1 day &repeater cumulate 1 month)) (org-ml-to-trimmed-string)) => "SCHEDULED: <2019-01-01 Tue +1m -1d>") (defexamples org-ml-build-property-drawer! (->> (org-ml-build-property-drawer! '("key" "val")) (org-ml-to-trimmed-string)) => (:result ":PROPERTIES:" ":key: val" ":END:")) (defexamples org-ml-build-headline! (->> (org-ml-build-headline! :title-text "really impressive title") (org-ml-to-trimmed-string)) => "* really impressive title" (->> (org-ml-build-headline! :title-text "really impressive title" :statistics-cookie '(0 9000)) (org-ml-to-trimmed-string)) => "* really impressive title [0/9000]" (->> (org-ml-build-headline! :title-text "really impressive title" :section-children (list (org-ml-build-property-drawer! '("key" "val")) (org-ml-build-paragraph! "section text")) (org-ml-build-headline! :title-text "subhead")) (org-ml-to-trimmed-string)) => (:result "* really impressive title" ":PROPERTIES:" ":key: val" ":END:" "section text" "** subhead")) (defexamples org-ml-build-item! (->> (org-ml-build-item! :bullet 1 :tag "complicated *tag*" :paragraph "petulant /frenzy/" (org-ml-build-plain-list (org-ml-build-item! :bullet '- :paragraph "below"))) (org-ml-to-trimmed-string)) => (:result "1. complicated *tag* :: petulant /frenzy/" " - below")) (defexamples org-ml-build-paragraph! (->> (org-ml-build-paragraph! "stuff /with/ *formatting*" :post-blank 2) (org-ml-to-string)) => (:result "stuff /with/ *formatting*" "" "" "") (->> (org-ml-build-paragraph! "* stuff /with/ *formatting*") (org-ml-to-string)) => (:result "* stuff /with/ *formatting*" "")) (defexamples org-ml-build-table-cell! (->> (org-ml-build-table-cell! "rage") (org-ml-to-trimmed-string)) => "rage |" (->> (org-ml-build-table-cell! "*rage*") (org-ml-to-trimmed-string)) => "*rage* |") (defexamples org-ml-build-table-row! (->> (org-ml-build-table-row! '("R" "A" "G" "E")) (org-ml-to-trimmed-string)) => "| R | A | G | E |" (->> (org-ml-build-table-row! '("S" "" "X")) (org-ml-to-trimmed-string)) => "| S | | X |" (->> (org-ml-build-table-row! 'hline) (org-ml-to-trimmed-string)) => "|-") (defexamples org-ml-build-table! (->> (org-ml-build-table! '("R" "A") '("G" "E")) (org-ml-to-trimmed-string)) => (:result "| R | A |" "| G | E |") (->> (org-ml-build-table! '("S" "") '("" "X")) (org-ml-to-trimmed-string)) => (:result "| S | |" "| | X |") (->> (org-ml-build-table! '("L" "O") 'hline '("V" "E")) (org-ml-to-trimmed-string)) => (:result "| L | O |" "|---+---|" "| V | E |"))) (def-example-subgroup "Logbook Item Builders" "Build item nodes for inclusion in headline logbooks" (defexamples org-ml-build-log-note (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-note "noteworthy") (org-ml-to-trimmed-string)) => (:result "- Note taken on [2019-01-01 Tue 00:00] \\\\" " noteworthy")) (defexamples org-ml-build-log-done (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-done) (org-ml-to-trimmed-string)) => (:result "- CLOSING NOTE [2019-01-01 Tue 00:00]") (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-done "noteworthy") (org-ml-to-trimmed-string)) => (:result "- CLOSING NOTE [2019-01-01 Tue 00:00] \\\\" " noteworthy")) (defexamples org-ml-build-log-refile (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-refile) (org-ml-to-trimmed-string)) => (:result "- Refiled on [2019-01-01 Tue 00:00]") (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-refile "noteworthy") (org-ml-to-trimmed-string)) => (:result "- Refiled on [2019-01-01 Tue 00:00] \\\\" " noteworthy")) (defexamples org-ml-build-log-state (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-state "HOLD" "TODO") (org-ml-to-trimmed-string)) => (:result "- State \"HOLD\" from \"TODO\" [2019-01-01 Tue 00:00]") (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-state "HOLD" "TODO" "noteworthy") (org-ml-to-trimmed-string)) => (:result "- State \"HOLD\" from \"TODO\" [2019-01-01 Tue 00:00] \\\\" " noteworthy")) (defexamples org-ml-build-log-deldeadline (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-deldeadline (org-ml-build-timestamp! '(2019 1 2))) (org-ml-to-trimmed-string)) => (:result "- Removed deadline, was \"[2019-01-02 Wed]\" on [2019-01-01 Tue 00:00]") (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-deldeadline (org-ml-build-timestamp! '(2019 1 2)) "noteworthy") (org-ml-to-trimmed-string)) => (:result "- Removed deadline, was \"[2019-01-02 Wed]\" on [2019-01-01 Tue 00:00] \\\\" " noteworthy")) (defexamples org-ml-build-log-delschedule (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-delschedule (org-ml-build-timestamp! '(2019 1 2))) (org-ml-to-trimmed-string)) => (:result "- Not scheduled, was \"[2019-01-02 Wed]\" on [2019-01-01 Tue 00:00]") (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-delschedule (org-ml-build-timestamp! '(2019 1 2)) "noteworthy") (org-ml-to-trimmed-string)) => (:result "- Not scheduled, was \"[2019-01-02 Wed]\" on [2019-01-01 Tue 00:00] \\\\" " noteworthy")) (defexamples org-ml-build-log-redeadline (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-redeadline (org-ml-build-timestamp! '(2019 1 2))) (org-ml-to-trimmed-string)) => (:result "- New deadline from \"[2019-01-02 Wed]\" on [2019-01-01 Tue 00:00]") (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-redeadline (org-ml-build-timestamp! '(2019 1 2)) "noteworthy") (org-ml-to-trimmed-string)) => (:result "- New deadline from \"[2019-01-02 Wed]\" on [2019-01-01 Tue 00:00] \\\\" " noteworthy")) (defexamples org-ml-build-log-reschedule (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-reschedule (org-ml-build-timestamp! '(2019 1 2))) (org-ml-to-trimmed-string)) => (:result "- Rescheduled from \"[2019-01-02 Wed]\" on [2019-01-01 Tue 00:00]") (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-reschedule (org-ml-build-timestamp! '(2019 1 2)) "noteworthy") (org-ml-to-trimmed-string)) => (:result "- Rescheduled from \"[2019-01-02 Wed]\" on [2019-01-01 Tue 00:00] \\\\" " noteworthy")) (defexamples org-ml-build-log-type (let ((org-log-note-headings '((test . "Changed %s from %S on %t by %u"))) (ut (- 1546300800 (car (current-time-zone))))) (->> (org-ml-build-log-type 'test :unixtime ut :old "TODO" :new "DONE" :username "shadowbrokers" :note "We're coming for you") (org-ml-to-trimmed-string))) => (:result "- Changed \"DONE\" from \"TODO\" on [2019-01-01 Tue 00:00] by shadowbrokers \\\\" " We're coming for you") :begin-hidden (let ((org-log-note-headings '((test . "My note is %t")))) (->> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-type 'test :unixtime) (org-ml-to-trimmed-string))) => "- My note is [2019-01-01 Tue 00:00]" (let ((org-log-note-headings '((test . "My note is %T")))) (->> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-type 'test :unixtime) (org-ml-to-trimmed-string))) => "- My note is <2019-01-01 Tue 00:00>" (let ((org-log-note-headings '((test . "My note is %d")))) (->> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-type 'test :unixtime) (org-ml-to-trimmed-string))) => "- My note is [2019-01-01 Tue]" (let ((org-log-note-headings '((test . "My note is %D")))) (->> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-type 'test :unixtime) (org-ml-to-trimmed-string))) => "- My note is <2019-01-01 Tue>" (let ((org-log-note-headings '((test . "My name is %u")))) (->> (org-ml-build-log-type 'test :username "slim") (org-ml-to-trimmed-string))) => "- My name is slim" (let ((org-log-note-headings '((test . "My name is %U")))) (->> (org-ml-build-log-type 'test :full-username "slimshady") (org-ml-to-trimmed-string))) => "- My name is slimshady" (let ((org-log-note-headings '((test . "My note is %S")))) (->> (org-ml-build-log-type 'test :old "DONE") (org-ml-to-trimmed-string))) => "- My note is \"DONE\"" (let ((org-log-note-headings '((test . "My note is %S")))) (->> (org-ml-build-timestamp! '(2019 1 1 0 0)) (org-ml-build-log-type 'test :old) (org-ml-to-trimmed-string))) => "- My note is \"[2019-01-01 Tue 00:00]\"" (let ((org-log-note-headings '((test . "My note is %s")))) (->> (org-ml-build-log-type 'test :new "DONE") (org-ml-to-trimmed-string))) => "- My note is \"DONE\"" (let ((org-log-note-headings '((test . "My note is %s")))) (->> (org-ml-build-timestamp! '(2019 1 1 0 0)) (org-ml-build-log-type 'test :new) (org-ml-to-trimmed-string))) => "- My note is \"[2019-01-01 Tue 00:00]\"" :end-hidden ) )) (def-example-group "Type Predicates" "Test node types." (defexamples-content org-ml-get-type nil (:buffer "*I'm emboldened*") (->> (org-ml-parse-this-object) (org-ml-get-type)) => 'bold (:buffer "* I'm the headliner") (->> (org-ml-parse-this-element) (org-ml-get-type)) => 'headline (:buffer "[2112-12-21 Wed]") (->> (org-ml-parse-this-object) (org-ml-get-type)) => 'timestamp) (defexamples-content org-ml-is-type nil (:buffer "*ziltoid*") (->> (org-ml-parse-this-object) (org-ml-is-type 'bold)) => t (->> (org-ml-parse-this-object) (org-ml-is-type 'italic)) => nil) (defexamples-content org-ml-is-any-type nil (:buffer "*ziltoid*") (->> (org-ml-parse-this-object) (org-ml-is-any-type '(bold))) => t (->> (org-ml-parse-this-object) (org-ml-is-any-type '(bold italic))) => t (->> (org-ml-parse-this-object) (org-ml-is-any-type '(italic))) => nil) (defexamples-content org-ml-is-element nil (:buffer "*ziltoid*") (:comment "Parsing this text as an element node gives a paragraph node") (->> (org-ml-parse-this-element) (org-ml-is-element)) => t (:comment "Parsing the same text as an object node gives a bold node") (->> (org-ml-parse-this-object) (org-ml-is-element)) => nil) (defexamples-content org-ml-is-branch-node nil (:buffer "*ziltoid*") (:comment "Parsing this as an element node gives a paragraph node" "(a branch node)") (->> (org-ml-parse-this-element) (org-ml-is-branch-node)) => t (:comment "Parsing this as an object node gives a bold node" "(also a branch node)") (->> (org-ml-parse-this-object) (org-ml-is-branch-node)) => t (:buffer "~ziltoid~") (:comment "Parsing this as an object node gives a code node" "(not a branch node)") (->> (org-ml-parse-this-object) (org-ml-is-branch-node)) => nil (:buffer "# ziltoid") (:comment "Parsing this as an element node gives a comment node" "(also not a branch node)") (->> (org-ml-parse-this-element) (org-ml-is-branch-node)) => nil (:buffer "* I'm so great") (:comment "Parsing this as an element node gives a headline node" "(a branch node)") (->> (org-ml-parse-this-element) (org-ml-is-branch-node)) => t) (defexamples-content org-ml-node-may-have-child-objects nil (:buffer "*ziltoid*") (:comment "Parsing this as an element node gives a paragraph node" "(can have child object nodes)") (->> (org-ml-parse-this-element) (org-ml-node-may-have-child-objects)) => t (:comment "Parsing this as an object node gives a bold node" "(also can have child object nodes)") (->> (org-ml-parse-this-object) (org-ml-node-may-have-child-objects)) => t (:buffer "~ziltoid~") (:comment "Parsing this as an object node gives a code node" "(not a branch node)") (->> (org-ml-parse-this-object) (org-ml-node-may-have-child-objects)) => nil (:buffer "# ziltoid") (:comment "Parsing this as an element node gives a comment node" "(not a branch node)") (->> (org-ml-parse-this-element) (org-ml-node-may-have-child-objects)) => nil (:buffer "* I'm so great") (:comment "Parsing this as an element node gives a headline node" "(can only have child element nodes)") (->> (org-ml-parse-this-element) (org-ml-node-may-have-child-objects)) => nil) (defexamples-content org-ml-node-may-have-child-elements nil (:buffer "* I'm so great") (:comment "Parsing this as an element node gives a headline node" "(can have child element nodes)") (->> (org-ml-parse-this-element) (org-ml-node-may-have-child-elements)) => t (:buffer "*ziltoid*") (:comment "Parsing this as an element node gives a paragraph node" "(can only have child object nodes)") (->> (org-ml-parse-this-element) (org-ml-node-may-have-child-elements)) => nil (:buffer "# ziltoid") (:comment "Parsing this as an element node gives a comment node" "(not a branch node)") (->> (org-ml-parse-this-element) (org-ml-node-may-have-child-elements)) => nil)) (def-example-group "Property Manipulation" "Set, get, and map properties of nodes." (def-example-subgroup "Generic" nil (defexamples-content org-ml-contains-point-p nil (:buffer "*findme*") (->> (org-ml-parse-this-object) (org-ml-contains-point-p 2)) => t (->> (org-ml-parse-this-object) (org-ml-contains-point-p 10)) => nil) (defexamples-content org-ml-set-property nil (:buffer "#+call: ktulu()") (org-ml->> (org-ml-parse-this-element) (org-ml-set-property :call "cthulhu") (org-ml-set-property :inside-header '(:cache no)) (org-ml-set-property :arguments '("x=4")) (org-ml-set-property :end-header '(:exports results)) (org-ml-to-trimmed-string)) => "#+call: cthulhu[:cache no](x=4) :exports results" :begin-hidden (:buffer "CLOCK: [2019-01-01 Tue]") (org-ml->> (org-ml-parse-this-element) (org-ml-set-property :value (org-ml-build-timestamp! '(2019 1 1) :end '(2019 1 2))) (org-ml-to-trimmed-string)) => "CLOCK: [2019-01-01 Tue]--[2019-01-02 Wed] => 24:00" (:buffer "~learn to~") (org-ml->> (org-ml-parse-this-object) (org-ml-set-property :value "why?") (org-ml-to-trimmed-string)) => "~why?~" (:buffer "# not here") (org-ml->> (org-ml-parse-this-element) (org-ml-set-property :value "still not here") (org-ml-to-trimmed-string)) => "# still not here" (:buffer "#+begin_comment" "not here" "#+end_comment") (org-ml->> (org-ml-parse-this-element) (org-ml-set-property :value "still not here") (org-ml-to-trimmed-string)) => (:result "#+begin_comment" "still not here" "#+end_comment") (:buffer "%%(print :valueble)") (org-ml->> (org-ml-parse-this-element) (org-ml-set-property :value '(print :invaluble)) (org-ml-to-trimmed-string)) => "%%(print :invaluble)" (:buffer ":LOGBOOK:" ":END:") (org-ml->> (org-ml-parse-this-element) (org-ml-set-property :drawer-name "BOOKOFSOULS") (org-ml-to-trimmed-string)) => (:result ":BOOKOFSOULS:" ":END:") (:buffer "#+begin: blockhead" "#+end:") (org-ml->> (org-ml-parse-this-element) (org-ml-set-property :block-name "blockfoot") (org-ml-set-property :arguments '(:cache no)) (org-ml-to-trimmed-string)) => (:result "#+begin: blockfoot :cache no" "#+end:") (:buffer "\\pi") (org-ml->> (org-ml-parse-this-object) (org-ml-set-property :name "gamma") (org-ml-set-property :use-brackets-p t) (org-ml-to-trimmed-string)) => "\\gamma{}" ;; TODO test org-src-preserve-indentation (:buffer "#+begin_example" "#+end_example") (org-ml->> (org-ml-parse-this-element) (org-ml-set-property :switches '("-n")) (org-ml-set-property :value "example.com") (org-ml-to-trimmed-string)) => (:buffer "#+begin_example -n" " example.com" "#+end_example") (:buffer "#+begin_export latex" "#+end_export") (org-ml->> (org-ml-parse-this-element) (org-ml-set-property :type "domestic") (org-ml-set-property :value "bullets, bombs, and bigotry") (org-ml-to-trimmed-string)) => (:buffer "#+begin_export domestic" "bullets, bombs, and bigotry" "#+end_export") (:buffer "@@back-end:value@@") (org-ml->> (org-ml-parse-this-object) (org-ml-set-property :back-end "latex") (org-ml-set-property :value "new-value") (org-ml-to-trimmed-string)) => "@@latex:new-value@@" (:buffer ": fixed") (org-ml->> (org-ml-parse-this-element) (org-ml-set-property :value "unfixed") (org-ml-to-trimmed-string)) => ": unfixed" (:buffer "[fn:whitelabel] society") (org-ml->> (org-ml-parse-this-element) (org-ml-set-property :label "blacklabel") (org-ml-to-trimmed-string)) => "[fn:blacklabel] society" (:buffer "* dummy" "stuff") (org-ml->> (org-ml-parse-this-element) (org-ml-set-property :archivedp t) (org-ml-set-property :commentedp t) (org-ml-set-property :level 2) (org-ml-set-property :pre-blank 1) (org-ml-set-property :priority ?A) (org-ml-set-property :tags '("tmsu")) (org-ml-set-property :title '("smartie")) (org-ml-set-property :todo-keyword "TODO") (org-ml-to-trimmed-string)) => (:result "** TODO COMMENT [#A] smartie :tmsu:ARCHIVE:" "" "stuff") :begin-hidden (org-ml->> (org-ml-parse-this-element) (org-ml-set-property :footnote-section-p t) (org-ml-to-trimmed-string)) => (:result "* Footnotes" "stuff") :end-hidden (:buffer "call_kthulu()") (org-ml->> (org-ml-parse-this-object) (org-ml-set-property :call "cthulhu") (org-ml-set-property :inside-header '(:cache no)) (org-ml-set-property :arguments '("x=4")) (org-ml-set-property :end-header '(:exports results)) (org-ml-to-trimmed-string)) => "call_cthulhu[:cache no](x=4)[:exports results]" (:buffer "src_emacs{(print 'yeah-boi)}") (org-ml->> (org-ml-parse-this-object) (org-ml-set-property :language "python") (org-ml-set-property :parameters '(:cache no)) (org-ml-set-property :value "print \"yeah boi\"") (org-ml-to-trimmed-string)) => "src_python[:cache no]{print \"yeah boi\"}" :end-hidden (:buffer "- thing") (org-ml->> (org-ml-parse-this-item) (org-ml-set-property :bullet 1) (org-ml-set-property :checkbox 'on) (org-ml-set-property :counter 2) (org-ml-set-property :tag '("tmsu")) (org-ml-to-trimmed-string)) => "1. [@2] [X] tmsu :: thing" :begin-hidden (:buffer "#+KEY: VAL") (org-ml->> (org-ml-parse-this-element) (org-ml-set-property :key "kee") (org-ml-set-property :value "vahl") (org-ml-to-trimmed-string)) => "#+kee: vahl" (:buffer "\begin{env}" "body" "\end{env}") (org-ml->> (org-ml-parse-this-element) (org-ml-set-property :value "\begin{vne}\nbody\end{vne}") (org-ml-to-trimmed-string)) => (:buffer "\begin{vne}" "body" "\end{vne}") (:buffer "$2+2=4$") (org-ml->> (org-ml-parse-this-object) (org-ml-set-property :value "$2+2=5$") (org-ml-to-trimmed-string)) => "$2+2=5$" (:buffer "https://example.com") (org-ml->> (org-ml-parse-this-object) (org-ml-set-property :path "/dev/null") (org-ml-set-property :type "file") (org-ml-set-property :format 'bracket) (org-ml-to-trimmed-string)) => "[[file:/dev/null]]" (:buffer "{{{economics}}}") (org-ml->> (org-ml-parse-this-object) (org-ml-set-property :key "freakonomics") (org-ml-set-property :args '("x=4" "y=2")) (org-ml-to-trimmed-string)) => "{{{freakonomics(x=4,y=2)}}}" (:buffer "* dummy" ":PROPERTIES:" ":KEY: VAL" ":END:") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-get-section) (-first-item) (org-ml-get-children) (-first-item) (org-ml-set-property :key "kee") (org-ml-set-property :value "vahl") (org-ml-to-trimmed-string)) => ":kee: vahl" (:buffer "* dummy" "CLOSED: <2019-01-01 Tue>") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-get-section) (-first-item) (org-ml-set-property :closed (org-ml-build-timestamp! '(2019 1 2) :active nil)) (org-ml-to-trimmed-string)) => "CLOSED: [2019-01-02 Wed]" (:buffer "#+begin_special" "#+end_special") (org-ml->> (org-ml-parse-this-element) (org-ml-set-property :type "talent") (org-ml-to-trimmed-string)) => (:result "#+begin_talent" "#+end_talent") (:buffer "#+begin_src" "something amorphous" "#+end_src") (org-ml->> (org-ml-parse-this-element) (org-ml-set-property :language "emacs") (org-ml-set-property :value "(print 'hi)") (org-ml-set-property :parameters '(:cache no)) (org-ml-set-property :switches '("-n")) ;; TODO test org-src-preserve-indentation (org-ml-to-trimmed-string)) => (:result "#+begin_src emacs -n :cache no" " (print 'hi)" "#+end_src") (:buffer "* dummy [50%]") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-get-statistics-cookie) (org-ml-set-property :value '(0 5)) (org-ml-to-trimmed-string)) => "[0/5]" (:buffer "sub_woofer") (org-ml->> (org-ml-parse-object-at 5) (org-ml-set-property :use-brackets-p t) (org-ml-to-trimmed-string)) => "_{woofer}" (:buffer "super^woofer") (org-ml->> (org-ml-parse-object-at 7) (org-ml-set-property :use-brackets-p t) (org-ml-to-trimmed-string)) => "^{woofer}" (:buffer "| a |") (org-ml->> (org-ml-parse-this-element) (org-ml-set-property :tblfm '("x=$2")) (org-ml-to-trimmed-string)) => (:result "| a |" "#+TBLFM: x=$2") (:buffer "<>") (org-ml->> (org-ml-parse-this-object) (org-ml-set-property :value "lost") (org-ml-to-trimmed-string)) => "<>" (:buffer "[2019-01-01 Tue]") (org-ml->> (org-ml-parse-this-object) (org-ml-set-property :year-start 2020) (org-ml-set-property :month-start 2) (org-ml-set-property :day-start 2) (org-ml-set-property :hour-start 12) (org-ml-set-property :minute-start 0) (org-ml-set-property :year-end 2020) (org-ml-set-property :month-end 2) (org-ml-set-property :day-end 3) (org-ml-set-property :hour-end 12) (org-ml-set-property :minute-end 0) (org-ml-set-property :type 'active-range) (org-ml-set-property :warning-type 'all) (org-ml-set-property :warning-unit 'day) (org-ml-set-property :warning-value 1) (org-ml-set-property :repeater-type 'cumulate) (org-ml-set-property :repeater-unit 'day) (org-ml-set-property :repeater-value 1) (org-ml-to-trimmed-string)) => "<2020-02-02 Sun 12:00 +1d -1d>--<2020-02-03 Mon 12:00 +1d -1d>" (:buffer "=I am not a crook=") (org-ml->> (org-ml-parse-this-object) (org-ml-set-property :value "You totally are") (org-ml-to-trimmed-string)) => "=You totally are=" (:buffer "plain") (org-ml->> (org-ml-set-property :post-blank 1 "plain") (org-ml-to-string)) => "plain " (:buffer "*not plain*") (org-ml->> (org-ml-parse-this-object) (org-ml-set-property :post-blank 1) (org-ml-to-string)) => "*not plain* " ;; affiliated keywords (:buffer "short paragraph") (org-ml->> (org-ml-parse-this-element) (org-ml-set-property :name "foo") (org-ml-to-trimmed-string)) => (:result "#+name: foo" "short paragraph") (org-ml->> (org-ml-parse-this-element) (org-ml-set-property :attr_bar '("foo")) (org-ml-to-trimmed-string)) => (:result "#+attr_bar: foo" "short paragraph") (org-ml->> (org-ml-parse-this-element) (org-ml-set-property :header '((:k1 "h1") (:k2 "h2"))) (org-ml-to-trimmed-string)) => (:result "#+header: :k1 h1" "#+header: :k2 h2" "short paragraph") (org-ml->> (org-ml-parse-this-element) (org-ml-set-property :results '("bar" "foo")) (org-ml-to-trimmed-string)) => (:result "#+results[bar]: foo" "short paragraph") (org-ml->> (org-ml-parse-this-element) (org-ml-set-property :caption '("cap")) (org-ml-to-trimmed-string)) => (:result "#+caption: cap" "short paragraph") (org-ml->> (org-ml-parse-this-element) (org-ml-set-property :caption '(("foo" "cap"))) (org-ml-to-trimmed-string)) => (:result "#+caption[foo]: cap" "short paragraph") (org-ml->> (org-ml-parse-this-element) (org-ml-set-property :caption '(("FOO" "CAP") ("foo" "cap"))) (org-ml-to-trimmed-string)) => (:result "#+caption[FOO]: CAP" "#+caption[foo]: cap" "short paragraph") (:buffer "#+caption: cap" "short paragraph") (org-ml->> (org-ml-parse-this-element) (org-ml-set-property :caption nil) (org-ml-to-trimmed-string)) => "short paragraph" (:buffer "#+name: deleteme" "short paragraph") (org-ml->> (org-ml-parse-this-element) (org-ml-set-property :name nil) (org-ml-to-trimmed-string)) => "short paragraph" :end-hidden (:buffer "* not valuable") (:comment "Throw error when setting a property that doesn't exist") (org-ml->> (org-ml-parse-this-headline) (org-ml-set-property :value "wtf") (org-ml-to-trimmed-string)) !!> arg-type-error (:comment "Throw error when setting to an improper type") (org-ml->> (org-ml-parse-this-headline) (org-ml-set-property :title 666) (org-ml-to-trimmed-string)) !!> arg-type-error) (defexamples-content org-ml-get-property nil (:buffer "#+call: ktulu(x=4) :exports results") (->> (org-ml-parse-this-element) (org-ml-get-property :call)) => "ktulu" (->> (org-ml-parse-this-element) (org-ml-get-property :inside-header)) => nil :begin-hidden (->> (org-ml-parse-this-element) (org-ml-get-property :arguments)) => '("x=4") (->> (org-ml-parse-this-element) (org-ml-get-property :end-header)) => '(:exports results) (:buffer "CLOCK: [2019-01-01 Tue]") (->> (org-ml-parse-this-element) (org-ml-get-property :value) (org-ml-to-string)) => "[2019-01-01 Tue]" (:buffer "~learn to~") (->> (org-ml-parse-this-object) (org-ml-get-property :value)) => "learn to" (:buffer "# not here") (->> (org-ml-parse-this-element) (org-ml-get-property :value)) => "not here" (:buffer "#+begin_comment" "not here" "#+end_comment") (->> (org-ml-parse-this-element) (org-ml-get-property :value)) => "not here" (:buffer "%%(print :hi)") (->> (org-ml-parse-this-element) (org-ml-get-property :value)) => '(print :hi) (:buffer ":LOGBOOK:" ":END:") (->> (org-ml-parse-this-element) (org-ml-get-property :drawer-name)) => "LOGBOOK" (:buffer "#+begin: blockhead :cache no" "#+end:") (->> (org-ml-parse-this-element) (org-ml-get-property :block-name)) => "blockhead" (->> (org-ml-parse-this-element) (org-ml-get-property :arguments)) => '(:cache no) (:buffer "\\pi{}") (->> (org-ml-parse-this-object) (org-ml-get-property :name)) => "pi" (->> (org-ml-parse-this-object) (org-ml-get-property :use-brackets-p)) => t ;; TODO test org-src-preserve-indentation => (:buffer "#+begin_example -n" "example.com" "#+end_example") (->> (org-ml-parse-this-element) (org-ml-get-property :switches)) => '("-n") (->> (org-ml-parse-this-element) (org-ml-get-property :value)) => "example.com" (:buffer "#+begin_export domestic" "bullets, bombs, and bigotry" "#+end_export") (->> (org-ml-parse-this-element) (org-ml-get-property :type)) ;; TODO why capitalized? => "DOMESTIC" (->> (org-ml-parse-this-element) (org-ml-get-property :value)) => "bullets, bombs, and bigotry\n" (:buffer "@@back-end:value@@") (->> (org-ml-parse-this-object) (org-ml-get-property :back-end)) => "back-end" (->> (org-ml-parse-this-object) (org-ml-get-property :value)) => "value" (:buffer ": fixed") (->> (org-ml-parse-this-element) (org-ml-get-property :value)) => "fixed" (:buffer "[fn:blacklabel] society") (->> (org-ml-parse-this-element) (org-ml-get-property :label)) => "blacklabel" ;; TODO the priority should be parsable after "COMMENT" (:buffer "** TODO [#A] COMMENT dummy :tmsu:ARCHIVE:" "" "stuff") (->> (org-ml-parse-this-element) (org-ml-get-property :archivedp)) => t (->> (org-ml-parse-this-element) (org-ml-get-property :commentedp)) => t (->> (org-ml-parse-this-element) (org-ml-get-property :level)) => 2 (->> (org-ml-parse-this-element) (org-ml-get-property :pre-blank)) => 1 (->> (org-ml-parse-this-element) (org-ml-get-property :priority)) => ?A (->> (org-ml-parse-this-element) (org-ml-get-property :tags)) => '("tmsu") (->> (org-ml-parse-this-element) (org-ml-get-property :title)) => '("dummy") (->> (org-ml-parse-this-element) (org-ml-get-property :todo-keyword)) => "TODO" (:buffer "* Footnotes") (->> (org-ml-parse-this-element) (org-ml-get-property :footnote-section-p)) => t (:buffer "call_ktulu[:cache no](x=4)[:exports results]") (->> (org-ml-parse-this-object) (org-ml-get-property :call)) => "ktulu" (->> (org-ml-parse-this-object) (org-ml-get-property :inside-header)) => '(:cache no) (->> (org-ml-parse-this-object) (org-ml-get-property :arguments)) => '("x=4") (->> (org-ml-parse-this-object) (org-ml-get-property :end-header)) => '(:exports results) (:buffer "src_python[:cache no]{print \"yeah boi\"}") (->> (org-ml-parse-this-object) (org-ml-get-property :language)) => "python" (->> (org-ml-parse-this-object) (org-ml-get-property :parameters)) => '(:cache no) (->> (org-ml-parse-this-object) (org-ml-get-property :value)) => "print \"yeah boi\"" (:buffer "- [@2] [X] tmsu :: thing") (->> (org-ml-parse-this-item) (org-ml-get-property :bullet)) => '- (->> (org-ml-parse-this-item) (org-ml-get-property :checkbox)) => 'on (->> (org-ml-parse-this-item) (org-ml-get-property :counter)) => 2 (->> (org-ml-parse-this-item) (org-ml-get-property :tag)) => '("tmsu") (:buffer "#+KEY: VAL") (->> (org-ml-parse-this-element) (org-ml-get-property :key)) => "KEY" (->> (org-ml-parse-this-element) (org-ml-get-property :value)) => "VAL" (:buffer "\begin{env}" "body" "\end{env}") (->> (org-ml-parse-this-element) (org-ml-get-property :value)) => (:buffer "\begin{env}" "body" "\end{env}") (:buffer "$2+2=4$") (->> (org-ml-parse-this-object) (org-ml-get-property :value)) => "$2+2=4$" (:buffer "[[file:/dev/null]]") (->> (org-ml-parse-this-object) (org-ml-get-property :path)) => "/dev/null" (->> (org-ml-parse-this-object) (org-ml-get-property :type)) => "file" (->> (org-ml-parse-this-object) (org-ml-get-property :format)) => 'bracket (:buffer "{{{economics(x=4,y=2)}}}") (->> (org-ml-parse-this-object) (org-ml-get-property :key)) => "economics" (->> (org-ml-parse-this-object) (org-ml-get-property :args)) => '("x=4" "y=2") (:buffer "* dummy" ":PROPERTIES:" ":KEY: VAL" ":END:") (->> (org-ml-parse-this-headline) (org-ml-headline-get-section) (-first-item) (org-ml-get-children) (-first-item) (org-ml-get-property :key)) => "KEY" (->> (org-ml-parse-this-headline) (org-ml-headline-get-section) (-first-item) (org-ml-get-children) (-first-item) (org-ml-get-property :value)) => "VAL" (:buffer "* dummy" "CLOSED: [2019-01-01 Tue]") (->> (org-ml-parse-this-headline) (org-ml-headline-get-section) (-first-item) (org-ml-get-property :closed) (org-ml-to-string)) => "[2019-01-01 Tue]" (:buffer "#+BEGIN_special" "#+END_special") (->> (org-ml-parse-this-element) (org-ml-get-property :type)) => "special" (:buffer "#+begin_src emacs -n :cache no" " (print 'hi)" "#+end_src") (->> (org-ml-parse-this-element) (org-ml-get-property :language)) => "emacs" (->> (org-ml-parse-this-element) (org-ml-get-property :value)) ;; TODO why indented? => " (print 'hi)" (->> (org-ml-parse-this-element) (org-ml-get-property :parameters)) => '(:cache no) (->> (org-ml-parse-this-element) (org-ml-get-property :switches)) => '("-n") (:buffer "* dummy [50%]") (->> (org-ml-parse-this-headline) (org-ml-headline-get-statistics-cookie) (org-ml-get-property :value)) => '(50) (:buffer "sub_{woofer}") (->> (org-ml-parse-object-at 6) (org-ml-get-property :use-brackets-p)) => t (:buffer "super_{woofer}") (->> (org-ml-parse-object-at 8) (org-ml-get-property :use-brackets-p)) => t (:buffer "| a |" "#+TBLFM: x=$2") (->> (org-ml-parse-this-element) (org-ml-get-property :tblfm)) => '("x=$2") (:buffer "<>") (->> (org-ml-parse-this-object) (org-ml-get-property :value)) => "found" (:buffer "<2020-02-02 Sun 12:00 +1d -1d>--<2020-02-03 Mon 12:00 +1d -1d>") (->> (org-ml-parse-this-object) (org-ml-get-property :year-start)) => 2020 (->> (org-ml-parse-this-object) (org-ml-get-property :month-start)) => 2 (->> (org-ml-parse-this-object) (org-ml-get-property :day-start)) => 2 (->> (org-ml-parse-this-object) (org-ml-get-property :hour-start)) => 12 (->> (org-ml-parse-this-object) (org-ml-get-property :minute-start)) => 0 (->> (org-ml-parse-this-object) (org-ml-get-property :year-end)) => 2020 (->> (org-ml-parse-this-object) (org-ml-get-property :month-end)) => 2 (->> (org-ml-parse-this-object) (org-ml-get-property :day-end)) => 3 (->> (org-ml-parse-this-object) (org-ml-get-property :hour-end)) => 12 (->> (org-ml-parse-this-object) (org-ml-get-property :minute-end)) => 0 (->> (org-ml-parse-this-object) (org-ml-get-property :type)) => 'active-range (->> (org-ml-parse-this-object) (org-ml-get-property :warning-type)) => 'all (->> (org-ml-parse-this-object) (org-ml-get-property :warning-unit)) => 'day (->> (org-ml-parse-this-object) (org-ml-get-property :warning-value)) => 1 (->> (org-ml-parse-this-object) (org-ml-get-property :repeater-type)) => 'cumulate (->> (org-ml-parse-this-object) (org-ml-get-property :repeater-unit)) => 'day (->> (org-ml-parse-this-object) (org-ml-get-property :repeater-value)) => 1 (:buffer "=I am not a crook=") (->> (org-ml-parse-this-object) (org-ml-get-property :value)) => "I am not a crook" (:buffer "*postable* ") (->> (org-ml-parse-this-object) (org-ml-get-property :post-blank)) => 1 (:buffer "/*child*/") (->> (org-ml-parse-this-object) (org-ml-get-children) (car) (org-ml-get-property :parent) (org-ml-to-trimmed-string)) => "/*child*/" (:buffer "/16-chars-long/") (->> (org-ml-parse-this-object) (org-ml-get-property :begin)) => 1 (->> (org-ml-parse-this-object) (org-ml-get-property :contents-begin)) => 2 (->> (org-ml-parse-this-object) (org-ml-get-property :contents-end)) => 15 (->> (org-ml-parse-this-object) (org-ml-get-property :end)) => 16 ;; affiliated keywords (:buffer "#+name: name" "#+attr_foo: bar" "#+attr_foo: BAR" "#+plot: poo" "#+caption: koo" "#+caption[COO]: KOO" "#+results[hash]: res" "#+header: :k1 h1" "#+header: :k2 h2" "#+begin_src" "echo test for echo" "#+end_src") (->> (org-ml-parse-this-element) (org-ml-get-property :name)) => "name" (->> (org-ml-parse-this-element) (org-ml-get-property :plot)) => "poo" (->> (org-ml-parse-this-element) (org-ml-get-property :attr_foo)) => '("bar" "BAR") (->> (org-ml-parse-this-element) (org-ml-get-property :header)) => '((:k1 "h1") (:k2 "h2")) (->> (org-ml-parse-this-element) (org-ml-get-property :results)) => '("hash" "res") (->> (org-ml-parse-this-element) (org-ml-get-property :caption)) => '("koo" ("COO" "KOO")) :end-hidden (:buffer "* not arguable") (:comment "Throw error when requesting a property that doesn't exist") (->> (org-ml-parse-this-headline) (org-ml-get-property :value)) !!> arg-type-error) (defexamples-content org-ml-map-property nil :begin-hidden (:buffer "#+call: ktulu()") (org-ml->> (org-ml-parse-this-element) (org-ml-map-property :call #'s-upcase) (org-ml-to-trimmed-string)) => "#+call: KTULU()" (:buffer "CLOCK: [2019-01-01 Tue 12:00]") (org-ml->> (org-ml-parse-this-element) (org-ml-map-property* :value (org-ml-timestamp-shift-end 1 'hour it)) (org-ml-to-trimmed-string)) => "CLOCK: [2019-01-01 Tue 12:00]--[2019-01-01 Tue 13:00] => 1:00" :end-hidden (:buffer "~learn to~") (org-ml->> (org-ml-parse-this-object) (org-ml-map-property :value #'s-upcase) (org-ml-to-trimmed-string)) => "~LEARN TO~" (:comment "Throw error if property doesn't exist") (org-ml->> (org-ml-parse-this-object) (org-ml-map-property :title #'s-upcase) (org-ml-to-trimmed-string)) !!> arg-type-error (:comment "Throw error if function doesn't return proper type") (org-ml->> (org-ml-parse-this-object) (org-ml-map-property* :value (if it 1 0)) (org-ml-to-trimmed-string)) !!> arg-type-error :begin-hidden (:buffer "# not here") (org-ml->> (org-ml-parse-this-element) (org-ml-map-property :value #'s-upcase) (org-ml-to-trimmed-string)) => "# NOT HERE" (:buffer "#+begin_comment" "not here" "#+end_comment") (org-ml->> (org-ml-parse-this-element) (org-ml-map-property :value #'s-upcase) (org-ml-to-trimmed-string)) => (:result "#+begin_comment" "NOT HERE" "#+end_comment") (:buffer "%%(diary-float t 1 -1)") (org-ml->> (org-ml-parse-this-element) (org-ml-map-property :value (org-ml--map-last* (+ 2 it) it)) (org-ml-to-trimmed-string)) => (:buffer "%%(diary-float t 1 1)") (:buffer ":LOGBOOK:" ":END:") (org-ml->> (org-ml-parse-this-element) (org-ml-map-property :drawer-name #'s-capitalize) (org-ml-to-trimmed-string)) => (:result ":Logbook:" ":END:") (:buffer "#+begin: blockhead" "#+end:") (org-ml->> (org-ml-parse-this-element) (org-ml-map-property :block-name #'s-upcase) (org-ml-to-trimmed-string)) => (:result "#+begin: BLOCKHEAD" "#+end:") ;; TODO add entity (:buffer "#+begin_example" "example.com" "#+end_example") (org-ml->> (org-ml-parse-this-element) (org-ml-map-property* :value (concat "https://" it)) (org-ml-to-trimmed-string)) => (:result "#+begin_example" " https://example.com" "#+end_example") (:buffer "#+begin_export domestic" "bullets, bombs, and bigotry" "#+end_export") (org-ml->> (org-ml-parse-this-element) (org-ml-map-property :type #'s-upcase) (org-ml-map-property :value #'s-upcase) (org-ml-to-trimmed-string)) => (:result "#+begin_export DOMESTIC" "BULLETS, BOMBS, AND BIGOTRY" "#+end_export") (:buffer "@@back-end:value@@") (org-ml->> (org-ml-parse-this-object) (org-ml-map-property :back-end #'s-upcase) (org-ml-map-property :value #'s-upcase) (org-ml-to-trimmed-string)) => "@@BACK-END:VALUE@@" (:buffer ": fixed") (org-ml->> (org-ml-parse-this-element) (org-ml-map-property :value #'s-upcase) (org-ml-to-trimmed-string)) => ": FIXED" (:buffer "[fn:blacklabel] society") (org-ml->> (org-ml-parse-this-element) (org-ml-map-property :label #'s-upcase) (org-ml-to-trimmed-string)) => "[fn:BLACKLABEL] society" (:buffer "* headline") (org-ml->> (org-ml-parse-this-headline) (org-ml-map-property* :title (-map #'s-upcase it)) (org-ml-to-trimmed-string)) => "* HEADLINE" (:buffer "call_ktulu()") (org-ml->> (org-ml-parse-this-object) (org-ml-map-property :call #'s-upcase) (org-ml-to-trimmed-string)) => "call_KTULU()" (:buffer "src_python{print \"hi\"}") (org-ml->> (org-ml-parse-this-object) (org-ml-map-property* :value (s-replace-regexp "\".*\"" #'s-upcase it)) (org-ml-to-trimmed-string)) => "src_python{print \"HI\"}" (:buffer "- tag :: thing") (org-ml->> (org-ml-parse-this-item) (org-ml-map-property :tag (lambda (it) (-map #'s-upcase it))) (org-ml-to-trimmed-string)) => "- TAG :: thing" (:buffer "#+key: VAL") (org-ml->> (org-ml-parse-this-element) (org-ml-map-property :key (-partial #'s-prepend "OM_")) (org-ml-map-property :value (-partial #'s-prepend "OM_")) (org-ml-to-trimmed-string)) => "#+om_key: OM_VAL" ;; TODO add examples for latex frag/env (:buffer "[[https://downloadmoreram.org][legit]]") (org-ml->> (org-ml-parse-this-object) (org-ml-map-property* :path (s-replace ".org" ".com" it)) (org-ml-to-trimmed-string)) => "[[https://downloadmoreram.com][legit]]" (:buffer "{{{economics}}}") (org-ml->> (org-ml-parse-this-object) (org-ml-map-property :key #'s-upcase) (org-ml-to-trimmed-string)) => "{{{ECONOMICS}}}" (:buffer "* dummy" ":PROPERTIES:" ":KEY: VAL" ":END:") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-get-section) (-first-item) (org-ml-get-children) (-first-item) (org-ml-map-property :key (-partial #'s-prepend "OM_")) (org-ml-map-property :value (-partial #'s-prepend "OM_")) (org-ml-to-trimmed-string)) => ":OM_KEY: OM_VAL" ;; TODO add example for planning (:buffer "#+begin_special" "#+end_special") (org-ml->> (org-ml-parse-this-element) (org-ml-map-property :type #'s-upcase) (org-ml-to-trimmed-string)) => (:result "#+begin_SPECIAL" "#+end_SPECIAL") ;; TODO add example for src block ;; TODO add example for statistics cookie (:buffer "<>") (org-ml->> (org-ml-parse-this-object) (org-ml-map-property :value #'s-upcase) (org-ml-to-trimmed-string)) => "<>" (:buffer "=I am not a crook=") (org-ml->> (org-ml-parse-this-object) (org-ml-map-property :value #'s-upcase) (org-ml-to-trimmed-string)) => "=I AM NOT A CROOK=" :end-hidden) (defexamples-content org-ml-toggle-property nil (:buffer "\\pi") (org-ml->> (org-ml-parse-this-object) (org-ml-toggle-property :use-brackets-p) (org-ml-to-trimmed-string)) => "\\pi{}" ;; TODO test src/example block preserve indent :begin-hidden (:buffer "* headline") (org-ml->> (org-ml-parse-this-headline) (org-ml-toggle-property :archivedp) (org-ml-to-trimmed-string)) => "* headline :ARCHIVE:" (org-ml->> (org-ml-parse-this-headline) (org-ml-toggle-property :commentedp) (org-ml-to-trimmed-string)) => "* COMMENT headline" (org-ml->> (org-ml-parse-this-headline) (org-ml-toggle-property :footnote-section-p) (org-ml-to-trimmed-string)) => "* Footnotes" (:buffer "sub_woofer") (org-ml->> (org-ml-parse-object-at 5) (org-ml-toggle-property :use-brackets-p) (org-ml-to-trimmed-string)) => "_{woofer}" (:buffer "super^woofer") (org-ml->> (org-ml-parse-object-at 7) (org-ml-toggle-property :use-brackets-p) (org-ml-to-trimmed-string)) => "^{woofer}" :end-hidden (:buffer "- [ ] nope") (:comment "Throw an error when trying to toggle a non-boolean property") (org-ml->> (org-ml-parse-this-item) (org-ml-toggle-property :checkbox) (org-ml-to-trimmed-string)) !!> arg-type-error) (defexamples-content org-ml-shift-property nil (:buffer "* no priorities") (:comment "Do nothing if there is nothing to shift.") (org-ml->> (org-ml-parse-this-headline) (org-ml-shift-property :priority 1) (org-ml-to-trimmed-string)) => "* no priorities" (:buffer "* [#A] priorities") (org-ml->> (org-ml-parse-this-headline) (org-ml-shift-property :priority -1) (org-ml-to-trimmed-string)) => "* [#B] priorities" (:comment "Wrap priority around when crossing the min or max") (org-ml->> (org-ml-parse-this-headline) (org-ml-shift-property :priority 1) (org-ml-to-trimmed-string)) => "* [#C] priorities" :begin-hidden (org-ml->> (org-ml-parse-this-headline) (org-ml-shift-property :priority -2) (org-ml-to-trimmed-string)) => "* [#C] priorities" :end-hidden (:buffer "* TODO or not todo") (:comment "Throw error when shifting an unshiftable property") (org-ml->> (org-ml-parse-this-headline) (org-ml-shift-property :todo-keyword 1) (org-ml-to-string)) !!> arg-type-error :begin-hidden (:buffer "*bold*") (org-ml->> (org-ml-parse-this-object) (org-ml-shift-property :post-blank 1) (org-ml-to-string)) => "*bold* " (org-ml->> (org-ml-parse-this-object) (org-ml-shift-property :post-blank -1) (org-ml-to-string)) => "*bold*" (:buffer "1. thing") (org-ml->> (org-ml-parse-this-item) (org-ml-shift-property :counter 1) (org-ml-to-trimmed-string)) => "1. thing" (:buffer "1. [@1] thing") (org-ml->> (org-ml-parse-this-item) (org-ml-shift-property :counter 1) (org-ml-to-trimmed-string)) => "1. [@2] thing" (org-ml->> (org-ml-parse-this-item) (org-ml-shift-property :counter -1) (org-ml-to-trimmed-string)) => "1. [@1] thing" (:buffer "* noob level") (org-ml->> (org-ml-parse-this-headline) (org-ml-shift-property :level 1) (org-ml-to-trimmed-string)) => "** noob level" (:comment "Do nothing when final value is less than one.") (org-ml->> (org-ml-parse-this-headline) (org-ml-shift-property :level -1) (org-ml-to-trimmed-string)) => "* noob level" (:buffer "* headline" "stuff") (org-ml->> (org-ml-parse-this-headline) (org-ml-shift-property :pre-blank 1) (org-ml-to-trimmed-string)) => (:result "* headline" "" "stuff") (org-ml->> (org-ml-parse-this-headline) (org-ml-shift-property :pre-blank -1) (org-ml-to-trimmed-string)) => (:result "* headline" "stuff") :end-hidden) (defexamples-content org-ml-insert-into-property nil (:buffer "#+call: ktulu(y=1)") (org-ml->> (org-ml-parse-this-element) (org-ml-insert-into-property :arguments 0 "x=4") (org-ml-to-trimmed-string)) => "#+call: ktulu(x=4,y=1)" (:comment "Do nothing if the string is already in the list") (org-ml->> (org-ml-parse-this-element) (org-ml-insert-into-property :arguments 0 "y=1") (org-ml-to-trimmed-string)) => "#+call: ktulu(y=1)" (:comment "Throw error when inserting into a property that is not a list of strings") (org-ml->> (org-ml-parse-this-element) (org-ml-insert-into-property :end-header 0 "html") (org-ml-to-trimmed-string)) !!> arg-type-error :begin-hidden (:buffer "* headline :tag1:") (org-ml->> (org-ml-parse-this-headline) (org-ml-insert-into-property :tags 0 "tag0") (org-ml-to-trimmed-string)) => "* headline :tag0:tag1:" (:buffer "#+begin_example -n" "#+end_example") (org-ml->> (org-ml-parse-this-element) (org-ml-insert-into-property :switches -1 "-r") (org-ml-to-trimmed-string)) => (:result "#+begin_example -n -r" "#+end_example") (:buffer "call_ktulu(y=1)") (org-ml->> (org-ml-parse-this-object) (org-ml-insert-into-property :arguments 0 "x=4") (org-ml-to-trimmed-string)) => "call_ktulu(x=4,y=1)" (:buffer "{{{economics(x=4)}}}") (org-ml->> (org-ml-parse-this-object) (org-ml-insert-into-property :args 0 "z=2") (org-ml-to-trimmed-string)) => "{{{economics(z=2,x=4)}}}" (:buffer "#+begin_src emacs-lisp -n" "#+end_src") (org-ml->> (org-ml-parse-this-element) (org-ml-insert-into-property :switches -1 "-r") (org-ml-to-trimmed-string)) => (:result "#+begin_src emacs-lisp -n -r" "#+end_src") (:buffer "| a |" "#+TBLFM: x=$2") (org-ml->> (org-ml-parse-this-element) (org-ml-insert-into-property :tblfm -1 "y=$3") (org-ml-to-trimmed-string)) => (:result "| a |" "#+TBLFM: y=$3" "#+TBLFM: x=$2") :end-hidden) (defexamples-content org-ml-remove-from-property nil (:buffer "#+call: ktulu(y=1)") (org-ml->> (org-ml-parse-this-element) (org-ml-remove-from-property :arguments "y=1") (org-ml-to-trimmed-string)) => "#+call: ktulu()" (:comment "Do nothing if the string does not exist") (org-ml->> (org-ml-parse-this-element) (org-ml-remove-from-property :arguments "d=666") (org-ml-to-trimmed-string)) => "#+call: ktulu(y=1)" (:comment "Throw error when removing from property that is not a string list") (org-ml->> (org-ml-parse-this-element) (org-ml-remove-from-property :end-header ":results") (org-ml-to-trimmed-string)) !!> arg-type-error :begin-hidden (:buffer "* headline :tag1:") (org-ml->> (org-ml-parse-this-headline) (org-ml-remove-from-property :tags "tag1") (org-ml-to-trimmed-string)) => "* headline" (:buffer "#+begin_example -n" "#+end_example") (org-ml->> (org-ml-parse-this-element) (org-ml-remove-from-property :switches "-n") (org-ml-to-trimmed-string)) => (:result "#+begin_example" "#+end_example") (:buffer "call_ktulu(y=1)") (org-ml->> (org-ml-parse-this-object) (org-ml-remove-from-property :arguments "y=1") (org-ml-to-trimmed-string)) => "call_ktulu()" (:buffer "{{{economics(x=4)}}}") (org-ml->> (org-ml-parse-this-object) (org-ml-remove-from-property :args "x=4") (org-ml-to-trimmed-string)) => "{{{economics}}}" (:buffer "#+begin_src emacs-lisp -n" "#+end_src") (org-ml->> (org-ml-parse-this-element) (org-ml-remove-from-property :switches "-n") (org-ml-to-trimmed-string)) => (:result "#+begin_src emacs-lisp" "#+end_src") (:buffer "| a |" "#+TBLFM: x=$2") (org-ml->> (org-ml-parse-this-element) (org-ml-remove-from-property :tblfm "x=$2") (org-ml-to-trimmed-string)) => "| a |" :end-header) (defexamples-content org-ml-plist-put-property nil (:buffer "#+call: ktulu[:cache no]()") (org-ml->> (org-ml-parse-this-element) (org-ml-plist-put-property :end-header :results 'html) (org-ml-to-trimmed-string)) => "#+call: ktulu[:cache no]() :results html" (:comment "Change the value of key if it already is present") (org-ml->> (org-ml-parse-this-element) (org-ml-plist-put-property :inside-header :cache 'yes) (org-ml-to-trimmed-string)) => "#+call: ktulu[:cache yes]()" (:comment "Do nothing if the key and value already exist") (org-ml->> (org-ml-parse-this-element) (org-ml-plist-put-property :inside-header :cache 'no) (org-ml-to-trimmed-string)) => "#+call: ktulu[:cache no]()" (:comment "Throw error if setting property that isn't a plist") (org-ml->> (org-ml-parse-this-element) (org-ml-plist-put-property :arguments :cache 'no) (org-ml-to-trimmed-string)) !!> arg-type-error :begin-hidden (:buffer "#+begin: blockhead :format \"[%s]\"" "#+end:") (org-ml->> (org-ml-parse-this-element) (org-ml-plist-put-property :arguments :format "<%s>") (org-ml-to-trimmed-string)) => (:result "#+begin: blockhead :format \"<%s>\"" "#+end:") (:buffer "call_ktulu[:cache no]()") (org-ml->> (org-ml-parse-this-object) (org-ml-plist-put-property :inside-header :cache 'yes) (org-ml-plist-put-property :end-header :results 'html) (org-ml-to-trimmed-string)) => "call_ktulu[:cache yes]()[:results html]" (:buffer "src_emacs-lisp[:exports results]{}") (org-ml->> (org-ml-parse-this-object) (org-ml-plist-put-property :parameters :exports 'both) (org-ml-to-trimmed-string)) => "src_emacs-lisp[:exports both]{}" (:buffer "#+begin_src emacs-lisp -n :exports results" "#+end_src") (org-ml->> (org-ml-parse-this-element) (org-ml-plist-put-property :parameters :exports 'both) (org-ml-to-trimmed-string)) => (:result "#+begin_src emacs-lisp -n :exports both" "#+end_src") :end-hidden) (defexamples-content org-ml-plist-remove-property nil (:buffer "#+call: ktulu() :results html") (org-ml->> (org-ml-parse-this-element) (org-ml-plist-remove-property :end-header :results) (org-ml-to-trimmed-string)) => "#+call: ktulu()" (:comment "Do nothing if the key is not present") (org-ml->> (org-ml-parse-this-element) (org-ml-plist-remove-property :inside-header :cache) (org-ml-to-trimmed-string)) => "#+call: ktulu() :results html" (:comment "Throw error if trying to remove key from non-plist property") (org-ml->> (org-ml-parse-this-element) (org-ml-plist-remove-property :arguments :cache) (org-ml-to-trimmed-string)) !!> arg-type-error :begin-hidden (:buffer "#+begin: blockhead :format \"[%s]\"" "#+end:") (org-ml->> (org-ml-parse-this-element) (org-ml-plist-remove-property :arguments :format) (org-ml-to-trimmed-string)) => (:result "#+begin: blockhead" "#+end:") (:buffer "call_ktulu[:cache no]()[:results html]") (org-ml->> (org-ml-parse-this-object) (org-ml-plist-remove-property :inside-header :cache) (org-ml-plist-remove-property :end-header :results) (org-ml-to-trimmed-string)) => "call_ktulu()" (:buffer "src_emacs-lisp[:exports results]{}") (org-ml->> (org-ml-parse-this-object) (org-ml-plist-remove-property :parameters :exports) (org-ml-to-trimmed-string)) => "src_emacs-lisp{}" (:buffer "#+begin_src emacs-lisp -n :exports results" "#+end_src") (org-ml->> (org-ml-parse-this-element) (org-ml-plist-remove-property :parameters :exports) (org-ml-to-trimmed-string)) => (:result "#+begin_src emacs-lisp -n" "#+end_src") :end-hidden) ;; (defexamples-content org-ml-property-is-nil-p ;; nil ;; (:buffer "* TODO dummy") ;; (->> (org-ml-parse-this-headline) ;; (org-ml-property-is-nil-p :todo-keyword)) ;; => nil ;; (->> (org-ml-parse-this-headline) ;; (org-ml-property-is-nil-p :commentedp)) ;; => t) ;; (defexamples-content org-ml-property-is-non-nil-p ;; nil ;; (:buffer "* TODO dummy") ;; (->> (org-ml-parse-this-headline) ;; (org-ml-property-is-non-nil-p :todo-keyword)) ;; => t ;; (->> (org-ml-parse-this-headline) ;; (org-ml-property-is-non-nil-p :commentedp)) ;; => nil) ;; (defexamples-content org-ml-property-is-eq-p ;; nil ;; (:buffer "* [#A] dummy") ;; (->> (org-ml-parse-this-headline) ;; (org-ml-property-is-eq-p :priority ?A)) ;; => t ;; (->> (org-ml-parse-this-headline) ;; (org-ml-property-is-eq-p :priority ?B)) ;; => nil) ;; (defexamples-content org-ml-property-is-equal-p ;; nil ;; (:buffer "* TODO dummy") ;; (->> (org-ml-parse-this-headline) ;; (org-ml-property-is-equal-p :todo-keyword "TODO")) ;; => t ;; (->> (org-ml-parse-this-headline) ;; (org-ml-property-is-equal-p :todo-keyword "DONE")) ;; => nil) ;; (defexamples-content org-ml-property-is-predicate-p ;; nil ;; (:buffer "* this is a dummy") ;; (->> (org-ml-parse-this-headline) ;; (org-ml-property-is-predicate-p* ;; :title (s-contains? "dummy" (car it)))) ;; => t) (defexamples-content org-ml-get-properties nil (:buffer "call_ktulu[:cache no](x=4)[:exports results]") (->> (org-ml-parse-this-object) (org-ml-get-properties '(:call :inside-header :arguments :end-header))) => '("ktulu" (:cache no) ("x=4") (:exports results))) (defexamples-content org-ml-get-all-properties nil (:buffer "*bold*") (--> (org-ml-parse-this-object) (org-ml-get-all-properties it) (plist-put it :buffer nil) (plist-put it :parent nil)) => (list :begin 1 :post-affiliated nil :contents-begin 2 :contents-end 6 :end 7 :post-blank 0 :secondary nil :mode nil :granularity nil :cached nil :org-element--cache-sync-key nil :robust-begin nil :robust-end nil :true-level nil :buffer nil :deferred nil :structure nil :parent nil)) (defexamples-content org-ml-set-properties nil (:buffer "- thing") (org-ml->> (org-ml-parse-this-item) (org-ml-set-properties (list :bullet 1 :checkbox 'on :counter 2 :tag '("tmsu"))) (org-ml-to-trimmed-string)) => "1. [@2] [X] tmsu :: thing" (:buffer "- plain") (org-ml->> (org-ml-parse-this-element) (org-ml-set-properties (list :name "plain name" :attr_XXX '("tmsu"))) (org-ml-to-trimmed-string)) => (:result "#+name: plain name" "#+attr_xxx: tmsu" "- plain")) (defexamples-content org-ml-map-properties nil (:buffer "#+KEY: VAL") (org-ml->> (org-ml-parse-this-element) (org-ml-map-properties (list :key (-partial #'s-prepend "OM_") :value (-partial #'s-prepend "OM_"))) (org-ml-to-trimmed-string)) => "#+om_key: OM_VAL" (:comment "Throw error if any of the properties are invalid") (org-ml->> (org-ml-parse-this-element) (org-ml-map-properties* (:title (s-prepend "OM_" it) :value (s-prepend "OM_" it))) (org-ml-to-trimmed-string)) !!> error ) (defexamples-content org-ml-get-parents nil (:buffer "* one" "** two" "*** three") (->> (org-ml-parse-this-subtree) (org-ml-get-parents) (--map (org-ml-get-property :begin it))) => '(1) (->> (org-ml-parse-this-subtree) (org-ml-headline-get-subheadlines) (car) (org-ml-headline-get-subheadlines) (car) (org-ml-get-parents) (--map (org-ml-get-property :begin it))) => '(1 7 14)) (defexamples-content org-ml-remove-parent nil (:buffer "one") (:comment "This is actually a paragraph node, but parsing the object" "will directly return a plain-text node with the :parent" "pointing to the paragraph") (org-ml->> (org-ml-parse-this-object) (org-ml-remove-parent)) => "one" (defexamples-content org-ml-remove-parents nil (:buffer "one") (org-ml->> (org-ml-parse-this-element) (org-ml-remove-parents)) => '(paragraph (:begin 1 :end 4 :contents-begin 1 :contents-end 4 :post-blank 0 :post-affiliated 1 :parent nil) "one")) (:buffer "* headline") (org-ml->> (org-ml-parse-this-element) (org-ml-remove-parents) (org-ml-get-property :parent)) => nil (:buffer "- tag :: thingy") (org-ml->> (org-ml-parse-this-item) (org-ml-remove-parents) (org-ml-get-children) (car) (org-ml-get-property :parent)) nil :begin-hidden ;; for some reason the timestamps in planning don't have parents (:buffer "* headline" "SCHEDULED: <2021-08-27 Fri>") (->> (org-ml-parse-this-element) (org-ml-headline-get-planning) (org-ml-get-property :scheduled) ;; (org-ml-remove-parents) (org-ml-get-property :parent) => nil) ;; same thing with clocks... (:buffer "* headline" "CLOCK: [2021-08-27 Fri 23:31]--[2021-08-28 Sat 00:45] => 1:14") (->> (org-ml-parse-this-element) (org-ml-headline-get-logbook-clocks nil) (car) (org-ml-get-property :value) (org-ml-get-property :parent) => nil) :end-hidden )) (def-example-subgroup "Clock" nil (defexamples-content org-ml-clock-is-running nil (:buffer "CLOCK: [2019-01-01 Tue 00:00]") (->> (org-ml-parse-this-element) (org-ml-clock-is-running)) => t (:buffer "CLOCK: [2019-01-01 Tue 00:00]--[2019-01-02 Wed 00:00] => 24:00") (->> (org-ml-parse-this-element) (org-ml-clock-is-running)) => nil)) (def-example-subgroup "Entity" nil (defexamples-content org-ml-entity-get-replacement nil (:buffer "\\pi{}") (->> (org-ml-parse-this-object) (org-ml-entity-get-replacement :latex)) => "\\pi" (->> (org-ml-parse-this-object) (org-ml-entity-get-replacement :latex-math-p)) => t (->> (org-ml-parse-this-object) (org-ml-entity-get-replacement :html)) => "π" (->> (org-ml-parse-this-object) (org-ml-entity-get-replacement :ascii)) => "pi" (->> (org-ml-parse-this-object) (org-ml-entity-get-replacement :latin1)) => "pi" (->> (org-ml-parse-this-object) (org-ml-entity-get-replacement :utf-8)) => "π")) (def-example-subgroup "Headline" nil (defexamples-content org-ml-headline-set-title! nil (:buffer "* really impressive title") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-title! "really *impressive* title" '(2 3)) (org-ml-to-trimmed-string)) => "* really *impressive* title [2/3]") (defexamples-content org-ml-headline-is-done nil (:buffer "* TODO darn") (->> (org-ml-parse-this-headline) (org-ml-headline-is-done)) => nil (:buffer "* DONE yay") (->> (org-ml-parse-this-headline) (org-ml-headline-is-done)) => t) (defexamples-content org-ml-headline-has-tag nil (:buffer "* dummy") (->> (org-ml-parse-this-headline) (org-ml-headline-has-tag "tmsu")) => nil (:buffer "* dummy :tmsu:") (->> (org-ml-parse-this-headline) (org-ml-headline-has-tag "tmsu")) => t) (defexamples-content org-ml-headline-get-statistics-cookie nil (:buffer "* statistically significant [10/10]") (->> (org-ml-parse-this-headline) (org-ml-headline-get-statistics-cookie) (org-ml-to-string)) => "[10/10]" (:buffer "* not statistically significant") (->> (org-ml-parse-this-headline) (org-ml-headline-get-statistics-cookie)) => nil) ;; TODO add the shortcut version title setter ) ;; TODO add inlinetask (def-example-subgroup "Item" nil ;; TODO add shortcut tag setter (defexamples-content org-ml-item-toggle-checkbox nil (:buffer "- [ ] one") (org-ml->> (org-ml-parse-this-item) (org-ml-item-toggle-checkbox) (org-ml-to-trimmed-string)) => "- [X] one" (:buffer "- [-] one") (:comment "Ignore trans state checkboxes") (org-ml->> (org-ml-parse-this-item) (org-ml-item-toggle-checkbox) (org-ml-to-trimmed-string)) => "- [-] one" (:buffer "- one") (:comment "Do nothing if there is no checkbox") (org-ml->> (org-ml-parse-this-item) (org-ml-item-toggle-checkbox) (org-ml-to-trimmed-string)) => "- one")) (def-example-subgroup "Statistics Cookie" nil (defexamples-content org-ml-statistics-cookie-is-complete nil (:buffer "* statistically significant [10/10]") (->> (org-ml-parse-this-headline) (org-ml-headline-get-statistics-cookie) (org-ml-statistics-cookie-is-complete)) => t (:buffer "* statistically significant [1/10]") (->> (org-ml-parse-this-headline) (org-ml-headline-get-statistics-cookie) (org-ml-statistics-cookie-is-complete)) => nil (:buffer "* statistically significant [100%]") (->> (org-ml-parse-this-headline) (org-ml-headline-get-statistics-cookie) (org-ml-statistics-cookie-is-complete)) => t (:buffer "* statistically significant [33%]") (->> (org-ml-parse-this-headline) (org-ml-headline-get-statistics-cookie) (org-ml-statistics-cookie-is-complete)) => nil)) ;; ;; TODO add these ;; (def-example-subgroup "Timestamp (Auxiliary)" ;; "Functions to work with timestamp data" ;; (defexamples-content org-ml-time-is-long ;; nil) ;; (defexamples-content org-ml-time-to-unixtime ;; nil) ;; (defexamples-content org-ml-unixtime-to-time-long ;; nil) ;; (defexamples-content org-ml-unixtime-to-time-short ;; nil)) ;; (def-example-subgroup "Timestamp (Standard)" ;; nil (defexamples-content org-ml-timestamp-get-start-time nil (:buffer "[2019-01-01 Tue]") (->> (org-ml-parse-this-object) (org-ml-timestamp-get-start-time)) => '(2019 1 1 nil nil) (:buffer "[2019-01-01 Tue]--[2019-01-02 Wed]") (->> (org-ml-parse-this-object) (org-ml-timestamp-get-start-time)) => '(2019 1 1 nil nil) (:buffer "[2019-01-01 Tue 00:00-12:00]") (->> (org-ml-parse-this-object) (org-ml-timestamp-get-start-time)) => '(2019 1 1 0 0)) (defexamples-content org-ml-timestamp-get-end-time nil (:buffer "[2019-01-01 Tue]") (->> (org-ml-parse-this-object) (org-ml-timestamp-get-end-time)) => nil (:buffer "[2019-01-01 Tue]--[2019-01-02 Wed]") (->> (org-ml-parse-this-object) (org-ml-timestamp-get-end-time)) => '(2019 1 2 nil nil) (:buffer "[2019-01-01 Tue]--[2019-01-01 Tue]") (->> (org-ml-parse-this-object) (org-ml-timestamp-get-end-time)) => '(2019 1 1 nil nil) (:buffer "[2019-01-01 Tue 00:00-12:00]") (->> (org-ml-parse-this-object) (org-ml-timestamp-get-end-time)) => '(2019 1 1 12 0)) (defexamples-content org-ml-timestamp-get-range nil (:buffer "[2019-01-01 Tue]") (->> (org-ml-parse-this-object) (org-ml-timestamp-get-range)) => 0 (:buffer "[2019-01-01 Tue]--[2019-01-02 Wed]") (->> (org-ml-parse-this-object) (org-ml-timestamp-get-range)) => 86400 (:buffer "[2019-01-01 Tue 00:00-12:00]") (->> (org-ml-parse-this-object) (org-ml-timestamp-get-range)) => 43200) (defexamples-content org-ml-timestamp-is-active nil (:buffer "<2019-01-01 Tue>") (->> (org-ml-parse-this-object) (org-ml-timestamp-is-active)) => t (:buffer "[2019-01-01 Tue]") (->> (org-ml-parse-this-object) (org-ml-timestamp-is-active)) => nil) (defexamples-content org-ml-timestamp-is-ranged nil (:buffer "[2019-01-01 Tue]--[2019-01-02 Wed]") (->> (org-ml-parse-this-object) (org-ml-timestamp-is-ranged)) => t (:buffer "[2019-01-01 Tue 00:00-12:00]") (->> (org-ml-parse-this-object) (org-ml-timestamp-is-ranged)) => t (:buffer "[2019-01-01 Tue]") (->> (org-ml-parse-this-object) (org-ml-timestamp-is-ranged)) => nil) (defexamples-content org-ml-timestamp-range-contains-p nil (:buffer "[2019-01-01 Tue 00:00]") (let ((ut (org-ml-timelist-to-unixtime '(2019 1 1 0 0)))) (->> (org-ml-parse-this-object) (org-ml-timestamp-range-contains-p ut))) => t (let ((ut (org-ml-timelist-to-unixtime '(2019 1 1 0 30)))) (->> (org-ml-parse-this-object) (org-ml-timestamp-range-contains-p ut))) => nil (:buffer "[2019-01-01 Tue 00:00-01:00]") (let ((ut (org-ml-timelist-to-unixtime '(2019 1 1 0 30)))) (->> (org-ml-parse-this-object) (org-ml-timestamp-range-contains-p ut))) => t) (defexamples-content org-ml-timestamp-set-collapsed nil (:buffer "[2019-01-01 Tue 12:00-13:00]") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-collapsed nil) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue 12:00]--[2019-01-01 Tue 13:00]" (:buffer "[2019-01-01 Tue 12:00-13:00]") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-collapsed nil) (org-ml-timestamp-set-collapsed t) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue 12:00-13:00]" (:buffer "[2019-01-01 Tue 12:00]") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-collapsed nil) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue 12:00]" (:buffer "[2019-01-01 Tue]--[2019-01-02 Wed]") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-collapsed nil) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue]--[2019-01-02 Wed]") (defexamples-content org-ml-timestamp-get-warning nil (:buffer "[2019-01-01 Tue 12:00]") (->> (org-ml-parse-this-object) (org-ml-timestamp-get-warning)) => nil (:buffer "[2019-01-01 Tue 12:00 -1d]") (->> (org-ml-parse-this-object) (org-ml-timestamp-get-warning)) => '(all 1 day)) (defexamples-content org-ml-timestamp-set-warning nil (:buffer "[2019-01-01 Tue 12:00]") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-warning nil) (org-ml-to-string)) => "[2019-01-01 Tue 12:00]" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-warning '(all 1 day)) (org-ml-to-string)) => "[2019-01-01 Tue 12:00 -1d]" (:buffer "[2019-01-01 Tue 12:00]") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-warning nil) (org-ml-to-string)) => "[2019-01-01 Tue 12:00]" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-warning '(all 1 year)) (org-ml-to-string)) => "[2019-01-01 Tue 12:00 -1y]") (defexamples-content org-ml-timestamp-map-warning nil (:buffer "[2019-01-01 Tue 12:00 -1d]") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-map-warning* (-let (((y v u) it)) `(,y ,(1+ v) ,u))) (org-ml-to-string)) => "[2019-01-01 Tue 12:00 -2d]") (defexamples-content org-ml-timestamp-get-repeater nil (:buffer "[2019-01-01 Tue 12:00]") (->> (org-ml-parse-this-object) (org-ml-timestamp-get-repeater)) => nil (:buffer "[2019-01-01 Tue 12:00 +1d]") (->> (org-ml-parse-this-object) (org-ml-timestamp-get-repeater)) => '(cumulate 1 day) (:buffer "[2019-01-01 Tue 12:00 +1d/3d]") (->> (org-ml-parse-this-object) (org-ml-timestamp-get-repeater)) => '(cumulate 1 day)) (defexamples-content org-ml-timestamp-get-deadline nil (:buffer "[2019-01-01 Tue 12:00]") (->> (org-ml-parse-this-object) (org-ml-timestamp-get-deadline)) => nil (:buffer "[2019-01-01 Tue 12:00 +1d]") (->> (org-ml-parse-this-object) (org-ml-timestamp-get-deadline)) => nil (:buffer "[2019-01-01 Tue 12:00 +1d/3d]") (->> (org-ml-parse-this-object) (org-ml-timestamp-get-deadline)) => '(3 day)) (defexamples-content org-ml-timestamp-set-repeater nil (:buffer "[2019-01-01 Tue 12:00]") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-repeater nil) (org-ml-to-string)) => "[2019-01-01 Tue 12:00]" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-repeater '(restart 1 day)) (org-ml-to-string)) => "[2019-01-01 Tue 12:00 .+1d]" :begin-hidden (:buffer "[2019-01-01 Tue 12:00 .+1d]") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-repeater nil) (org-ml-to-string)) => "[2019-01-01 Tue 12:00]" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-repeater '(cumulate 1 day)) (org-ml-to-string)) => "[2019-01-01 Tue 12:00 +1d]" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-repeater '(cumulate 1 day)) (org-ml-to-string)) => "[2019-01-01 Tue 12:00 +1d]" (:buffer "[2019-01-01 Tue 12:00 .+1d/3d]") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-repeater nil) (org-ml-to-string)) => "[2019-01-01 Tue 12:00]" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-repeater '(cumulate 1 day)) (org-ml-to-string)) => "[2019-01-01 Tue 12:00 +1d/3d]" :end-hidden) (defexamples-content org-ml-timestamp-set-deadline nil (:buffer "[2019-01-01 Tue 12:00]") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-deadline nil) (org-ml-to-string)) => "[2019-01-01 Tue 12:00]" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-deadline '(3 day)) (org-ml-to-string)) => "[2019-01-01 Tue 12:00]" (:buffer "[2019-01-01 Tue 12:00 .+1d]") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-deadline nil) (org-ml-to-string)) => "[2019-01-01 Tue 12:00 .+1d]" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-deadline '(3 day)) (org-ml-to-string)) => "[2019-01-01 Tue 12:00 .+1d/3d]" :begin-hidden (:buffer "[2019-01-01 Tue 12:00 .+1d/3d]") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-deadline nil) (org-ml-to-string)) => "[2019-01-01 Tue 12:00 .+1d]" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-deadline '(5 day)) (org-ml-to-string)) => "[2019-01-01 Tue 12:00 .+1d/5d]" :end-hidden) (defexamples-content org-ml-timestamp-map-repeater nil (:buffer "[2019-01-01 Tue 12:00 +1d]") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-map-repeater* (-let (((y v u) it)) `(,y ,(1+ v) ,u))) (org-ml-to-string)) => "[2019-01-01 Tue 12:00 +2d]") (defexamples-content org-ml-timestamp-set-start-time nil (:buffer "[2019-01-02 Wed]") (:comment "If not a range this will turn into a range by moving only the start time.") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-start-time '(2019 1 1)) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue]--[2019-01-02 Wed]" (:comment "Set a different time with different precision.") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-start-time '(2019 1 1 10 0)) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue 10:00]--[2019-01-02 Wed]" (:buffer "[2019-01-02 Wed 12:00]") (:comment "If not a range and set within a day, use short format") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-start-time '(2019 1 2 0 0)) (org-ml-to-trimmed-string)) => "[2019-01-02 Wed 00:00-12:00]" :begin-hidden (:buffer "[2019-01-02 Wed 12:00 +1d]") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-start-time '(2019 1 2 0 0)) (org-ml-to-trimmed-string)) => "[2019-01-02 Wed 00:00-12:00 +1d]" (:buffer "[2019-01-02 Wed 12:00 +1d/3d]") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-start-time '(2019 1 2 0 0)) (org-ml-to-trimmed-string)) => "[2019-01-02 Wed 00:00-12:00 +1d/3d]" :end-hidden) (defexamples-content org-ml-timestamp-set-end-time nil (:buffer "[2019-01-01 Tue]") (:comment "Add the end time") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-end-time '(2019 1 2)) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue]--[2019-01-02 Wed]" (:buffer "[2019-01-01 Tue]--[2019-01-02 Wed]") (:comment "Remove the end time") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-end-time nil) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue]" (:buffer "[2019-01-01 Tue 12:00]") (:comment "Use short range format") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-end-time '(2019 1 1 13 0)) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue 12:00-13:00]") (defexamples-content org-ml-timestamp-set-single-time nil (:buffer "[2019-01-01 Tue]") (:comment "Don't make a range") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-single-time '(2019 1 2)) (org-ml-to-trimmed-string)) => "[2019-01-02 Wed]" (:buffer "[2019-01-01 Tue]--[2019-01-02 Wed]") (:comment "Output is not a range despite input being ranged") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-single-time '(2019 1 3)) (org-ml-to-trimmed-string)) => "[2019-01-03 Thu]") (defexamples-content org-ml-timestamp-set-double-time nil (:buffer "[2019-01-01 Tue]") (:comment "Make a range") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-double-time '(2019 1 2) '(2019 1 3)) (org-ml-to-trimmed-string)) => "[2019-01-02 Wed]--[2019-01-03 Thu]" (:buffer "[2019-01-01 Tue]--[2019-01-03 Wed]") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-double-time '(2019 1 4) '(2019 1 5)) (org-ml-to-trimmed-string)) => "[2019-01-04 Fri]--[2019-01-05 Sat]" (:buffer "[2019-01-01 Tue]--[2019-01-03 Wed]") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-double-time '(2019 1 1 0 0) '(2019 1 1 1 0)) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue 00:00]--[2019-01-01 Tue 01:00]") (defexamples-content org-ml-timestamp-set-length nil (:buffer "[2019-01-01 Tue]") (:comment "Use days as the unit for short format") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-length 1 'day) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue]--[2019-01-02 Wed]" (:buffer "[2019-01-01 Tue 00:00]") (:comment "Use minutes as the unit for long format") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-length 3 'minute) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue 00:00-00:03]" (:buffer "[2019-01-01 Tue]--[2019-01-03 Wed]") (:comment "Set range to 0 to remove end time") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-length 0 'day) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue]") (defexamples-content org-ml-timestamp-set-active nil (:buffer "[2019-01-01 Tue]") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-active t) (org-ml-to-trimmed-string)) => "<2019-01-01 Tue>" (:buffer "<2019-01-01 Tue>") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-active nil) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue]") (defexamples-content org-ml-timestamp-shift nil (:buffer "[2019-01-01 Tue 12:00]") (:comment "Change each unit, and wrap around to the next unit as needed.") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-shift 30 'minute) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue 12:30]" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-shift 13 'month) (org-ml-to-trimmed-string)) => "[2020-02-01 Sat 12:00]" :begin-hidden (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-shift 60 'minute) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue 13:00]" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-shift 1 'hour) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue 13:00]" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-shift 1 'day) (org-ml-to-trimmed-string)) => "[2019-01-02 Wed 12:00]" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-shift 31 'day) (org-ml-to-trimmed-string)) => "[2019-02-01 Fri 12:00]" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-shift 1 'month) (org-ml-to-trimmed-string)) => "[2019-02-01 Fri 12:00]" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-shift 1 'year) (org-ml-to-trimmed-string)) => "[2020-01-01 Wed 12:00]" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-shift 0 'year) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue 12:00]" :end-hidden (:buffer "[2019-01-01 Tue]") (:comment "Error when shifting hour/minute in short format") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-shift 30 'minute) (org-ml-to-trimmed-string)) !!> arg-type-error :begin-hidden (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-shift 30 'hour) (org-ml-to-trimmed-string)) !!> arg-type-error :end-hidden) (defexamples-content org-ml-timestamp-shift-start nil (:buffer "[2019-01-01 Tue 12:00]") (:comment "If not a range, change start time and leave implicit end time.") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-shift-start -1 'year) (org-ml-to-trimmed-string)) => "[2018-01-01 Mon 12:00]--[2019-01-01 Tue 12:00]" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-shift-start -1 'hour) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue 11:00-12:00]" (:buffer "[2019-01-01 Tue]--[2019-01-03 Thu]") (:comment "Change only start time if a range") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-shift-start 1 'day) (org-ml-to-trimmed-string)) => "[2019-01-02 Wed]--[2019-01-03 Thu]") (defexamples-content org-ml-timestamp-shift-end nil (:buffer "[2019-01-01 Tue]") (:comment "Shift implicit end time if not a range.") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-shift-end 1 'day) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue]--[2019-01-02 Wed]" (:buffer "[2019-01-01 Tue]--[2019-01-02 Wed]") (:comment "Move only the second time if a range.") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-shift-end 1 'day) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue]--[2019-01-03 Thu]") (defexamples-content org-ml-timestamp-toggle-active nil (:buffer "[2019-01-01 Tue]") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-toggle-active) (org-ml-to-trimmed-string)) => "<2019-01-01 Tue>" :begin-hidden (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-toggle-active) (org-ml-timestamp-toggle-active) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue]" :end-hidden (:buffer "<2019-01-01 Tue>--<2019-01-02 Wed>") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-toggle-active) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue]--[2019-01-02 Wed]" :begin-hidden (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-toggle-active) (org-ml-timestamp-toggle-active) (org-ml-to-trimmed-string)) => "<2019-01-01 Tue>--<2019-01-02 Wed>" :end-hidden) (defexamples-content org-ml-timestamp-truncate nil (:buffer "[2019-01-01 Tue]--[2019-01-02 Wed]") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-truncate) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue]--[2019-01-02 Wed]" (:buffer "[2019-01-01 Tue 12:00]--[2019-01-02 Wed 13:00]") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-truncate) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue]--[2019-01-02 Wed]") (defexamples-content org-ml-timestamp-truncate-start nil (:buffer "[2019-01-01 Tue 12:00]") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-truncate-start) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue]" (:buffer "[2019-01-01 Tue 12:00]--[2019-01-02 Wed 12:00]") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-truncate-start) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue]--[2019-01-02 Wed 12:00]" (:buffer "[2019-01-01 Tue]") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-truncate-start) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue]") (defexamples-content org-ml-timestamp-truncate-end nil (:buffer "[2019-01-01 Tue]--[2019-01-02 Wed]") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-truncate-end) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue]--[2019-01-02 Wed]" (:buffer "[2019-01-01 Tue 12:00]--[2019-01-02 Wed 13:00]") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-truncate-end) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue 12:00]--[2019-01-02 Wed]" (:buffer "[2019-01-01 Tue 12:00]") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-truncate-end) (org-ml-to-trimmed-string)) => "[2019-01-01 Tue 12:00]")) (def-example-subgroup "Timestamp (diary)" nil (defexamples-content org-ml-timestamp-diary-set-value nil (:buffer "<%%(diary-float t 4 2)>") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-value '(diary-float 1 3 2)) (org-ml-to-string)) => "<%%(diary-float 1 3 2)>") (defexamples-content org-ml-timestamp-diary-set-single-time nil (:buffer "<%%(diary-float t 4 2)>") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-single-time '(0 0)) (org-ml-to-string)) => "<%%(diary-float t 4 2) 00:00>" (:buffer "<%%(diary-float t 4 2) 00:01>") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-single-time nil) (org-ml-to-string)) => "<%%(diary-float t 4 2)>") (defexamples-content org-ml-timestamp-diary-set-double-time nil (:buffer "<%%(diary-float t 4 2)>") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-double-time '(0 0) '(0 1)) (org-ml-to-string)) => "<%%(diary-float t 4 2) 00:00-00:01>" (:buffer "<%%(diary-float t 4 2) 00:00-00:01>") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-double-time '(1 0) '(2 0)) (org-ml-to-string)) => "<%%(diary-float t 4 2) 01:00-02:00>" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-double-time '(1 0) nil) (org-ml-to-string)) => "<%%(diary-float t 4 2) 01:00>" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-double-time nil nil) (org-ml-to-string)) => "<%%(diary-float t 4 2)>" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-double-time nil '(2 0)) (org-ml-to-string)) !!> arg-type-error) (defexamples-content org-ml-timestamp-diary-get-start-time nil (:buffer "<%%(diary-float t 4 2)>") (->> (org-ml-parse-this-object) (org-ml-timestamp-diary-get-start-time)) => nil (:buffer "<%%(diary-float t 4 2) 12:00-13:00>") (->> (org-ml-parse-this-object) (org-ml-timestamp-diary-get-start-time)) => '(12 0)) (defexamples-content org-ml-timestamp-diary-set-start-time nil (:buffer "<%%(diary-float t 4 2)>") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-start-time '(0 0)) (org-ml-to-string)) => "<%%(diary-float t 4 2) 00:00>" (:buffer "<%%(diary-float t 4 2) 12:00>") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-start-time '(1 0)) (org-ml-to-string)) => "<%%(diary-float t 4 2) 01:00-12:00>" :begin-hidden (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-start-time '(0 0)) (org-ml-to-string)) => "<%%(diary-float t 4 2) 00:00-12:00>" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-start-time '(12 0)) (org-ml-to-string)) => "<%%(diary-float t 4 2) 12:00>" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-start-time nil) (org-ml-to-string)) !!> arg-type-error :end-hidden) (defexamples-content org-ml-timestamp-diary-get-end-time nil (:buffer "<%%(diary-float t 4 2)>") (->> (org-ml-parse-this-object) (org-ml-timestamp-diary-get-end-time)) => nil (:buffer "<%%(diary-float t 4 2) 12:00-13:00>") (->> (org-ml-parse-this-object) (org-ml-timestamp-diary-get-end-time)) => '(13 0)) (defexamples-content org-ml-timestamp-diary-set-end-time nil (:buffer "<%%(diary-float t 4 2)>") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-end-time '(0 0)) (org-ml-to-string)) => "<%%(diary-float t 4 2)>" (:buffer "<%%(diary-float t 4 2) 12:00>") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-end-time '(13 0)) (org-ml-to-string)) => "<%%(diary-float t 4 2) 12:00-13:00>" :begin-hidden (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-end-time nil) (org-ml-to-string)) => "<%%(diary-float t 4 2) 12:00>" :end-hidden) (defexamples-content org-ml-timestamp-diary-set-length nil (:buffer "<%%(diary-float t 4 2)>") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-length 1 'hour) (org-ml-to-string)) => "<%%(diary-float t 4 2)>" (:buffer "<%%(diary-float t 4 2) 12:00>") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-length 1 'hour) (org-ml-to-string)) => "<%%(diary-float t 4 2) 12:00-13:00>" (:buffer "<%%(diary-float t 4 2) 12:00-13:00>") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-length 0 'hour) (org-ml-to-string)) => "<%%(diary-float t 4 2) 12:00>" :begin-hidden (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-length 24 'hour) (org-ml-to-string)) => "<%%(diary-float t 4 2) 12:00>" :end-hidden) (defexamples-content org-ml-timestamp-diary-shift nil (:buffer "<%%(diary-float t 4 2)>") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-shift 1 'hour) (org-ml-to-string)) => "<%%(diary-float t 4 2)>" (:buffer "<%%(diary-float t 4 2) 12:00>") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-shift 1 'hour) (org-ml-to-string)) => "<%%(diary-float t 4 2) 13:00>" :begin-hidden (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-shift 24 'hour) (org-ml-to-string)) => "<%%(diary-float t 4 2) 12:00>" :end-hidden) (defexamples-content org-ml-timestamp-diary-shift-start nil (:buffer "<%%(diary-float t 4 2)>") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-shift-start 1 'hour) (org-ml-to-string)) => "<%%(diary-float t 4 2)>" (:buffer "<%%(diary-float t 4 2) 12:00>") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-shift-start -1 'hour) (org-ml-to-string)) => "<%%(diary-float t 4 2) 11:00-12:00>" :begin-hidden (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-shift-start 24 'hour) (org-ml-to-string)) => "<%%(diary-float t 4 2) 12:00>" :end-hidden) (defexamples-content org-ml-timestamp-diary-shift-end nil (:buffer "<%%(diary-float t 4 2)>") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-shift-end 1 'hour) (org-ml-to-string)) => "<%%(diary-float t 4 2)>" (:buffer "<%%(diary-float t 4 2) 12:00>") (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-shift-end 1 'hour) (org-ml-to-string)) => "<%%(diary-float t 4 2) 12:00-13:00>" :begin-hidden (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-shift-end 24 'hour) (org-ml-to-string)) => "<%%(diary-float t 4 2) 12:00>" :end-hidden )) (def-example-group "Branch/Child Manipulation" "Set, get, and map the children of branch nodes." (def-example-subgroup "Polymorphic" nil (defexamples-content org-ml-children-contain-point nil (:buffer "* headline" "findme") (->> (org-ml-parse-this-headline) (org-ml-children-contain-point 2)) => nil (->> (org-ml-parse-this-headline) (org-ml-children-contain-point 15)) => t) (defexamples-content org-ml-get-children nil (:buffer "/this/ is a *paragraph*") (:comment "Return child nodes for branch nodes") (->> (org-ml-parse-this-element) (org-ml-get-children) (-map #'org-ml-get-type)) => '(italic plain-text bold) (:buffer "* headline") (:comment "Return nil if no children") (->> (org-ml-parse-this-subtree) (org-ml-get-children) (-map #'org-ml-get-type)) => nil ;; (:buffer "#+call: ktulu()") ;; (:comment "Throw error when attempting to get contents of a non-branch node") ;; (->> (org-ml-parse-this-element) ;; (org-ml-get-children) ;; (-map #'org-ml-get-type)) ;; !!> arg-type-error :begin-hidden (:buffer "* headline" "stuff" "** subheadline") (:comment "Return child element nodes") (->> (org-ml-parse-this-subtree) (org-ml-get-children) (-map #'org-ml-get-type)) => '(section headline) (:buffer "| a | b |") (->> (org-ml-parse-this-table-row) (org-ml-get-children) (-map #'org-ml-get-type)) => '(table-cell table-cell) (:buffer "#+begin_verse" "verse /666/" "#+end_verse") (->> (org-ml-parse-this-element) (org-ml-get-children) (-map #'org-ml-get-type)) ;; plain-text for the newline at the end...I think => '(plain-text italic plain-text) (:buffer "#+begin_center" "paragraph thing" "#+end_center") (->> (org-ml-parse-this-element) (org-ml-get-children) (-map #'org-ml-get-type)) => '(paragraph) (:buffer ":LOGBOOK:" "- log entry" "CLOCK: [2019-01-01 Tue]" ":END:") (->> (org-ml-parse-this-element) (org-ml-get-children) (-map #'org-ml-get-type)) => '(plain-list clock) (:buffer "[fn:1] bigfoot") (->> (org-ml-parse-this-element) (org-ml-get-children) (-map #'org-ml-get-type)) => '(paragraph) (:buffer "- item" " - subitem") (->> (org-ml-parse-this-element) (org-ml-get-children) (-map #'org-ml-get-type)) => '(item) (->> (org-ml-parse-this-item) (org-ml-get-children) (-map #'org-ml-get-type)) => '(paragraph plain-list) (:buffer "* dummy" ":PROPERTIES:" ":ONE: one" ":TWO: two" ":END:") (->> (org-ml-parse-this-headline) (org-ml-headline-get-section) (-first-item) (org-ml-get-children) (-map #'org-ml-get-type)) => '(node-property node-property) (:buffer "#+begin_quote" "no pity for the majority" "#+end_quote") (->> (org-ml-parse-this-element) (org-ml-get-children) (-map #'org-ml-get-type)) => '(paragraph) ;; (:buffer "* dummy" ;; "stuff") ;; (->> (org-ml-parse-this-headline) ;; (org-ml-headline-get-section) ;; (org-ml-get-children) ;; (-map #'org-ml-get-type)) ;; => '(paragraph) (:buffer "| a |" "| b |") (->> (org-ml-parse-this-element) (org-ml-get-children) (-map #'org-ml-get-type)) => '(table-row table-row) :end-hidden) (defexamples-content org-ml-set-children nil (:buffer "/this/ is a *paragraph*") (:comment "Set children for branch object") (org-ml->> (org-ml-parse-this-element) (org-ml-set-children (list "this is lame")) (org-ml-to-trimmed-string)) => "this is lame" (:buffer "* headline") (:comment "Set children for branch element nodes") (org-ml->> (org-ml-parse-this-subtree) (org-ml-set-children (list (org-ml-build-headline! :title-text "only me" :level 2))) (org-ml-to-trimmed-string)) => (:result "* headline" "** only me") ;; (:buffer "#+call: ktulu()") ;; (:comment "Throw error when attempting to set children of a non-branch nodes") ;; (->> (org-ml-parse-this-element) ;; (org-ml-set-children "nil by mouth") ;; (org-ml-to-trimmed-string)) ;; !!> arg-type-error :begin-hidden ;; TODO add hidden tests :end-hidden) (defexamples-content org-ml-map-children nil (:buffer "/this/ is a *paragraph*") (org-ml->> (org-ml-parse-this-element) (org-ml-map-children (lambda (objs) (append objs (list " ...yeah")))) (org-ml-to-trimmed-string)) => "/this/ is a *paragraph* ...yeah" (:buffer "* headline" "** subheadline") (org-ml->> (org-ml-parse-this-subtree) (org-ml-map-children* (--map (org-ml-shift-property :level 1 it) it)) (org-ml-to-trimmed-string)) => (:result "* headline" "*** subheadline") ;; (:buffer "#+call: ktulu()") ;; (:comment "Throw error when attempting to map children of a non-branch node") ;; (->> (org-ml-parse-this-element) ;; (org-ml-map-children #'ignore) ;; (org-ml-to-trimmed-string)) ;; !!> arg-type-error :begin-hidden ;; TODO add hidden tests :end-hidden) (defexamples-content org-ml-is-childless nil (:buffer "* dummy" "filled with useless knowledge") (->> (org-ml-parse-this-headline) (org-ml-is-childless)) => nil (:buffer "* dummy") (->> (org-ml-parse-this-headline) (org-ml-is-childless)) => t ;; (:buffer "#+call: ktulu()") ;; (:comment "Throw error when attempting to determine if non-branch node is empty") ;; (->> (org-ml-parse-this-element) ;; (org-ml-is-childless)) ;; !!> arg-type-error )) (def-example-subgroup "Object Nodes" nil (defexamples-content org-ml-unwrap nil (:buffer "_1 *2* 3 */4/* 5 /6/_") (:comment "Remove the outer underline formatting") (org-ml->> (org-ml-parse-this-object) (org-ml-unwrap) (apply #'org-ml-build-paragraph) (org-ml-to-trimmed-string)) => "1 *2* 3 */4/* 5 /6/") (defexamples-content org-ml-unwrap-types-deep nil (:buffer "_1 *2* 3 */4/* 5 /6/_") (:comment "Remove bold formatting at any level") (org-ml->> (org-ml-parse-this-object) (org-ml-unwrap-types-deep '(bold)) (apply #'org-ml-build-paragraph) (org-ml-to-trimmed-string)) => "_1 2 3 /4/ 5 /6/_") (defexamples-content org-ml-unwrap-deep nil (:buffer "_1 *2* 3 */4/* 5 /6/_") (:comment "Remove all formatting") (org-ml->> (org-ml-parse-this-object) (org-ml-unwrap-deep) (apply #'org-ml-build-paragraph) (org-ml-to-trimmed-string)) => "1 2 3 4 5 6")) (def-example-subgroup "Secondary Strings" nil (defexamples-content org-ml-flatten nil (:buffer "This (1 *2* 3 */4/* 5 /6/) is randomly formatted") (:comment "Remove first level of formatting") (org-ml->> (org-ml-parse-this-element) (org-ml-map-children #'org-ml-flatten) (org-ml-to-trimmed-string)) => "This (1 2 3 /4/ 5 6) is randomly formatted") (defexamples-content org-ml-flatten-types-deep nil (:buffer "This (1 *2* 3 */4/* 5 /6/) is randomly formatted") (:comment "Remove italic formatting at any level") (org-ml->> (org-ml-parse-this-element) (org-ml-map-children* (org-ml-flatten-types-deep '(italic) it)) (org-ml-to-trimmed-string)) => "This (1 *2* 3 *4* 5 6) is randomly formatted") (defexamples-content org-ml-flatten-deep nil (:buffer "This (1 *2* 3 */4/* 5 /6/) is randomly formatted") (:comment "Remove italic formatting at any level") (org-ml->> (org-ml-parse-this-element) (org-ml-map-children #'org-ml-flatten-deep) (org-ml-to-trimmed-string)) => "This (1 2 3 4 5 6) is randomly formatted")) (def-example-subgroup "Item" nil (defexamples-content org-ml-item-get-paragraph nil (:buffer "- one") (->> (org-ml-parse-this-item) (org-ml-item-get-paragraph)) => '("one") (:buffer "- ") (->> (org-ml-parse-this-item) (org-ml-item-get-paragraph)) => nil) (defexamples-content org-ml-item-set-paragraph nil (:buffer "- one") (org-ml->> (org-ml-parse-this-item) (org-ml-item-set-paragraph '("two")) (org-ml-to-string)) => "- two\n" (:buffer "- one") (org-ml->> (org-ml-parse-this-item) (org-ml-item-set-paragraph nil) (org-ml-to-string)) => "- \n") (defexamples-content org-ml-item-map-paragraph nil (:buffer "- one") (org-ml->> (org-ml-parse-this-item) (org-ml-item-map-paragraph* (-map #'upcase it)) (org-ml-to-string)) => "- ONE\n")) (def-example-subgroup "Headline" nil (defexamples-content org-ml-headline-get-section nil (:buffer "* headline 1" "sectional stuff" "** headline 2" "** headline 3") (->> (org-ml-parse-this-subtree) (org-ml-headline-get-section) (-map #'org-ml-to-trimmed-string)) => '("sectional stuff") (:buffer "* headline 1" "** headline 2" "** headline 3") (->> (org-ml-parse-this-subtree) (org-ml-headline-get-section) (org-ml-to-trimmed-string)) => "") (defexamples-content org-ml-headline-set-section nil (:buffer "* headline") (org-ml->> (org-ml-parse-this-subtree) (org-ml-headline-set-section (list (org-ml-build-paragraph! "x-section"))) (org-ml-to-trimmed-string)) => (:result "* headline" "x-section") (:buffer "* headline" "x-section") (org-ml->> (org-ml-parse-this-subtree) (org-ml-headline-set-section (list (org-ml-build-paragraph! "x-guard"))) (org-ml-to-trimmed-string)) => (:result "* headline" "x-guard") (org-ml->> (org-ml-parse-this-subtree) (org-ml-headline-set-section nil) (org-ml-to-trimmed-string)) => "* headline") (defexamples-content org-ml-headline-map-section nil (:buffer "* headline" "x-section") (org-ml->> (org-ml-parse-this-subtree) (org-ml-headline-map-section* (cons (org-ml-build-planning! :closed '(2019 1 1)) it)) (org-ml-to-trimmed-string)) => (:result "* headline" "CLOSED: [2019-01-01 Tue]" "x-section")) (defexamples-content org-ml-headline-get-subheadlines nil (:buffer "* headline 1" "sectional stuff" "** headline 2" "** headline 3") (org-ml->> (org-ml-parse-this-subtree) (org-ml-headline-get-subheadlines) (-map #'org-ml-to-trimmed-string)) => '("** headline 2" "** headline 3") (:buffer "* headline 1" "sectional stuff") (org-ml->> (org-ml-parse-this-subtree) (org-ml-headline-get-subheadlines) (-map #'org-ml-to-trimmed-string)) => nil) (defexamples-content org-ml-headline-set-subheadlines nil (:buffer "* headline 1" "sectional stuff" "** headline 2" "** headline 3") (org-ml->> (org-ml-parse-this-subtree) (org-ml-headline-set-subheadlines (list (org-ml-build-headline! :level 2 :title-text "headline x"))) (org-ml-to-trimmed-string)) => (:result "* headline 1" "sectional stuff" "** headline x") (org-ml->> (org-ml-parse-this-subtree) (org-ml-headline-set-subheadlines nil) (org-ml-to-trimmed-string)) => (:result "* headline 1" "sectional stuff")) (defexamples-content org-ml-headline-map-subheadlines nil (:buffer "* headline 1" "** headline 2" "** headline 3") (org-ml->> (org-ml-parse-this-subtree) (org-ml-headline-map-subheadlines* (--map (org-ml-set-property :todo-keyword "TODO" it) it)) (org-ml-to-trimmed-string)) => (:result "* headline 1" "** TODO headline 2" "** TODO headline 3"))) (def-example-subgroup "Headline (metadata)" nil (defexamples-content org-ml-headline-get-planning nil (:buffer "* headline" "CLOSED: [2019-01-01 Tue]") (->> (org-ml-parse-this-headline) (org-ml-headline-get-planning)) => '(:closed (2019 1 1 nil nil) :scheduled nil :deadline nil) (:buffer "* headline") (->> (org-ml-parse-this-headline) (org-ml-headline-get-planning)) => nil) (defexamples-content org-ml-headline-set-planning nil (:buffer "* headline") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-planning '(:closed (2019 1 1))) (org-ml-to-trimmed-string)) => (:result "* headline" "CLOSED: [2019-01-01 Tue]") (:buffer "* headline" "CLOSED: [2019-01-01 Tue]") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-planning '(:scheduled (2019 1 1))) (org-ml-to-trimmed-string)) => (:result "* headline" "SCHEDULED: <2019-01-01 Tue>") (:buffer "* headline" "CLOSED: [2019-01-01 Tue]") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-planning nil) (org-ml-to-trimmed-string)) => "* headline" :begin-hidden (:buffer "* headline" "" "rest") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-planning '(:scheduled (2019 1 1))) (org-ml-to-trimmed-string)) => (:result "* headline" "SCHEDULED: <2019-01-01 Tue>" "" "rest") (:buffer "* headline" "SCHEDULED: <2019-01-01 Tue>" "" "rest") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-planning nil) (org-ml-to-trimmed-string)) => (:result "* headline" "" "rest") :end-hidden ) (defexamples-content org-ml-headline-map-planning nil (:buffer "* headline" "CLOSED: [2019-01-01 Tue]") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-map-planning* (list :closed (org-ml-timelist-shift 1 'day (plist-get it :closed)))) (org-ml-to-trimmed-string)) => (:result "* headline" "CLOSED: [2019-01-02 Wed]")) (defexamples-content org-ml-headline-get-node-properties nil (:buffer "* headline" ":PROPERTIES:" ":Effort: 1:00" ":ID: minesfake" ":END:") (->> (org-ml-parse-this-headline) (org-ml-headline-get-node-properties)) => '(("Effort" "1:00") ("ID" "minesfake")) (:buffer "* headline") (->> (org-ml-parse-this-headline) (org-ml-headline-get-node-properties) (-map #'org-ml-to-trimmed-string)) => nil :begin-hidden (:buffer "* headline" "CLOSED: [2019-01-01 Tue]" ":PROPERTIES:" ":Effort: 1:00" ":ID: minesfake" ":END:") (->> (org-ml-parse-this-headline) (org-ml-headline-get-node-properties)) => '(("Effort" "1:00") ("ID" "minesfake")) :end-hidden) (defexamples-content org-ml-headline-set-node-properties nil (:buffer "* headline" ":PROPERTIES:" ":Effort: 1:00" ":ID: minesfake" ":END:") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-node-properties '(("Effort" "0:01") ("ID" "easy"))) (org-ml-to-trimmed-string)) => (:result "* headline" ":PROPERTIES:" ":Effort: 0:01" ":ID: easy" ":END:") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-node-properties nil) (org-ml-to-trimmed-string)) => "* headline" :begin-hidden (:buffer "* headline" "CLOSED: [2019-01-01 Tue]" ":PROPERTIES:" ":Effort: 1:00" ":ID: minesfake" ":END:") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-node-properties '(("Effort" "0:01") ("ID" "easy"))) (org-ml-to-trimmed-string)) => (:result "* headline" "CLOSED: [2019-01-01 Tue]" ":PROPERTIES:" ":Effort: 0:01" ":ID: easy" ":END:") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-node-properties nil) (org-ml-to-trimmed-string)) => (:result "* headline" "CLOSED: [2019-01-01 Tue]") (:buffer "* headline" "" "section") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-node-properties '(("New" "world man"))) (org-ml-to-trimmed-string)) => (:result "* headline" ":PROPERTIES:" ":New: world man" ":END:" "" "section") (:buffer "* headline" "CLOSED: [2019-01-01 Tue]" "" "section") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-node-properties '(("New" "world man"))) (org-ml-to-trimmed-string)) => (:result "* headline" "CLOSED: [2019-01-01 Tue]" ":PROPERTIES:" ":New: world man" ":END:" "" "section") (:buffer "* headline" "CLOSED: [2019-01-01 Tue]" ":PROPERTIES:" ":Effort: 0:01" ":ID: easy" ":END:" "" "section") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-node-properties nil) (org-ml-to-trimmed-string)) => (:result "* headline" "CLOSED: [2019-01-01 Tue]" "" "section")) (defexamples-content org-ml-headline-map-node-properties nil (:buffer "* headline" ":PROPERTIES:" ":Effort: 1:00" ":ID: minesfake" ":END:") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-map-node-properties* (cons (list "New" "world man") it)) (org-ml-to-trimmed-string)) => (:result "* headline" ":PROPERTIES:" ":New: world man" ":Effort: 1:00" ":ID: minesfake" ":END:") ;; assume this will work with planning in front because ;; we already tested the get/set base functions ) ;; assume these will work when planning is in front since ;; they are all based on the -map-properties (plural) functions ;; and these have already been tested (defexamples-content org-ml-headline-get-node-property nil (:buffer "* headline" ":PROPERTIES:" ":ID: fake" ":END:") (->> (org-ml-parse-this-headline) (org-ml-headline-get-node-property "ID")) => "fake" (:buffer "* headline" ":PROPERTIES:" ":ID: fake" ":END:") (->> (org-ml-parse-this-headline) (org-ml-headline-get-node-property "READ_ID")) => nil) (defexamples-content org-ml-headline-set-node-property nil (:buffer "* headline" ":PROPERTIES:" ":ID: fake" ":END:") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-node-property "ID" "real") (org-ml-to-trimmed-string)) => (:result "* headline" ":PROPERTIES:" ":ID: real" ":END:") (:buffer "* headline") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-node-property "ID" "real") (org-ml-to-trimmed-string)) => (:result "* headline" ":PROPERTIES:" ":ID: real" ":END:") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-node-property "ID" nil) (org-ml-to-trimmed-string)) => "* headline" (:buffer "* headline" ":PROPERTIES:" ":ID: real" ":END:") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-node-property "ID" nil) (org-ml-to-trimmed-string)) => "* headline") (defexamples-content org-ml-headline-map-node-property nil (:buffer "* headline" ":PROPERTIES:" ":ID: fake" ":END:") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-map-node-property "ID" #'s-upcase) (org-ml-to-trimmed-string)) => (:result "* headline" ":PROPERTIES:" ":ID: FAKE" ":END:"))) (def-example-subgroup "Headline (logbook and contents)" nil (defexamples-content org-ml-headline-get-supercontents nil (:buffer "* headline" "CLOSED: [2019-01-01 Tue 00:00]" ":PROPERTIES:" ":Effort: 0:30" ":END:" ":LOGGING:" "- Note taken on [2018-12-31 Mon 00:00] \\\\" " log note" ":END:" ":CLOCKING:" "CLOCK: [2019-01-01 Tue 00:00]" ":END:" "contents") (let ((config (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING"))) (->> (org-ml-parse-this-headline) (org-ml-headline-get-supercontents config) (org-ml-supercontents-get-logbook) (org-ml-logbook-get-items) (-map #'org-ml-to-trimmed-string))) => '("- Note taken on [2018-12-31 Mon 00:00] \\\\\n log note") (let ((config (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING"))) (->> (org-ml-parse-this-headline) (org-ml-headline-get-supercontents config) (org-ml-supercontents-get-logbook) (org-ml-logbook-get-clocks) (-map #'org-ml-to-trimmed-string))) => '("CLOCK: [2019-01-01 Tue 00:00]") (let ((config (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING"))) (->> (org-ml-parse-this-headline) (org-ml-headline-get-supercontents config) (org-ml-supercontents-get-logbook) (alist-get :unknown) (-map #'org-ml-to-trimmed-string))) => nil (let ((config (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING"))) (->> (org-ml-parse-this-headline) (org-ml-headline-get-supercontents config) (org-ml-supercontents-get-contents) (-map #'org-ml-to-trimmed-string))) => '("contents")) (defexamples-content org-ml-headline-set-supercontents nil (:buffer "* headline" "CLOSED: [2019-01-01 Tue 00:00]" ":PROPERTIES:" ":Effort: 0:30" ":END:" ":LOGGING:" "- Note taken on [2018-12-31 Mon 00:00] \\\\" " log note" ":END:" ":CLOCKING:" "CLOCK: [2019-01-01 Tue 00:00]" ":END:" "contents") (let ((config (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING"))) (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-supercontents config `(:blank 0 :contents ,(list (org-ml-build-paragraph! "new contents")))) (org-ml-to-trimmed-string))) => (:result "* headline" "new contents")) (defexamples-content org-ml-headline-map-supercontents nil (:buffer "* headline" "CLOSED: [2019-01-01 Tue 00:00]" ":PROPERTIES:" ":Effort: 0:30" ":END:" ":LOGGING:" "- Note taken on [2018-12-31 Mon 00:00] \\\\" " log note" ":END:" ":CLOCKING:" "CLOCK: [2019-01-01 Tue 00:00]" ":END:" "contents") (let ((config (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING"))) (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-map-supercontents* config (org-ml-supercontents-map-contents* (cons (org-ml-build-paragraph! "new contents") it) it)) (org-ml-to-trimmed-string))) => (:result "* headline" "CLOSED: [2019-01-01 Tue 00:00]" ":PROPERTIES:" ":Effort: 0:30" ":END:" ":LOGGING:" "- Note taken on [2018-12-31 Mon 00:00] \\\\" " log note" ":END:" ":CLOCKING:" "CLOCK: [2019-01-01 Tue 00:00]" ":END:" "new contents" "contents")) (defexamples-content org-ml-headline-get-logbook-items nil (:buffer "* headline" "CLOSED: [2019-01-01 Tue 00:00]" ":PROPERTIES:" ":Effort: 0:30" ":END:" ":LOGGING:" "- Note taken on [2018-12-31 Mon 00:00] \\\\" " log note" ":END:" ":CLOCKING:" "CLOCK: [2019-01-01 Tue 00:00]" ":END:" "contents") (let ((config (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING"))) (->> (org-ml-parse-this-headline) (org-ml-headline-get-logbook-items config) (-map #'org-ml-to-trimmed-string))) => '("- Note taken on [2018-12-31 Mon 00:00] \\\\\n log note")) (defexamples-content org-ml-headline-set-logbook-items nil (:buffer "* headline" "CLOSED: [2019-01-01 Tue 00:00]" ":PROPERTIES:" ":Effort: 0:30" ":END:" ":LOGGING:" "- Note taken on [2018-12-31 Mon 00:00] \\\\" " log note" ":END:" ":CLOCKING:" "CLOCK: [2019-01-01 Tue 00:00]" ":END:" "contents") (let ((config (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING"))) (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-logbook-items config nil) (org-ml-to-trimmed-string))) => (:result "* headline" "CLOSED: [2019-01-01 Tue 00:00]" ":PROPERTIES:" ":Effort: 0:30" ":END:" ":CLOCKING:" "CLOCK: [2019-01-01 Tue 00:00]" ":END:" "contents") :begin-hidden (:buffer "* headline" "CLOSED: [2019-01-01 Tue 00:00]" ":PROPERTIES:" ":Effort: 0:30" ":END:" ":LOGGING:" "- Note taken on [2018-12-31 Mon 00:00] \\\\" " log note" ":END:" "" "contents") (let ((config (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING"))) (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-logbook-items config nil) (org-ml-to-trimmed-string))) => (:result "* headline" "CLOSED: [2019-01-01 Tue 00:00]" ":PROPERTIES:" ":Effort: 0:30" ":END:" "" "contents") :end-hidden) (defexamples-content org-ml-headline-map-logbook-items nil (:buffer "* headline" "CLOSED: [2019-01-01 Tue 00:00]" ":PROPERTIES:" ":Effort: 0:30" ":END:" ":LOGGING:" "- Note taken on [2018-12-31 Mon 00:00] \\\\" " log note" ":END:" ":CLOCKING:" "CLOCK: [2019-01-01 Tue 00:00]" ":END:" "contents") (let ((config (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING"))) (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-map-logbook-items* config (--map (org-ml-map-children* (--map (org-ml-map-children* (--map-when (org-ml-is-type 'plain-text it) (upcase it) it) it) it) it) it)) (org-ml-to-trimmed-string))) => (:result "* headline" "CLOSED: [2019-01-01 Tue 00:00]" ":PROPERTIES:" ":Effort: 0:30" ":END:" ":LOGGING:" "- NOTE TAKEN ON [2018-12-31 Mon 00:00] \\\\" " LOG NOTE" ":END:" ":CLOCKING:" "CLOCK: [2019-01-01 Tue 00:00]" ":END:" "contents")) (defexamples-content org-ml-headline-get-logbook-clocks nil (:buffer "* headline" "CLOSED: [2019-01-01 Tue 00:00]" ":PROPERTIES:" ":Effort: 0:30" ":END:" ":LOGGING:" "- Note taken on [2018-12-31 Mon 00:00] \\\\" " log note" ":END:" ":CLOCKING:" "CLOCK: [2019-01-01 Tue 00:00]" ":END:" "contents") (let ((config (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING"))) (->> (org-ml-parse-this-headline) (org-ml-headline-get-logbook-clocks config) (-map #'org-ml-to-trimmed-string))) => '("CLOCK: [2019-01-01 Tue 00:00]")) (defexamples-content org-ml-headline-set-logbook-clocks nil (:buffer "* headline" "CLOSED: [2019-01-01 Tue 00:00]" ":PROPERTIES:" ":Effort: 0:30" ":END:" ":LOGGING:" "- Note taken on [2018-12-31 Mon 00:00] \\\\" " log note" ":END:" ":CLOCKING:" "CLOCK: [2019-01-01 Tue 00:00]" ":END:" "contents") (let ((config (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING"))) (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-logbook-clocks config nil) (org-ml-to-trimmed-string))) => (:result "* headline" "CLOSED: [2019-01-01 Tue 00:00]" ":PROPERTIES:" ":Effort: 0:30" ":END:" ":LOGGING:" "- Note taken on [2018-12-31 Mon 00:00] \\\\" " log note" ":END:" "contents")) (defexamples-content org-ml-headline-map-logbook-clocks nil (:buffer "* headline" "CLOSED: [2019-01-01 Tue 00:00]" ":PROPERTIES:" ":Effort: 0:30" ":END:" ":LOGGING:" "- Note taken on [2018-12-31 Mon 00:00] \\\\" " log note" ":END:" ":CLOCKING:" "CLOCK: [2019-01-01 Tue 00:00]" ":END:" "contents") (let ((config (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING"))) (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-map-logbook-clocks* config (--map (org-ml-map-property* :value (org-ml-timestamp-shift 1 'day it) it) it)) (org-ml-to-trimmed-string))) => (:result "* headline" "CLOSED: [2019-01-01 Tue 00:00]" ":PROPERTIES:" ":Effort: 0:30" ":END:" ":LOGGING:" "- Note taken on [2018-12-31 Mon 00:00] \\\\" " log note" ":END:" ":CLOCKING:" "CLOCK: [2019-01-02 Wed 00:00]" ":END:" "contents")) (defexamples-content org-ml-headline-get-contents nil (:buffer "* headline") (->> (org-ml-parse-this-headline) (org-ml-headline-get-contents (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t)) (-map #'org-ml-to-trimmed-string)) => nil (:buffer "* headline" "something") (->> (org-ml-parse-this-headline) (org-ml-headline-get-contents (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t)) (-map #'org-ml-to-trimmed-string)) => '("something") (:buffer "* headline" "CLOSED: [2019-01-01 Tue 00:00]" ":LOGBOOK:" "- Note taken on [2018-12-31 Mon 00:00] \\\\" " log note" "CLOCK: [2019-01-01 Tue 00:00]" ":END:" "" "- not log") (->> (org-ml-parse-this-headline) (org-ml-headline-get-contents (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t)) (-map #'org-ml-to-trimmed-string)) => '("- not log") (:buffer "* headline" "CLOSED: [2019-01-01 Tue 00:00]" ":LOGGING:" "- Note taken on [2018-12-31 Mon 00:00] \\\\" " log note" ":END:" ":CLOCKING:" "CLOCK: [2019-01-01 Tue 00:00]" ":END:" "" "- not log") (->> (org-ml-parse-this-headline) (org-ml-headline-get-contents (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING")) (-map #'org-ml-to-trimmed-string)) => '("- not log")) (defexamples-content org-ml-headline-set-contents nil (:buffer "* headline") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-contents (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t) (list (org-ml-build-paragraph! "I'm new"))) (org-ml-to-trimmed-string)) => (:result "* headline" "I'm new") (:buffer "* headline" "something") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-contents (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t) (list (org-ml-build-paragraph! "I'm new"))) (org-ml-to-trimmed-string)) => (:result "* headline" "I'm new") (:buffer "* headline" ":LOGBOOK:" "- Note taken on [2018-12-31 Mon 00:00] \\\\" " log1" ":END:" "something") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-contents (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t) (list (org-ml-build-paragraph! "I'm new"))) (org-ml-to-trimmed-string)) => (:result "* headline" ":LOGBOOK:" "- Note taken on [2018-12-31 Mon 00:00] \\\\" " log1" ":END:" "I'm new") (:buffer "* headline" ":LOGBOOK:" "- Note taken on [2018-12-31 Mon 00:00] \\\\" " log1" ":END:" "something") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-contents (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t) nil) (org-ml-to-trimmed-string)) => (:result "* headline" ":LOGBOOK:" "- Note taken on [2018-12-31 Mon 00:00] \\\\" " log1" ":END:")) (defexamples-content org-ml-headline-map-contents nil (:buffer "* headline" "something") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-map-contents* (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t) (cons (org-ml-build-paragraph! "I'm new") it)) (org-ml-to-trimmed-string)) => (:result "* headline" "I'm new" "something")) (defexamples-content org-ml-headline-logbook-append-item nil (:buffer "* headline") (let ((ut (- 1546300800 (car (current-time-zone))))) (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-logbook-append-item (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t) (org-ml-build-log-note ut "new note")) (org-ml-to-trimmed-string))) => (:result "* headline" ":LOGBOOK:" "- Note taken on [2019-01-01 Tue 00:00] \\\\" " new note" ":END:") (:buffer "* headline" ":LOGBOOK:" "- Note taken on [2018-12-31 Mon 00:00] \\\\" " old note" ":END:") (let ((ut (- 1546300800 (car (current-time-zone))))) (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-logbook-append-item (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t) (org-ml-build-log-note ut "new note")) (org-ml-to-trimmed-string))) => (:result "* headline" ":LOGBOOK:" "- Note taken on [2019-01-01 Tue 00:00] \\\\" " new note" "- Note taken on [2018-12-31 Mon 00:00] \\\\" " old note" ":END:") (:buffer "* headline" ":LOGGING:" "- Note taken on [2018-12-31 Mon 00:00] \\\\" " old note" ":END:" ":CLOCKING:" "CLOCK: [2112-01-01 Fri]" ":END:") (let ((ut (- 1546300800 (car (current-time-zone))))) (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-logbook-append-item (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING") (org-ml-build-log-note ut "new note")) (org-ml-to-trimmed-string))) => (:result "* headline" ":LOGGING:" "- Note taken on [2019-01-01 Tue 00:00] \\\\" " new note" "- Note taken on [2018-12-31 Mon 00:00] \\\\" " old note" ":END:" ":CLOCKING:" "CLOCK: [2112-01-01 Fri]" ":END:") ;; :begin-hidden ;; (:buffer "* headline" ;; "" ;; "something") ;; (let ((ut (- 1546300800 (car (current-time-zone))))) ;; (org-ml->> (org-ml-parse-this-headline) ;; (org-ml-headline-logbook-append-item ;; (list :log-into-drawer t ;; :clock-into-drawer t ;; :clock-out-notes t) ;; (org-ml-build-log-note ut "new note")) ;; (org-ml-to-trimmed-string))) ;; => (:result "* headline" ;; ":LOGBOOK:" ;; "- Note taken on [2019-01-01 Tue 00:00] \\\\" ;; " new note" ;; ":END:" ;; "" ;; "something") ;; :end-hidden ) (defexamples-content org-ml-headline-logbook-append-open-clock nil (:buffer "* headline") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-logbook-append-open-clock (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t) (- 1546300800 (car (current-time-zone)))) (org-ml-to-trimmed-string)) => (:result "* headline" ":LOGBOOK:" "CLOCK: [2019-01-01 Tue 00:00]" ":END:") (:buffer "* headline" ":LOGBOOK:" "- note taken on [2018-12-30 Sun 00:00]" ":END:") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-logbook-append-open-clock (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t) (- 1546300800 (car (current-time-zone)))) (org-ml-to-trimmed-string)) => (:result "* headline" ":LOGBOOK:" "CLOCK: [2019-01-01 Tue 00:00]" "- note taken on [2018-12-30 Sun 00:00]" ":END:") (:buffer "* headline" ":LOGGING:" "- note taken on [2018-12-30 Sun 00:00]" ":END:") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-logbook-append-open-clock (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING") (- 1546300800 (car (current-time-zone)))) (org-ml-to-trimmed-string)) => (:result "* headline" ":LOGGING:" "- note taken on [2018-12-30 Sun 00:00]" ":END:" ":CLOCKING:" "CLOCK: [2019-01-01 Tue 00:00]" ":END:")) (defexamples-content org-ml-headline-logbook-close-open-clock nil (:buffer "* headline" ":LOGBOOK:" "- note taken on [2018-12-30 Sun 00:00]" ":END:") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-logbook-close-open-clock (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t) (- 1546300800 (car (current-time-zone))) nil) (org-ml-to-trimmed-string)) => (:result "* headline" ":LOGBOOK:" "- note taken on [2018-12-30 Sun 00:00]" ":END:") (:buffer "* headline" ":LOGBOOK:" "CLOCK: [2018-12-31 Mon 00:00]" "- note taken on [2018-12-30 Sun 00:00]" ":END:") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-logbook-close-open-clock (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t) (- 1546300800 (car (current-time-zone))) nil) (org-ml-to-trimmed-string)) => (:result "* headline" ":LOGBOOK:" "CLOCK: [2018-12-31 Mon 00:00]--[2019-01-01 Tue 00:00] => 24:00" "- note taken on [2018-12-30 Sun 00:00]" ":END:") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-logbook-close-open-clock (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t) (- 1546300800 (car (current-time-zone))) "new note") (org-ml-to-trimmed-string)) => (:result "* headline" ":LOGBOOK:" "CLOCK: [2018-12-31 Mon 00:00]--[2019-01-01 Tue 00:00] => 24:00" "- new note" "- note taken on [2018-12-30 Sun 00:00]" ":END:") (:buffer "* headline" ":LOGGING:" "- note taken on [2018-12-30 Sun 00:00]" ":END:" ":CLOCKING:" "CLOCK: [2018-12-31 Mon 00:00]" ":END:") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-logbook-close-open-clock (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING" :clock-out-notes t) (- 1546300800 (car (current-time-zone))) nil) (org-ml-to-trimmed-string)) => (:result "* headline" ":LOGGING:" "- note taken on [2018-12-30 Sun 00:00]" ":END:" ":CLOCKING:" "CLOCK: [2018-12-31 Mon 00:00]--[2019-01-01 Tue 00:00] => 24:00" ":END:")) (defexamples-content org-ml-headline-logbook-convert-config nil (:buffer "* headline" "CLOCK: [2018-12-31 Mon 00:00]--[2019-01-01 Tue 00:00] => 24:00" "- note taken on [2018-12-30 Sun 00:00]") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-logbook-convert-config nil (list :log-into-drawer t :clock-into-drawer t)) (org-ml-to-trimmed-string)) => (:result "* headline" ":LOGBOOK:" "CLOCK: [2018-12-31 Mon 00:00]--[2019-01-01 Tue 00:00] => 24:00" "- note taken on [2018-12-30 Sun 00:00]" ":END:") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-logbook-convert-config nil (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING")) (org-ml-to-trimmed-string)) => (:result "* headline" ":LOGGING:" "- note taken on [2018-12-30 Sun 00:00]" ":END:" ":CLOCKING:" "CLOCK: [2018-12-31 Mon 00:00]--[2019-01-01 Tue 00:00] => 24:00" ":END:") (:buffer "* headline" ":LOGBOOK:" "CLOCK: [2018-12-31 Mon 00:00]--[2019-01-01 Tue 00:00] => 24:00" "- note taken on [2018-12-30 Sun 00:00]" ":END:") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-logbook-convert-config (list :log-into-drawer t :clock-into-drawer t) (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING")) (org-ml-to-trimmed-string)) => (:result "* headline" ":LOGGING:" "- note taken on [2018-12-30 Sun 00:00]" ":END:" ":CLOCKING:" "CLOCK: [2018-12-31 Mon 00:00]--[2019-01-01 Tue 00:00] => 24:00" ":END:"))) (def-example-subgroup "Headline (misc)" nil (defexamples-content org-ml-headline-get-path nil (:buffer "* one" "** two" "*** three") (->> (org-ml-parse-this-subtree) (org-ml-headline-get-path)) => '("one") (->> (org-ml-parse-this-subtree) (org-ml-headline-get-subheadlines) (car) (org-ml-headline-get-subheadlines) (car) (org-ml-headline-get-path)) => '("one" "two" "three")) (defexamples-content org-ml-headline-update-item-statistics nil (:buffer "* statistically significant [/]" "- irrelevant data" "- [ ] good data" "- [X] bad data") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-update-item-statistics) (org-ml-to-trimmed-string)) => (:result "* statistically significant [1/2]" "- irrelevant data" "- [ ] good data" "- [X] bad data") :begin-hidden (:buffer "* statistically significant [%]" "- irrelevant data" "- [ ] good data" "- [X] bad data") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-update-item-statistics) (org-ml-to-trimmed-string)) => (:result "* statistically significant [50%]" "- irrelevant data" "- [ ] good data" "- [X] bad data") :end-hidden (:buffer "* statistically significant" "- irrelevant data" "- [ ] good data" "- [X] bad data") (:comment "Do nothing if nothing to update") (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-update-item-statistics) (org-ml-to-trimmed-string)) => (:result "* statistically significant" "- irrelevant data" "- [ ] good data" "- [X] bad data")) (defexamples-content org-ml-headline-update-todo-statistics nil (:buffer "* statistically significant [/]" "** irrelevant data" "** TODO good data" "** DONE bad data") (org-ml->> (org-ml-parse-this-subtree) (org-ml-headline-update-todo-statistics) (org-ml-to-trimmed-string)) => (:result "* statistically significant [1/2]" "** irrelevant data" "** TODO good data" "** DONE bad data") :begin-hidden (:buffer "* statistically significant [%]" "** irrelevant data" "** TODO good data" "** DONE bad data") (org-ml->> (org-ml-parse-this-subtree) (org-ml-headline-update-todo-statistics) (org-ml-to-trimmed-string)) => (:result "* statistically significant [50%]" "** irrelevant data" "** TODO good data" "** DONE bad data") :end-hidden (:buffer "* statistically significant" "** irrelevant data" "** TODO good data" "** DONE bad data") (:comment "Do nothing if nothing to update") (org-ml->> (org-ml-parse-this-subtree) (org-ml-headline-update-todo-statistics) (org-ml-to-trimmed-string)) => (:result "* statistically significant" "** irrelevant data" "** TODO good data" "** DONE bad data")) (defexamples-content org-ml-headline-demote-subheadline nil (:buffer "* one" "** two" "** three" "*** four") (org-ml->> (org-ml-parse-element-at 1) (org-ml-headline-demote-subheadline 0) (org-ml-to-trimmed-string)) !!> error (org-ml->> (org-ml-parse-element-at 1) (org-ml-headline-demote-subheadline 1) (org-ml-to-trimmed-string)) => (:result "* one" "** two" "*** three" "*** four") :begin-hidden (:buffer "* one" "" "** two" "" "** three" "" "*** four") (->> (org-ml-parse-element-at 1) (org-ml-headline-demote-subheadline 1) (org-ml-to-trimmed-string)) => (:result "* one" "" "** two" "" "*** three" "" "*** four") (:buffer "* one" "" "** two" "" "*** two-ish" "" "** three" "" "*** four") (->> (org-ml-parse-element-at 1) (org-ml-headline-demote-subheadline 1) (org-ml-to-trimmed-string)) => (:result "* one" "" "** two" "" "*** two-ish" "" "*** three" "" "*** four") ;; TODO this is a bug in the interpreter that squishes whichspace from ;; internal nodes underneath headlines and section ;; ;; (:buffer "* one" ;; "something" ;; "" ;; "** two" ;; "something" ;; "" ;; "** three" ;; "something" ;; "" ;; "*** four") ;; (->> (org-ml-parse-element-at 1) ;; (org-ml-headline-demote-subheadline 1) ;; (org-ml-to-trimmed-string)) ;; => (:result "* one" ;; "something" ;; "" ;; "** two" ;; "something" ;; "" ;; "*** three" ;; "something" ;; "" ;; "*** four") :end-hidden) (defexamples-content org-ml-headline-demote-subtree nil (:buffer "* one" "** two" "** three" "*** four") (org-ml->> (org-ml-parse-element-at 1) (org-ml-headline-demote-subtree 1) (org-ml-to-trimmed-string)) => (:result "* one" "** two" "*** three" "**** four") :begin-hidden (:buffer "* one" "" "** two" "" "** three" "" "*** four") (org-ml->> (org-ml-parse-element-at 1) (org-ml-headline-demote-subtree 1) (org-ml-to-trimmed-string)) => (:result "* one" "" "** two" "" "*** three" "" "**** four") :end-hidden) (defexamples-content org-ml-headline-promote-subheadline nil (:buffer "* one" "** two" "** three" "*** four" "*** four" "*** four") (org-ml->> (org-ml-parse-element-at 1) (org-ml-headline-promote-subheadline 1 1) (org-ml-to-trimmed-string)) => (:result "* one" "** two" "** three" "*** four" "** four" "*** four") :begin-hidden (:buffer "* one" "** two" "** three" "*** four" "*** four" "**** five" "*** four") (org-ml->> (org-ml-parse-element-at 1) (org-ml-headline-promote-subheadline 1 1) (org-ml-to-trimmed-string)) => (:result "* one" "** two" "** three" "*** four" "** four" "*** five" "*** four") ;; TODO this is a whitespace bug in 9.7 ;; (:buffer "* one" ;; "" ;; "** two" ;; "" ;; "** three" ;; "" ;; "*** four" ;; "" ;; "*** four" ;; "" ;; "*** four") ;; (org-ml->> (org-ml-parse-element-at 1) ;; (org-ml-headline-promote-subheadline 1 1) ;; (org-ml-to-trimmed-string)) ;; => (:result "* one" ;; "" ;; "** two" ;; "" ;; "** three" ;; "" ;; "*** four" ;; "" ;; "** four" ;; "" ;; "*** four") :end-hidden) (defexamples-content org-ml-headline-promote-all-subheadlines nil (:buffer "* one" "** two" "** three" "*** four" "*** four" "*** four") (org-ml->> (org-ml-parse-element-at 1) (org-ml-headline-promote-all-subheadlines 1) (org-ml-to-trimmed-string)) => (:result "* one" "** two" "** three" "** four" "** four" "** four"))) (def-example-subgroup "Plain List" nil (defexamples-content org-ml-plain-list-set-type nil (:buffer "- [ ] one" "- [X] two") (org-ml->> (org-ml-parse-this-element) (org-ml-plain-list-set-type 'ordered) (org-ml-to-trimmed-string)) => (:result "1. [ ] one" "2. [X] two") (:buffer "1. [ ] one" "2. [X] two") (org-ml->> (org-ml-parse-this-element) (org-ml-plain-list-set-type 'unordered) (org-ml-to-trimmed-string)) => (:result "- [ ] one" "- [X] two")) (defexamples-content org-ml-plain-list-indent-item nil (:buffer "- one" "- two" " - three" "- four") (:comment "It makes no sense to indent the first item") (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-indent-item 0) (org-ml-to-trimmed-string)) !!> error (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-indent-item 1) (org-ml-to-trimmed-string)) => (:result "- one" " - two" " - three" "- four") (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-indent-item 2) (org-ml-to-trimmed-string)) => (:result "- one" "- two" " - three" " - four") :begin-hidden (:buffer "- one" "" "- two" "" "- four" "" " - five") (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-indent-item 2) (org-ml-to-trimmed-string)) => (:result "- one" "" "- two" "" " - four" "" " - five") (:buffer "- one" "" "- two" "" " - three" "" "- four" "" " - five") (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-indent-item 2) (org-ml-to-trimmed-string)) => (:result "- one" "" "- two" "" " - three" "" " - four" "" " - five") :end-hidden) (defexamples-content org-ml-plain-list-indent-item-tree nil (:buffer "- one" " - one-ish" "- two" " - three" "- four") (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-indent-item-tree 1) (org-ml-to-trimmed-string)) => (:result "- one" " - one-ish" " - two" " - three" "- four") :begin-hidden (:buffer "- one" "" "- two" "" " - three" "" "- four") (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-indent-item-tree 1) (org-ml-to-trimmed-string)) => (:result "- one" "" " - two" "" " - three" "" "- four") (:buffer "- one" "" " - one-ish" "" "- two" "" " - three" "" "- four") (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-indent-item-tree 1) (org-ml-to-trimmed-string)) => (:result "- one" "" " - one-ish" "" " - two" "" " - three" "" "- four") :end-hidden) (defexamples-content org-ml-plain-list-outdent-item nil (:buffer "- one" "- two" " - three" " - three" " - three" "- four") (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-outdent-item 1 0) (org-ml-to-trimmed-string)) => (:result "- one" "- two" "- three" " - three" " - three" "- four") (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-outdent-item 1 1) (org-ml-to-trimmed-string)) => (:result "- one" "- two" " - three" "- three" " - three" "- four") (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-outdent-item 2 1) (org-ml-to-trimmed-string)) => (:result "- one" "- two" " - three" " - three" " - three" "- four") :begin-hidden (:buffer "- one" "" "- two" "" " - three" "" " - three" "" " - three" "" "- four") (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-outdent-item 1 0) (org-ml-to-trimmed-string)) => (:result "- one" "" "- two" "" "- three" "" " - three" "" " - three" "" "- four") (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-outdent-item 1 1) (org-ml-to-trimmed-string)) => (:result "- one" "" "- two" "" " - three" "" "- three" "" " - three" "" "- four") (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-outdent-item 2 1) (org-ml-to-trimmed-string)) => (:result "- one" "" "- two" "" " - three" "" " - three" "" " - three" "" "- four") :end-hidden) (defexamples-content org-ml-plain-list-outdent-all-items nil (:buffer "- one" "- two" " - three" " - three" " - three" "- four") (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-outdent-all-items 1) (org-ml-to-trimmed-string)) => (:result "- one" "- two" "- three" "- three" "- three" "- four") (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-outdent-all-items 2) (org-ml-to-trimmed-string)) => (:result "- one" "- two" " - three" " - three" " - three" "- four") (:buffer "- one" "- two" " - three" " - three" " - three" " - three-ish" "- four") (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-outdent-all-items 1) (org-ml-to-trimmed-string)) => (:result "- one" "- two" "- three" "- three" "- three" " - three-ish" "- four") :begin-hidden (:buffer "- one" "" "- two" "" " - three" "" " - three" "" " - three" "" "- four") (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-outdent-all-items 1) (org-ml-to-trimmed-string)) => (:result "- one" "" "- two" "" "- three" "" "- three" "" "- three" "" "- four") (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-outdent-all-items 2) (org-ml-to-trimmed-string)) => (:result "- one" "" "- two" "" " - three" "" " - three" "" " - three" "" "- four") (:buffer "- one" "" "- two" "" " - three" "" " - three" "" " - three" "" " - three-ish" "" " rest" "" "- four") (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-outdent-all-items 1) (org-ml-to-trimmed-string)) => (:result "- one" "" "- two" "" "- three" "" "- three" "" "- three" "" " - three-ish" "" " rest" "" "- four") (:buffer "- one" "" "- two" "" " - three" "" " - three" "" " - three" "" " rest" "" "- four") (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-outdent-all-items 1) (org-ml-to-trimmed-string)) => (:result "- one" "" "- two" "" "- three" "" "- three" "" "- three" "" "rest" "" "- four") :end-hidden)) (def-example-subgroup "Table" nil (defexamples-content org-ml-table-get-cell nil (:buffer "| 1 | 2 | 3 |" "|---+---+---|" "| a | b | c |") (->> (org-ml-parse-this-element) (org-ml-table-get-cell 0 0) (org-ml-get-children) (car)) => "1" (->> (org-ml-parse-this-element) (org-ml-table-get-cell 1 1) (org-ml-get-children) (car)) => "b" (->> (org-ml-parse-this-element) (org-ml-table-get-cell -1 -1) (org-ml-get-children) (car)) => "c" :begin-hidden (->> (org-ml-parse-this-element) (org-ml-table-get-cell 0 3) (org-ml-get-children) (car)) !!> arg-type-error :end-hidden) (defexamples-content org-ml-table-delete-column nil (:buffer "| a | b |" "|---+---|" "| c | d |") (org-ml->> (org-ml-parse-this-element) (org-ml-table-delete-column 0) (org-ml-to-trimmed-string)) => (:result "| b |" "|---|" "| d |") (org-ml->> (org-ml-parse-this-element) (org-ml-table-delete-column 1) (org-ml-to-trimmed-string)) => (:result "| a |" "|---|" "| c |") (org-ml->> (org-ml-parse-this-element) (org-ml-table-delete-column -1) (org-ml-to-trimmed-string)) => (:result "| a |" "|---|" "| c |")) (defexamples-content org-ml-table-delete-row nil (:buffer "| a | b |" "|---+---|" "| c | d |") (org-ml->> (org-ml-parse-this-element) (org-ml-table-delete-row 0) (org-ml-to-trimmed-string)) => (:result "|---+---|" "| c | d |") (org-ml->> (org-ml-parse-this-element) (org-ml-table-delete-row 1) (org-ml-to-trimmed-string)) => (:result "| a | b |" "| c | d |") (org-ml->> (org-ml-parse-this-element) (org-ml-table-delete-row -1) (org-ml-to-trimmed-string)) => (:result "| a | b |" "|---+---|")) (defexamples-content org-ml-table-insert-column! nil (:buffer "| a | b |" "|---+---|" "| c | d |") (org-ml->> (org-ml-parse-this-element) (org-ml-table-insert-column! 1 '("x" "y")) (org-ml-to-trimmed-string)) => (:result "| a | x | b |" "|---+---+---|" "| c | y | d |") (org-ml->> (org-ml-parse-this-element) (org-ml-table-insert-column! -1 '("x" "y")) (org-ml-to-trimmed-string)) => (:result "| a | b | x |" "|---+---+---|" "| c | d | y |")) (defexamples-content org-ml-table-insert-row! nil (:buffer "| a | b |" "|---+---|" "| c | d |") (org-ml->> (org-ml-parse-this-element) (org-ml-table-insert-row! 1 '("x" "y")) (org-ml-to-trimmed-string)) => (:result "| a | b |" "| x | y |" "|---+---|" "| c | d |") (org-ml->> (org-ml-parse-this-element) (org-ml-table-insert-row! 2 '("x" "y")) (org-ml-to-trimmed-string)) => (:result "| a | b |" "|---+---|" "| x | y |" "| c | d |") (org-ml->> (org-ml-parse-this-element) (org-ml-table-insert-row! -1 '("x" "y")) (org-ml-to-trimmed-string)) => (:result "| a | b |" "|---+---|" "| c | d |" "| x | y |")) (defexamples-content org-ml-table-replace-cell! nil (:buffer "| 1 | 2 |" "|---+---|" "| a | b |") (org-ml->> (org-ml-parse-this-element) (org-ml-table-replace-cell! 0 0 "2") (org-ml-to-trimmed-string)) => (:result "| 2 | 2 |" "|---+---|" "| a | b |") (org-ml->> (org-ml-parse-this-element) (org-ml-table-replace-cell! 0 0 nil) (org-ml-to-trimmed-string)) => (:result "| | 2 |" "|---+---|" "| a | b |") (org-ml->> (org-ml-parse-this-element) (org-ml-table-replace-cell! -1 -1 "B") (org-ml-to-trimmed-string)) => (:result "| 1 | 2 |" "|---+---|" "| a | B |")) (defexamples-content org-ml-table-replace-column! nil (:buffer "| a | b |" "|---+---|" "| c | d |") (org-ml->> (org-ml-parse-this-element) (org-ml-table-replace-column! 0 '("A" "B")) (org-ml-to-trimmed-string)) => (:result "| A | b |" "|---+---|" "| B | d |") (org-ml->> (org-ml-parse-this-element) (org-ml-table-replace-column! 0 nil) (org-ml-to-trimmed-string)) => (:result "| | b |" "|---+---|" "| | d |") (org-ml->> (org-ml-parse-this-element) (org-ml-table-replace-column! -1 '("A" "B")) (org-ml-to-trimmed-string)) => (:result "| a | A |" "|---+---|" "| c | B |")) (defexamples-content org-ml-table-replace-row! nil (:buffer "| a | b |" "|---+---|" "| c | d |") (org-ml->> (org-ml-parse-this-element) (org-ml-table-replace-row! 0 '("A" "B")) (org-ml-to-trimmed-string)) => (:result "| A | B |" "|---+---|" "| c | d |") (org-ml->> (org-ml-parse-this-element) (org-ml-table-replace-row! 0 nil) (org-ml-to-trimmed-string)) => (:result "| | |" "|---+---|" "| c | d |") (org-ml->> (org-ml-parse-this-element) (org-ml-table-replace-row! -1 '("A" "B")) (org-ml-to-trimmed-string)) => (:result "| a | b |" "|---+---|" "| A | B |")))) (def-example-group "Node Matching" "Use pattern-matching to selectively perform operations on nodes in trees." (defexamples-content org-ml-match nil (:buffer "* headline 1" "** TODO headline 2" "stuff" "- item 1" "- item 2" "- item 3" "** DONE headline 3" "- item 4" "- item 5" "- item 6" "** TODO COMMENT headline 4" "- item 7" "- item 8" "- item 9") (:comment "Match items (excluding the first) in headlines that" "are marked \"TODO\" and not commented." "The :many keyword matches the section and plain-list" "nodes holding the items.") (->> (org-ml-parse-this-subtree) (org-ml-match '((:and (:todo-keyword "TODO") (:commentedp nil)) :any * (:and item (> 0)))) (-map #'org-ml-to-trimmed-string)) => '("- item 2" "- item 3") (:buffer "*one* *two* *three* *four* *five* *six*") (:comment "Return all bold nodes") (->> (org-ml-parse-this-element) (org-ml-match '(bold)) (-map #'org-ml-to-trimmed-string)) => '("*one*" "*two*" "*three*" "*four*" "*five*" "*six*") (:comment "Return first bold node") (->> (org-ml-parse-this-element) (org-ml-match '(:first bold)) (-map #'org-ml-to-trimmed-string)) => '("*one*") (:comment "Return last bold node") (->> (org-ml-parse-this-element) (org-ml-match '(:last bold)) (-map #'org-ml-to-trimmed-string)) => '("*six*") (:comment "Return a select bold node") (->> (org-ml-parse-this-element) (org-ml-match '(:nth 2 bold)) (-map #'org-ml-to-trimmed-string)) => '("*three*") (:comment "Return a sublist of matched bold nodes") (->> (org-ml-parse-this-element) (org-ml-match '(:sub 1 3 bold)) (-map #'org-ml-to-trimmed-string)) => '("*two*" "*three*" "*four*") :begin-hidden ;; Test all atomic and compound condition combinations here. ;; These tests ensure that: ;; - `org-ml--match-make-condition-form' is correct for all VALID ;; condition combinations (the error cases are tested in ;; `org-ml-test.el') ;; - the single and multiple condition paths in ;; `org-ml--match-make-inner-pattern-form' are correct (:buffer "* one" "** TODO two" "2" "** COMMENT three" "3" "** four" "4" "** DONE five" "5") ;; type (->> (org-ml-parse-this-subtree) (org-ml-match '(headline section)) (--map (org-ml-to-trimmed-string it))) => '("2" "3" "4" "5") (->> (org-ml-parse-this-subtree) (org-ml-match '(headline table)) (--map (org-ml-to-trimmed-string it))) => nil ;; index (->> (org-ml-parse-this-subtree) (org-ml-match '(0 section)) (--map (org-ml-to-trimmed-string it))) => '("2") (->> (org-ml-parse-this-subtree) (org-ml-match '(-1 section)) (--map (org-ml-to-trimmed-string it))) => '("5") (->> (org-ml-parse-this-subtree) (org-ml-match '(4 section)) (--map (org-ml-to-trimmed-string it))) => nil (->> (org-ml-parse-this-subtree) (org-ml-match '(-5 section)) (--map (org-ml-to-trimmed-string it))) => nil ;; relative index (->> (org-ml-parse-this-subtree) (org-ml-match '((> 0) section)) (--map (org-ml-to-trimmed-string it))) => '("3" "4" "5") (->> (org-ml-parse-this-subtree) (org-ml-match '((>= 1) section)) (--map (org-ml-to-trimmed-string it))) => '("3" "4" "5") (->> (org-ml-parse-this-subtree) (org-ml-match '((<= -2) section)) (--map (org-ml-to-trimmed-string it))) => '("2" "3" "4") (->> (org-ml-parse-this-subtree) (org-ml-match '((< -1) section)) (--map (org-ml-to-trimmed-string it))) => '("2" "3" "4") (->> (org-ml-parse-this-subtree) (org-ml-match '((< 0) section)) (--map (org-ml-to-trimmed-string it))) => nil (->> (org-ml-parse-this-subtree) (org-ml-match '((> 3) section)) (--map (org-ml-to-trimmed-string it))) => nil (->> (org-ml-parse-this-subtree) (org-ml-match '((> -1) section)) (--map (org-ml-to-trimmed-string it))) => nil (->> (org-ml-parse-this-subtree) (org-ml-match '((< -4) section)) (--map (org-ml-to-trimmed-string it))) => nil ;; properties (->> (org-ml-parse-this-subtree) (org-ml-match '((:todo-keyword "TODO") section)) (--map (org-ml-to-trimmed-string it))) => '("2") (->> (org-ml-parse-this-subtree) (org-ml-match '((:todo-keyword nil) section)) (--map (org-ml-to-trimmed-string it))) => '("3" "4") (->> (org-ml-parse-this-subtree) (org-ml-match '((:todo-keyword "DONE") section)) (--map (org-ml-to-trimmed-string it))) => '("5") ;; pred (->> (org-ml-parse-this-subtree) (org-ml-match '((:pred org-ml-headline-is-done) section)) (--map (org-ml-to-trimmed-string it))) => '("5") (->> (org-ml-parse-this-subtree) (org-ml-match '((:pred stringp) section)) ; silly but proves my point (--map (org-ml-to-trimmed-string it))) => nil ;; :not (->> (org-ml-parse-this-subtree) (org-ml-match '((:not (:todo-keyword nil)) section)) (--map (org-ml-to-trimmed-string it))) => '("2" "5") (->> (org-ml-parse-this-subtree) (org-ml-match '((:not headline) section)) (--map (org-ml-to-trimmed-string it))) => nil ;; :and (->> (org-ml-parse-this-subtree) (org-ml-match '((:and (< 2) (:todo-keyword nil)) section)) (--map (org-ml-to-trimmed-string it))) => '("3") (->> (org-ml-parse-this-subtree) (org-ml-match '((:and (:archivedp t) (:todo-keyword nil)) section)) (--map (org-ml-to-trimmed-string it))) => nil ;; :or (->> (org-ml-parse-this-subtree) (org-ml-match '((:or (:todo-keyword "DONE") (:todo-keyword "TODO")) section)) (--map (org-ml-to-trimmed-string it))) => '("2" "5") (->> (org-ml-parse-this-subtree) (org-ml-match '((:or (:archivedp t) (:todo-keyword "NEXT")) section)) (--map (org-ml-to-trimmed-string it))) => nil (->> (org-ml-parse-this-subtree) (org-ml-match '((:or (:todo-keyword "DONE") (:todo-keyword "TODO")) section)) (--map (org-ml-to-trimmed-string it))) => '("2" "5") ;; Test the remaining paths of `org-ml--match-make-inner-pattern-form' ;; These test cases ensure that: ;; - the :any + condition path is correct ;; - the condition + :any path is correct ;; - the * path is correct ;; - the + path is correct ;; - the ordering of each above path is correct (assumed because the tests ;; contain nodes with multiple children that have a defined order to be ;; preserved) ;; ;; Note that all error cases are tested in `org-ml-test.el' ;; ;; Also note that we assume `org-ml--match-make-condition-form' is ;; independent of `org-ml--match-make-inner-pattern-form' which ;; liberates us from testing all predicate patterns again below. ;; :any (first) (:buffer "*_1_* */2/* _*3*_ _/4/_ /*5*/ /_6_/") (->> (org-ml-parse-this-element) (org-ml-match '(:any (:or bold italic))) (--map (org-ml-to-trimmed-string it))) ;; :any (last) => '("/2/" "*3*" "/4/" "*5*") (->> (org-ml-parse-this-element) (org-ml-match '((:or bold italic) :any)) (--map (org-ml-to-trimmed-string it))) => '("_1_" "/2/" "*5*" "_6_") ;; * (:buffer "* one" "- 1" "- 2" " - 3" "** two" "- 4" "- 5" " - 6" "** three" "- 7" "- 8" " - 9") (->> (org-ml-parse-this-element) (org-ml-match '(:any * item)) (--map (org-ml-to-trimmed-string it))) => '("- 1" "- 2\n - 3" "- 3" "- 4" "- 5\n - 6" "- 6" "- 7" "- 8\n - 9" "- 9") (->> (org-ml-parse-this-element) (org-ml-match '(section plain-list :any * item)) (--map (org-ml-to-trimmed-string it))) => '("- 1" "- 2\n - 3" "- 3") ;; + and ? (:buffer "* one" "** two" "*** three" "** four" "*** five" "**** six") (->> (org-ml-parse-this-element) (org-ml-match '(headline +)) (--map (org-ml-to-trimmed-string it))) => '("** two\n*** three" "*** three" "** four\n*** five\n**** six" "*** five\n**** six" "**** six") (->> (org-ml-parse-this-element) (org-ml-match '(headline + headline)) (--map (org-ml-to-trimmed-string it))) => '("*** three" "*** five\n**** six" "**** six") (->> (org-ml-parse-this-element) (org-ml-match '(headline headline \?)) (--map (org-ml-to-trimmed-string it))) => '("** two\n*** three" "** four\n*** five\n**** six" "*** three" "*** five\n**** six") (->> (org-ml-parse-this-element) (org-ml-match '(headline headline \? headline)) (--map (org-ml-to-trimmed-string it))) => '("*** three" "*** five\n**** six" "**** six") ;; alternation (:buffer "* one" "** two" "*a* /_b_/" "*** three" "*c* /_d_/") (->> (org-ml-parse-this-element) (org-ml-match '(headline section paragraph (bold | italic underline))) (--map (org-ml-to-trimmed-string it))) => '("*a*" "_b_") (->> (org-ml-parse-this-element) (org-ml-match '(headline (nil | headline) section paragraph (bold | italic underline))) (--map (org-ml-to-trimmed-string it))) => '("*a*" "_b_" "*c*" "_d_") ;; slicer tests are not here, see `org-ml-test.el' :end-hidden) (defexamples-content org-ml-match-delete nil (:buffer "* headline one" "** headline two" "** headline three" "** headline four") (:comment "Selectively delete headlines") (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-delete '(headline)) (org-ml-to-trimmed-string)) => "* headline one" (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-delete '(:first headline)) (org-ml-to-trimmed-string)) => (:result "* headline one" "** headline three" "** headline four") (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-delete '(:last headline)) (org-ml-to-trimmed-string)) => (:result "* headline one" "** headline two" "** headline three")) (defexamples-content org-ml-match-extract nil (:buffer "pull me /under/") (--> (org-ml-parse-this-element) (org-ml-match-extract '(:any * italic) it) (cons (-map #'org-ml-to-trimmed-string (car it)) (org-ml-to-trimmed-string (cdr it)))) => '(("/under/") . "pull me")) (defexamples-content org-ml-match-map nil (:buffer "* headline one" "** TODO headline two" "** headline three" "** headline four") (:comment "Selectively mark headlines as DONE") (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-map '(headline) (lambda (it) (org-ml-set-property :todo-keyword "DONE" it))) (org-ml-to-trimmed-string)) => (:result "* headline one" "** DONE headline two" "** DONE headline three" "** DONE headline four") (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-map* '(:first headline) (org-ml-set-property :todo-keyword "DONE" it)) (org-ml-to-trimmed-string)) => (:result "* headline one" "** DONE headline two" "** headline three" "** headline four") (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-map '(:last headline) (-partial #'org-ml-set-property :todo-keyword "DONE")) (org-ml-to-trimmed-string)) => (:result "* headline one" "** TODO headline two" "** headline three" "** DONE headline four")) ;; (:buffer "* headline" ;; ":PROPERTIES:" ;; ":Effort: 0:30" ;; ":END:") ;; (:comment "Match the literal property-drawer node and map the" ;; "node-property inside if the property-drawer exists") ;; (let ((hl (org-ml-parse-this-headline))) ;; (-if-let (pd (org-ml-headline-get-property-drawer hl)) ;; (->> hl ;; (org-ml-match-map* `(,pd node-property) ;; (org-ml-set-property :value "1:30" it)) ;; (org-ml-to-trimmed-string)) ;; (print "...or do something else if no drawer"))) ;; => (:result "* headline" ;; ":PROPERTIES:" ;; ":Effort: 1:30" ;; ":END:")) (defexamples-content org-ml-match-mapcat nil (:buffer "* one" "** two") (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-mapcat* '(:first headline) (list (org-ml-build-headline! :title-text "1.5" :level 2) it)) (org-ml-to-trimmed-string)) => (:result "* one" "** 1.5" "** two")) (defexamples-content org-ml-match-replace nil (:buffer "*1* 2 *3* 4 *5* 6 *7* 8 *9* 10") (org-ml->> (org-ml-parse-this-element) (org-ml-match-replace '(:any * bold) (org-ml-build-bold :post-blank 1 "0")) (org-ml-to-trimmed-string)) => "*0* 2 *0* 4 *0* 6 *0* 8 *0* 10") (defexamples-content org-ml-match-insert-before nil (:buffer "* one" "** two" "** three") (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-insert-before '(headline) (org-ml-build-headline! :title-text "new" :level 2)) (org-ml-to-trimmed-string)) => (:result "* one" "** new" "** two" "** new" "** three")) (defexamples-content org-ml-match-insert-after nil (:buffer "* one" "** two" "** three") (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-insert-after '(headline) (org-ml-build-headline! :title-text "new" :level 2)) (org-ml-to-trimmed-string)) => (:result "* one" "** two" "** new" "** three" "** new")) (defexamples-content org-ml-match-insert-within nil (:buffer "* one" "** two" "** three") (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-insert-within '(headline) 0 (org-ml-build-headline! :title-text "new" :level 3)) (org-ml-to-trimmed-string)) => (:result "* one" "** two" "*** new" "** three" "*** new") (:comment "The nil pattern denotes top-level element") (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-insert-within nil 1 (org-ml-build-headline! :title-text "new" :level 2)) (org-ml-to-trimmed-string)) => (:result "* one" "** two" "** new" "** three")) (defexamples-content org-ml-match-splice nil (:buffer "* one" "** two" "** three") (let ((L (list (org-ml-build-headline! :title-text "new0" :level 2) (org-ml-build-headline! :title-text "new1" :level 2)))) (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-splice '(0) L) (org-ml-to-trimmed-string))) => (:result "* one" "** new0" "** new1" "** three")) (defexamples-content org-ml-match-splice-before nil (:buffer "* one" "** two" "** three") (let ((L (list (org-ml-build-headline! :title-text "new0" :level 2) (org-ml-build-headline! :title-text "new1" :level 2)))) (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-splice-before '(0) L) (org-ml-to-trimmed-string))) => (:result "* one" "** new0" "** new1" "** two" "** three")) (defexamples-content org-ml-match-splice-after nil (:buffer "* one" "** two" "** three") (let ((L (list (org-ml-build-headline! :title-text "new0" :level 2) (org-ml-build-headline! :title-text "new1" :level 2)))) (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-splice-after '(0) L) (org-ml-to-trimmed-string))) => (:result "* one" "** two" "** new0" "** new1" "** three")) (defexamples-content org-ml-match-splice-within nil (:buffer "* one" "** two" "** three" "*** four") (let ((L (list (org-ml-build-headline! :title-text "new0" :level 3) (org-ml-build-headline! :title-text "new1" :level 3)))) (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-splice-within '(headline) 0 L) (org-ml-to-trimmed-string))) => (:result "* one" "** two" "*** new0" "*** new1" "** three" "*** new0" "*** new1" "*** four") (let ((L (list (org-ml-build-headline! :title-text "new0" :level 2) (org-ml-build-headline! :title-text "new1" :level 2)))) (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-splice-within nil 1 L) (org-ml-to-trimmed-string))) => (:result "* one" "** two" "** new0" "** new1" "** three" "*** four")) (defexamples-content org-ml-match-do nil)) (def-example-group "Buffer Side Effects" "Map node manipulations into buffers." (def-example-subgroup "Insert" nil (defexamples-content org-ml-insert nil (:buffer "* one" "") (:comment "Insert single node") (->> (org-ml-build-headline! :title-text "two") (org-ml-insert (point-max))) $> (:result "* one" "* two") (:comment "Insert multiple nodes") (->> (org-ml-build-headline! :title-text "two") (list (org-ml-build-headline! :title-text "more")) (org-ml-insert (point-max))) $> (:result "* one" "* more" "* two") (:buffer "a *game* or a /boy/") (->> (org-ml-build-paragraph! "we don't care if you're") (org-ml-insert (point-min))) $> (:result "we don't care if you're" "a *game* or a /boy/")) (defexamples-content org-ml-insert-tail nil :begin-hidden (:buffer "* one" "") (:comment "Insert single node") (->> (org-ml-build-headline! :title-text "two") (org-ml-insert-tail (point-max))) $> (:result "* one" "* two") (:comment "Insert multiple nodes") (->> (org-ml-build-headline! :title-text "two") (list (org-ml-build-headline! :title-text "more")) (org-ml-insert (point-max))) $> (:result "* one" "* more" "* two") (:buffer "a *game* or a /boy/") (->> (org-ml-build-paragraph! "we don't care if you're") (org-ml-insert-tail (point-min))) $> (:result "we don't care if you're" "a *game* or a /boy/") :end-hidden)) (def-example-subgroup "Update" nil (defexamples-content org-ml-update nil (:buffer "* TODO win grammy") (org-ml->> (org-ml-parse-this-headline) (org-ml-update (lambda (hl) (org-ml-set-property :todo-keyword "DONE" hl)))) $> "* DONE win grammy" (:buffer "* win grammy [0/0]" "- [ ] write punk song" "- [ ] get new vocalist" "- [ ] sell 2 singles") (org-ml->> (org-ml-parse-this-headline) (org-ml-update* (->> (org-ml-match-map '(:any * item) #'org-ml-item-toggle-checkbox it) (org-ml-headline-update-item-statistics)))) $> (:result "* win grammy [3/3]" "- [X] write punk song" "- [X] get new vocalist" "- [X] sell 2 singles")) (defexamples-content org-ml-update-object-at nil (:buffer "[[http://example.com][desc]]") (org-ml-update-object-at* (point) (org-ml-set-property :path "//buymoreram.com" it)) $> "[[http://buymoreram.com][desc]]") (defexamples-content org-ml-update-element-at nil (:buffer "#+call: ktulu()") (org-ml-update-element-at* (point) (org-ml-set-properties (list :call "cthulhu" :inside-header '(:cache no) :arguments '("x=4") :end-header '(:results html)) it)) $> "#+call: cthulhu[:cache no](x=4) :results html") (defexamples-content org-ml-update-table-row-at nil (:buffer "| a | b |") (org-ml-update-table-row-at* (point) (org-ml-map-children* (cons (org-ml-build-table-cell! "0") it) it)) $> "| 0 | a | b |") (defexamples-content org-ml-update-item-at nil (:buffer "- [ ] thing") (org-ml-update-item-at* (point) (org-ml-item-toggle-checkbox it)) $> "- [X] thing") (defexamples-content org-ml-update-headline-at nil (:buffer "* TODO might get done" "* DONE no need to update") (org-ml-update-headline-at* (point) (org-ml-set-property :todo-keyword "DONE" it)) $> (:result "* DONE might get done" "* DONE no need to update")) (defexamples-content org-ml-update-subtree-at nil (:buffer "* one" "** two" "** three" "* not updated") (org-ml-update-subtree-at* (point) (org-ml-headline-demote-subheadline 1 it)) $> (:result "* one" "** two" "*** three" "* not updated")) (defexamples-content org-ml-update-section-at nil (:buffer "#+key1: VAL1" "#+key2: VAL2" "* irrelevant headline") (:comment "Update the top buffer section before the headlines start") (org-ml-update-section-at* (point) (org-ml-map-children* (--map (org-ml-map-property :value #'s-downcase it) it) it)) $> (:result "#+key1: val1" "#+key2: val2" "* irrelevant headline")) (defexamples-content org-ml-update-headlines nil (:buffer "* one" "* two" "* three") (org-ml-update-headlines* 0 (org-ml-set-property :todo-keyword "DONE" it)) $> (:result "* DONE one" "* two" "* three") (org-ml-update-headlines* '(0 1) (org-ml-set-property :todo-keyword "DONE" it)) $> (:result "* DONE one" "* DONE two" "* three") (org-ml-update-headlines* [2 nil] (org-ml-set-property :todo-keyword "DONE" it)) $> (:result "* one" "* DONE two" "* DONE three") (org-ml-update-headlines* [2 10] (org-ml-set-property :todo-keyword "DONE" it)) $> (:result "* one" "* DONE two" "* three") (:buffer "* one" "* two" "* three") (org-ml-update-headlines* 'all (org-ml-set-property :todo-keyword "DONE" it)) $> (:result "* DONE one" "* DONE two" "* DONE three")) (defexamples-content org-ml-update-subtrees nil (:buffer "* one [/]" "** DONE _one" "* two [/]" "** DONE _one" "* three [/]" "** DONE _one") (org-ml-update-subtrees* 0 (org-ml-headline-update-todo-statistics it)) $> (:result "* one [1/1]" "** DONE _one" "* two [/]" "** DONE _one" "* three [/]" "** DONE _one") (org-ml-update-subtrees* '(0 1) (org-ml-headline-update-todo-statistics it)) $> (:result "* one [1/1]" "** DONE _one" "* two [1/1]" "** DONE _one" "* three [/]" "** DONE _one") (org-ml-update-subtrees* [2 nil] (org-ml-headline-update-todo-statistics it)) $> (:result "* one [/]" "** DONE _one" "* two [1/1]" "** DONE _one" "* three [1/1]" "** DONE _one") (org-ml-update-subtrees* [nil 5] (org-ml-headline-update-todo-statistics it)) $> (:result "* one [1/1]" "** DONE _one" "* two [/]" "** DONE _one" "* three [/]" "** DONE _one") (:buffer "* one [/]" "** DONE _one" "** DONE _two" "* two [/]" "** DONE _one" "** DONE _two")) (defexamples-content org-ml-update-supercontents nil (:buffer "* one") (let ((pl '(:scheduled (2000 1 1)))) (org-ml-wrap-impure (org-ml-update-supercontents* nil 'all (org-ml-supercontents-set-planning pl it)))) $> (:result "* one" "SCHEDULED: <2000-01-01 Sat>") (:buffer "* one" "" "something") (let ((pl '(:scheduled (2000 1 1)))) (org-ml-wrap-impure (org-ml-update-supercontents* nil 'all (org-ml-supercontents-set-planning pl it)))) $> (:result "* one" "SCHEDULED: <2000-01-01 Sat>" "" "something") (:buffer "* one" "** two") (let ((pl '(:scheduled (2000 1 1)))) (org-ml-wrap-impure (org-ml-update-supercontents* nil 'all (org-ml-supercontents-set-planning pl it)))) $> (:result "* one" "SCHEDULED: <2000-01-01 Sat>" "** two" "SCHEDULED: <2000-01-01 Sat>") (:buffer "* one" "** two" "stuff") (let ((pl '(:scheduled (2000 1 1)))) (org-ml-wrap-impure (org-ml-update-supercontents* nil 'all (org-ml-supercontents-set-planning pl it)))) $> (:result "* one" "SCHEDULED: <2000-01-01 Sat>" "** two" "SCHEDULED: <2000-01-01 Sat>" "stuff") (:buffer "* one" "stuff") (let ((pl '(:scheduled (2000 1 1)))) (org-ml-wrap-impure (org-ml-update-supercontents* nil 'all (org-ml-supercontents-set-planning pl it)))) $> (:result "* one" "SCHEDULED: <2000-01-01 Sat>" "stuff"))) (def-example-subgroup "Misc" nil (defexamples-content org-ml-fold nil) (defexamples-content org-ml-unfold nil))) (provide 'org-ml-examples) ;;; org-ml-examples.el ends here ================================================ FILE: dev/org-ml-test-common.el ================================================ ;;; org-ml-test-common.el --- Common Test functions -*- lexical-binding: t; -*- ;; Copyright (C) 2020 Nathan Dwarshuis ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;;; Code: (require 's) (require 'dash) (require 'buttercup) ;; set up standard org environment (defmacro org-ml--with-org-env (&rest body) "Execute BODY in a standardized Org-mode buffer." `(let ((org-tags-column 20) (org-todo-keywords '((sequence "TODO" "DONE"))) (org-archive-tag "ARCHIVE") (org-lowest-priority ?C) (org-highest-priority ?A) (org-list-allow-alphabetical nil) (org-log-into-drawer "LOGBOOK")) (with-temp-buffer (org-mode) ,@body))) (defun example-to-should (actual sym expected) (let ((expected (if (eq (and (listp expected) (car expected)) :result) (s-join "\n" (cdr expected)) expected))) (cond ((eq sym '=>) `(expect ,actual :to-equal ,expected)) ;; this will only work with defexamples-content ((eq sym '$>) `(expect (progn ,actual (s-trim (buffer-string))) :to-equal ,expected)) ;; TODO I never use this? ;; ((eq sym '~>) ;; `(should (approx-equal ,actual ,expected))) ((eq sym '!!>) `(should-error (eval ',actual) :type ',expected)) (t (error "Invalid test case: %S" `(,actual ,sym ,expected)))))) (defmacro defexamples (cmd &rest examples) (declare (indent 1)) (let ((tests (->> examples (remove :begin-hidden) (remove :end-hidden) (-partition 3) (--map (apply #'example-to-should it))))) (when tests `(it ,(format "%S" cmd) (org-ml--with-org-env ,@tests))))) (defmacro defexamples-content (cmd _docstring &rest args) (declare (indent 1)) (cl-flet* ((make-test-form (test contents) `(org-ml--with-org-env (when ,contents (insert ,contents)) (goto-char (point-min)) ,test)) (make-tests (list) (let ((contents (->> (car list) (-drop 1) (s-join "\n"))) (tests (->> (-drop 1 list) (--remove (eq (and (listp it) (car it)) :comment)) (-partition 3) (--map (apply #'example-to-should it))))) (--map (make-test-form it contents) tests)))) (let ((body (->> args (remove :begin-hidden) (remove :end-hidden) (-partition-before-pred (lambda (it) (eq (and (listp it) (car it)) :buffer))) (-mapcat #'make-tests)))) (when body `(it ,(format "%S" cmd) ,@body))))) (defmacro def-example-subgroup (title _subtitle &rest specs) (declare (indent 1)) (when specs `(describe ,title ,@specs))) (defmacro def-example-group (title _subtitle &rest specs) (declare (indent 1)) (when specs `(describe ,title ,@specs))) (provide 'org-ml-test-common) ;;; org-ml-test-common.el ends here ================================================ FILE: dev/org-ml-test-external.el ================================================ ;;; org-ml-test-external.el --- External tests for org-ml -*- lexical-binding: t; -*- ;;; Commentary: ;;; Code: (require 'org-ml-test-common) (require 'org-ml-examples) (provide 'org-ml-test-external) ;;; org-ml-test-external.el ends here ================================================ FILE: dev/org-ml-test-internal.el ================================================ ;;; org-ml-test-internal.el --- Internal tests for org-ml -*- lexical-binding: t; -*- ;;; Commentary: ;;; Code: (require 's) (require 'dash) (require 'org-ml) (require 'org-ml-macs) (require 'org-ml-test-common) (defconst org-ml--inter-ignore-props (list :begin :contents-begin :end :contents-end :parent :post-affiliated :name :plot :header :results :caption :granularity :mode :robust-begin :robust-end)) ;;; LIST OPERATIONS (describe "internal list functions" (describe "org-ml--pad-or-truncate" (before-each (setq finite-list '(1 2 3))) (it "zero length list with zero length" (expect (org-ml--pad-or-truncate 0 'x nil) :to-equal nil)) (it "zero length list with positive length" (expect (org-ml--pad-or-truncate 1 'x nil) :to-equal '(x))) (it "positive length list; length is less" (expect (org-ml--pad-or-truncate 2 'x finite-list) :to-equal '(1 2))) (it "positive length list; length is equal" (expect (org-ml--pad-or-truncate 3 'x finite-list) :to-equal '(1 2 3))) (it "positive length list; length is greater" (expect (org-ml--pad-or-truncate 4 'x finite-list) :to-equal '(1 2 3 x))) (it "positive length list; length is zero" (expect (org-ml--pad-or-truncate 0 'x finite-list) :to-equal nil))) ;; TODO add plist-get-keys? ;; TODO add plist-get-vals? ;; TODO add plist-map-values? (describe "org-ml--is-plist" (it "finite plist" (expect (org-ml--is-plist '(:one one :two 2 :three "3")) :to-be-truthy)) (it "zero-length plist" (expect (org-ml--is-plist nil) :to-be-truthy)) (it "symbols instead of keywords" (expect (org-ml--is-plist '(one one two 2 three "3")) :not :to-be-truthy)) (it "incomplete" (expect (org-ml--is-plist '(:one one :two 2 :three)) :not :to-be-truthy)) (it "not list" (expect (org-ml--is-plist ":one one :two 2 :three") :not :to-be-truthy)))) ;; TODO add plist-remove? ;;; inter-list operations (defmacro org-ml--inter-list-ops-test (fun input output-single output-upper output-lower) "Return form to test intra-index list operations using FUN. INPUT is an input list, OUTPUT-SINGLE is a list made as if FUN were applied to an empty list, OUTPUT-UPPER is the input list with FUN applied as if it was given the highest possible index, and OUTPUT-LOWER is the converse." (declare (indent 1)) `(progn (it "zero length list at 0" (expect ,output-single :to-equal (funcall ,fun 0 nil)) (expect ,output-single :to-equal (funcall ,fun -1 nil))) (it "zero length list (overrange)" (should-error (funcall fun 100 nil)) (expect ,output-single :to-equal (funcall ,fun 100 nil t))) (it "zero length list (underrange)" (should-error (funcall fun -100 nil)) (expect ,output-single :to-equal (funcall ,fun -100 nil t))) (it "finite list (in range)" (expect ,output-lower :to-equal (funcall ,fun 0 ,input)) (expect ,output-upper :to-equal (funcall ,fun -1 ,input))) (it "finite list (overrange)" (should-error (funcall fun 100 '(1 2))) (expect ,output-upper :to-equal (funcall ,fun 100 ,input t))) (it "finite list (underrange)" (should-error (funcall fun -100 '(1 2))) (expect ,output-lower :to-equal (funcall ,fun -100 ,input t))))) (defmacro org-ml--intra-list-ops-test (fun input output-upper output-lower) "Return form to test intra-index list operations using FUN. INPUT is an input list, OUTPUT-UPPER is the input list with FUN applied as if it was given the highest possible index, and OUTPUT-LOWER is the converse." (declare (indent 1)) `(progn (it "index 0 in an empty list" (should-error (funcall ,fun 0 nil)) (should-error (funcall ,fun 0 nil t)) (expect (funcall ,fun 0 nil 'permit-empty) :not :to-be-truthy)) (it "overrange in empty list" (should-error (funcall ,fun 100 nil)) (should-error (funcall ,fun 100 nil t)) (expect (funcall ,fun 100 nil 'permit-empty) :not :to-be-truthy)) (it "underrange in empty list" (should-error (funcall ,fun -100 nil)) (should-error (funcall ,fun -100 nil t)) (expect (funcall ,fun -100 nil 'permit-empty) :not :to-be-truthy)) (it "positive in finite list" (expect ,output-lower :to-equal (funcall ,fun 0 ,input))) (it "negative in finite list" (expect ,output-upper :to-equal (funcall ,fun -1 ,input))) (it "positive overrange in finite list" (expect ,output-upper :to-equal (funcall ,fun 100 ,input t)) (should-error (funcall ,fun 100 input))) (it "negative underrange in finite list" (expect ,output-lower :to-equal (funcall ,fun -100 ,input t)) (should-error (funcall fun -100 ,input))))) (describe "test consistency of internal list function index references" (describe "inter-member references" ;; These functions operate using indices that refer to spaces between list ;; members. As such there is no such thing as a nonsensical index. Since ;; there will always be the option to add to the front or the back of the ;; list, even an empty list has a logical index that points to these ;; locations (they just happen to be the same). Therefore, the only errors ;; we need to catch here are those that refer to out of range indices. (describe "org-ml--insert-at" (org-ml--inter-list-ops-test (lambda (n list &optional p) (org-ml--insert-at n 'x list p)) '(1 2) '(x) '(1 2 x) '(x 1 2))) (describe "org-ml--split-at" (org-ml--inter-list-ops-test #'org-ml--split-at '(1 2) nil '((1 2) nil) '(nil (1 2)))) (describe "org-ml--splice-at" (org-ml--inter-list-ops-test (lambda (n list &optional p) (org-ml--splice-at n '(x y) list p)) '(1 2) '(x y) '(1 2 x y) '(x y 1 2)))) (describe "intra-member references" ;; These functions operate using indices that refer to explicit members of a ;; list. As such there will be no possible integers that will be valid for ;; an empty list. This provides one extra error case to test, which is the ;; possibility that we cannot operate on the list and thus return nil. All ;; else is the same relative to the inter-list operations tests above (describe "org-ml--remove-at/properties" (org-ml--intra-list-ops-test #'org-ml--remove-at '(1 2 3) '(1 2) '(2 3))) (describe "org-ml--replace-at/properties" (org-ml--intra-list-ops-test (lambda (n list &optional p) (org-ml--replace-at n 'x list p)) '(1 2 3) '(1 2 x) '(x 2 3))) (describe "org-ml--nth/properties" (org-ml--intra-list-ops-test #'org-ml--nth '(1 2 3) 3 1)))) (defmacro org-ml--test-list-functor (fun map-fun single-a single-b multi-a multi-b) (declare (indent 2)) `(progn (it "mapping empty list should return empty list" (expect (,fun (,map-fun it) nil) :not :to-be-truthy)) (it "mapping list with one member should return that member modified" (expect ,single-a :to-equal (,fun (,map-fun it) ,single-b))) (it "mapping list with multiple members should only modify one member" (expect ,multi-a :to-equal (,fun (,map-fun it) ,multi-b))) (it "identity should hold true for any length list (0, 1, and 1+)" (--each '(nil (1) (1 2)) (expect it :to-equal (,fun (identity it) it)))))) (describe "list functors" (describe "org-ml--map-first" (org-ml--test-list-functor org-ml--map-first* upcase '("X") '("x") '("A" "b" "c") '("a" "b" "c"))) (describe "org-ml--map-last" (org-ml--test-list-functor org-ml--map-last* upcase '("X") '("x") '("a" "b" "C") '("a" "b" "c")))) ;;; FROM STRING CONVERSTION (defun org-ml--plist-nonequal-p (exclude-props plist1 plist2) (cl-flet ((partition-plist (props plist) (->> (-partition 2 plist) (--remove (memq (car it) props))))) (let* ((a (partition-plist exclude-props plist1)) (b (partition-plist exclude-props plist2)) (suba (-difference a b)) (subb (-difference b a))) (when (or suba subb) (list suba subb))))) (defun org-ml--equal~ (exclude-props node1 node2) (if (and (stringp node1) (stringp node2)) `(expect ,node1 :to-equal ,node2) (cl-flet ((prop2 (key node1 node2) (list (org-element-property key node1) (org-element-property key node2)))) (-let (((type1 . (props1 . children1)) node1) ((type2 . (props2 . children2)) node2) ((pb1 pb2) (prop2 :post-blank node1 node2)) ;; NOTE exclude post-blank since some elements won't have it in their ;; regular plist, and we already query it above (xs (append '(:post-blank :standard-properties) exclude-props))) `(progn (expect ',type1 :to-be ',type2) (expect ,pb1 :to-be ,pb2) (expect (org-ml--plist-nonequal-p ',xs ',props1 ',props2) :to-be nil) (and (eq ',type1 ',type2) (->> (-zip-fill nil ',children1 ',children2) (--all? (org-ml--equal~ ',xs (car it) (cdr it)))))))))) (defun org-ml--test-from-string (omit-props &rest specs) (declare (indent 1)) (let ((props (append omit-props org-ml--inter-ignore-props))) (->> (-partition 2 specs) (--map (-let* (((node string) it) (type (org-ml-get-type node))) `(it ,(format "%s - %s" type (s-replace "\n" "\\n" string)) ,(org-ml--equal~ props node (org-ml-from-string type string)))))))) (defmacro describe-many (header &rest forms) (declare (indent 1)) (let ((it-forms (-flatten-n 1 (-map #'eval forms)))) `(describe ,header ,@it-forms))) (describe "converting from string" (describe-many "object leaf nodes" (org-ml--test-from-string nil (org-ml-build-code "code") "~code~") (org-ml--test-from-string '(:latex :latex-math-p :ascii :html :latin1 :utf-8) (org-ml-build-entity "pi") "\\pi") (org-ml--test-from-string nil (org-ml-build-export-snippet "be" "val") "@@be:val@@") (org-ml--test-from-string '(:value) (org-ml-build-inline-babel-call "ktulu") "call_ktulu()") (org-ml--test-from-string '(:value) (org-ml-build-inline-src-block "python") "src_python{}") (org-ml--test-from-string nil (org-ml-build-line-break) "\\\\\n") (org-ml--test-from-string nil (org-ml-build-latex-fragment "$1+1$") "$1+1$") (org-ml--test-from-string nil (org-ml-build-macro "macro") "{{{macro}}}") (org-ml--test-from-string '(:value) (org-ml-build-radio-target "radio") "<<>>") (org-ml--test-from-string nil (org-ml-build-statistics-cookie '(1 2)) "[1/2]" (org-ml-build-statistics-cookie '(nil nil)) "[/]" (org-ml-build-statistics-cookie '(50)) "[50%]" (org-ml-build-statistics-cookie '(nil)) "[%]") (org-ml--test-from-string nil (org-ml-build-target "target") "<>") ;; TODO this is a bug in org-element which should include :repeater-deadline-value/unit (org-ml--test-from-string '(:raw-value :repeater-deadline-value :repeater-deadline-unit) (org-ml-build-timestamp! '(2020 1 1 0 0) :end '(2020 1 1 0 10) :repeater '(cumulate 1 day) :warning '(all 1 day)) "[2020-01-01 Tue 00:00-00:10 -1d +1d]") (org-ml--test-from-string nil (org-ml-build-verbatim "b") "=b=")) (describe-many "object branch nodes" (org-ml--test-from-string nil (org-ml-build-bold "bold") "*bold*") (org-ml--test-from-string '(:type) (org-ml-build-footnote-reference "ref") "[fn::ref]") (org-ml--test-from-string nil (org-ml-build-italic "italic") "/italic/") (org-ml--test-from-string '(:raw-link :format) (org-ml-build-link "//example.com" :type "https") "https://example.com") (org-ml--test-from-string nil (org-ml-build-subscript "ss") "_ss") (org-ml--test-from-string nil (org-ml-build-superscript "ss") "^ss") (org-ml--test-from-string nil (org-ml-build-strike-through "s") "+s+") (org-ml--test-from-string nil (org-ml-build-table-cell "cell") " cell |") (org-ml--test-from-string nil (org-ml-build-underline "u") "_u_")) (describe-many "element leaf nodes" (org-ml--test-from-string '(:value) (org-ml-build-babel-call "name") "#+call: name()") (org-ml--test-from-string nil (org-ml-build-center-block) "#+begin_center\n#+end_center" (org-ml-build-center-block (org-ml-build-paragraph! "p")) "#+begin_center\np\n#+end_center") ;; NOTE special treatment for clock so we can compare values directly (-let* ((s "CLOCK: [2020-01-01 Tue 00:00]") (result (org-ml-from-string 'clock s)) (node (org-ml-build-clock! '(2020 1 1 0 0))) (type (org-ml-get-type node))) `((it ,(format "clock - %s" s) (expect ',type :to-be 'clock) (org-ml--equal~ (cons :value org-ml--inter-ignore-props) ',node ',result) (org-ml--equal~ org-ml--inter-ignore-props (org-element-property :value ',node) (org-element-property :value ',result))))) (org-ml--test-from-string nil (org-ml-build-comment "comment") "# comment") (org-ml--test-from-string nil (org-ml-build-comment-block) "#+begin_comment\n#+end_comment" (org-ml-build-comment-block :value "p\n") "#+begin_comment\np\n#+end_comment") (org-ml--test-from-string nil (org-ml-build-diary-sexp :value '(print 'hi)) "%%(print 'hi)") (org-ml--test-from-string '(:value :retain-labels :use-labels) (org-ml-build-example-block) "#+begin_example\n#+end_example" (org-ml-build-example-block :value "v\n") "#+begin_example\nv\n#+end_example") (org-ml--test-from-string nil (org-ml-build-export-block "TYPE" "value\n") "#+begin_export TYPE\nvalue\n#+end_export") (org-ml--test-from-string nil (org-ml-build-fixed-width "val") ": val") (org-ml--test-from-string nil (org-ml-build-horizontal-rule) "------") (org-ml--test-from-string nil (org-ml-build-latex-environment '("env" "value")) "\\begin{env}\nvalue\n\\end{env}") (org-ml--test-from-string nil (org-ml-build-keyword "K" "v") "#+K: v") (org-ml--test-from-string nil (org-ml-build-special-block "type") "#+begin_type\n#+end_type") (org-ml--test-from-string '(:number-lines :retain-labels :use-labels :label-fmt) (org-ml-build-src-block :value "(print 'hi)\n") "#+begin_src\n(print 'hi)\n#+end_src") (org-ml--test-from-string nil (org-ml-build-node-property "KEY" "val") ":KEY: val") (org-ml--test-from-string '(:scheduled :deadline :closed) (org-ml-build-planning! :scheduled '(2020 1 1)) "SCHEDULED: [2020-01-01 Tue]")) (describe-many "element branch nodes" (org-ml--test-from-string nil (org-ml-build-drawer "DRAW") ":DRAW:\n:END:" (org-ml-build-drawer "DRAW" (org-ml-build-paragraph! "p")) ":DRAW:\np\n:END:") (org-ml--test-from-string nil (org-ml-build-dynamic-block "name") "#+begin: name\n#+end" (org-ml-build-dynamic-block "name" (org-ml-build-paragraph! "p")) "#+begin: name\np\n#+end") (org-ml--test-from-string nil (org-ml-build-footnote-definition "label" (org-ml-build-paragraph! "p")) "[fn:label] p") (org-ml--test-from-string '(:raw-value) (org-ml-build-headline! :title-text "headline") "* headline") (org-ml--test-from-string '(:structure) (org-ml-build-item! :paragraph "item") "- item") (org-ml--test-from-string nil (org-ml-build-paragraph! "para") "para" (org-ml-build-paragraph! "*para") "*para" (org-ml-build-paragraph) "") (org-ml--test-from-string '(:structure :type) (org-ml-build-plain-list (org-ml-build-item! :paragraph "item")) "- item") (org-ml--test-from-string nil (org-ml-build-section (org-ml-build-paragraph! "sec")) "sec" (org-ml-build-section (org-ml-build-paragraph! "*sec")) "*sec") (org-ml--test-from-string nil (org-ml-build-property-drawer) ":PROPERTIES:\n:END:" (org-ml-build-property-drawer! '("KEY" "val")) ":PROPERTIES:\n:KEY: val\n:END:") (org-ml--test-from-string nil (org-ml-build-quote-block) "#+begin_quote\n#+end_quote" (org-ml-build-quote-block (org-ml-build-paragraph! "p")) "#+begin_quote\np\n#+end_quote") (org-ml--test-from-string nil (org-ml-build-table! '("a")) "| a |" (org-ml-build-table) "|") (org-ml--test-from-string nil (org-ml-build-table-row! '("a")) "| a |" (org-ml-build-table-row-hline) "|---|" (org-ml-build-table-row) "|") (org-ml--test-from-string nil (org-ml-build-verse-block) "#+begin_verse\n#+end_verse" (org-ml-build-verse-block "hi\n") "#+begin_verse\nhi\n#+end_verse"))) ;;; PARSING INVERTABILITY ;; For all org buffer contents, parsing and printing should be ;; perfect inverses. ;; These tests test/use the following: ;; - all the parse functions ;; - `org-ml-to-string' ;; - `org-ml-get-type' (defun org-ml--test-contents-parse-inversion (type parse-fun contents-list &optional prefix suffix) "Return form to test the parse/print inversion of CONTENTS-LIST. Use PARSE-FUN to get the node tree from the contents. All should be parsed to TYPE." (declare (indent 2)) (let* ((contents-list (--map (if (consp it) (s-join "\n" it) it) contents-list)) (suffix-char (if (memq type org-ml-elements) "\n" " ")) ;; Also test each string with a space after it. In some cases, this ;; won't parse correctly, hence the filter. (contents-list-space (unless (memq type '(node-property plain-text line-break table-cell)) (--map (s-append suffix-char it) contents-list))) (test-list (append contents-list contents-list-space))) (--each test-list (-let* ((at (if prefix (1+ (length prefix)) 1)) ((parsed parsed-type) (org-ml--with-org-env (when prefix (insert prefix)) (insert it) (when suffix (insert suffix)) (let ((p (funcall parse-fun at))) (list (org-ml-to-string p) (org-ml-get-type p)))))) (if (equal type parsed-type) (should t) (print (format "%s parsed as %s" it parsed-type))) (should (equal it parsed)))))) (describe "parse and print should be perfect inverses" (describe "object nodes" (describe "leaves" (it "code" (org-ml--test-contents-parse-inversion 'code #'org-ml-parse-object-at (list "~code~"))) (it "entity" (org-ml--test-contents-parse-inversion 'entity #'org-ml-parse-object-at (list "\\pi" "\\pi{}"))) (it "export-snippet" (org-ml--test-contents-parse-inversion 'export-snippet #'org-ml-parse-object-at (list "@@x:y@@"))) (it "inline-babel-call" (org-ml--test-contents-parse-inversion 'inline-babel-call #'org-ml-parse-object-at (list "call_ktulu()" "call_ktulu(n=1)" "call_ktulu[:x y]()" "call_ktulu[:x y](n=1)" "call_ktulu()[:a b]" "call_ktulu(n=1)[:a b]" "call_ktulu[:x y]()[:a b]" "call_ktulu[:x y](n=1)[:a b]"))) (it "inline-src-block" (org-ml--test-contents-parse-inversion 'inline-src-block #'org-ml-parse-object-at (list "src_python{}" "src_python{print \"yo\"}" "src_python[:x y]{}" "src_python[:x y]{print \"yo\"}"))) (it "line-break" (org-ml--test-contents-parse-inversion 'line-break #'org-ml-parse-object-at (list "\\\\\n"))) (it "latex-fragment" (org-ml--test-contents-parse-inversion 'latex-fragment #'org-ml-parse-object-at (list "$2+2=5$"))) (it "macro" (org-ml--test-contents-parse-inversion 'macro #'org-ml-parse-object-at (list "{{{key}}}" "{{{key(x=4)}}}"))) (it "statistics-cookie" (org-ml--test-contents-parse-inversion 'statistics-cookie #'org-ml-parse-object-at (list "[/]" "[0/0]" "[%]" "[0%]"))) (it "timestamp" (org-ml--test-contents-parse-inversion 'timestamp #'org-ml-parse-object-at (list "[2019-01-01 Tue]" "[2019-01-01 Tue 12:00]" "[2019-01-01 Tue 12:00-13:00]" "[2019-01-01 Tue 12:00]--[2019-01-01 Tue 13:00]" "[2019-01-01 Tue]--[2019-01-02 Wed]" "<2019-01-01 Tue>" "[2019-01-01 Tue +1d]" "[2019-01-01 Tue -1y]" "[2019-01-01 Tue +1d -1y]" "<%%(diary-float 1 3 2) 00:00>" "<%%(diary-float 1 3 2) 00:00-12:00>" "<%%(diary-float 1 3 2)>"))) (it "verbatim" (org-ml--test-contents-parse-inversion 'verbatim #'org-ml-parse-object-at (list "=verbatim="))) (it "plain-text" (org-ml--test-contents-parse-inversion 'plain-text #'org-ml-parse-object-at (list "plain-text" ;; all syntax chars by themselves should be plain-text "**" "~~" "@@:@@" "//" "[]" "[[]]" "{{{}}}" "<>" "<<>>" "<<<>>>" "++" "^" "_" "__" "==")))) (describe "branches" (it "bold" (org-ml--test-contents-parse-inversion 'bold #'org-ml-parse-object-at (list "*bold*"))) (it "footnote-reference" (org-ml--test-contents-parse-inversion 'footnote-reference #'org-ml-parse-object-at (list "[fn:label]" "[fn:label:nodes]") " ")) (it "italic" (org-ml--test-contents-parse-inversion 'italic #'org-ml-parse-object-at (list "/italic/"))) (it "link" ;; ignore the value of `org-link-abbrev-alist' (let ((org-link-abbrev-alist '(("test" . "fail")))) (org-ml--test-contents-parse-inversion 'link #'org-ml-parse-object-at ;; this is not exhaustive but hopefully good enough (list "https://downloadmoreram.com" "mailto:vladimirputin@pwned.ru" "file:/home/kalilinux/pwneddata" "" "[[test:foo]]" "[[https://downloadmoreram.com]]" "[[https://downloadmoreram.com][legit advice]]")))) (it "radio-target" (org-ml--test-contents-parse-inversion 'radio-target #'org-ml-parse-object-at (list "<<>>"))) (it "strike-through" (org-ml--test-contents-parse-inversion 'strike-through #'org-ml-parse-object-at (list "+strike+"))) (it "subscript" (org-ml--test-contents-parse-inversion 'subscript #'org-ml-parse-object-at (list "_sub" "_{sub}") "dummy")) (it "superscript" (org-ml--test-contents-parse-inversion 'superscript #'org-ml-parse-object-at (list "^super" "^{super}") "dummy")) (it "table-cell" (org-ml--test-contents-parse-inversion 'table-cell #'org-ml-parse-object-at (list " cell |") "|")))) (describe "element nodes" (describe "leaves" (it "babel-call" (org-ml--test-contents-parse-inversion 'babel-call #'org-ml-parse-element-at (list "#+call: name()\n" "#+call: name(x=1)\n" "#+call: name[:x y](x=1)\n" "#+call: name[:x y]()\n" "#+call: name[:x y](x=1) :a b\n" "#+call: name[:x y]() :a b\n" "#+call: name[]() :a b\n"))) ;; TODO this doesn't work (it "clock" (org-ml--test-contents-parse-inversion 'clock #'org-ml-parse-element-at (list "CLOCK: [2019-01-01 Tue]\n" "CLOCK: [2019-01-01 Tue]--[2019-01-02 Wed] => 24:00\n" "CLOCK: [2019-01-01 Tue 00:00-01:00] => 1:00\n" ))) (it "comment" (org-ml--test-contents-parse-inversion 'comment #'org-ml-parse-element-at (list "# one\n" '("# one" "# two\n") ;; TODO this doesn't work ;; "#\n" ))) (it "comment-block" (org-ml--test-contents-parse-inversion 'comment-block #'org-ml-parse-element-at (list '("#+begin_comment" "battle of being" "#+end_comment\n") '("#+begin_comment" "#+end_comment\n")))) (it "diary-sexp" (org-ml--test-contents-parse-inversion 'diary-sexp #'org-ml-parse-element-at (list "%%()\n" "%%(whatever)\n"))) (it "example-block" (org-ml--test-contents-parse-inversion 'example-block #'org-ml-parse-element-at (list '("#+begin_example" " example.com" "#+end_example\n") '("#+begin_example" "#+end_example\n")))) (it "export-block" (org-ml--test-contents-parse-inversion 'export-block #'org-ml-parse-element-at (list '("#+begin_export PLAIN" "bullet, bombs, bigotry" "#+end_export\n") ;; TODO type needs to always be uppercase? ;; '("#+BEGIN_EXPORT plain" ;; "#+END_EXPORT\n") '("#+begin_export PLAIN" "#+end_export\n")))) ;; ;; TODO this will randomly insert a blank after it is parsed ;; (it "fixed-width" ;; (org-ml--test-contents-parse-inversion 'fixed-width #'org-ml-parse-element-at ;; (list ": crucifixed" ;; ;; TODO this make a blank ;; ;; ":\n" ;; ))) (it "horizontal-rule" (org-ml--test-contents-parse-inversion 'horizontal-rule #'org-ml-parse-element-at (list "-----\n"))) (it "keyword" (org-ml--test-contents-parse-inversion 'keyword #'org-ml-parse-element-at (list "#+key: val\n" ;; TODO must be lowercase and must have at least a space ;; "#+KEY: \n" "#+key: \n"))) (it "latex-environment" (org-ml--test-contents-parse-inversion 'latex-environment #'org-ml-parse-element-at (list '("\\begin{env}" "\\end{env}\n") '("\\begin{env}" "latex >>> ms word" "\\end{env}\n")))) (it "node-property" (org-ml--test-contents-parse-inversion 'node-property #'org-ml-parse-element-at (list ":node: prop\n" ;; TODO node props will always be returned with 5 spaces after ;; ":node:\n" ":node: \n") "* dummy\n:PROPERTIES:\n" ":END:\n")) (it "planning" (org-ml--test-contents-parse-inversion 'planning #'org-ml-parse-element-at (list "CLOSED: <2019-01-01 Tue>\n" "CLOSED: <2019-01-01 Tue +1d>\n" "CLOSED: <2019-01-01 Tue -1y>\n" "CLOSED: <2019-01-01 Tue +1d -1y>\n") "* dummy\n")) (it "src-block" (org-ml--test-contents-parse-inversion 'src-block #'org-ml-parse-element-at (list '("#+begin_src" "#+end_src\n") ;; TODO this doesn't work if is isn't indented '("#+begin_src python -n :x y" " print \"yo\"" "#+end_src\n"))))) (describe "branches (object node children)" (it "paragraph" (org-ml--test-contents-parse-inversion 'paragraph #'org-ml-parse-element-at ;; TODO there are probably other things I could put here (list "paragraph\n"))) (it "table-row" (org-ml--test-contents-parse-inversion 'table-row #'org-ml-parse-table-row-at (list "| cell |\n" ;; TODO this makes an empty string ;; "| |\n" ))) (it "verse-block" (org-ml--test-contents-parse-inversion 'verse-block #'org-ml-parse-element-at (list '("#+begin_verse" "#+end_verse\n") '("#+begin_verse" "Once upon a midnight dreary..." "#+end_verse\n"))))) (describe "branches (element node children)" (it "center-block" (org-ml--test-contents-parse-inversion 'center-block #'org-ml-parse-element-at (list '("#+begin_center" "#+end_center\n") '("#+begin_center" "Of the universe..." "#+end_center\n")))) (it "drawer" (org-ml--test-contents-parse-inversion 'drawer #'org-ml-parse-element-at (list '(":LOGBOOK:" ":END:\n") '(":LOGBOOK:" "- logged thingy" ":END:\n")))) (it "dynamic-block" (org-ml--test-contents-parse-inversion 'dynamic-block #'org-ml-parse-element-at (list '("#+begin: name" "#+end:\n") '("#+begin: name" "Random contents..." "#+end:\n")))) (it "footnote-definition" ;; TODO blanks are apparently not allowed and will error (org-ml--test-contents-parse-inversion 'footnote-definition #'org-ml-parse-element-at (list ;; "[fn:label] \n" ;; TODO needs a random space at the end ;; "[fn:label]" "[fn:label] stuff after\n" ))) (it "headline" (org-ml--test-contents-parse-inversion 'headline #'org-ml-parse-element-at ;; this is not exhaustive... (list "* dummy\n" "** dummy\n" "* COMMENT dummy\n" "* TODO COMMENT dummy\n" "* TODO dummy\n" "* TODO [#A] dummy\n" "* dummy\n\n" ;; BUG extra space added to the end of this (no section seems fine) ;; "* dummy\nsomething\n" ;; "* dummy\n\n** dummy\n" ;; BUG additionally, the space after "something" gets taken out ;; "* dummy\nsomething\n\n** dummy\n" ;; BUG order of comment and priority comes out reversed ;; "* TODO [#A] COMMENT dummy\n" ;; "* [#A] COMMENT dummy\n" ))) (it "item" (org-ml--test-contents-parse-inversion 'item #'org-ml-parse-item-at ;; this is not exhaustive... ;; TODO not sure why these have two newlines (list "- \n\n" "1. \n\n" ;; TODO this becomes - ;; "+ \n\n" ;; TODO this becomes 1. ;; "1) \n\n" "- thing\n" "- tagged :: thing\n" "1. [@20] thing\n" ))) (it "plain-list" (org-ml--test-contents-parse-inversion 'plain-list #'org-ml-parse-element-at (list "- thing\n" "1. thing\n" '("- thing" "- more thing\n") "- one\n- two\n" "- one\n - two\n" "- one\n\n - two\n" "- one\n - two\n\n" ))) (it "property-drawer" (org-ml--test-contents-parse-inversion 'property-drawer #'org-ml-parse-element-at (list '(":PROPERTIES:" ":END:\n") '(":PROPERTIES:" ":Effort: 0:30" ":END:\n")) "* dummy\n")) (it "quote-block" (org-ml--test-contents-parse-inversion 'quote-block #'org-ml-parse-element-at (list '("#+begin_quote" "#+end_quote\n") '("#+begin_quote" "Fear is the mind killer..." "#+end_quote\n")))) (it "section" (org-ml--test-contents-parse-inversion 'section #'org-ml-parse-section-at (list "things that could be a paragraph\n" "#+key: val\n" "# nothing important...\n"))) (it "special-block" (org-ml--test-contents-parse-inversion 'special-block #'org-ml-parse-element-at (list '("#+begin_special" "#+end_special\n") '("#+begin_special" "You don't belong here" "#+end_special\n")))) (it "table" (org-ml--test-contents-parse-inversion 'table #'org-ml-parse-element-at (list "| simple |\n" "| less | simple |\n" '("| R | A |" "| G | E |\n") ;; TODO this makes a blank string ;; "| |\n" )))))) ;;; FUNCTIONAL PURITY (defmacro org-ml--test-purity (header node &rest forms) "Test that FORMS will not modify NODE by side effect. HEADER is the it-header." (declare (indent 1)) (let ((it-forms (-map (lambda (form) `(let* ((it ,node) (s0 (org-ml-to-string it)) (sx (org-ml-to-string ,form)) (s1 (org-ml-to-string it))) (if (equal s0 s1) (should t) (let ((x (format "Form %S has a side effect on '%s', making '%s'" ',form s0 s1))) (expect x :to-be nil))) (if (not (equal s0 sx)) (should t) (let ((x (format "Form %S has no effect on '%s'" ',form s0))) (expect x :to-be nil))))) forms))) `(it ,header ,@it-forms))) (describe "all functions that modify nodes should be pure" (org-ml--test-purity "polymorphic setters" (org-ml-build-headline! :title-text "hi" :tags '("stuff")) (org-ml-set-property :level 2 it) (org-ml-set-properties '(:level 2 :archivedp t) it) (org-ml-shift-property :level 1 it) (org-ml-map-property :level (lambda (x) (1+ x)) it) (org-ml-map-properties '(:level (lambda (_) 2) :archivedp (lambda (_) t)) it) (org-ml-toggle-property :archivedp it) (org-ml-insert-into-property :tags 0 "stfu" it) (org-ml-remove-from-property :tags "stuff" it)) (org-ml--test-purity "polymorphic setters (plist)" (org-ml-from-string 'inline-call "#+call: ktulu[:cache no]()") (org-ml-plist-put-property :end-header :results 'html it) (org-ml-plist-remove-property :inside-header :cache it)) (describe "leaf nodes" (org-ml--test-purity "timestamp setters" (org-ml-build-timestamp! '(2024 1 1 0 0) :end '(2024 1 1 0 1)) (org-ml-timestamp-set-start-time '(2024 2 1 0 0) it) (org-ml-timestamp-set-end-time '(2024 2 1 0 0) it) (org-ml-timestamp-set-single-time '(2024 1 2 0 0) it) (org-ml-timestamp-set-double-time '(2024 1 2 0 0) '(2024 1 3 0 0) it) (org-ml-timestamp-set-length 1 'day it) (org-ml-timestamp-set-active t it) (org-ml-timestamp-shift 1 'day it) (org-ml-timestamp-shift-start 1 'day it) (org-ml-timestamp-shift-end 1 'day it) (org-ml-timestamp-toggle-active it) (org-ml-timestamp-truncate it) (org-ml-timestamp-truncate-start it) (org-ml-timestamp-truncate-end it) (org-ml-timestamp-set-collapsed nil it) (org-ml-timestamp-set-warning '(all 1 day) it) (org-ml-timestamp-map-warning (lambda (it) '(all 2 day)) it) (org-ml-timestamp-set-repeater '(restart 1 day) it) (org-ml-timestamp-map-repeater (lambda (it) '(restart 2 day)) it) (org-ml-timestamp-set-repeater '(restart 1 day) it) (org-ml-timestamp-map-repeater (lambda (it) '(restart 2 day)) it)) (org-ml--test-purity "timestamp diary setters" (org-ml-build-timestamp-diary '(diary-float t 4 2) :start '(12 0) :end '(13 0)) (org-ml-timestamp-diary-set-value '(diary-float t 4 3) it) (org-ml-timestamp-diary-set-start-time '(0 0) it) (org-ml-timestamp-diary-set-end-time '(0 0) it) (org-ml-timestamp-diary-set-single-time '(0 0) it) (org-ml-timestamp-diary-set-double-time '(0 0) '(0 1) it) (org-ml-timestamp-diary-set-length 2 'hour it) (org-ml-timestamp-diary-shift 1 'hour it) (org-ml-timestamp-diary-shift-start 1 'hour it) (org-ml-timestamp-diary-shift-end 1 'hour it)) (org-ml--test-purity "headline setters" (org-ml-build-headline! :title-text "really impressive title" :section-children (list (org-ml-build-paragraph! "hi"))) (org-ml-headline-set-title! "really *impressive* title" '(2 3) it)) (org-ml--test-purity "item setters" (org-ml-build-item! :checkbox 'off :paragraph "petulant /frenzy/" (org-ml-build-plain-list (org-ml-build-item! :bullet '- :paragraph "below"))) (org-ml-item-toggle-checkbox it))) (describe "branch nodes" ;; TODO polymorphic branch setters (org-ml--test-purity "polymorphic" (org-ml-build-paragraph! "/this/ is a *paragraph*") (org-ml-set-children (list "this is lame") it) (org-ml-map-children (lambda (_) (list "this is lame")) it)) (org-ml--test-purity "objects" (org-ml-from-string 'underline "_1 *2* 3 */4/* 5 /6/_ ") (apply #'org-ml-build-paragraph (org-ml-unwrap it)) (apply #'org-ml-build-paragraph (org-ml-unwrap-types-deep '(bold) it)) (apply #'org-ml-build-paragraph (org-ml-unwrap-deep it))) (org-ml--test-purity "secondary strings" (org-ml-build-paragraph! "This (1 *2* 3 */4/* 5 /6/) is randomly formatted ") (->> (org-ml-get-children it) (org-ml-flatten) (apply #'org-ml-build-paragraph)) (->> (org-ml-get-children it) (org-ml-flatten-types-deep '(italic)) (apply #'org-ml-build-paragraph)) (->> (org-ml-get-children it) (org-ml-flatten-deep) (apply #'org-ml-build-paragraph)) ) (org-ml--test-purity "item setters" (org-ml-build-item! :checkbox 'off :paragraph "petulant frenzy" (org-ml-build-plain-list (org-ml-build-item! :bullet '- :paragraph "below"))) (org-ml-item-set-paragraph '("calm") it) (org-ml-item-map-paragraph* (-map #'upcase it) it)) (org-ml--test-purity "headline setters" (org-ml-build-headline! :title-text "really impressive title" :pre-blank 1 :section-children (list (org-ml-build-paragraph! "something useful"))) (org-ml-headline-set-section (list (org-ml-build-paragraph! "x-section")) it) (org-ml-headline-map-section* (cons (org-ml-build-planning! :closed '(2019 1 1)) it) it) (org-ml-headline-set-subheadlines (list (org-ml-build-headline! :level 2 :title-text "headline x")) it) (org-ml-headline-map-subheadlines* (cons (org-ml-build-headline! :level 2 :title-text "headline x") it) it) (org-ml-headline-set-planning '(:closed (2019 1 1)) it) (org-ml-headline-map-planning (lambda (_) '(:closed (2019 1 1))) it) (org-ml-headline-set-node-properties '(("Effort" "0:01") ("ID" "easy")) it) (org-ml-headline-map-node-properties* (cons (list "New" "world man") it) it) (org-ml-headline-set-node-property "ID" "real" it) (org-ml-headline-map-node-property "ID" (lambda (_) "real") it)) (org-ml--test-purity "headline setters (logbook)" (->> (org-ml-build-headline! :title-text "really impressive title") (org-ml-headline-logbook-append-open-clock '(:log-into-drawer t :clock-into-drawer t :clock-out-notes t) (- 1546300800 (car (current-time-zone)))) (org-ml-headline-logbook-append-item '(:log-into-drawer t :clock-into-drawer t :clock-out-notes t) (org-ml-build-log-note (- 1546300800 (car (current-time-zone))) "new note"))) (org-ml-headline-set-logbook-items '(:log-into-drawer t :clock-into-drawer t :clock-out-notes t) nil it) (org-ml-headline-map-logbook-items '(:log-into-drawer t :clock-into-drawer t :clock-out-notes t) (lambda (_) nil) it) (org-ml-headline-set-logbook-clocks '(:log-into-drawer t :clock-into-drawer t :clock-out-notes t) nil it) (org-ml-headline-map-logbook-clocks '(:log-into-drawer t :clock-into-drawer t :clock-out-notes t) (lambda (_) nil) it) (org-ml-headline-set-supercontents '(:log-into-drawer t :clock-into-drawer t :clock-out-notes t) `(:blank 0 :contents (,(org-ml-build-paragraph! "new contents"))) it) (org-ml-headline-map-supercontents '(:log-into-drawer t :clock-into-drawer t :clock-out-notes t) (lambda (_) `(:blank 0 :contents (,(org-ml-build-paragraph! "new contents")))) it) (org-ml-headline-logbook-append-item '(:log-into-drawer t :clock-into-drawer t :clock-out-notes t) (org-ml-build-log-note (- 1546300800 (car (current-time-zone))) "new note") it) (org-ml-headline-logbook-append-open-clock '(:log-into-drawer t :clock-into-drawer t :clock-out-notes t) (- 1546300800 (car (current-time-zone))) it) (org-ml-headline-logbook-close-open-clock '(:log-into-drawer t :clock-into-drawer t :clock-out-notes t) (- 1546310800 (car (current-time-zone))) nil it) (org-ml-headline-set-contents '(:log-into-drawer t :clock-into-drawer t :clock-out-notes t) (list (org-ml-build-paragraph! "I'm new")) it) (org-ml-headline-map-contents '(:log-into-drawer t :clock-into-drawer t :clock-out-notes t) (lambda (_) (list (org-ml-build-paragraph! "I'm new"))) it) (org-ml-headline-logbook-convert-config '(:log-into-drawer t :clock-into-drawer t :clock-out-notes t) '(:log-into-drawer "LLL" :clock-into-drawer "CCC" :clock-out-notes t) it)) (org-ml--test-purity "headline setters (stats cookie item)" (org-ml-build-headline! :title-text "really impressive title" :statistics-cookie '(0 0) :section-children (list (org-ml-build-plain-list (org-ml-build-item! :checkbox 'on :paragraph "the one")))) (org-ml-headline-update-item-statistics it)) (org-ml--test-purity "headline setters (stats cookie todo)" (org-ml-build-headline! :title-text "really impressive title" :statistics-cookie '(0 0) (org-ml-build-headline! :title-text "the one" :todo-keyword "DONE")) (org-ml-headline-update-todo-statistics it)) (org-ml--test-purity "headline setters (indentation)" (org-ml-build-headline! :title-text "one" (org-ml-build-headline! :level 2 :title-text "two") (org-ml-build-headline! :level 2 :title-text "three" (org-ml-build-headline! :level 3 :title-text "four") (org-ml-build-headline! :level 3 :title-text "five") (org-ml-build-headline! :level 3 :title-text "six"))) (org-ml-headline-demote-subheadline 1 it) (org-ml-headline-demote-subtree 1 it) (org-ml-headline-promote-subheadline 1 1 it) (org-ml-headline-promote-all-subheadlines 1 it)) (org-ml--test-purity "plain list" (org-ml-build-plain-list (org-ml-build-item! :checkbox 'off :paragraph "one") (org-ml-build-item! :checkbox 'on :paragraph "two")) (org-ml-plain-list-set-type 'ordered it)) (org-ml--test-purity "plain list (indentation)" (org-ml-build-plain-list (org-ml-build-item! :paragraph "one") (org-ml-build-item! :paragraph "two" (org-ml-build-plain-list (org-ml-build-item! :paragraph "three") (org-ml-build-item! :paragraph "four") (org-ml-build-item! :paragraph "five"))) (org-ml-build-item! :paragraph "six")) (org-ml-plain-list-indent-item 1 it) (org-ml-plain-list-indent-item-tree 1 it) (org-ml-plain-list-outdent-item 1 0 it) (org-ml-plain-list-outdent-all-items 1 it)) (org-ml--test-purity "table" (org-ml-from-string 'table "| a | b |\n|---+---|\n| c | d |") (org-ml-table-delete-column 0 it) (org-ml-table-delete-row 0 it) (org-ml-table-insert-column! 1 '("x" "y") it) (org-ml-table-insert-row! 1 '("x" "y") it) (org-ml-table-replace-cell! 0 0 "2" it) (org-ml-table-replace-column! 0 '("A" "B") it) (org-ml-table-replace-row! 0 '("A" "B") it)))) ;;; NODE PROPERTY COMPLETENESS (defun should-have-equal-properties (e1 e2) (unless (eq (org-ml-get-type e1) (org-ml-get-type e2)) (error "Type mismatch: %s\n\n%s" e1 e2)) (cl-flet ((plist-get-keys (plist) (let ((keys (-slice plist 0 nil 2))) (if (org-ml-is-any-type org-ml--element-nodes-with-affiliated e1) (-difference keys '(:name :plot :header :results :caption)) keys)))) (let ((p1 (plist-get-keys (nth 1 e1))) (p2 (plist-get-keys (nth 1 e2)))) (expect (-difference p1 p2) :not :to-be-truthy) (expect (-difference p2 p1) :not :to-be-truthy)))) (defun org-ml--compare-object-props (elem string) (should-have-equal-properties elem (->> (org-ml--from-string (concat " " string)) (org-ml--get-descendent '(0 1))))) (defun org-ml--compare-element-props (elem string) (should-have-equal-properties elem (->> (org-ml--from-string string) (org-ml--get-descendent '(0))))) (describe "ensure builders include all properties" (describe "object nodes" (describe "leaves" (it "org-ml--code" (org-ml--compare-object-props (org-ml-build-code "value") "~code~")) (it "org-ml--entity" (org-ml--compare-object-props (org-ml-build-entity "pi") "\\pi")) (it "org-ml--export-snippet" (org-ml--compare-object-props (org-ml-build-export-snippet "backend" "value") "@@im:padme@@")) (it "org-ml--inline-babel-call" (org-ml--compare-object-props (org-ml-build-inline-babel-call "name") "call_name()")) (it "org-ml--inline-src-block" (org-ml--compare-object-props (org-ml-build-inline-src-block "lang") "src_lang{value}")) ;; TODO add latex fragment (it "org-ml--line-break" (org-ml--compare-object-props (org-ml-build-line-break) "\\\\\n")) (it "org-ml--macro" (org-ml--compare-object-props (org-ml-build-macro "value") "{{{value}}}")) (it "org-ml--statistics-cookie" (org-ml--compare-object-props (org-ml-build-statistics-cookie '(1)) "[/]")) (it "org-ml--target" (org-ml--compare-object-props (org-ml-build-target "value") "<>")) (it "org-ml--timestamp" (org-ml--compare-object-props (org-ml-build-timestamp! '(2019 1 1)) ;; TODO the timestamp parser does not add properties for warnings, ;; deadlines, or repeaters if they are not given, this appears to be a ;; bug "[2019-01-01 Tue +1d/3d -1d]")) (it "org-ml--verbatim" (org-ml--compare-object-props (org-ml-build-verbatim "value") "=value="))) (describe "branches" (it "org-ml--bold" (org-ml--compare-object-props (org-ml-build-bold) "*bold*")) (it "org-ml--footnote-reference" (org-ml--compare-object-props (org-ml-build-footnote-reference) "[fn:1]")) (it "org-ml--italic" (org-ml--compare-object-props (org-ml-build-italic) "/italic/")) (it "org-ml--link" (org-ml--compare-object-props (org-ml-build-link "path") "[[path]]")) (it "org-ml--radio-target" (org-ml--compare-object-props (org-ml-build-radio-target) "<<>>")) (it "org-ml--strike-through" (org-ml--compare-object-props (org-ml-build-strike-through) "+bad+")) (it "org-ml--superscript" (should-have-equal-properties (org-ml-build-superscript) (->> (org-ml--from-string "thisis^super") (org-ml--get-descendent '(0 1))))) (it "org-ml--subscript" (should-have-equal-properties (org-ml-build-subscript) (->> (org-ml--from-string "thisis_subpar") (org-ml--get-descendent '(0 1))))) (it "org-ml--table-cell" (should-have-equal-properties (org-ml-build-table-cell "cell") (->> (org-ml--from-string "| cell |") (org-ml--get-descendent '(0 0 0))))) (it "org-ml--underline" (org-ml--compare-object-props (org-ml-build-underline) "_bad_")))) (describe "element nodes" (describe "leaves" (it "org-ml--babel-call" (org-ml--compare-element-props (org-ml-build-babel-call "call") "#+call: name()")) (it "org-ml--clock" (org-ml--compare-element-props (org-ml-build-clock (org-ml-build-timestamp! '(2019 1 1))) "CLOCK: [2019-01-01 Tue]")) (it "org-ml--comment" (org-ml--compare-element-props (org-ml-build-comment "useless") "# useless")) (it "org-ml--comment-block" (org-ml--compare-element-props (org-ml-build-comment-block) "#+begin_comment\nuseless\n#+end_comment")) (it "org-ml--diary-sexp" (org-ml--compare-element-props (org-ml-build-diary-sexp) "%%()")) (it "org-ml--example-block" (org-ml--compare-element-props (org-ml-build-example-block) "#+begin_example\nuseless\n#+end_example")) (it "org-ml--export-block" (org-ml--compare-element-props (org-ml-build-export-block "type" "value") "#+begin_export type\nuseless\n#+end_export")) (it "org-ml--fixed-width" (org-ml--compare-element-props (org-ml-build-fixed-width "value") ": value")) (it "org-ml--horizontal-rule" (org-ml--compare-element-props (org-ml-build-horizontal-rule) "-----")) (it "org-ml--keyword" (org-ml--compare-element-props (org-ml-build-keyword "key" "val") "#+KEY: val")) (it "org-ml--latex-environment" (org-ml--compare-element-props (org-ml-build-latex-environment '("gloves" "text")) "\\begin{env}\nvalue\n\\end{env}")) (it "org-ml--node-property" (should-have-equal-properties (org-ml-build-node-property "key" "value") (->> (org-ml--from-string "* dummy\n:PROPERTIES:\n:key: val\n:END:") (org-ml--get-descendent '(0 0 0))))) (it "org-ml--planning" (should-have-equal-properties (org-ml-build-planning :closed (org-ml-build-timestamp! '(2019 1 1) :active nil)) (->> (org-ml--from-string "* dummy\nCLOSED: <2019-01-01 Tue>") (org-ml--get-descendent '(0 0))))) (it "org-ml--src-block" (org-ml--compare-element-props (org-ml-build-src-block) "#+begin_src\nuseless\n#+end_src"))) (describe "branches" (it "org-ml--paragraph" (should-have-equal-properties (org-ml-build-paragraph) (->> (org-ml--from-string "text") (org-ml--get-descendent '(0))))) (it "org-ml--table-row" (should-have-equal-properties (org-ml-build-table-row) (->> (org-ml--from-string "| row |") (org-ml--get-descendent '(0 0))))) (it "org-ml--verse-block" (should-have-equal-properties (org-ml-build-verse-block) (->> (org-ml--from-string "#+begin_verse\nthing\n#+end_verse") (org-ml--get-descendent '(0))))) (it "org-ml--center-block" (org-ml--compare-element-props (org-ml-build-center-block) "#+begin_center\nuseless\n#+end_center")) (it "org-ml--drawer" (org-ml--compare-element-props (org-ml-build-drawer "name") ":LOGBOOK:\nuseless\n:END:")) (it "org-ml--dynamic-block" (org-ml--compare-element-props (org-ml-build-dynamic-block "name" :arguments '(:key val)) "#+begin: name args\nuseless\n#+end:")) (it "org-ml--footnote-definition" (org-ml--compare-element-props (org-ml-build-footnote-definition "label") "[fn:label]\n")) (it "org-ml--headline" (should-have-equal-properties (org-ml-build-headline) (org-ml--from-string "* head"))) (it "org-ml--item" (should-have-equal-properties (org-ml-build-item) (->> (org-ml--from-string "- head") (org-ml--get-descendent '(0 0))))) (it "org-ml--plain-list" (org-ml--compare-element-props (org-ml-build-plain-list) "- item")) (it "org-ml--property-drawer" (should-have-equal-properties (org-ml-build-property-drawer) (->> (org-ml--from-string "* dummy\n:PROPERTIES:\n:END:") (org-ml--get-descendent '(0 0))))) (it "org-ml--quote-block" (org-ml--compare-element-props (org-ml-build-quote-block) "#+begin_quote\n#+end_quote")) (it "org-ml--section" (org-ml--compare-element-props (org-ml-build-section) "* dummy\nstuff")) (it "org-ml--special-block" (org-ml--compare-element-props (org-ml-build-special-block "type") "#+begin_type:\n#+end_type:")) (it "org-ml--table" (org-ml--compare-element-props (org-ml-build-table) "| table |"))))) ;; ;; SPECIALIZED DEFUN MACRO TESTS (describe "org-ml--defun-kw internal definition" (describe "org-ml--make-header" (it "make header" (expect (org-ml--make-header '("docstring" (print 'hi)) nil) :to-equal "docstring\n\n(fn)") (expect (org-ml--make-header '("docstring" (print 'hi)) '(one)) :to-equal "docstring\n\n(fn ONE)") (expect (org-ml--make-header '("docstring" (print 'hi)) '(one two)) :to-equal "docstring\n\n(fn ONE TWO)"))) (describe "org-ml--make-kwarg-let/error" (it "list too long" (should-error (org-ml--make-kwarg-let '(one two three)))) (it "keyword slot must be a real keyword" (should-error (org-ml--make-kwarg-let '((one two)))) (should-error (org-ml--make-kwarg-let '((one two) three)))) (it "single arg must be a symbol but not a keyword" ;; TODO the keyword guard does not work yet ;; (should-error (org-ml--make-kwarg-let :one)) (should-error (org-ml--make-kwarg-let 1)) (should-error (org-ml--make-kwarg-let "one")) (should-error (org-ml--make-kwarg-let '(1))))) (describe "org-ml--make-rest-partition-form" (describe "valid restargs" (it "single arg" (expect '(nil . (one)) :to-equal (org-ml--make-rest-partition-form '(one) nil t))) (it "multiple args" (expect '(nil . (one two)) :to-equal (org-ml--make-rest-partition-form '(one two) nil t)))) (describe "error" (it "invalid keywords" (should-error (org-ml--make-rest-partition-form '(:one one) '(:two) nil))) (it "too many arguments" (should-error (org-ml--make-rest-partition-form '(:one one two) (:one) nil))) (it "multiple keywords" (should-error (org-ml--make-rest-partition-form '(:one one :one three two) (:one) nil)))))) ;;; SUPERCONTENTS FRAMEWORK TESTING (defun org-ml--test-merge-logbook-valid (config output items clocks) `(expect (org-ml--merge-logbook ,config ,items ,clocks) :to-equal ,output)) (defun org-ml--test-merge-logbook-error (config items clocks) `(should-error (org-ml--merge-logbook ,config ,items ,clocks))) (defmacro org-ml--test-merge-logbook-specs (config &rest specs) (declare (indent 1)) (let ((forms (->> (-partition 4 specs) (--map (-let (((title output items clocks) it)) `(it ,title ,(if (eq output 'error) (org-ml--test-merge-logbook-error config items clocks) (org-ml--test-merge-logbook-valid config output items clocks)))))))) `(progn ,@forms))) (describe "org-ml--merge-logbook" (before-all (setq enconf (org-ml--scc-encode nil) enconf-notes (org-ml--scc-encode '(:clock-out-notes t)) c1 (org-ml-build-clock! '(2020 1 1 0 0) :end '(2020 1 1 1 0)) i1 (org-ml-build-log-note (org-ml-timelist-to-unixtime '(2020 1 2 0 0)) "1") c2 (org-ml-build-clock! '(2020 1 3 0 0) :end '(2020 1 3 1 0)) i2 (org-ml-build-log-note (org-ml-timelist-to-unixtime '(2020 1 4 0 0)) "2") n1 (org-ml-build-item! :paragraph "clock note") p1 (org-ml-build-plain-list i1) p2 (org-ml-build-plain-list i2) pn1 (org-ml-build-plain-list n1) p1n1 (org-ml-build-plain-list n1 i1) ;; there should never be a p12 analogue since that's not the right order p21 (org-ml-build-plain-list i2 i1) x1 (org-ml-build-code "I should cause a fatal error"))) (describe "without clock notes" (org-ml--test-merge-logbook-specs enconf "nothing" nil nil nil "just clocks" `(,c2 ,c1) nil `(,c1 ,c2) "just items" `(,p21) `(,i1 ,i2) nil "single clock and item" `(,p1 ,c1) `(,i1) `(,c1) "clocks and items" `(,p2 ,c2 ,p1 ,c1) `(,i1 ,i2) `(,c1 ,c2) "just clocks (note)" error nil `(,c1 ,n1 ,c2) "single clock (note) and item" error `(,i1) `(,c1 ,n1) "clocks (note) and items" error `(,i1 ,i2) `(,c1 ,n1 ,c2) "just clocks (note in wrong place)" error nil `(,n1 ,c1 ,c2) "just garbage (items)" error `(,x1) nil "just garbage (clocks)" error nil `(,x1))) (describe "with clock notes" (org-ml--test-merge-logbook-specs enconf-notes "nothing" nil nil nil "just clocks" `(,c2 ,c1) nil `(,c1 ,c2) "just items" `(,p21) `(,i1 ,i2) nil "single clock and item" `(,p1 ,c1) `(,i1) `(,c1) "clocks and items" `(,p2 ,c2 ,p1 ,c1) `(,i1 ,i2) `(,c1 ,c2) "just clocks (note)" `(,c2 ,c1 ,pn1) nil `(,c1 ,n1 ,c2) "single clock (note) and item" `(,p1 ,c1 ,pn1) `(,i1) `(,c1 ,n1) "clocks (note) and items" `(,p2 ,c2 ,p1 ,c1 ,pn1) `(,i1 ,i2) `(,c1 ,n1 ,c2) "clocks (note) and items (different order)" `(,p2 ,c2 ,p1n1 ,c1) `(,i1 ,i2) `(,c1 ,c2 ,n1) "just clocks (note in wrong place)" error nil `(,n1 ,c1 ,c2) "just garbage (items)" error `(,x1) nil "just garbage (clocks)" error nil `(,x1)))) (defmacro expect-separated (c m items clocks unknown in) `(-let (((&alist 'items i 'clocks c 'unknown u) (-group-by #'car (org-ml--separate-logbook ,c ,m ,in)))) (expect (list ,items ,clocks ,unknown) :to-equal (list (-map #'cdr i) (-map #'cdr c) (-map #'cdr u))))) (defmacro org-ml--test-separate-logbook-specs (config mode &rest specs) (declare (indent 2)) (let ((forms (->> (-partition 5 specs) (--map (-let (((title items clocks unknown input) it)) `(it ,title (expect-separated ,config ,mode ,items ,clocks ,unknown ,input))))))) `(progn ,@forms))) (describe "org-ml--separate-logbook" (before-all (setq enconf (org-ml--scc-encode nil) enconf-notes (org-ml--scc-encode '(:clock-out-notes t)) c1 (org-ml-build-clock! '(2020 1 1 0 0) :end '(2020 1 1 1 0)) i1 (org-ml-build-log-note (org-ml-timelist-to-unixtime '(2020 1 2 0 0)) "1") c2 (org-ml-build-clock! '(2020 1 3 0 0) :end '(2020 1 3 1 0)) i2 (org-ml-build-log-note (org-ml-timelist-to-unixtime '(2020 1 4 0 0)) "2") n1 (org-ml-build-item! :paragraph "clock note") p1 (org-ml-build-plain-list i1) p2 (org-ml-build-plain-list i2) pn1 (org-ml-build-plain-list n1) pn11 (org-ml-build-plain-list n1 i1) p1n1 (org-ml-build-plain-list i1 n1) p12 (org-ml-build-plain-list i1 i2) x1 (org-ml-build-code "I should cause a fatal error"))) (describe "mixed mode" (describe "without clock notes" (org-ml--test-separate-logbook-specs enconf :mixed "nothing" nil nil nil nil "single item" `(,i1) nil nil `(,p1) "single clock" nil `(,c1) nil `(,c1) "single garbage entry" nil nil `(,x1) `(,x1) "single item and clock" `(,i1) `(,c1) nil `(,p1 ,c1) "single item and garbage" `(,i1) nil `(,x1) `(,p1 ,x1) "single clock and garbage" nil `(,c1) `(,x1) `(,c1 ,x1) "single item, clock, and garbage" `(,i1) `(,c1) `(,x1) `(,p1 ,c1 ,x1) "multiple items and clocks" `(,i2 ,i1) `(,c2 ,c1) nil `(,p12 ,c1 ,c2) "multiple items and clocks (interlaced)" `(,i2 ,i1) `(,c2 ,c1) nil `(,p1 ,c1 ,p2 ,c2) "clock with note" nil `(,c1) `(,n1) `(,c1 ,pn1) "clock with note in wrong place" nil `(,c1) `(,n1) `(,pn1 ,c1) "clock with note and item" `(,i1) `(,c1) `(,n1) `(,c1 ,pn11) "clock with item and note" `(,i1) `(,c1) `(,n1) `(,c1 ,p1n1))) (describe "clock notes" (org-ml--test-separate-logbook-specs enconf-notes :mixed "nothing" nil nil nil nil "single item" `(,i1) nil nil `(,p1) "single clock" nil `(,c1) nil `(,c1) "single garbage entry" nil nil `(,x1) `(,x1) "single item and clock" `(,i1) `(,c1) nil `(,p1 ,c1) "single item and garbage" `(,i1) nil `(,x1) `(,p1 ,x1) "single clock and garbage" nil `(,c1) `(,x1) `(,c1 ,x1) "single item, clock, and garbage" `(,i1) `(,c1) `(,x1) `(,p1 ,c1 ,x1) "multiple items and clocks" `(,i2 ,i1) `(,c2 ,c1) nil `(,p12 ,c1 ,c2) "multiple items and clocks (interlaced)" `(,i2 ,i1) `(,c2 ,c1) nil `(,p1 ,c1 ,p2 ,c2) "clock with note" nil `(,n1 ,c1) nil `(,c1 ,pn1) "clock with note in wrong place" nil `(,c1) `(,n1) `(,pn1 ,c1) "clock with note and item" `(,i1) `(,n1 ,c1) nil `(,c1 ,pn11) "clock with item and note" `(,i1) `(,c1) `(,n1) `(,c1 ,p1n1)))) (describe "items mode" (describe "without clock notes" (org-ml--test-separate-logbook-specs enconf :items "nothing" nil nil nil nil "single item" `(,i1) nil nil `(,p1) "single clock" nil nil `(,c1) `(,c1) "single garbage entry" nil nil `(,x1) `(,x1) "single item and clock" `(,i1) nil `(,c1) `(,p1 ,c1) "single item and garbage" `(,i1) nil `(,x1) `(,p1 ,x1) "single clock and garbage" nil nil `(,x1 ,c1) `(,c1 ,x1) "single item, clock, and garbage" `(,i1) nil `(,x1 ,c1) `(,p1 ,c1 ,x1) "multiple items and clocks" `(,i2 ,i1) nil `(,c2 ,c1) `(,p12 ,c1 ,c2) "multiple items and clocks (interlaced)" `(,i2 ,i1) nil `(,c2 ,c1) `(,p1 ,c1 ,p2 ,c2) "clock with note" nil nil `(,n1 ,c1) `(,c1 ,pn1) "clock with note in wrong place" nil nil `(,c1 ,n1) `(,pn1 ,c1) "clock with note and item" `(,i1) nil `(,n1 ,c1) `(,c1 ,pn11) "clock with item and note" `(,i1) nil `(,n1 ,c1) `(,c1 ,p1n1))) (describe "with clock notes" (org-ml--test-separate-logbook-specs enconf-notes :items "nothing" nil nil nil nil "single item" `(,i1) nil nil `(,p1) "single clock" nil nil `(,c1) `(,c1) "single garbage entry" nil nil `(,x1) `(,x1) "single item and clock" `(,i1) nil `(,c1) `(,p1 ,c1) "single item and garbage" `(,i1) nil `(,x1) `(,p1 ,x1) "single clock and garbage" nil nil `(,x1 ,c1) `(,c1 ,x1) "single item, clock, and garbage" `(,i1) nil `(,x1 ,c1) `(,p1 ,c1 ,x1) "multiple items and clocks" `(,i2 ,i1) nil `(,c2 ,c1) `(,p12 ,c1 ,c2) "multiple items and clocks (interlaced)" `(,i2 ,i1) nil `(,c2 ,c1) `(,p1 ,c1 ,p2 ,c2) "clock with note" nil nil `(,n1 ,c1) `(,c1 ,pn1) "clock with note in wrong place" nil nil `(,c1 ,n1) `(,pn1 ,c1) "clock with note and item" `(,i1) nil `(,n1 ,c1) `(,c1 ,pn11) "clock with item and note" `(,i1) nil `(,n1 ,c1) `(,c1 ,p1n1)))) (describe "clocks mode" (describe "without clock notes" (org-ml--test-separate-logbook-specs enconf :clocks "nothing" nil nil nil nil "single item" nil nil `(,i1) `(,p1) "single clock" nil `(,c1) nil `(,c1) "single garbage entry" nil nil `(,x1) `(,x1) "single item and clock" nil `(,c1) `(,i1) `(,p1 ,c1) "single item and garbage" nil nil `(,x1 ,i1) `(,p1 ,x1) "single clock and garbage" nil `(,c1) `(,x1) `(,c1 ,x1) "single item, clock, and garbage" nil `(,c1) `(,x1 ,i1) `(,p1 ,c1 ,x1) "multiple items and clocks" nil `(,c2 ,c1) `(,i2 ,i1) `(,p12 ,c1 ,c2) "multiple items and clocks (interlaced)" nil `(,c2 ,c1) `(,i2 ,i1) `(,p1 ,c1 ,p2 ,c2) "clock with note" nil `(,c1) `(,n1) `(,c1 ,pn1) "clock with note in wrong place" nil `(,c1) `(,n1) `(,pn1 ,c1) "clock with note and item" nil `(,c1) `(,i1 ,n1) `(,c1 ,pn11) "clock with item and note" nil `(,c1) `(,n1 ,i1) `(,c1 ,p1n1))) (describe "with clock notes" (org-ml--test-separate-logbook-specs enconf-notes :clocks "nothing" nil nil nil nil "single item" nil nil `(,i1) `(,p1) "single clock" nil `(,c1) nil `(,c1) "single garbage entry" nil nil `(,x1) `(,x1) "single item and clock" nil `(,c1) `(,i1) `(,p1 ,c1) "single item and garbage" nil nil `(,x1 ,i1) `(,p1 ,x1) "single clock and garbage" nil `(,c1) `(,x1) `(,c1 ,x1) "single item, clock, and garbage" nil `(,c1) `(,x1 ,i1) `(,p1 ,c1 ,x1) "multiple items and clocks" nil `(,c2 ,c1) `(,i2 ,i1) `(,p12 ,c1 ,c2) "multiple items and clocks (interlaced)" nil `(,c2 ,c1) `(,i2 ,i1) `(,p1 ,c1 ,p2 ,c2) "clock with note" nil `(,n1 ,c1) nil `(,c1 ,pn1) "clock with note in wrong place" nil `(,c1) `(,n1) `(,pn1 ,c1) "clock with note and item" nil `(,n1 ,c1) `(,i1) `(,c1 ,pn11) "clock with item and note" nil `(,c1) `(,n1 ,i1) `(,c1 ,p1n1))))) (defmacro org-ml--test-logbook-to-nodes (c out items clocks) `(->> (org-ml--logbook-init ,items ,clocks nil) (org-ml--logbook-to-nodes ,c) (equal ,out) (should))) (defmacro org-ml--test-logbook-to-nodes-specs (&rest specs) (let ((forms (->> (-partition 5 specs) (--map (-let (((title config output items clocks) it)) `(it ,title (org-ml--test-logbook-to-nodes ,config ,output ,items ,clocks))))))) `(progn ,@forms))) (describe "logbook to nodes" (before-all (setq i-name "LOGGING" c-name "CLOCKING" m-name "LOGBOOK" c1 (->> (org-ml-build-clock! '(2020 1 1 0 0) :end '(2020 1 1 1 0)) (org-ml-remove-parents)) i1 (->> (org-ml-build-log-note (org-ml-timelist-to-unixtime '(2020 1 2 0 0)) "1") (org-ml-remove-parents)) c2 (->> (org-ml-build-clock! '(2020 1 3 0 0) :end '(2020 1 3 1 0)) (org-ml-remove-parents)) i2 (->> (org-ml-build-log-note (org-ml-timelist-to-unixtime '(2020 1 4 0 0)) "2") (org-ml-remove-parents)) p1 (org-ml-build-plain-list i1) p2 (org-ml-build-plain-list i2) p21 (org-ml-build-plain-list i2 i1) di (org-ml-build-drawer i-name p21) di* (org-ml-build-drawer m-name p21) dc (org-ml-build-drawer c-name c2 c1) dc* (org-ml-build-drawer m-name c2 c1) dm (org-ml-build-drawer m-name p2 c2 p1 c1))) ;; ASSUME the sorting function takes care of clock notes, and since ;; everything passes through that, don't test it here (org-ml--test-logbook-to-nodes-specs "no config" nil `(,p2 ,c2 ,p1 ,c1) `(,i1 ,i2) `(,c1 ,c2) "item drawer" `(:log-into-drawer ,i-name) `(,di ,c2 ,c1) `(,i1 ,i2) `(,c1 ,c2) "clock drawer" `(:clock-into-drawer ,c-name) `(,dc ,p21) `(,i1 ,i2) `(,c1 ,c2) "item and clock drawer (different)" `(:log-into-drawer ,i-name :clock-into-drawer ,c-name) `(,di ,dc) `(,i1 ,i2) `(,c1 ,c2) "items and clock drawer (same)" '(:log-into-drawer t :clock-into-drawer t) `(,dm) `(,i1 ,i2) `(,c1 ,c2) "clock limit" '(:log-into-drawer nil :clock-into-drawer 1) `(,dc* ,p21) `(,i1 ,i2) `(,c1 ,c2) "clock limit (higher)" '(:log-into-drawer nil :clock-into-drawer 2) `(,p2 ,c2 ,p1 ,c1) `(,i1 ,i2) `(,c1 ,c2) "clock limit and item drawer (same)" '(:log-into-drawer t :clock-into-drawer 1) `(,dm) `(,i1 ,i2) `(,c1 ,c2) "clock limit (higher) and item drawer (same)" '(:log-into-drawer t :clock-into-drawer 2) `(,di* ,c2 ,c1) `(,i1 ,i2) `(,c1 ,c2) "clock limit and item drawer (different)" `(:log-into-drawer ,i-name :clock-into-drawer 1) `(,di ,dc*) `(,i1 ,i2) `(,c1 ,c2) "clock limit (higher and item drawer (different)" `(:log-into-drawer ,i-name :clock-into-drawer 2) `(,di ,c2 ,c1) `(,i1 ,i2) `(,c1 ,c2) nil)) ;; eight possible configurations for the logbook based on the values of ;; `org-log-into-drawer' (L) and `org-clock-into-drawer' (C) ;; - L = C = nil: 'mixed' ;; - L = string, C = nil: 'single-items' ;; - L = nil, C = string: 'single-clocks' ;; - L = C = string: 'single-mixed' ;; - L = string1, C = string2: 'dual' ;; - L = nil, C = int: 'single-clocks-or-mixed' ;; - L = string, C = int: 'single-items-or-dual' ;; - L = "LOGBOOK", C = int: 'single-mixed-or-single-items' (defmacro expect-supercontents (config nodes items clocks unknown blank rest) (declare (indent 2)) `(expect (org-ml--supersection-to-supercontents ,config (list :pre-blank 0 :section ,nodes)) :to-equal (org-ml--supercontents-init nil nil ,items ,clocks ,unknown ,blank ,rest))) (defmacro org-ml--test-supercontents-specs (config &rest specs) (declare (indent 1)) (let ((forms (->> (-partition 7 specs) (--map (-let (((title input items clocks unknown post-blank contents) it)) `(it ,title (expect-supercontents ,config ,input ,items ,clocks ,unknown ,post-blank ,contents))))))) `(progn ,@forms))) (describe "org-ml--supercontents-mixed" (before-all (setq config nil config-notes '(:clock-out-notes t) i1 (org-ml-build-log-note 1603767576 "i1") i2 (org-ml-build-item! :paragraph "clock note") p1 (org-ml-build-plain-list i1) p2 (org-ml-build-plain-list i2) p12 (org-ml-build-plain-list i1 i2) p21 (org-ml-build-plain-list i2 i1) c1 (org-ml-build-clock (org-ml-build-timestamp! '(2112 1 1 0 0) :end '(2112 1 2 0 0))) r1 (org-ml-build-paragraph! "foo"))) (describe "with clock notes" (org-ml--test-supercontents-specs config-notes "nothing" nil nil nil nil 0 nil "no logbook" (list r1) nil nil nil 0 `(,r1) "item clock note rest" (list p1 c1 p2 r1) `(,i1) `(,c1 ,i2) nil 0 `(,r1) "item note clock rest" (list p1 p2 c1 r1) `(,i1) nil nil 0 `(,p2 ,c1 ,r1) "clock item note rest" (list c1 p2 p1 r1) `(,i1) `(,c1 ,i2) nil 0 `(,r1) "clock note item rest" (list c1 p1 p2 r1) `(,i1) `(,c1) nil 0 `(,p2 ,r1) "note item clock rest" (list p2 p1 c1 r1) nil nil nil 0 `(,p21 ,c1 ,r1) "note clock item rest" (list p2 c1 p1 r1) nil nil nil 0 `(,p2 ,c1 ,p1 ,r1) "item clock note" (list p1 c1 p2) `(,i1) `(,c1 ,i2) nil 0 nil "item note clock" (list p1 p2 c1) `(,i1) nil nil 0 `(,p2 ,c1) "clock item note" (list c1 p2 p1) `(,i1) `(,c1 ,i2) nil 0 nil "clock note item" (list c1 p1 p2) `(,i1) `(,c1) nil 0 `(,p2) "note item clock" (list p2 p1 c1) nil nil nil 0 `(,p21 ,c1) "note clock item" (list p2 c1 p1) nil nil nil 0 `(,p2 ,c1 ,p1) "item clock" (list p1 c1) `(,i1) `(,c1) nil 0 nil "item note" (list p1 p2) `(,i1) nil nil 0 `(,p2) "clock note" (list c1 p2) nil `(,c1 ,i2) nil 0 nil "clock item" (list c1 p1) `(,i1) `(,c1) nil 0 nil "note item" (list p2 p1) nil nil nil 0 `(,p21) "note clock" (list p2 c1) nil nil nil 0 `(,p2 ,c1) "rest list" (list r1 p1) nil nil nil 0 `(,r1 ,p1))) (describe "without clock notes" (org-ml--test-supercontents-specs config "nothing" nil nil nil nil 0 nil "no logbook" (list r1) nil nil nil 0 `(,r1) "item clock note rest" (list p1 c1 p2 r1) `(,i1) `(,c1) nil 0 `(,p2 ,r1) "item note clock rest" (list p1 p2 c1 r1) `(,i1) nil nil 0 `(,p2 ,c1 ,r1) "clock item note rest" (list c1 p2 p1 r1) nil `(,c1) nil 0 `(,p21 ,r1) "clock note item rest" (list c1 p1 p2 r1) `(,i1) `(,c1) nil 0 `(,p2 ,r1) "note item clock rest" (list p2 p1 c1 r1) nil nil nil 0 `(,p21 ,c1 ,r1) "note clock item rest" (list p2 c1 p1 r1) nil nil nil 0 `(,p2 ,c1 ,p1 ,r1) "item clock note" (list p1 c1 p2) `(,i1) `(,c1) nil 0 `(,p2) "item note clock" (list p1 p2 c1) `(,i1) nil nil 0 `(,p2 ,c1) "clock item note" (list c1 p2 p1) nil `(,c1) nil 0 `(,p21) "clock note item" (list c1 p1 p2) `(,i1) `(,c1) nil 0 `(,p2) "note item clock" (list p2 p1 c1) nil nil nil 0 `(,p21 ,c1) "note clock item" (list p2 c1 p1) nil nil nil 0 `(,p2 ,c1 ,p1) "item note" (list p1 c1) `(,i1) `(,c1) nil 0 nil "clock note" (list p1 p2) `(,i1) nil nil 0 `(,p2) "clock item" (list c1 p2) nil `(,c1) nil 0 `(,p2) "note item" (list c1 p1) `(,i1) `(,c1) nil 0 nil "note clock" (list p2 p1) nil nil nil 0 `(,p21) "rest list" (list p2 c1) nil nil nil 0 `(,p2 ,c1)))) (describe "org-ml--supercontents-single-items" (before-all (setq id-name "LOGGING" config `(:log-into-drawer ,id-name) config-notes `(:log-into-drawer ,id-name :clock-out-notes t) i1 (org-ml-build-item! :paragraph "i1") i2 (org-ml-build-log-note 1603767576 "log note") i3 (org-ml-build-log-note 1603767576 "log note in drawer") p1 (org-ml-build-plain-list i1) p2 (org-ml-build-plain-list i2) p3 (org-ml-build-plain-list i3) p4 (org-ml-build-plain-list i1 i2) drwr (org-ml-build-drawer id-name p3) ts1 (org-ml-build-timestamp! '(2112 1 1 0 0 :end '(2112 1 2 0 0))) c1 (org-ml-build-clock ts1) r1 (org-ml-build-paragraph! "foo"))) (describe "without clock notes" (org-ml--test-supercontents-specs config "nothing" nil nil nil nil 0 nil "no logbook" (list r1) nil nil nil 0 `(,r1) "clock note (no notes)" (list c1 p1 r1) nil `(,c1) nil 0 `(,p1 ,r1) "clock note item (no notes)" (list c1 p4 r1) nil `(,c1) nil 0 `(,p4 ,r1) ;; ASSUME the code that stops splitting after finding an invalid item is ;; fully tested with this example and will therefore do the same in the ;; permutations below "item clock (store none)" (list p1 c1 r1) nil nil nil 0 `(,p1 ,c1 ,r1) "drawer clock (store both)" (list drwr c1 r1) `(,i3) `(,c1) nil 0 `(,r1) "clock drawer (store both)" (list c1 drwr r1) `(,i3) `(,c1) nil 0 `(,r1) "clock item drawer (don't store note)" (list c1 p1 drwr r1) nil `(,c1) nil 0 `(,p1 ,drwr ,r1))) (describe "with clock notes" (org-ml--test-supercontents-specs config-notes "clock item drawer (store all)" (list c1 p1 drwr r1) `(,i3) `(,c1 ,i1) nil 0 `(,r1) "clock note item" (list c1 p4 r1) nil `(,c1 ,i1) nil 0 `(,p2 ,r1) "clock note" (list c1 p1 r1) nil `(,c1 ,i1) nil 0 `(,r1) "clock item" (list c1 p2 r1) nil `(,c1) nil 0 `(,p2 ,r1)))) (describe "org-ml--supercontents-single-clocks" (before-all (setq cd-name "CLOCKING" config `(:clock-into-drawer ,cd-name) config-notes `(:clock-into-drawer ,cd-name :clock-out-notes t) i1 (org-ml-build-log-note 1603767576 "note 1") i2 (org-ml-build-log-note 1603767576 "note 2") i3 (org-ml-build-item! :paragraph "clock note") p1 (org-ml-build-plain-list i1) p2 (org-ml-build-plain-list i2) p3 (org-ml-build-plain-list i3) ts1 (org-ml-build-timestamp! '(2112 1 1 0 0) :end '(2112 1 2 0 0)) c1 (org-ml-build-clock ts1) drwr1 (org-ml-build-drawer cd-name c1) drwr2 (org-ml-build-drawer cd-name c1 p3) r1 (org-ml-build-paragraph! "foo"))) (describe "without clock notes" (org-ml--test-supercontents-specs config "nothing" nil nil nil nil 0 nil "no logbook" (list r1) nil nil nil 0 `(,r1) ;; this only has five valid combinations ;; "item, drawer, item" (list p1 drwr1 p2 r1) `(,i1 ,i2) `(,c1) nil 0 `(,r1) "item, drawer" (list p1 drwr1 r1) `(,i1) `(,c1) nil 0 `(,r1) "item" (list p1 r1) `(,i1) nil nil 0 `(,r1) "drawer, item" (list drwr1 p1 r1) `(,i1) `(,c1) nil 0 `(,r1) "drawer" (list drwr1 r1) nil `(,c1) nil 0 `(,r1) ;; invalid "loose clock anywhere" (list c1 p1 r1) nil nil nil 0 `(,c1 ,p1 ,r1))) (describe "with clock notes" (org-ml--test-supercontents-specs config-notes "drawer with clock notes" (list drwr2 r1) nil `(,c1 ,i3) nil 0 `(,r1)))) (describe "org-ml--supercontents-dual" (before-all (setq cd-name "CLOCKING" id-name "LOGGING" config `(:log-into-drawer ,id-name :clock-into-drawer ,cd-name) i1 (org-ml-build-log-note 1603767576 "note") p1 (org-ml-build-plain-list i1) ts1 (org-ml-build-timestamp! '(2112 1 1 0 0) :end '(2112 1 2 0 0)) c1 (org-ml-build-clock ts1) drwr1 (org-ml-build-drawer cd-name c1) drwr2 (org-ml-build-drawer id-name p1) r1 (org-ml-build-paragraph! "foo"))) (org-ml--test-supercontents-specs config "nothing" nil nil nil nil 0 nil "no logbook" (list r1) nil nil nil 0 `(,r1) "one drawer" (list drwr1 r1) nil `(,c1) nil 0 `(,r1) "one drawer (other one)" (list drwr2 r1) `(,i1) nil nil 0 `(,r1) "two drawers" (list drwr1 drwr2 r1) `(,i1) `(,c1) nil 0 `(,r1) "two drawers (other order)" (list drwr2 drwr1 r1) `(,i1) `(,c1) nil 0 `(,r1) "clock outside (invalid)" (list c1 drwr2 r1) nil nil nil 0 `(,c1 ,drwr2 ,r1) "item outside (invalid)" (list p1 drwr1 r1) nil nil nil 0 `(,p1 ,drwr1 ,r1))) (describe "org-ml--supercontents-single-mixed" (before-all (setq d-name "LOGBOOK" config '(:log-into-drawer t :clock-into-drawer t) config-notes (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t) i1 (org-ml-build-log-note 1603767576 "note 2") i2 (org-ml-build-item! :paragraph "clock note") p1 (org-ml-build-plain-list i1) p2 (org-ml-build-plain-list i2) ts1 (org-ml-build-timestamp! '(2112 1 1 0 0) :end '(2112 1 2 0 0)) c1 (org-ml-build-clock ts1) drwr1 (org-ml-build-drawer d-name c1 p1) drwr2 (org-ml-build-drawer d-name c1 p2 p1) r1 (org-ml-build-paragraph! "foo"))) (describe "without clock notes" (org-ml--test-supercontents-specs config "nothing" nil nil nil nil 0 nil "no logging" (list r1) nil nil nil 0 `(,r1) "single drawer" (list drwr1 r1) `(,i1) `(,c1) nil 0 `(,r1) "clock outside (invalid)" (list c1 drwr1 r1) nil nil nil 0 `(,c1 ,drwr1 ,r1) "item outside (invalid)" (list p1 drwr1 r1) nil nil nil 0 `(,p1 ,drwr1 ,r1))) (describe "with clock notes" (org-ml--test-supercontents-specs config-notes "single drawer with notes" (list drwr2 r1) `(,i1) `(,c1 ,i2) nil 0 `(,r1)))) (describe "org-ml--supercontents-single-clocks-or-mixed" ;; ASSUME clock notes are tested using the mixed and single-clocks tests (before-all (setq clock-limit 1 config `(:clock-into-drawer ,clock-limit) i1 (org-ml-build-log-note 1603767576 "note 1") i2 (org-ml-build-log-note 1603767576 "note 2") p1 (org-ml-build-plain-list i1) p2 (org-ml-build-plain-list i2) ts1 (org-ml-build-timestamp! '(2112 1 1 0 0) :end '(2112 1 2 0 0)) c1 (org-ml-build-clock ts1) ts2 (org-ml-build-timestamp! '(2112 1 2 0 0) :end '(2112 1 3 0 0)) c2 (org-ml-build-clock ts1) drwr (org-ml-build-drawer "LOGBOOK" c1) r1 (org-ml-build-paragraph! "foo"))) (org-ml--test-supercontents-specs config "nothing" nil nil nil nil 0 nil "no logbook" (list r1) nil nil nil 0 `(,r1) ;; same tests as single-clocks when over clock limit ;; "plain-list, drawer, plain-list" (list p1 drwr p2 r1) `(,i1 ,i2) `(,c1) nil 0 `(,r1) "plain-list, drawer" (list p1 drwr r1) `(,i1) `(,c1) nil 0 `(,r1) "plain-list" (list p1 r1) `(,i1) nil nil 0 `(,r1) "drawer, plain-list" (list drwr p1 r1) `(,i1) `(,c1) nil 0 `(,r1) "drawer" (list drwr r1) nil `(,c1) nil 0 `(,r1) ;; same as mixed ;; "loose clock under clock limit" (list c1 p1 r1) `(,i1) `(,c1) nil 0 `(,r1) "too many clocks" (list c1 c2 p1 r1) nil `(,c1) nil 0 `(,c2 ,p1 ,r1))) (describe "org-ml--supercontents-single-items-or-dual" (before-all (setq id-name "LOGGING" clock-limit 1 config `(:log-into-drawer ,id-name :clock-into-drawer ,clock-limit) i1 (org-ml-build-log-note 1603767576 "note 1") i2 (org-ml-build-log-note 1603767576 "note 2") i3 (org-ml-build-log-note 1603767576 "note 3") p1 (org-ml-build-plain-list i1) p2 (org-ml-build-plain-list i1 i2) p3 (org-ml-build-plain-list i3) drwr1 (org-ml-build-drawer id-name p3) ts1 (org-ml-build-timestamp! '(2112 1 1 0 0) :end '(2112 1 2 0 0)) c1 (org-ml-build-clock ts1) ts2 (org-ml-build-timestamp! '(2112 1 2 0 0) :end '(2112 1 3 0 0)) c2 (org-ml-build-clock ts2) drwr2 (org-ml-build-drawer "LOGBOOK" c1) r1 (org-ml-build-paragraph! "foo"))) (org-ml--test-supercontents-specs config "nothing" nil nil nil nil 0 nil "no logbook" (list r1) nil nil nil 0 `(,r1) ;; same as single-items ;; "clock item (don't store note)" (list c1 p1 r1) nil `(,c1) nil 0 `(,p1 ,r1) "clock items (store only clock)" (list c1 p2 r1) nil `(,c1) nil 0 `(,p2 ,r1) ;; ASSUME the code that stops splitting ;; after finding an invalid item is fully tested with this example and will ;; therefore do the same in the permutations below "item clock (store none)" (list p1 c1 r1) nil nil nil 0 `(,p1 ,c1 ,r1) "drawer clock (store both)" (list drwr1 c1 r1) `(,i3) `(,c1) nil 0 `(,r1) "clock drawer (store both)" (list c1 drwr1 r1) `(,i3) `(,c1) nil 0 `(,r1) "drawer clock item (store only clock)" (list drwr1 c1 p1 r1) `(,i3) `(,c1) nil 0 `(,p1 ,r1) "clock item drawer (don't store note)" (list c1 p1 drwr1 r1) nil `(,c1) nil 0 `(,p1 ,drwr1 ,r1) "too many clocks" (list c1 c2 p1 drwr1 r1) nil `(,c1) nil 0 `(,c2 ,p1 ,drwr1 ,r1) "dual drawer (clock only)" (list drwr2 r1) nil `(,c1) nil 0 `(,r1) "dual drawer (item only)" (list drwr1 r1) `(,i3) nil nil 0 `(,r1) "dual drawer (both)" (list drwr1 drwr2 r1) `(,i3) `(,c1) nil 0 `(,r1))) (describe "org-ml--supercontents-single-mixed-or-single-items" (before-all (setq clock-limit 1 config `(:log-into-drawer t :clock-into-drawer ,clock-limit) i1 (org-ml-build-log-note 1603767576 "note 1") p1 (org-ml-build-plain-list i1) ts1 (org-ml-build-timestamp! '(2112 1 1 0 0) :end '(2112 1 2 0 0)) c1 (org-ml-build-clock ts1) ts2 (org-ml-build-timestamp! '(2112 1 2 0 0) :end '(2112 1 3 0 0)) c2 (org-ml-build-clock ts2) drwr1 (org-ml-build-drawer "LOGBOOK" c1 p1) drwr2 (org-ml-build-drawer "LOGBOOK" p1) r1 (org-ml-build-paragraph! "foo"))) (org-ml--test-supercontents-specs config "nothing" nil nil nil nil 0 nil "no logging" (list r1) nil nil nil 0 `(,r1) "single drawer" (list drwr1 r1) `(,i1) `(,c1) nil 0 `(,r1) "clock outside and inside" (list c1 drwr1 r1) `(,i1) `(,c1) `(,c1) 0 `(,r1) "clocks outside and not inside" (list c1 drwr2 r1) `(,i1) `(,c1) nil 0 `(,r1) "too many clocks outside" (list c1 c2 drwr2 r1) nil `(,c1) nil 0 `(,c2 ,drwr2 ,r1) "item outside (invalid)" (list p1 drwr1 r1) nil nil nil 0 `(,p1 ,drwr1 ,r1))) ;; logbook blank line testing ;; ;; assume these tests cover all code paths ;; - any logbook type followed by a blank (item, clock, drawer) ;; - in the case of clocks with notes, clocks followed by plain lists where the ;; first item has a blank after it (describe "org-ml--supercontents-mixed-blank-line" (before-all (setq config nil config-notes '(:clock-out-notes t) config-drawer '(:log-into-drawer t) i1 (->> (org-ml-build-log-note 1603767576 "note 1") (org-ml-set-property :post-blank 1)) i2 (org-ml-build-log-note 1603767576 "note 2") i3 (org-ml-build-item! :post-blank 1 :paragraph "clock note") p1 (org-ml-build-plain-list i1 i2) p2 (org-ml-build-plain-list i1) p3 (org-ml-build-plain-list i2) p4 (org-ml-build-plain-list :post-blank 1 i1 i2) p5 (org-ml-build-plain-list :post-blank 1 i2) p6 (org-ml-build-plain-list i3 i2) p66 (org-ml-build-plain-list i2) ;; (p6 (org-ml-build-plain-list i1) p7 (org-ml-build-plain-list :post-blank 1 i2) ts1 (org-ml-build-timestamp! '(2112 1 1 0 0) :end '(2112 1 2 0 0)) c1 (org-ml-build-clock ts1) c2 (org-ml-build-clock ts1 :post-blank 1) drwr (org-ml-build-drawer "LOGBOOK" :post-blank 1 p2) r1 (org-ml-build-paragraph! "foo"))) (describe "with clock notes" (org-ml--test-supercontents-specs config-notes "item space item" (list p1 c1 r1) `(,i1) nil nil 1 `(,p3 ,c1 ,r1) "clock item space item" (list c1 p1 r1) `(,i1) `(,c1) nil 1 `(,p3 ,r1) "clock note space item" (list c1 p6 r1) nil `(,c1 ,i3) nil 1 `(,p66 ,r1) "clock space item" (list c2 p1 r1) nil `(,c2) nil 1 `(,p1 ,r1) "item space item space" (list p4 r1) `(,i1) nil nil 1 `(,p7 ,r1))) (describe "without clock notes" (org-ml--test-supercontents-specs config "item space item" (list p1 c1 r1) `(,i1) nil nil 1 `(,p3 ,c1 ,r1) "clock item space item" (list c1 p1 r1) `(,i1) `(,c1) nil 1 `(,p3 ,r1) "clock note space item" (list c1 p6 r1) nil `(,c1) nil 0 `(,p6 ,r1) "clock space item" (list c2 p1 r1) nil `(,c2) nil 1 `(,p1 ,r1) "item space item space" (list p4 r1) `(,i1) nil nil 1 `(,p7 ,r1))) (describe "with drawer" ;; TODO this has side effects :( (org-ml--test-supercontents-specs config-drawer "single drawer" (list drwr r1) `(,i1) nil nil 1 `(,r1)))) ;;; MATCH FRAMEWORK TESTING ;; These are tests for `org-ml-match' and friends. Proceed with caution :) (defmacro should-error-arg (form) "Make an ert error form to test if FORM signals an `arg-type-error'." `(should-error ,form :type 'arg-type-error)) (describe "org-ml--match-make-condition-form/error" ;; Ensure `org-ml--match-make-condition-form' will error when it ;; supposed to do so. All errors (in theory) should be tested here ;; so that we don't need to bother testing them anywhere else when ;; we test functions higher in the framework (unless (fboundp 'org-ml--match-make-condition-form) (error "Function not defined")) (before-all (setq fun #'org-ml--match-make-condition-form)) (it "quoted" (should-error-arg (funcall fun '(quote bold))) (should-error-arg (funcall fun '(function bold)))) (it "invalid type" (should-error-arg (funcall fun 'protoss))) (it "invalid operator" (should-error-arg (funcall fun '(= 1))) (should-error-arg (funcall fun '(=/ 1)))) (it "valid operator with non-integer" (should-error-arg (funcall fun '(< "1")))) (it "valid operator with too many arguments" (should-error-arg (funcall fun '(< 1 2)))) (it "pred with no arguments" (should-error-arg (funcall fun '(:pred)))) (it "pred with too many arguments" (should-error-arg (funcall fun '(:pred stringp integerp)))) (it "not with no arguments" (should-error-arg (funcall fun '(:not)))) (it "not with too many arguments" (should-error-arg (funcall fun '(:not 1 3)))) (it "and with no arguments" (should-error-arg (funcall fun '(:and)))) (it "and with nonsense" (should-error-arg (funcall fun '(:and bold :2)))) (it "or with no arguments" (should-error-arg (funcall fun '(:or)))) (it "or with nonsense" (should-error-arg (funcall fun '(:or bold :2)))) (it "properties with symbols instead of keywords" (should-error-arg (funcall fun '(tags '("hi"))))) (it "multiple properties" (should-error-arg (funcall fun '(:tags '("hi") :todo-keyword "DONE")))) (it "just wrong..." (should-error-arg (funcall fun nil)) (should-error-arg (funcall fun :1)))) (describe "org-ml--match-pattern-make-inner-form/error" ;; Ensure `org-ml--match-make-inner-form' will error when it supposed to ;; do so. All errors (in theory) should be tested here so that ;; we don't need to bother testing them anywhere else when we test ;; functions higher in the framework ;; ;; Assume: ;; - all invalid patterns at the condition level will be caught by ;; `org-ml--match-make-condition-form/error'. ;; - these error paths are independent of `END?' and `LIMIT' so ;; set them both to nil (unless (fboundp 'org-ml--match-pattern-make-inner-form) (error "Function not defined")) (before-all (setq fun (-partial #'org-ml--match-pattern-make-inner-form nil nil))) (it "slicers present" (should-error-arg (funcall fun '(:first bold))) (should-error-arg (funcall fun '(:last bold))) (should-error-arg (funcall fun '(:nth bold))) (should-error-arg (funcall fun '(:sub bold))) (should-error-arg (funcall fun '(bold :first))) (should-error-arg (funcall fun '(bold :last))) (should-error-arg (funcall fun '(bold :nth))) (should-error-arg (funcall fun '(bold :sub)))) (it "just wrong..." (should-error-arg (funcall fun '(:swaggart))))) (defun should-expand-to-alts (pattern alt-patterns) (should (equal (org-ml--match-pattern-expand-alternations pattern) alt-patterns))) (describe "org-ml--match-pattern-expand-alternations" ;; ensure that alternations expand properly (unless (fboundp 'org-ml--match-pattern-expand-alternations) (error "Function not defined")) (it "no alternations" (should-expand-to-alts '(a) '((a))) (should-expand-to-alts '(a b c) '((a b c)))) (it "1-level alternations" (should-expand-to-alts '((x | y)) '((x) (y))) (should-expand-to-alts '((x | y) a) '((x a) (y a))) (should-expand-to-alts '(a (x | y)) '((a x) (a y))) (should-expand-to-alts '(a (x | y) b) '((a x b) (a y b)))) (it "1-level alternations with nil" (should-expand-to-alts '((nil | y)) '(nil (y))) (should-expand-to-alts '((nil | y) a) '((a) (y a))) (should-expand-to-alts '(a (nil | y)) '((a) (a y))) (should-expand-to-alts '(a (nil | y) b) '((a b) (a y b)))) (it "1-level serial alternations" (should-expand-to-alts '((m | n) (x | y)) '((m x) (m y) (n x) (n y))) (should-expand-to-alts '(a (m | n) b (x | y) c) '((a m b x c) (a m b y c) (a n b x c) (a n b y c)))) (it "1-level serial alternations with nil" (should-expand-to-alts '((nil | n) (x | y)) '((x) (y) (n x) (n y))) (should-expand-to-alts '((m | n) (nil | y)) '((m) (m y) (n) (n y))) (should-expand-to-alts '(a (nil | n) b (x | y) c) '((a b x c) (a b y c) (a n b x c) (a n b y c))) (should-expand-to-alts '(a (m | n) b (nil | y) c) '((a m b c) (a m b y c) (a n b c) (a n b y c)))) (it "2-level alternations" (should-expand-to-alts '((x | (m | n))) '((x) (m) (n))) (should-expand-to-alts '(a (x | (m | n))) '((a x) (a m) (a n))) (should-expand-to-alts '((x | y (m | n))) '((x) (y m) (y n))) (should-expand-to-alts '(a (x | y (m | n))) '((a x) (a y m) (a y n)))) (it "2-level alternations with nil" (should-expand-to-alts '((nil | (m | n))) '(nil (m) (n))) (should-expand-to-alts '(a (nil | (m | n))) '((a) (a m) (a n))) (should-expand-to-alts '((nil | y (m | n))) '(nil (y m) (y n))) (should-expand-to-alts '(a (nil | y (m | n))) '((a) (a y m) (a y n))) (should-expand-to-alts '((x | (nil | n))) '((x) nil (n))) (should-expand-to-alts '(a (x | (nil | n))) '((a x) (a) (a n))) (should-expand-to-alts '((x | y (nil | n))) '((x) (y) (y n))) (should-expand-to-alts '(a (x | y (nil | n))) '((a x) (a y) (a y n))))) (defun should-expand-to (pattern expanded-pattern) (should (equal (org-ml--match-pattern-simplify-wildcards pattern) expanded-pattern))) (describe "org-ml--match-pattern-simplify-wildcards" ;; ensure that bracket and + wildcards expand properly (unless (fboundp 'org-ml--match-pattern-simplify-wildcards) (error "Function not defined")) (it "?" (should-expand-to '(x \?) '((nil | x))) (should-expand-to '(x \? y) '((nil | x) y))) (it "+" (should-expand-to '(x +) '(x x *)) (should-expand-to '(x + y) '(x x * y))) (it "brackets" (should-expand-to '(x [1]) '(x)) (should-expand-to '(x [2]) '(x x)) (should-expand-to '(x [0 1]) '((nil | x))) (should-expand-to '(x [2 2]) '(x x)) (should-expand-to '(x [1 2]) '((x | x x))) (should-expand-to '(x [1 nil]) '(x x *)))) (describe "org-ml--match-pattern-simplify-wildcards/error" ;; test errors in wildcard expansion ;; note, we assume that any malformed patterns are caught later ;; so no need to test if we supply two +'s in a row and other garbage (unless (fboundp 'org-ml--match-pattern-simplify-wildcards) (error "Function not defined")) (it "zero not allowed" (should-error-arg (org-ml--match-pattern-simplify-wildcards '(x [0])))) (it "negative not allowed" (should-error-arg (org-ml--match-pattern-simplify-wildcards '(x [-1])))) (it "double zeros not allowed" (should-error-arg (org-ml--match-pattern-simplify-wildcards '(x [0 0])))) (it "negatives not allowed" (should-error-arg (org-ml--match-pattern-simplify-wildcards '(x [-1 1]))) (should-error-arg (org-ml--match-pattern-simplify-wildcards '(x [1 -1]))) (should-error-arg (org-ml--match-pattern-simplify-wildcards '(x [-1 -1])))) (it "must be ascending order" (should-error-arg (org-ml--match-pattern-simplify-wildcards '(x [2 1]))))) (describe "org-ml--match-make-slicer-form" ;; Ensure `org-ml--match-make-inner-form' will error when it supposed to ;; do so. All errors (in theory) should be tested here so that ;; we don't need to bother testing them anywhere else when we test ;; functions higher in the framework ;; ;; Assume that all invalid patterns at the predicate and wildcard ;; level will be caught by `org-ml--match-make-condition-form/error' and ;; `org-ml--match-pattern-make-inner-form/error' (unless (fboundp 'org-ml--match-make-slicer-form) (error "Function not defined")) (before-all (setq fun #'org-ml--match-make-slicer-form)) (it "nth with non-integer" (should-error-arg (funcall fun '(:nth "1" bold)))) (it "sub with non-integers" (should-error-arg (funcall fun '(:sub "1" 2 bold))) (should-error-arg (funcall fun '(:sub 1 "2" bold)))) (it "sub with flipped integers" (should-error-arg (funcall fun '(:sub 2 1 bold))) (should-error-arg (funcall fun '(:sub -1 -2 bold)))) (it "sub with split integers" (should-error-arg (funcall fun '(:sub -1 2 bold))))) (defmacro match-should-equal (node result &rest patterns) "Return form to test if all PATTERNS applied NODE return RESULT." (declare (indent 2)) (let ((tests (--map `(expect ,result :to-equal (->> (org-ml-match ',it ,node) (-map #'org-ml-to-trimmed-string))) patterns))) `(progn ,@tests))) (defmacro match-slicer-should-equal (node expected pattern) "Return form to test if PATTERN applied to NODE works with all slicers. EXPECTED is a list of matches returned using PATTERN if no slicer is applied." (declare (indent 1)) ;; The basic behavior of slicers can be put in terms of -drop(-last) ;; and -take(-last). Additionally, some slicing operations have ;; multiple syntactical representations. Ensure equality of all ;; these specifications here `(progn ;; these slicers have multiple equivalent expressions ;; (it "first match" (match-should-equal node (-take 1 ,expected) (:first ,@pattern) (:nth 0 ,@pattern) (:sub 0 0 ,@pattern))) (it "last match" (match-should-equal node (-take-last 1 ,expected) (:last ,@pattern) (:nth -1 ,@pattern) (:sub -1 -1 ,@pattern))) (it "nth match positive" (match-should-equal node (-drop 1 (-take 2 ,expected)) (:nth 1 ,@pattern) (:sub 1 1 ,@pattern))) (it "nth match negative" (match-should-equal node (-drop-last 1 (-take-last 2 ,expected)) (:nth -2 ,@pattern) (:sub -2 -2 ,@pattern))) (it "out of range positive" (match-should-equal node nil (:nth 100 ,@pattern) (:sub 100 100 ,@pattern))) (it "out of range negative" (match-should-equal node nil (:nth -100 ,@pattern) (:sub -100 -100 ,@pattern))) (it "bounded to out of range" (match-should-equal node ,expected (:sub 0 100 ,@pattern) (:sub -100 -1 ,@pattern))) ;; ;; these slicers can only be expressed one way ;; (it "zero-bounded finite positive" (match-should-equal node (-take 2 ,expected) (:sub 0 1 ,@pattern))) (it "zero-bounded finite negative" (match-should-equal node (-take-last 2 ,expected) (:sub -2 -1 ,@pattern))) (it "floating finite positive" (match-should-equal node (-drop 1 (-take 3 ,expected)) (:sub 1 2 ,@pattern))) (it "floating finite negative" (match-should-equal node (-drop-last 1 (-take-last 3 ,expected)) (:sub -3 -2 ,@pattern))) (it "floating out of range positive" (match-should-equal node (-drop 1 ,expected) (:sub 1 100 ,@pattern))) (it "floating out of range negative" (match-should-equal node (-drop-last 1 ,expected) (:sub -100 -2 ,@pattern))))) ;; Here we test the following pattern combinations ;; - multi-level condition ;; - :any + condition ;; - condition + :any ;; - * ;; ;; The reason for choosing these combinations is that all of them ;; combined should hit each of the valid form-building switches in ;; `org-ml--match-pattern-make-inner-form'. Since the behavior of these ;; depends on the value of `LIMIT' and `END?' and these are set ;; depending on the slicer, testing these combinations with all ;; reasonable slicer combination should ensure that every path with ;; every combination of `LIMIT' and `END?' is tested. Note this ;; assumes that `org-ml--match-make-condition-form' is working correctly ;; as the following test only use a few combinations in this function. ;; However, `org-ml--match-make-condition-form' is independent of the ;; chosen slicer so this should not matter (describe "org-ml-match/slicer-predicate" ;; test the single/multiple condition path with all slicers (before-all (setq node (->> (s-join "\n" '("* one" "** TODO two" "2" "** COMMENT three" "3" "** four" "4" "** DONE five" "5")) (org-ml--from-string)))) (match-slicer-should-equal node '("2" "3" "4" "5") (headline section))) (describe "org-ml-match/slicer-any-first" ;; test the :any + condition path with all slicers (before-all (setq node (org-ml-build-paragraph! "*_1_* */2/* _*3*_ _/4/_ /*5*/ /_6_/"))) (match-slicer-should-equal node '("/2/" "*3*" "/4/" "*5*") (:any (:or bold italic)))) (describe "org-ml-match/slicer-any-last" ;; test the condition + :any path with all slicers (before-all (setq node (org-ml-build-paragraph! "*_1_* */2/* _*3*_ _/4/_ /*5*/ /_6_/"))) (match-slicer-should-equal node '("_1_" "/2/" "*5*" "_6_") ((:or bold italic) :any))) (describe "org-ml-match/empty-patterns" (before-all (setq node (->> (s-join "\n" '("* one" "** two" "** three")) (org-ml--from-string))) (defun match-empty (p) (expect (org-ml-match p node) :to-equal (list node)))) (it "empty patterns" (match-empty '()) (match-empty '(:first)) (match-empty '(:last)) (match-empty '(:nth 0)) (match-empty '(:sub 0 0))) (it "wildcards with the empty pattern" (match-empty '(:first headline \?)) (match-empty '(:first headline *)) (match-empty '(:first (nil | headline))) (match-empty '(:last (headline | nil))))) (ert-deftest org-ml-match/slicer-many () ;; Test the * paths with all slicers. Here the node ;; is chosen such that some values are nested and thus * will ;; return them but *! will not (let ((node (->> (s-join "\n" '("* one" "- 1" "- 2" " - 3" "** two" "- 4" "- 5" " - 6" "** three" "- 7" "- 8" " - 9")) (org-ml--from-string))) (expected '("- 1" "- 2\n - 3" "- 3" "- 4" "- 5\n - 6" "- 6" "- 7" "- 8\n - 9" "- 9")) (expected! '("- 1" "- 2\n - 3" "- 4" "- 5\n - 6" "- 7" "- 8\n - 9"))) (match-slicer-should-equal node expected (:any * item)) (match-slicer-should-equal node expected! (:any *! item)))) ;;; DIFF ALGORITHM (defun org-ml--diff-apply (str-a str-b) "Turn STR-A into STR-B using the diff algorithm. Obviously this should return a string identical to STR-B assuming diff is working correctly, and if not, well...get it together, dummy." (cl-flet* ((edit-del (str i j) (concat (substring str 0 i) (substring str j))) (edit-ins (str i a b) (concat (substring str 0 i) (substring str-b a b) (substring str i))) (edit (str edit) (pcase edit (`(ins ,i ,a ,b) (edit-ins str i a b)) (`(del ,i ,j) (edit-del str i j))))) (->> (org-ml--diff str-a str-b) (-reduce-from #'edit str-a)))) (defmacro org-ml--test-diff-specs (&rest specs) (declare (indent 1)) (let ((forms (->> (-partition 3 specs) (--map (-let (((title a b) it)) `(it ,title (expect (org-ml--diff-apply ,a ,b) :to-equal ,b))))))) `(progn ,@forms))) (describe "better diff algorithm" (describe "find SES" (org-ml--test-diff-specs "empty strings" "" "" "one identical char" "a" "a" "two identical chars" "aa" "aa" "zero chars, insert one (1)" "a" "" "zero chars, insert one (2)" "" "a" "one char, insert one (1)" "ba" "a" "one char, insert one (2)" "ab" "a" "one char, insert one (3)" "a" "ba" "one char, insert one (4)" "a" "ab" "one char, insert two (1)" "a" "abc" "one char, insert two (2)" "a" "acb" "one char, insert two (3)" "a" "cab" "one char, insert two (4)" "a" "cba" "one char, insert two (5)" "a" "bca" "one char, insert two (6)" "a" "bac" "different chars" "a" "b" "two chars, one different (1)" "aa" "ab" "two chars, one different (2)" "aa" "ba" "three chars, one different (1)" "aaa" "baa" "three chars, one different (2)" "aaa" "aba" "three chars, one different (3)" "aaa" "aab" "three chars, two different (1)" "aaa" "abc" "three chars, two different (2)" "aaa" "acb" "three chars, two different (3)" "aaa" "bac" "three chars, two different (4)" "aaa" "cab" "three chars, two different (5)" "aaa" "cba" "three chars, two different (6)" "aaa" "bca" ))) (provide 'org-ml-dev-test) ;;; org-ml-dev-test.el ends here ================================================ FILE: docs/api-reference.md ================================================ # API Reference ## String Conversion Convert nodes to strings. * [org-ml-to-string](#org-ml-to-string-node) `(node)` * [org-ml-to-trimmed-string](#org-ml-to-trimmed-string-node) `(node)` * [org-ml-from-string](#org-ml-from-string-type-string) `(type string)` ## Buffer Parsing Parse buffers to trees. * [org-ml-parse-this-buffer](#org-ml-parse-this-buffer-nil) `nil` * [org-ml-parse-object-at](#org-ml-parse-object-at-point) `(point)` * [org-ml-parse-element-at](#org-ml-parse-element-at-point) `(point)` * [org-ml-parse-table-row-at](#org-ml-parse-table-row-at-point) `(point)` * [org-ml-parse-headline-at](#org-ml-parse-headline-at-point) `(point)` * [org-ml-parse-subtree-at](#org-ml-parse-subtree-at-point) `(point)` * [org-ml-parse-item-at](#org-ml-parse-item-at-point) `(point)` * [org-ml-parse-section-at](#org-ml-parse-section-at-point) `(point)` * [org-ml-parse-this-toplevel-section](#org-ml-parse-this-toplevel-section-nil) `nil` * [org-ml-this-buffer-has-headlines](#org-ml-this-buffer-has-headlines-nil) `nil` * [org-ml-parse-headlines](#org-ml-parse-headlines-which) `(which)` * [org-ml-parse-subtrees](#org-ml-parse-subtrees-which) `(which)` ## Building Build new nodes. ### Leaf Object Nodes * [org-ml-build-code](#org-ml-build-code-value-key-post-blank) `(value &key post-blank)` * [org-ml-build-entity](#org-ml-build-entity-name-key-use-brackets-p-post-blank) `(name &key use-brackets-p post-blank)` * [org-ml-build-export-snippet](#org-ml-build-export-snippet-back-end-value-key-post-blank) `(back-end value &key post-blank)` * [org-ml-build-inline-babel-call](#org-ml-build-inline-babel-call-call-key-inside-header-arguments-end-header-post-blank) `(call &key inside-header arguments end-header post-blank)` * [org-ml-build-inline-src-block](#org-ml-build-inline-src-block-language-key-parameters-value--post-blank) `(language &key parameters (value "") post-blank)` * [org-ml-build-line-break](#org-ml-build-line-break-key-post-blank) `(&key post-blank)` * [org-ml-build-latex-fragment](#org-ml-build-latex-fragment-value-key-post-blank) `(value &key post-blank)` * [org-ml-build-macro](#org-ml-build-macro-key-key-args-post-blank) `(key &key args post-blank)` * [org-ml-build-statistics-cookie](#org-ml-build-statistics-cookie-value-key-post-blank) `(value &key post-blank)` * [org-ml-build-target](#org-ml-build-target-value-key-post-blank) `(value &key post-blank)` * [org-ml-build-timestamp](#org-ml-build-timestamp-type-year-start-month-start-day-start-year-end-month-end-day-end-key-range-type-hour-start-minute-start-hour-end-minute-end-repeater-type-repeater-unit-repeater-value-repeater-deadline-unit-repeater-deadline-value-warning-type-warning-unit-warning-value-post-blank) `(type year-start month-start day-start year-end month-end day-end &key range-type hour-start minute-start hour-end minute-end repeater-type repeater-unit repeater-value repeater-deadline-unit repeater-deadline-value warning-type warning-unit warning-value post-blank)` * [org-ml-build-verbatim](#org-ml-build-verbatim-value-key-post-blank) `(value &key post-blank)` ### Branch Object Nodes * [org-ml-build-bold](#org-ml-build-bold-key-post-blank-rest-object-nodes) `(&key post-blank &rest object-nodes)` * [org-ml-build-footnote-reference](#org-ml-build-footnote-reference-key-label-post-blank-rest-object-nodes) `(&key label post-blank &rest object-nodes)` * [org-ml-build-italic](#org-ml-build-italic-key-post-blank-rest-object-nodes) `(&key post-blank &rest object-nodes)` * [org-ml-build-link](#org-ml-build-link-path-key-format-type-fuzzy-post-blank-rest-object-nodes) `(path &key format (type "fuzzy") post-blank &rest object-nodes)` * [org-ml-build-radio-target](#org-ml-build-radio-target-key-post-blank-rest-object-nodes) `(&key post-blank &rest object-nodes)` * [org-ml-build-strike-through](#org-ml-build-strike-through-key-post-blank-rest-object-nodes) `(&key post-blank &rest object-nodes)` * [org-ml-build-superscript](#org-ml-build-superscript-key-use-brackets-p-post-blank-rest-object-nodes) `(&key use-brackets-p post-blank &rest object-nodes)` * [org-ml-build-subscript](#org-ml-build-subscript-key-use-brackets-p-post-blank-rest-object-nodes) `(&key use-brackets-p post-blank &rest object-nodes)` * [org-ml-build-table-cell](#org-ml-build-table-cell-key-post-blank-rest-object-nodes) `(&key post-blank &rest object-nodes)` * [org-ml-build-underline](#org-ml-build-underline-key-post-blank-rest-object-nodes) `(&key post-blank &rest object-nodes)` ### Leaf Element Nodes * [org-ml-build-babel-call](#org-ml-build-babel-call-call-key-inside-header-arguments-end-header-name-plot-header-results-caption-post-blank) `(call &key inside-header arguments end-header name plot header results caption post-blank)` * [org-ml-build-clock](#org-ml-build-clock-value-key-post-blank) `(value &key post-blank)` * [org-ml-build-comment](#org-ml-build-comment-value-key-post-blank) `(value &key post-blank)` * [org-ml-build-comment-block](#org-ml-build-comment-block-key-value--name-plot-header-results-caption-post-blank) `(&key (value "") name plot header results caption post-blank)` * [org-ml-build-diary-sexp](#org-ml-build-diary-sexp-key-value-name-plot-header-results-caption-post-blank) `(&key value name plot header results caption post-blank)` * [org-ml-build-example-block](#org-ml-build-example-block-key-preserve-indent-switches-value--name-plot-header-results-caption-post-blank) `(&key preserve-indent switches (value "") name plot header results caption post-blank)` * [org-ml-build-export-block](#org-ml-build-export-block-type-value-key-name-plot-header-results-caption-post-blank) `(type value &key name plot header results caption post-blank)` * [org-ml-build-fixed-width](#org-ml-build-fixed-width-value-key-name-plot-header-results-caption-post-blank) `(value &key name plot header results caption post-blank)` * [org-ml-build-horizontal-rule](#org-ml-build-horizontal-rule-key-name-plot-header-results-caption-post-blank) `(&key name plot header results caption post-blank)` * [org-ml-build-keyword](#org-ml-build-keyword-key-value-key-name-plot-header-results-caption-post-blank) `(key value &key name plot header results caption post-blank)` * [org-ml-build-latex-environment](#org-ml-build-latex-environment-value-key-name-plot-header-results-caption-post-blank) `(value &key name plot header results caption post-blank)` * [org-ml-build-node-property](#org-ml-build-node-property-key-value-key-post-blank) `(key value &key post-blank)` * [org-ml-build-planning](#org-ml-build-planning-key-closed-deadline-scheduled-post-blank) `(&key closed deadline scheduled post-blank)` * [org-ml-build-src-block](#org-ml-build-src-block-key-value--language-parameters-preserve-indent-switches-name-plot-header-results-caption-post-blank) `(&key (value "") language parameters preserve-indent switches name plot header results caption post-blank)` ### Branch Element Nodes with Child Object Nodes * [org-ml-build-paragraph](#org-ml-build-paragraph-key-name-plot-header-results-caption-post-blank-rest-object-nodes) `(&key name plot header results caption post-blank &rest object-nodes)` * [org-ml-build-table-row](#org-ml-build-table-row-key-post-blank-rest-object-nodes) `(&key post-blank &rest object-nodes)` * [org-ml-build-verse-block](#org-ml-build-verse-block-key-name-plot-header-results-caption-post-blank-rest-object-nodes) `(&key name plot header results caption post-blank &rest object-nodes)` ### Branch Element Nodes with Child Element Nodes * [org-ml-build-org-data](#org-ml-build-org-data-rest-nodes) `(&rest nodes)` * [org-ml-build-center-block](#org-ml-build-center-block-key-name-plot-header-results-caption-post-blank-rest-element-nodes) `(&key name plot header results caption post-blank &rest element-nodes)` * [org-ml-build-drawer](#org-ml-build-drawer-drawer-name-key-name-plot-header-results-caption-post-blank-rest-element-nodes) `(drawer-name &key name plot header results caption post-blank &rest element-nodes)` * [org-ml-build-dynamic-block](#org-ml-build-dynamic-block-block-name-key-arguments-name-plot-header-results-caption-post-blank-rest-element-nodes) `(block-name &key arguments name plot header results caption post-blank &rest element-nodes)` * [org-ml-build-footnote-definition](#org-ml-build-footnote-definition-label-key-pre-blank-0-name-plot-header-results-caption-post-blank-rest-element-nodes) `(label &key (pre-blank 0) name plot header results caption post-blank &rest element-nodes)` * [org-ml-build-headline](#org-ml-build-headline-key-archivedp-commentedp-footnote-section-p-level-1-pre-blank-0-priority-tags-title-todo-keyword-post-blank-rest-element-nodes) `(&key archivedp commentedp footnote-section-p (level 1) (pre-blank 0) priority tags title todo-keyword post-blank &rest element-nodes)` * [org-ml-build-item](#org-ml-build-item-key-bullet---pre-blank-0-checkbox-counter-tag-post-blank-rest-element-nodes) `(&key (bullet '-) (pre-blank 0) checkbox counter tag post-blank &rest element-nodes)` * [org-ml-build-plain-list](#org-ml-build-plain-list-key-name-plot-header-results-caption-post-blank-rest-element-nodes) `(&key name plot header results caption post-blank &rest element-nodes)` * [org-ml-build-property-drawer](#org-ml-build-property-drawer-key-post-blank-rest-element-nodes) `(&key post-blank &rest element-nodes)` * [org-ml-build-quote-block](#org-ml-build-quote-block-key-name-plot-header-results-caption-post-blank-rest-element-nodes) `(&key name plot header results caption post-blank &rest element-nodes)` * [org-ml-build-section](#org-ml-build-section-key-post-blank-rest-element-nodes) `(&key post-blank &rest element-nodes)` * [org-ml-build-special-block](#org-ml-build-special-block-type-key-parameters-name-plot-header-results-caption-post-blank-rest-element-nodes) `(type &key parameters name plot header results caption post-blank &rest element-nodes)` * [org-ml-build-table](#org-ml-build-table-key-tblfm-name-plot-header-results-caption-post-blank-rest-element-nodes) `(&key tblfm name plot header results caption post-blank &rest element-nodes)` ### Miscellaneous Builders * [org-ml-build-secondary-string!](#org-ml-build-secondary-string-string) `(string)` * [org-ml-build-table-row-hline](#org-ml-build-table-row-hline-key-post-blank) `(&key post-blank)` * [org-ml-build-timestamp-diary](#org-ml-build-timestamp-diary-form-key-start-end-post-blank) `(form &key start end post-blank)` ### Shorthand Builders Build nodes with more convenient/shorter syntax. * [org-ml-build-timestamp!](#org-ml-build-timestamp-start-key-end-active-repeater-deadline-warning-collapsed-post-blank) `(start &key end active repeater deadline warning collapsed post-blank)` * [org-ml-build-clock!](#org-ml-build-clock-start-key-end-post-blank) `(start &key end post-blank)` * [org-ml-build-planning!](#org-ml-build-planning-key-closed-deadline-scheduled-post-blank) `(&key closed deadline scheduled post-blank)` * [org-ml-build-property-drawer!](#org-ml-build-property-drawer-key-post-blank-rest-keyvals) `(&key post-blank &rest keyvals)` * [org-ml-build-headline!](#org-ml-build-headline-key-level-1-title-text-todo-keyword-tags-pre-blank-priority-commentedp-archivedp-post-blank-planning-statistics-cookie-section-children-rest-subheadlines) `(&key (level 1) title-text todo-keyword tags pre-blank priority commentedp archivedp post-blank planning statistics-cookie section-children &rest subheadlines)` * [org-ml-build-item!](#org-ml-build-item-key-post-blank-bullet-checkbox-tag-paragraph-counter-rest-children) `(&key post-blank bullet checkbox tag paragraph counter &rest children)` * [org-ml-build-paragraph!](#org-ml-build-paragraph-string-key-post-blank) `(string &key post-blank)` * [org-ml-build-table-cell!](#org-ml-build-table-cell-string) `(string)` * [org-ml-build-table-row!](#org-ml-build-table-row-row-list) `(row-list)` * [org-ml-build-table!](#org-ml-build-table-key-tblfm-post-blank-rest-row-lists) `(&key tblfm post-blank &rest row-lists)` ### Logbook Item Builders Build item nodes for inclusion in headline logbooks * [org-ml-build-log-note](#org-ml-build-log-note-unixtime-note) `(unixtime note)` * [org-ml-build-log-done](#org-ml-build-log-done-unixtime-optional-note) `(unixtime &optional note)` * [org-ml-build-log-refile](#org-ml-build-log-refile-unixtime-optional-note) `(unixtime &optional note)` * [org-ml-build-log-state](#org-ml-build-log-state-unixtime-new-state-old-state-optional-note) `(unixtime new-state old-state &optional note)` * [org-ml-build-log-deldeadline](#org-ml-build-log-deldeadline-unixtime-old-timestamp-optional-note) `(unixtime old-timestamp &optional note)` * [org-ml-build-log-delschedule](#org-ml-build-log-delschedule-unixtime-old-timestamp-optional-note) `(unixtime old-timestamp &optional note)` * [org-ml-build-log-redeadline](#org-ml-build-log-redeadline-unixtime-old-timestamp-optional-note) `(unixtime old-timestamp &optional note)` * [org-ml-build-log-reschedule](#org-ml-build-log-reschedule-unixtime-old-timestamp-optional-note) `(unixtime old-timestamp &optional note)` * [org-ml-build-log-type](#org-ml-build-log-type-type-key-old-new-unixtime-username-full-username-note) `(type &key old new unixtime username full-username note)` ## Type Predicates Test node types. * [org-ml-get-type](#org-ml-get-type-node-optional-anonymous) `(node &optional anonymous)` * [org-ml-is-type](#org-ml-is-type-type-node) `(type node)` * [org-ml-is-any-type](#org-ml-is-any-type-types-node) `(types node)` * [org-ml-is-element](#org-ml-is-element-node) `(node)` * [org-ml-is-branch-node](#org-ml-is-branch-node-node) `(node)` * [org-ml-node-may-have-child-objects](#org-ml-node-may-have-child-objects-node) `(node)` * [org-ml-node-may-have-child-elements](#org-ml-node-may-have-child-elements-node) `(node)` ## Property Manipulation Set, get, and map properties of nodes. ### Generic * [org-ml-contains-point-p](#org-ml-contains-point-p-point-node) `(point node)` * [org-ml-set-property](#org-ml-set-property-prop-value-node) `(prop value node)` * [org-ml-get-property](#org-ml-get-property-prop-node) `(prop node)` * [org-ml-map-property](#org-ml-map-property-prop-fun-node) `(prop fun node)` * [org-ml-toggle-property](#org-ml-toggle-property-prop-node) `(prop node)` * [org-ml-shift-property](#org-ml-shift-property-prop-n-node) `(prop n node)` * [org-ml-insert-into-property](#org-ml-insert-into-property-prop-index-string-node) `(prop index string node)` * [org-ml-remove-from-property](#org-ml-remove-from-property-prop-string-node) `(prop string node)` * [org-ml-plist-put-property](#org-ml-plist-put-property-prop-key-value-node) `(prop key value node)` * [org-ml-plist-remove-property](#org-ml-plist-remove-property-prop-key-node) `(prop key node)` * [org-ml-get-properties](#org-ml-get-properties-props-node) `(props node)` * [org-ml-get-all-properties](#org-ml-get-all-properties-node) `(node)` * [org-ml-set-properties](#org-ml-set-properties-plist-node) `(plist node)` * [org-ml-map-properties](#org-ml-map-properties-plist-node) `(plist node)` * [org-ml-get-parents](#org-ml-get-parents-node) `(node)` * [org-ml-remove-parent](#org-ml-remove-parent-node) `(node)` ### Clock * [org-ml-clock-is-running](#org-ml-clock-is-running-clock) `(clock)` ### Entity * [org-ml-entity-get-replacement](#org-ml-entity-get-replacement-key-entity) `(key entity)` ### Headline * [org-ml-headline-set-title!](#org-ml-headline-set-title-title-text-stats-cookie-value-headline) `(title-text stats-cookie-value headline)` * [org-ml-headline-is-done](#org-ml-headline-is-done-headline) `(headline)` * [org-ml-headline-has-tag](#org-ml-headline-has-tag-tag-headline) `(tag headline)` * [org-ml-headline-get-statistics-cookie](#org-ml-headline-get-statistics-cookie-headline) `(headline)` ### Item * [org-ml-item-toggle-checkbox](#org-ml-item-toggle-checkbox-item) `(item)` ### Statistics Cookie * [org-ml-statistics-cookie-is-complete](#org-ml-statistics-cookie-is-complete-statistics-cookie) `(statistics-cookie)` * [org-ml-timestamp-get-start-time](#org-ml-timestamp-get-start-time-timestamp) `(timestamp)` * [org-ml-timestamp-get-end-time](#org-ml-timestamp-get-end-time-timestamp) `(timestamp)` * [org-ml-timestamp-get-range](#org-ml-timestamp-get-range-timestamp) `(timestamp)` * [org-ml-timestamp-is-active](#org-ml-timestamp-is-active-timestamp) `(timestamp)` * [org-ml-timestamp-is-ranged](#org-ml-timestamp-is-ranged-timestamp) `(timestamp)` * [org-ml-timestamp-range-contains-p](#org-ml-timestamp-range-contains-p-unixtime-timestamp) `(unixtime timestamp)` * [org-ml-timestamp-set-collapsed](#org-ml-timestamp-set-collapsed-flag-timestamp) `(flag timestamp)` * [org-ml-timestamp-get-warning](#org-ml-timestamp-get-warning-timestamp) `(timestamp)` * [org-ml-timestamp-set-warning](#org-ml-timestamp-set-warning-warning-timestamp) `(warning timestamp)` * [org-ml-timestamp-map-warning](#org-ml-timestamp-map-warning-fun-timestamp) `(fun timestamp)` * [org-ml-timestamp-get-repeater](#org-ml-timestamp-get-repeater-timestamp) `(timestamp)` * [org-ml-timestamp-get-deadline](#org-ml-timestamp-get-deadline-timestamp) `(timestamp)` * [org-ml-timestamp-set-repeater](#org-ml-timestamp-set-repeater-repeater-timestamp) `(repeater timestamp)` * [org-ml-timestamp-set-deadline](#org-ml-timestamp-set-deadline-deadline-timestamp) `(deadline timestamp)` * [org-ml-timestamp-map-repeater](#org-ml-timestamp-map-repeater-fun-timestamp) `(fun timestamp)` * [org-ml-timestamp-set-start-time](#org-ml-timestamp-set-start-time-time-timestamp) `(time timestamp)` * [org-ml-timestamp-set-end-time](#org-ml-timestamp-set-end-time-time-timestamp) `(time timestamp)` * [org-ml-timestamp-set-single-time](#org-ml-timestamp-set-single-time-time-timestamp) `(time timestamp)` * [org-ml-timestamp-set-double-time](#org-ml-timestamp-set-double-time-time1-time2-timestamp) `(time1 time2 timestamp)` * [org-ml-timestamp-set-range](#org-ml-timestamp-set-range-n-timestamp) `(n timestamp)` * [org-ml-timestamp-set-active](#org-ml-timestamp-set-active-flag-timestamp) `(flag timestamp)` * [org-ml-timestamp-shift](#org-ml-timestamp-shift-n-unit-timestamp) `(n unit timestamp)` * [org-ml-timestamp-shift-start](#org-ml-timestamp-shift-start-n-unit-timestamp) `(n unit timestamp)` * [org-ml-timestamp-shift-end](#org-ml-timestamp-shift-end-n-unit-timestamp) `(n unit timestamp)` * [org-ml-timestamp-toggle-active](#org-ml-timestamp-toggle-active-timestamp) `(timestamp)` * [org-ml-timestamp-truncate](#org-ml-timestamp-truncate-timestamp) `(timestamp)` * [org-ml-timestamp-truncate-start](#org-ml-timestamp-truncate-start-timestamp) `(timestamp)` * [org-ml-timestamp-truncate-end](#org-ml-timestamp-truncate-end-timestamp) `(timestamp)` ### Timestamp (diary) * [org-ml-timestamp-diary-set-value](#org-ml-timestamp-diary-set-value-form-timestamp-diary) `(form timestamp-diary)` * [org-ml-timestamp-diary-set-single-time](#org-ml-timestamp-diary-set-single-time-time-timestamp-diary) `(time timestamp-diary)` * [org-ml-timestamp-diary-set-double-time](#org-ml-timestamp-diary-set-double-time-time1-time2-timestamp-diary) `(time1 time2 timestamp-diary)` * [org-ml-timestamp-diary-get-start-time](#org-ml-timestamp-diary-get-start-time-timestamp-diary) `(timestamp-diary)` * [org-ml-timestamp-diary-set-start-time](#org-ml-timestamp-diary-set-start-time-time-timestamp-diary) `(time timestamp-diary)` * [org-ml-timestamp-diary-get-end-time](#org-ml-timestamp-diary-get-end-time-timestamp-diary) `(timestamp-diary)` * [org-ml-timestamp-diary-set-end-time](#org-ml-timestamp-diary-set-end-time-time-timestamp-diary) `(time timestamp-diary)` * [org-ml-timestamp-diary-set-length](#org-ml-timestamp-diary-set-length-n-unit-timestamp-diary) `(n unit timestamp-diary)` * [org-ml-timestamp-diary-shift](#org-ml-timestamp-diary-shift-n-unit-timestamp-diary) `(n unit timestamp-diary)` * [org-ml-timestamp-diary-shift-start](#org-ml-timestamp-diary-shift-start-n-unit-timestamp-diary) `(n unit timestamp-diary)` * [org-ml-timestamp-diary-shift-end](#org-ml-timestamp-diary-shift-end-n-unit-timestamp-diary) `(n unit timestamp-diary)` ## Branch/Child Manipulation Set, get, and map the children of branch nodes. ### Polymorphic * [org-ml-children-contain-point](#org-ml-children-contain-point-point-branch-node) `(point branch-node)` * [org-ml-get-children](#org-ml-get-children-branch-node) `(branch-node)` * [org-ml-set-children](#org-ml-set-children-children-branch-node) `(children branch-node)` * [org-ml-map-children](#org-ml-map-children-fun-branch-node) `(fun branch-node)` * [org-ml-is-childless](#org-ml-is-childless-branch-node) `(branch-node)` ### Object Nodes * [org-ml-unwrap](#org-ml-unwrap-object-node) `(object-node)` * [org-ml-unwrap-types-deep](#org-ml-unwrap-types-deep-types-object-node) `(types object-node)` * [org-ml-unwrap-deep](#org-ml-unwrap-deep-object-node) `(object-node)` ### Secondary Strings * [org-ml-flatten](#org-ml-flatten-secondary-string) `(secondary-string)` * [org-ml-flatten-types-deep](#org-ml-flatten-types-deep-types-secondary-string) `(types secondary-string)` * [org-ml-flatten-deep](#org-ml-flatten-deep-secondary-string) `(secondary-string)` ### Item * [org-ml-item-get-paragraph](#org-ml-item-get-paragraph-item) `(item)` * [org-ml-item-set-paragraph](#org-ml-item-set-paragraph-secondary-string-item) `(secondary-string item)` * [org-ml-item-map-paragraph](#org-ml-item-map-paragraph-fun-item) `(fun item)` ### Headline * [org-ml-headline-get-section](#org-ml-headline-get-section-headline) `(headline)` * [org-ml-headline-set-section](#org-ml-headline-set-section-children-headline) `(children headline)` * [org-ml-headline-map-section](#org-ml-headline-map-section-fun-headline) `(fun headline)` * [org-ml-headline-get-subheadlines](#org-ml-headline-get-subheadlines-headline) `(headline)` * [org-ml-headline-set-subheadlines](#org-ml-headline-set-subheadlines-subheadlines-headline) `(subheadlines headline)` * [org-ml-headline-map-subheadlines](#org-ml-headline-map-subheadlines-fun-headline) `(fun headline)` ### Headline (metadata) * [org-ml-headline-get-planning](#org-ml-headline-get-planning-headline) `(headline)` * [org-ml-headline-set-planning](#org-ml-headline-set-planning-planning-headline) `(planning headline)` * [org-ml-headline-map-planning](#org-ml-headline-map-planning-fun-headline) `(fun headline)` * [org-ml-headline-get-node-properties](#org-ml-headline-get-node-properties-headline) `(headline)` * [org-ml-headline-set-node-properties](#org-ml-headline-set-node-properties-node-properties-headline) `(node-properties headline)` * [org-ml-headline-map-node-properties](#org-ml-headline-map-node-properties-fun-headline) `(fun headline)` * [org-ml-headline-get-node-property](#org-ml-headline-get-node-property-key-headline) `(key headline)` * [org-ml-headline-set-node-property](#org-ml-headline-set-node-property-key-value-headline) `(key value headline)` * [org-ml-headline-map-node-property](#org-ml-headline-map-node-property-key-fun-headline) `(key fun headline)` ### Headline (logbook and contents) * [org-ml-headline-get-supercontents](#org-ml-headline-get-supercontents-config-headline) `(config headline)` * [org-ml-headline-set-supercontents](#org-ml-headline-set-supercontents-config-supercontents-headline) `(config supercontents headline)` * [org-ml-headline-map-supercontents](#org-ml-headline-map-supercontents-config-fun-headline) `(config fun headline)` * [org-ml-headline-get-logbook-items](#org-ml-headline-get-logbook-items-config-headline) `(config headline)` * [org-ml-headline-set-logbook-items](#org-ml-headline-set-logbook-items-config-items-headline) `(config items headline)` * [org-ml-headline-map-logbook-items](#org-ml-headline-map-logbook-items-config-fun-headline) `(config fun headline)` * [org-ml-headline-get-logbook-clocks](#org-ml-headline-get-logbook-clocks-config-headline) `(config headline)` * [org-ml-headline-set-logbook-clocks](#org-ml-headline-set-logbook-clocks-config-clocks-headline) `(config clocks headline)` * [org-ml-headline-map-logbook-clocks](#org-ml-headline-map-logbook-clocks-config-fun-headline) `(config fun headline)` * [org-ml-headline-get-contents](#org-ml-headline-get-contents-config-headline) `(config headline)` * [org-ml-headline-set-contents](#org-ml-headline-set-contents-config-contents-headline) `(config contents headline)` * [org-ml-headline-map-contents](#org-ml-headline-map-contents-config-fun-headline) `(config fun headline)` * [org-ml-headline-logbook-append-item](#org-ml-headline-logbook-append-item-config-item-headline) `(config item headline)` * [org-ml-headline-logbook-append-open-clock](#org-ml-headline-logbook-append-open-clock-config-unixtime-headline) `(config unixtime headline)` * [org-ml-headline-logbook-close-open-clock](#org-ml-headline-logbook-close-open-clock-config-unixtime-note-headline) `(config unixtime note headline)` * [org-ml-headline-logbook-convert-config](#org-ml-headline-logbook-convert-config-config1-config2-headline) `(config1 config2 headline)` ### Headline (misc) * [org-ml-headline-get-path](#org-ml-headline-get-path-headline) `(headline)` * [org-ml-headline-update-item-statistics](#org-ml-headline-update-item-statistics-headline) `(headline)` * [org-ml-headline-update-todo-statistics](#org-ml-headline-update-todo-statistics-headline) `(headline)` * [org-ml-headline-demote-subheadline](#org-ml-headline-demote-subheadline-index-headline) `(index headline)` * [org-ml-headline-demote-subtree](#org-ml-headline-demote-subtree-index-headline) `(index headline)` * [org-ml-headline-promote-subheadline](#org-ml-headline-promote-subheadline-index-child-index-headline) `(index child-index headline)` * [org-ml-headline-promote-all-subheadlines](#org-ml-headline-promote-all-subheadlines-index-headline) `(index headline)` ### Plain List * [org-ml-plain-list-set-type](#org-ml-plain-list-set-type-type-plain-list) `(type plain-list)` * [org-ml-plain-list-indent-item](#org-ml-plain-list-indent-item-index-plain-list) `(index plain-list)` * [org-ml-plain-list-indent-item-tree](#org-ml-plain-list-indent-item-tree-index-plain-list) `(index plain-list)` * [org-ml-plain-list-outdent-item](#org-ml-plain-list-outdent-item-index-child-index-plain-list) `(index child-index plain-list)` * [org-ml-plain-list-outdent-all-items](#org-ml-plain-list-outdent-all-items-index-plain-list) `(index plain-list)` ### Table * [org-ml-table-get-cell](#org-ml-table-get-cell-row-index-column-index-table) `(row-index column-index table)` * [org-ml-table-delete-column](#org-ml-table-delete-column-column-index-table) `(column-index table)` * [org-ml-table-delete-row](#org-ml-table-delete-row-row-index-table) `(row-index table)` * [org-ml-table-insert-column!](#org-ml-table-insert-column-column-index-column-text-table) `(column-index column-text table)` * [org-ml-table-insert-row!](#org-ml-table-insert-row-row-index-row-text-table) `(row-index row-text table)` * [org-ml-table-replace-cell!](#org-ml-table-replace-cell-row-index-column-index-cell-text-table) `(row-index column-index cell-text table)` * [org-ml-table-replace-column!](#org-ml-table-replace-column-column-index-column-text-table) `(column-index column-text table)` * [org-ml-table-replace-row!](#org-ml-table-replace-row-row-index-row-text-table) `(row-index row-text table)` ## Node Matching Use pattern-matching to selectively perform operations on nodes in trees. * [org-ml-match](#org-ml-match-pattern-node) `(pattern node)` * [org-ml-match-delete](#org-ml-match-delete-pattern-node) `(pattern node)` * [org-ml-match-extract](#org-ml-match-extract-pattern-node) `(pattern node)` * [org-ml-match-map](#org-ml-match-map-pattern-fun-node) `(pattern fun node)` * [org-ml-match-mapcat](#org-ml-match-mapcat-pattern-fun-node) `(pattern fun node)` * [org-ml-match-replace](#org-ml-match-replace-pattern-node-node) `(pattern node* node)` * [org-ml-match-insert-before](#org-ml-match-insert-before-pattern-node-node) `(pattern node* node)` * [org-ml-match-insert-after](#org-ml-match-insert-after-pattern-node-node) `(pattern node* node)` * [org-ml-match-insert-within](#org-ml-match-insert-within-pattern-index-node-node) `(pattern index node* node)` * [org-ml-match-splice](#org-ml-match-splice-pattern-nodes-node) `(pattern nodes* node)` * [org-ml-match-splice-before](#org-ml-match-splice-before-pattern-nodes-node) `(pattern nodes* node)` * [org-ml-match-splice-after](#org-ml-match-splice-after-pattern-nodes-node) `(pattern nodes* node)` * [org-ml-match-splice-within](#org-ml-match-splice-within-pattern-index-nodes-node) `(pattern index nodes* node)` * [org-ml-match-do](#org-ml-match-do-pattern-fun-node) `(pattern fun node)` ## Buffer Side Effects Map node manipulations into buffers. ### Insert * [org-ml-insert](#org-ml-insert-point-node) `(point node)` * [org-ml-insert-tail](#org-ml-insert-tail-point-node) `(point node)` ### Update * [org-ml-update](#org-ml-update-fun-node) `(fun node)` * [org-ml-update-object-at](#org-ml-update-object-at-point-fun) `(point fun)` * [org-ml-update-element-at](#org-ml-update-element-at-point-fun) `(point fun)` * [org-ml-update-table-row-at](#org-ml-update-table-row-at-point-fun) `(point fun)` * [org-ml-update-item-at](#org-ml-update-item-at-point-fun) `(point fun)` * [org-ml-update-headline-at](#org-ml-update-headline-at-point-fun) `(point fun)` * [org-ml-update-subtree-at](#org-ml-update-subtree-at-point-fun) `(point fun)` * [org-ml-update-section-at](#org-ml-update-section-at-point-fun) `(point fun)` * [org-ml-update-headlines](#org-ml-update-headlines-which-fun) `(which fun)` * [org-ml-update-subtrees](#org-ml-update-subtrees-which-fun) `(which fun)` * [org-ml-update-supercontents](#org-ml-update-supercontents-config-which-fun) `(config which fun)` ### Misc * [org-ml-fold](#org-ml-fold-node) `(node)` * [org-ml-unfold](#org-ml-unfold-node) `(node)` ## String Conversion Convert nodes to strings. #### org-ml-to-string `(node)` Return **`node`** as an interpreted string without text properties. ```el (org-ml-to-string (quote (bold (:begin 1 :end 5 :parent nil :post-blank 0 :post-affiliated nil) "text"))) ;; => "*text*" (org-ml-to-string (quote (bold (:begin 1 :end 5 :parent nil :post-blank 3 :post-affiliated nil) "text"))) ;; => "*text* " (org-ml-to-string nil) ;; => "" ``` #### org-ml-to-trimmed-string `(node)` Like [`org-ml-to-string`](#org-ml-to-string-node) but strip whitespace when returning **`node`**. ```el (org-ml-to-trimmed-string (quote (bold (:begin 1 :end 5 :parent nil :post-blank 0 :post-affiliated nil) "text"))) ;; => "*text*" (org-ml-to-trimmed-string (quote (bold (:begin 1 :end 5 :parent nil :post-blank 3 :post-affiliated nil) "text"))) ;; => "*text*" (org-ml-to-trimmed-string nil) ;; => "" ``` #### org-ml-from-string `(type string)` Convert **`string`** to a node. **`type`** is the node type intended by **`string`**; if **`string`** cannot be parsed into **`type`** this function will return nil. ```el (->> (org-ml-from-string 'bold "*text*") (org-ml-get-type)) ;; => 'bold (->> (org-ml-from-string 'bold "*text*") (org-ml-get-property :begin)) ;; => 1 (->> (org-ml-from-string 'bold "*text*") (org-ml-get-property :end)) ;; => 7 (->> (org-ml-from-string 'bold "*text*") (org-ml-get-property :post-blank)) ;; => 0 (->> (org-ml-from-string 'bold "*text*") (org-ml-get-property :contents-begin)) ;; => 2 (->> (org-ml-from-string 'bold "*text*") (org-ml-get-property :contents-end)) ;; => 6 (org-ml-from-string 'italic "*text*") ;; => nil ``` ## Buffer Parsing Parse buffers to trees. #### org-ml-parse-this-buffer `nil` Return org-data document tree for the current buffer. Contrary to the org-element specification, the org-data element returned from this function will have :begin and :end properties. ```el ;; Given the following contents: ; text (->> (org-ml-parse-this-buffer) (org-ml-get-property :begin)) ;; => 1 (->> (org-ml-parse-this-buffer) (org-ml-get-property :end)) ;; => 5 ``` #### org-ml-parse-object-at `(point)` Return object node under **`point`** or nil if not on an object. ```el ;; Given the following contents: ; *text* (->> (org-ml-parse-object-at 1) (car)) ;; => 'bold ;; Given the following contents: ; [2019-01-01 Tue] (->> (org-ml-parse-object-at 1) (car)) ;; => 'timestamp ;; Given the following contents: ; - notme ;; Return nil when parsing an element (org-ml-parse-object-at 1) ;; => nil ``` #### org-ml-parse-element-at `(point)` Return element node under **`point`** or nil if not on an element. This function will return every element available in `org-ml-elements` with the exception of `section`, `item`, and `table-row`. To specifically parse these, use the functions [`org-ml-parse-section-at`](#org-ml-parse-section-at-point), [`org-ml-parse-item-at`](#org-ml-parse-item-at-point), and [`org-ml-parse-table-row-at`](#org-ml-parse-table-row-at-point). ```el ;; Given the following contents: ; #+call: ktulu() (->> (org-ml-parse-element-at 1) (car)) ;; => 'babel-call ;; Given the following contents: ; - plain-list ;; Give the plain-list, not the item for this function (->> (org-ml-parse-element-at 1) (car)) ;; => 'plain-list ;; Given the following contents: ; | R | A | ; | G | E | ;; Return a table, not the table-row for this function (->> (org-ml-parse-element-at 1) (car)) ;; => 'table ``` #### org-ml-parse-table-row-at `(point)` Return table-row node under **`point`** or nil if not on a table-row. ```el ;; Given the following contents: ; | bow | stroke | ; |-----+--------| ; | wob | ekorts | ;; Return the row itself (->> (org-ml-parse-table-row-at 1) (car)) ;; => 'table-row (->> (org-ml-parse-table-row-at 20) (car)) ;; => 'table-row (->> (org-ml-parse-table-row-at 40) (car)) ;; => 'table-row ;; Also return the row when not at beginning of line (->> (org-ml-parse-table-row-at 5) (car)) ;; => 'table-row ;; Given the following contents: ; - bow and arrow choke ;; Return nil if not a table-row (->> (org-ml-parse-table-row-at 1) (car)) ;; => nil ``` #### org-ml-parse-headline-at `(point)` Return headline node under **`point`** or nil if not on a headline. **`point`** does not need to be on the headline itself. Only the headline and its section will be returned. To include subheadlines, use [`org-ml-parse-subtree-at`](#org-ml-parse-subtree-at-point). ```el ;; Given the following contents: ; * headline ;; Return the headline itself (->> (org-ml-parse-headline-at 1) (org-ml-to-trimmed-string)) ;; => "* headline" ;; Given the following contents: ; * headline ; section crap ;; Return headline and section (->> (org-ml-parse-headline-at 1) (org-ml-to-trimmed-string)) ;; => "* headline ; section crap" ;; Return headline when point is in the section (->> (org-ml-parse-headline-at 12) (org-ml-to-trimmed-string)) ;; => "* headline ; section crap" ;; Given the following contents: ; * headline ; section crap ; ** not parsed ;; Don't parse any subheadlines (->> (org-ml-parse-headline-at 1) (org-ml-to-trimmed-string)) ;; => "* headline ; section crap" ;; Given the following contents: ; nothing nowhere ;; Return nil if not under a headline (->> (org-ml-parse-headline-at 1) (org-ml-to-trimmed-string)) ;; => "" ``` #### org-ml-parse-subtree-at `(point)` Return headline node under **`point`** or nil if not on a headline. **`point`** does not need to be on the headline itself. Unlike [`org-ml-parse-headline-at`](#org-ml-parse-headline-at-point), the returned node will include child headlines. ```el ;; Given the following contents: ; * headline ;; Return the headline itself (->> (org-ml-parse-subtree-at 1) (org-ml-to-trimmed-string)) ;; => "* headline" ;; Given the following contents: ; * headline ; section crap ;; Return headline and section (->> (org-ml-parse-subtree-at 1) (org-ml-to-trimmed-string)) ;; => "* headline ; section crap" ;; Return headline when point is in the section (->> (org-ml-parse-subtree-at 12) (org-ml-to-trimmed-string)) ;; => "* headline ; section crap" ;; Given the following contents: ; * headline ; section crap ; ** parsed ;; Return all the subheadlines (->> (org-ml-parse-subtree-at 1) (org-ml-to-trimmed-string)) ;; => "* headline ; section crap ; ** parsed" ;; Given the following contents: ; nothing nowhere ;; Return nil if not under a headline (->> (org-ml-parse-subtree-at 1) (org-ml-to-trimmed-string)) ;; => "" ``` #### org-ml-parse-item-at `(point)` Return item node under **`point`** or nil if not on an item. This will return the item node even if **`point`** is not at the beginning of the line. ```el ;; Given the following contents: ; - item ;; Return the item itself (->> (org-ml-parse-item-at 1) (org-ml-to-trimmed-string)) ;; => "- item" ;; Also return the item when not at beginning of line (->> (org-ml-parse-item-at 5) (org-ml-to-trimmed-string)) ;; => "- item" ;; Given the following contents: ; - item ; - item 2 ;; Return item and its subitems (->> (org-ml-parse-item-at 1) (org-ml-to-trimmed-string)) ;; => "- item ; - item 2" ;; Given the following contents: ; * not item ;; Return nil if not an item (->> (org-ml-parse-item-at 1) (org-ml-to-trimmed-string)) ;; => "" ``` #### org-ml-parse-section-at `(point)` Return section node under **`point`** or nil if not on a section. If **`point`** is on or within a headline, return the section under that headline. If **`point`** is before the first headline (if any), return the section at the top of the org buffer. ```el ;; Given the following contents: ; over headline ; * headline ; under headline ;; Return the section above the headline (->> (org-ml-parse-section-at 1) (org-ml-to-trimmed-string)) ;; => "over headline" ;; Return the section under headline (->> (org-ml-parse-section-at 25) (org-ml-to-trimmed-string)) ;; => "under headline" ;; Given the following contents: ; * headline ; ** subheadline ;; Return nil if no section under headline (->> (org-ml-parse-section-at 1) (org-ml-to-trimmed-string)) ;; => "" ;; Given the following contents: ; ;; Return nil if no section at all (->> (org-ml-parse-section-at 1) (org-ml-to-trimmed-string)) ;; => "" ``` #### org-ml-parse-this-toplevel-section `nil` Return section node corresponding to the top of the current buffer. If there is no such section, return nil. ```el ;; Given the following contents: ; over headline ; * headline ; under headline (->> (org-ml-parse-this-toplevel-section) (org-ml-to-trimmed-string)) ;; => "over headline" ;; Given the following contents: ; * headline ; under headline (->> (org-ml-parse-this-toplevel-section) (org-ml-to-trimmed-string)) ;; => "" ``` #### org-ml-this-buffer-has-headlines `nil` Return t if the current buffer has headlines, else return nil. ```el ;; Given the following contents: ; not headline ; * headline (org-ml-this-buffer-has-headlines) ;; => t ;; Given the following contents: ; not headline (org-ml-this-buffer-has-headlines) ;; => nil ``` #### org-ml-parse-headlines `(which)` Return list of headline nodes from current buffer. **`which`** describes the location of headlines to be parsed and is one of the following: - `n`: parse up to index `n` headlines (which 0 is the first); if negative start counting from the last headline (which -1 refers to the last) - `(m n)`: like `n` but parse after index `m` headlines; `m` and `n` may both be similarly negative - [`a` `b`]: parse all headlines whose first point falls between points `a` and `b` in the buffer; if `a` and `b` are nil, use `point-min` and `point-max` respectively. - `all`: parse all headlines (equivalent to [nil nil]) Each headline is obtained with [`org-ml-parse-headline-at`](#org-ml-parse-headline-at-point). ```el ;; Given the following contents: ; not headline ; * one ; * two ; * three (->> (org-ml-parse-headlines 'all) (-map #'org-ml-to-string) (s-join "")) ;; => "* one ; * two ; * three ; " ;; Given the following contents: ; not headline (->> (org-ml-parse-headlines 'all) (-map #'org-ml-to-string) (s-join "")) ;; => "" ;; Given the following contents: ; not headline ; * one ; ** two ; *** three (->> (org-ml-parse-headlines 'all) (-map #'org-ml-to-trimmed-string)) ;; => '("* one ; ** two ; *** three" "** two ; *** three" "*** three") ;; Given the following contents: ; not headline ; *ignore this* ; * one ; * two ; * three (->> (org-ml-parse-headlines 0) (-map #'org-ml-to-string) (s-join "")) ;; => "* one ; " (->> (org-ml-parse-headlines '(0 1)) (-map #'org-ml-to-string) (s-join "")) ;; => "* one ; * two ; " (->> (org-ml-parse-headlines [23 38]) (-map #'org-ml-to-string) (s-join "")) ;; => "* one ; * two ; " ``` #### org-ml-parse-subtrees `(which)` Return list of subtree nodes from current buffer. **`which`** has analogous meaning to that in [`org-ml-parse-headlines`](#org-ml-parse-headlines-which) except applied to subtrees not individual headlines. ```el ;; Given the following contents: ; not headline ; * one ; ** _one ; * two ; ** _two ; * three ; ** _three (->> (org-ml-parse-subtrees 'all) (-map #'org-ml-to-string) (s-join "")) ;; => "* one ; ** _one ; * two ; ** _two ; * three ; ** _three ; " ;; Given the following contents: ; not headline (->> (org-ml-parse-subtrees 'all) (-map #'org-ml-to-string) (s-join "")) ;; => "" ;; Given the following contents: ; not headline ; * one ; ** _one ; * two ; ** _two ; * three ; ** _three (->> (org-ml-parse-subtrees 0) (-map #'org-ml-to-string) (s-join "")) ;; => "* one ; ** _one ; " (->> (org-ml-parse-subtrees '(0 1)) (-map #'org-ml-to-string) (s-join "")) ;; => "* one ; ** _one ; * two ; ** _two ; " (->> (org-ml-parse-subtrees [10 30]) (-map #'org-ml-to-string) (s-join "")) ;; => "* one ; ** _one ; * two ; ** _two ; " ``` ## Building Build new nodes. ### Leaf Object Nodes #### org-ml-build-code `(value &key post-blank)` Build a code object node. The following properties are settable: - **`value`**: (required) a string - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-code "text") (org-ml-to-string)) ;; => "~text~" ``` #### org-ml-build-entity `(name &key use-brackets-p post-blank)` Build an entity object node. The following properties are settable: - **`name`**: (required) a string that makes `org-entity-get` return non-nil - **`use-brackets-p`**: nil or t - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-entity "gamma") (org-ml-to-string)) ;; => "\\gamma" ``` #### org-ml-build-export-snippet `(back-end value &key post-blank)` Build an export-snippet object node. The following properties are settable: - **`back-end`**: (required) a oneline string - **`value`**: (required) a string - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-export-snippet "back" "value") (org-ml-to-string)) ;; => "@@back:value@@" ``` #### org-ml-build-inline-babel-call `(call &key inside-header arguments end-header post-blank)` Build an inline-babel-call object node. The following properties are settable: - **`call`**: (required) a oneline string - **`inside-header`**: a plist - **`arguments`**: a list of oneline strings - **`end-header`**: a plist - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-inline-babel-call "name") (org-ml-to-string)) ;; => "call_name()" (->> (org-ml-build-inline-babel-call "name" :arguments '("n=4")) (org-ml-to-string)) ;; => "call_name(n=4)" (->> (org-ml-build-inline-babel-call "name" :inside-header '(:key val)) (org-ml-to-string)) ;; => "call_name[:key val]()" (->> (org-ml-build-inline-babel-call "name" :end-header '(:key val)) (org-ml-to-string)) ;; => "call_name()[:key val]" ``` #### org-ml-build-inline-src-block `(language &key parameters (value "") post-blank)` Build an inline-src-block object node. The following properties are settable: - **`language`**: (required) a oneline string - **`parameters`**: a plist - **`value`**: (default `""`) a string - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-inline-src-block "lang") (org-ml-to-string)) ;; => "src_lang{}" (->> (org-ml-build-inline-src-block "lang" :value "value") (org-ml-to-string)) ;; => "src_lang{value}" (->> (org-ml-build-inline-src-block "lang" :value "value" :parameters '(:key val)) (org-ml-to-string)) ;; => "src_lang[:key val]{value}" ``` #### org-ml-build-line-break `(&key post-blank)` Build a line-break object node. The following properties are settable: - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-line-break) (org-ml-to-string)) ;; => "\\\\ ; " ``` #### org-ml-build-latex-fragment `(value &key post-blank)` Build a latex-fragment object node. The following properties are settable: - **`value`**: (required) a string - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-latex-fragment "$2+2=5$") (org-ml-to-string)) ;; => "$2+2=5$" ``` #### org-ml-build-macro `(key &key args post-blank)` Build a macro object node. The following properties are settable: - **`key`**: (required) a oneline string - **`args`**: a list of oneline strings - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-macro "economics") (org-ml-to-string)) ;; => "{{{economics}}}" (->> (org-ml-build-macro "economics" :args '("s=d")) (org-ml-to-string)) ;; => "{{{economics(s=d)}}}" ``` #### org-ml-build-statistics-cookie `(value &key post-blank)` Build a statistics-cookie object node. The following properties are settable: - **`value`**: (required) a list of non-neg integers like `(perc)` or `(num den)` which make [`num`/`den`] and [`perc`%] respectively - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-statistics-cookie '(nil)) (org-ml-to-string)) ;; => "[%]" (->> (org-ml-build-statistics-cookie '(nil nil)) (org-ml-to-string)) ;; => "[/]" (->> (org-ml-build-statistics-cookie '(50)) (org-ml-to-string)) ;; => "[50%]" (->> (org-ml-build-statistics-cookie '(1 3)) (org-ml-to-string)) ;; => "[1/3]" ``` #### org-ml-build-target `(value &key post-blank)` Build a target object node. The following properties are settable: - **`value`**: (required) a oneline string - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-target "text") (org-ml-to-string)) ;; => "<>" ``` #### org-ml-build-timestamp `(type year-start month-start day-start year-end month-end day-end &key range-type hour-start minute-start hour-end minute-end repeater-type repeater-unit repeater-value repeater-deadline-unit repeater-deadline-value warning-type warning-unit warning-value post-blank)` Build a timestamp object node. The following properties are settable: - **`type`**: (required) a symbol from `inactive`, `active`, `inactive-range`, or `active-range` - **`year-start`**: (required) a positive integer - **`month-start`**: (required) a positive integer - **`day-start`**: (required) a positive integer - **`year-end`**: (required) a positive integer - **`month-end`**: (required) a positive integer - **`day-end`**: (required) a positive integer - **`range-type`**: either symbol `daterange` or `timerange` or nil - **`hour-start`**: a non-negative integer or nil - **`minute-start`**: a non-negative integer or nil - **`hour-end`**: a non-negative integer or nil - **`minute-end`**: a non-negative integer or nil - **`repeater-type`**: nil or a symbol from `catch-up`, `restart`, or `cumulate` - **`repeater-unit`**: nil or a symbol from `year` `month` `week` `day`, or `hour` - **`repeater-value`**: a positive integer or nil - **`repeater-deadline-unit`**: nil or a symbol from `year` `month` `week` `day`, or `hour` - **`repeater-deadline-value`**: a positive integer or nil - **`warning-type`**: nil or a symbol from `all` or `first` - **`warning-unit`**: nil or a symbol from `year` `month` `week` `day`, or `hour` - **`warning-value`**: a positive integer or nil - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-timestamp 'inactive 2019 1 15 2019 1 15) (org-ml-to-string)) ;; => "[2019-01-15 Tue]" (->> (org-ml-build-timestamp 'active-range 2019 1 15 2019 1 16) (org-ml-to-string)) ;; => "<2019-01-15 Tue>--<2019-01-16 Wed>" (->> (org-ml-build-timestamp 'inactive 2019 1 15 2019 1 15 :warning-type 'all :warning-unit 'day :warning-value 1) (org-ml-to-string)) ;; => "[2019-01-15 Tue -1d]" ``` #### org-ml-build-verbatim `(value &key post-blank)` Build a verbatim object node. The following properties are settable: - **`value`**: (required) a string - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-verbatim "text") (org-ml-to-string)) ;; => "=text=" ``` ### Branch Object Nodes #### org-ml-build-bold `(&key post-blank &rest object-nodes)` Build a bold object node with **`object-nodes`** as children. The following properties are settable: - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-bold "text") (org-ml-to-string)) ;; => "*text*" ``` #### org-ml-build-footnote-reference `(&key label post-blank &rest object-nodes)` Build a footnote-reference object node with **`object-nodes`** as children. The following properties are settable: - **`label`**: a oneline string or nil - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-footnote-reference) (org-ml-to-string)) ;; => "[fn:]" (->> (org-ml-build-footnote-reference :label "label") (org-ml-to-string)) ;; => "[fn:label]" (->> (org-ml-build-footnote-reference :label "label" "content") (org-ml-to-string)) ;; => "[fn:label:content]" ``` #### org-ml-build-italic `(&key post-blank &rest object-nodes)` Build an italic object node with **`object-nodes`** as children. The following properties are settable: - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-italic "text") (org-ml-to-string)) ;; => "/text/" ``` #### org-ml-build-link `(path &key format (type "fuzzy") post-blank &rest object-nodes)` Build a link object node with **`object-nodes`** as children. The following properties are settable: - **`path`**: (required) a oneline string - **`format`**: the symbol `plain`, `bracket` or `angle` - **`type`**: (default `"fuzzy"`) a oneline string from `org-link-types` or `"coderef"`, `"custorg-ml-id"`, `"file"`, `"id"`, `"radio"`, or `"fuzzy"` - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-link "target") (org-ml-to-string)) ;; => "[[target]]" (->> (org-ml-build-link "target" :type "file") (org-ml-to-string)) ;; => "[[file:target]]" (->> (org-ml-build-link "target" "desc") (org-ml-to-string)) ;; => "[[target][desc]]" ``` #### org-ml-build-radio-target `(&key post-blank &rest object-nodes)` Build a radio-target object node with **`object-nodes`** as children. The following properties are settable: - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-radio-target "text") (org-ml-to-string)) ;; => "<<>>" ``` #### org-ml-build-strike-through `(&key post-blank &rest object-nodes)` Build a strike-through object node with **`object-nodes`** as children. The following properties are settable: - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-strike-through "text") (org-ml-to-string)) ;; => "+text+" ``` #### org-ml-build-superscript `(&key use-brackets-p post-blank &rest object-nodes)` Build a superscript object node with **`object-nodes`** as children. The following properties are settable: - **`use-brackets-p`**: nil or t - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-superscript "text") (org-ml-to-string)) ;; => "^text" ``` #### org-ml-build-subscript `(&key use-brackets-p post-blank &rest object-nodes)` Build a subscript object node with **`object-nodes`** as children. The following properties are settable: - **`use-brackets-p`**: nil or t - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-subscript "text") (org-ml-to-string)) ;; => "_text" ``` #### org-ml-build-table-cell `(&key post-blank &rest object-nodes)` Build a table-cell object node with **`object-nodes`** as children. The following properties are settable: - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-table-cell "text") (org-ml-to-string)) ;; => " text |" ``` #### org-ml-build-underline `(&key post-blank &rest object-nodes)` Build an underline object node with **`object-nodes`** as children. The following properties are settable: - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-underline "text") (org-ml-to-string)) ;; => "_text_" ``` ### Leaf Element Nodes #### org-ml-build-babel-call `(call &key inside-header arguments end-header name plot header results caption post-blank)` Build a babel-call element node. The following properties are settable: - **`call`**: (required) a oneline string - **`inside-header`**: a plist - **`arguments`**: a list of oneline strings - **`end-header`**: a plist - **`name`**: a string or nil - **`plot`**: a string or nil - **`header`**: a list of plists where all plist values are strings - **`results`**: a list like `(source)` or `(hash source)` where `hash` and `source` are strings. - **`caption`**: a list including `(long)` or `(short long)` where `short` and `long` are both strings representing the short and long captions - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-babel-call "name") (org-ml-to-trimmed-string)) ;; => "#+call: name()" (->> (org-ml-build-babel-call "name" :arguments '("arg=x")) (org-ml-to-trimmed-string)) ;; => "#+call: name(arg=x)" (->> (org-ml-build-babel-call "name" :inside-header '(:key val)) (org-ml-to-trimmed-string)) ;; => "#+call: name[:key val]()" (->> (org-ml-build-babel-call "name" :end-header '(:key val)) (org-ml-to-trimmed-string)) ;; => "#+call: name() :key val" ``` #### org-ml-build-clock `(value &key post-blank)` Build a clock element node. The following properties are settable: - **`value`**: (required) a ranged or unranged inactive timestamp node with no warning or repeater - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-clock (org-ml-build-timestamp! '(2019 1 1 0 0))) (org-ml-to-trimmed-string)) ;; => "CLOCK: [2019-01-01 Tue 00:00]" (->> (org-ml-build-timestamp! '(2019 1 1 0 0) :end '(2019 1 1 1 0)) (org-ml-set-property :type 'inactive-range) (org-ml-build-clock) (org-ml-to-trimmed-string)) ;; => "CLOCK: [2019-01-01 Tue 00:00]--[2019-01-01 Tue 01:00] => 1:00" ``` #### org-ml-build-comment `(value &key post-blank)` Build a comment element node. The following properties are settable: - **`value`**: (required) a string - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-comment "text") (org-ml-to-trimmed-string)) ;; => "# text" (->> (org-ml-build-comment "text less") (org-ml-to-trimmed-string)) ;; => "# text ; # less" ``` #### org-ml-build-comment-block `(&key (value "") name plot header results caption post-blank)` Build a comment-block element node. The following properties are settable: - **`value`**: (default `""`) a string - **`name`**: a string or nil - **`plot`**: a string or nil - **`header`**: a list of plists where all plist values are strings - **`results`**: a list like `(source)` or `(hash source)` where `hash` and `source` are strings. - **`caption`**: a list including `(long)` or `(short long)` where `short` and `long` are both strings representing the short and long captions - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-comment-block) (org-ml-to-trimmed-string)) ;; => "#+begin_comment ; #+end_comment" (->> (org-ml-build-comment-block :value "text") (org-ml-to-trimmed-string)) ;; => "#+begin_comment ; text ; #+end_comment" ``` #### org-ml-build-diary-sexp `(&key value name plot header results caption post-blank)` Build a diary-sexp element node. The following properties are settable: - **`value`**: a list form or nil - **`name`**: a string or nil - **`plot`**: a string or nil - **`header`**: a list of plists where all plist values are strings - **`results`**: a list like `(source)` or `(hash source)` where `hash` and `source` are strings. - **`caption`**: a list including `(long)` or `(short long)` where `short` and `long` are both strings representing the short and long captions - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-diary-sexp) (org-ml-to-trimmed-string)) ;; => "%%()" (->> (org-ml-build-diary-sexp :value '(text)) (org-ml-to-trimmed-string)) ;; => "%%(text)" ``` #### org-ml-build-example-block `(&key preserve-indent switches (value "") name plot header results caption post-blank)` Build an example-block element node. The following properties are settable: - **`preserve-indent`**: nil or t - **`switches`**: a list of oneline strings - **`value`**: (default `""`) a string - **`name`**: a string or nil - **`plot`**: a string or nil - **`header`**: a list of plists where all plist values are strings - **`results`**: a list like `(source)` or `(hash source)` where `hash` and `source` are strings. - **`caption`**: a list including `(long)` or `(short long)` where `short` and `long` are both strings representing the short and long captions - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-example-block) (org-ml-to-trimmed-string)) ;; => "#+begin_example ; #+end_example" (->> (org-ml-build-example-block :value "text") (org-ml-to-trimmed-string)) ;; => "#+begin_example ; text ; #+end_example" (->> (org-ml-build-example-block :value "text" :switches '("switches")) (org-ml-to-trimmed-string)) ;; => "#+begin_example switches ; text ; #+end_example" ``` #### org-ml-build-export-block `(type value &key name plot header results caption post-blank)` Build an export-block element node. The following properties are settable: - **`type`**: (required) a oneline string - **`value`**: (required) a string - **`name`**: a string or nil - **`plot`**: a string or nil - **`header`**: a list of plists where all plist values are strings - **`results`**: a list like `(source)` or `(hash source)` where `hash` and `source` are strings. - **`caption`**: a list including `(long)` or `(short long)` where `short` and `long` are both strings representing the short and long captions - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-export-block "type" "value ") (org-ml-to-trimmed-string)) ;; => "#+begin_export type ; value ; #+end_export" ``` #### org-ml-build-fixed-width `(value &key name plot header results caption post-blank)` Build a fixed-width element node. The following properties are settable: - **`value`**: (required) a oneline string - **`name`**: a string or nil - **`plot`**: a string or nil - **`header`**: a list of plists where all plist values are strings - **`results`**: a list like `(source)` or `(hash source)` where `hash` and `source` are strings. - **`caption`**: a list including `(long)` or `(short long)` where `short` and `long` are both strings representing the short and long captions - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-fixed-width "text") (org-ml-to-trimmed-string)) ;; => ": text" ``` #### org-ml-build-horizontal-rule `(&key name plot header results caption post-blank)` Build a horizontal-rule element node. The following properties are settable: - **`name`**: a string or nil - **`plot`**: a string or nil - **`header`**: a list of plists where all plist values are strings - **`results`**: a list like `(source)` or `(hash source)` where `hash` and `source` are strings. - **`caption`**: a list including `(long)` or `(short long)` where `short` and `long` are both strings representing the short and long captions - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-horizontal-rule) (org-ml-to-trimmed-string)) ;; => "-----" ``` #### org-ml-build-keyword `(key value &key name plot header results caption post-blank)` Build a keyword element node. The following properties are settable: - **`key`**: (required) a oneline string - **`value`**: (required) a oneline string - **`name`**: a string or nil - **`plot`**: a string or nil - **`header`**: a list of plists where all plist values are strings - **`results`**: a list like `(source)` or `(hash source)` where `hash` and `source` are strings. - **`caption`**: a list including `(long)` or `(short long)` where `short` and `long` are both strings representing the short and long captions - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-keyword "FILETAGS" "tmsu") (org-ml-to-trimmed-string)) ;; => "#+filetags: tmsu" ``` #### org-ml-build-latex-environment `(value &key name plot header results caption post-blank)` Build a latex-environment element node. The following properties are settable: - **`value`**: (required) a list of strings like `(env body)` or `(env)` - **`name`**: a string or nil - **`plot`**: a string or nil - **`header`**: a list of plists where all plist values are strings - **`results`**: a list like `(source)` or `(hash source)` where `hash` and `source` are strings. - **`caption`**: a list including `(long)` or `(short long)` where `short` and `long` are both strings representing the short and long captions - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-latex-environment '("env" "text")) (org-ml-to-trimmed-string)) ;; => "\\begin{env} ; text ; \\end{env}" ``` #### org-ml-build-node-property `(key value &key post-blank)` Build a node-property element node. The following properties are settable: - **`key`**: (required) a oneline string - **`value`**: (required) a oneline string - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-node-property "key" "val") (org-ml-to-trimmed-string)) ;; => ":key: val" ``` #### org-ml-build-planning `(&key closed deadline scheduled post-blank)` Build a planning element node. The following properties are settable: - **`closed`**: a zero-range, inactive timestamp node - **`deadline`**: a zero-range, active timestamp node - **`scheduled`**: a zero-range, active timestamp node - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-planning :closed (org-ml-build-timestamp! '(2019 1 1) :active nil)) (org-ml-to-trimmed-string)) ;; => "CLOSED: [2019-01-01 Tue]" (->> (org-ml-build-planning :scheduled (org-ml-build-timestamp! '(2019 1 1) :active t)) (org-ml-to-trimmed-string)) ;; => "SCHEDULED: <2019-01-01 Tue>" (->> (org-ml-build-planning :deadline (org-ml-build-timestamp! '(2019 1 1) :active t)) (org-ml-to-trimmed-string)) ;; => "DEADLINE: <2019-01-01 Tue>" ``` #### org-ml-build-src-block `(&key (value "") language parameters preserve-indent switches name plot header results caption post-blank)` Build a src-block element node. The following properties are settable: - **`value`**: (default `""`) a string - **`language`**: a string or nil - **`parameters`**: a plist - **`preserve-indent`**: nil or t - **`switches`**: a list of oneline strings - **`name`**: a string or nil - **`plot`**: a string or nil - **`header`**: a list of plists where all plist values are strings - **`results`**: a list like `(source)` or `(hash source)` where `hash` and `source` are strings. - **`caption`**: a list including `(long)` or `(short long)` where `short` and `long` are both strings representing the short and long captions - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-src-block) (org-ml-to-trimmed-string)) ;; => "#+begin_src ; #+end_src" (->> (org-ml-build-src-block :value "body") (org-ml-to-trimmed-string)) ;; => "#+begin_src ; body ; #+end_src" (->> (org-ml-build-src-block :value "body" :language "emacs-lisp") (org-ml-to-trimmed-string)) ;; => "#+begin_src emacs-lisp ; body ; #+end_src" (->> (org-ml-build-src-block :value "body" :switches '("-n 20" "-r")) (org-ml-to-trimmed-string)) ;; => "#+begin_src -n 20 -r ; body ; #+end_src" (->> (org-ml-build-src-block :value "body" :parameters '(:key val)) (org-ml-to-trimmed-string)) ;; => "#+begin_src :key val ; body ; #+end_src" ``` ### Branch Element Nodes with Child Object Nodes #### org-ml-build-paragraph `(&key name plot header results caption post-blank &rest object-nodes)` Build a paragraph element node with **`object-nodes`** as children. The following properties are settable: - **`name`**: a string or nil - **`plot`**: a string or nil - **`header`**: a list of plists where all plist values are strings - **`results`**: a list like `(source)` or `(hash source)` where `hash` and `source` are strings. - **`caption`**: a list including `(long)` or `(short long)` where `short` and `long` are both strings representing the short and long captions - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-paragraph "text") (org-ml-to-trimmed-string)) ;; => "text" ``` #### org-ml-build-table-row `(&key post-blank &rest object-nodes)` Build a table-row element node with **`object-nodes`** as children. The following properties are settable: - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-table-cell "a") (org-ml-build-table-row) (org-ml-to-trimmed-string)) ;; => "| a |" ``` #### org-ml-build-verse-block `(&key name plot header results caption post-blank &rest object-nodes)` Build a verse-block element node with **`object-nodes`** as children. The following properties are settable: - **`name`**: a string or nil - **`plot`**: a string or nil - **`header`**: a list of plists where all plist values are strings - **`results`**: a list like `(source)` or `(hash source)` where `hash` and `source` are strings. - **`caption`**: a list including `(long)` or `(short long)` where `short` and `long` are both strings representing the short and long captions - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-verse-block "text ") (org-ml-to-trimmed-string)) ;; => "#+begin_verse ; text ; #+end_verse" ``` ### Branch Element Nodes with Child Element Nodes #### org-ml-build-org-data `(&rest nodes)` Return a new org-data node using **`nodes`**. **`nodes`** should be either headline or section nodes. ```el (->> (org-ml-build-headline :title '("dummy")) (org-ml-build-org-data) (org-ml-to-trimmed-string)) ;; => "* dummy" ``` #### org-ml-build-center-block `(&key name plot header results caption post-blank &rest element-nodes)` Build a center-block element node with **`element-nodes`** as children. The following properties are settable: - **`name`**: a string or nil - **`plot`**: a string or nil - **`header`**: a list of plists where all plist values are strings - **`results`**: a list like `(source)` or `(hash source)` where `hash` and `source` are strings. - **`caption`**: a list including `(long)` or `(short long)` where `short` and `long` are both strings representing the short and long captions - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-center-block) (org-ml-to-trimmed-string)) ;; => "#+begin_center ; #+end_center" (->> (org-ml-build-paragraph "text") (org-ml-build-center-block) (org-ml-to-trimmed-string)) ;; => "#+begin_center ; text ; #+end_center" ``` #### org-ml-build-drawer `(drawer-name &key name plot header results caption post-blank &rest element-nodes)` Build a drawer element node with **`element-nodes`** as children. The following properties are settable: - **`drawer-name`**: (required) a oneline string - **`name`**: a string or nil - **`plot`**: a string or nil - **`header`**: a list of plists where all plist values are strings - **`results`**: a list like `(source)` or `(hash source)` where `hash` and `source` are strings. - **`caption`**: a list including `(long)` or `(short long)` where `short` and `long` are both strings representing the short and long captions - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-drawer "NAME") (org-ml-to-trimmed-string)) ;; => ":NAME: ; :END:" (->> (org-ml-build-paragraph "text") (org-ml-build-drawer "NAME") (org-ml-to-trimmed-string)) ;; => ":NAME: ; text ; :END:" ``` #### org-ml-build-dynamic-block `(block-name &key arguments name plot header results caption post-blank &rest element-nodes)` Build a dynamic-block element node with **`element-nodes`** as children. The following properties are settable: - **`block-name`**: (required) a oneline string - **`arguments`**: a plist - **`name`**: a string or nil - **`plot`**: a string or nil - **`header`**: a list of plists where all plist values are strings - **`results`**: a list like `(source)` or `(hash source)` where `hash` and `source` are strings. - **`caption`**: a list including `(long)` or `(short long)` where `short` and `long` are both strings representing the short and long captions - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-dynamic-block "empty") (org-ml-to-trimmed-string)) ;; => "#+begin: empty ; #+end:" (->> (org-ml-build-comment "I'm in here") (org-ml-build-dynamic-block "notempty") (org-ml-to-trimmed-string)) ;; => "#+begin: notempty ; # I'm in here ; #+end:" ``` #### org-ml-build-footnote-definition `(label &key (pre-blank 0) name plot header results caption post-blank &rest element-nodes)` Build a footnote-definition element node with **`element-nodes`** as children. The following properties are settable: - **`label`**: (required) a oneline string - **`pre-blank`**: a non-negative integer - **`name`**: a string or nil - **`plot`**: a string or nil - **`header`**: a list of plists where all plist values are strings - **`results`**: a list like `(source)` or `(hash source)` where `hash` and `source` are strings. - **`caption`**: a list including `(long)` or `(short long)` where `short` and `long` are both strings representing the short and long captions - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-paragraph "footnote contents") (org-ml-build-footnote-definition "label") (org-ml-to-trimmed-string)) ;; => "[fn:label] footnote contents" ``` #### org-ml-build-headline `(&key archivedp commentedp footnote-section-p (level 1) (pre-blank 0) priority tags title todo-keyword post-blank &rest element-nodes)` Build a headline element node with **`element-nodes`** as children. The following properties are settable: - **`archivedp`**: nil or t - **`commentedp`**: nil or t - **`footnote-section-p`**: nil or t - **`level`**: a positive integer - **`pre-blank`**: a non-negative integer - **`priority`**: an integer between (inclusive) `org-highest-priority` and `org-lowest-priority` - **`tags`**: a string list - **`title`**: a secondary string - **`todo-keyword`**: a oneline string or nil - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-headline) (org-ml-to-trimmed-string)) ;; => "*" (->> (org-ml-build-headline :level 2 :title '("dummy") :tags '("tmsu")) (org-ml-to-trimmed-string)) ;; => "** dummy :tmsu:" (->> (org-ml-build-headline :todo-keyword "TODO" :archivedp t :commentedp t :priority 65) (org-ml-to-trimmed-string)) ;; => "* TODO COMMENT [#A] :ARCHIVE:" ``` #### org-ml-build-item `(&key (bullet '-) (pre-blank 0) checkbox counter tag post-blank &rest element-nodes)` Build an item element node with **`element-nodes`** as children. The following properties are settable: - **`bullet`**: (default `-`) a positive integer (ordered) or the symbol `-` (unordered) - **`pre-blank`**: a non-negative integer - **`checkbox`**: nil or the symbols `on`, `off`, or `trans` - **`counter`**: a positive integer or nil - **`tag`**: a secondary string - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-paragraph "item contents") (org-ml-build-item) (org-ml-to-trimmed-string)) ;; => "- item contents" (->> (org-ml-build-paragraph "item contents") (org-ml-build-item :bullet 1) (org-ml-to-trimmed-string)) ;; => "1. item contents" (->> (org-ml-build-paragraph "item contents") (org-ml-build-item :checkbox 'on) (org-ml-to-trimmed-string)) ;; => "- [X] item contents" (->> (org-ml-build-paragraph "item contents") (org-ml-build-item :tag '("tmsu")) (org-ml-to-trimmed-string)) ;; => "- tmsu :: item contents" (->> (org-ml-build-paragraph "item contents") (org-ml-build-item :counter 10) (org-ml-to-trimmed-string)) ;; => "- [@10] item contents" ``` #### org-ml-build-plain-list `(&key name plot header results caption post-blank &rest element-nodes)` Build a plain-list element node with **`element-nodes`** as children. The following properties are settable: - **`name`**: a string or nil - **`plot`**: a string or nil - **`header`**: a list of plists where all plist values are strings - **`results`**: a list like `(source)` or `(hash source)` where `hash` and `source` are strings. - **`caption`**: a list including `(long)` or `(short long)` where `short` and `long` are both strings representing the short and long captions - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-paragraph "item contents") (org-ml-build-item) (org-ml-build-plain-list) (org-ml-to-trimmed-string)) ;; => "- item contents" ``` #### org-ml-build-property-drawer `(&key post-blank &rest element-nodes)` Build a property-drawer element node with **`element-nodes`** as children. The following properties are settable: - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-property-drawer) (org-ml-to-trimmed-string)) ;; => ":PROPERTIES: ; :END:" (->> (org-ml-build-node-property "key" "val") (org-ml-build-property-drawer) (org-ml-to-trimmed-string)) ;; => ":PROPERTIES: ; :key: val ; :END:" ``` #### org-ml-build-quote-block `(&key name plot header results caption post-blank &rest element-nodes)` Build a quote-block element node with **`element-nodes`** as children. The following properties are settable: - **`name`**: a string or nil - **`plot`**: a string or nil - **`header`**: a list of plists where all plist values are strings - **`results`**: a list like `(source)` or `(hash source)` where `hash` and `source` are strings. - **`caption`**: a list including `(long)` or `(short long)` where `short` and `long` are both strings representing the short and long captions - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-quote-block) (org-ml-to-trimmed-string)) ;; => "#+begin_quote ; #+end_quote" (->> (org-ml-build-paragraph "quoted stuff") (org-ml-build-quote-block) (org-ml-to-trimmed-string)) ;; => "#+begin_quote ; quoted stuff ; #+end_quote" ``` #### org-ml-build-section `(&key post-blank &rest element-nodes)` Build a section element node with **`element-nodes`** as children. The following properties are settable: - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-paragraph "text") (org-ml-build-section) (org-ml-to-trimmed-string)) ;; => "text" ``` #### org-ml-build-special-block `(type &key parameters name plot header results caption post-blank &rest element-nodes)` Build a special-block element node with **`element-nodes`** as children. The following properties are settable: - **`type`**: (required) a oneline string - **`parameters`**: a oneline string or nil - **`name`**: a string or nil - **`plot`**: a string or nil - **`header`**: a list of plists where all plist values are strings - **`results`**: a list like `(source)` or `(hash source)` where `hash` and `source` are strings. - **`caption`**: a list including `(long)` or `(short long)` where `short` and `long` are both strings representing the short and long captions - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-special-block "monad") (org-ml-to-trimmed-string)) ;; => "#+begin_monad ; #+end_monad" (->> (org-ml-build-comment "Launch missiles") (org-ml-build-special-block "monad") (org-ml-to-trimmed-string)) ;; => "#+begin_monad ; # Launch missiles ; #+end_monad" ``` #### org-ml-build-table `(&key tblfm name plot header results caption post-blank &rest element-nodes)` Build a table element node with **`element-nodes`** as children. The following properties are settable: - **`tblfm`**: a list of oneline strings - **`name`**: a string or nil - **`plot`**: a string or nil - **`header`**: a list of plists where all plist values are strings - **`results`**: a list like `(source)` or `(hash source)` where `hash` and `source` are strings. - **`caption`**: a list including `(long)` or `(short long)` where `short` and `long` are both strings representing the short and long captions - **`post-blank`**: a non-negative integer ```el (->> (org-ml-build-table-cell "cell") (org-ml-build-table-row) (org-ml-build-table) (org-ml-to-trimmed-string)) ;; => "| cell |" ``` ### Miscellaneous Builders #### org-ml-build-secondary-string! `(string)` Return a secondary string (list of object nodes) from **`string`**. **`string`** is any string that contains a textual representation of object nodes. If the string does not represent a list of object nodes, throw an error. ```el (->> (org-ml-build-secondary-string! "I'm plain") (-map #'org-ml-get-type)) ;; => '(plain-text) (->> (org-ml-build-secondary-string! "I'm *not* plain") (-map #'org-ml-get-type)) ;; => '(plain-text bold plain-text) (->> (org-ml-build-secondary-string! "1. I'm *not* a plain list") (-map #'org-ml-get-type)) ;; => '(plain-text bold plain-text) (->> (org-ml-build-secondary-string! "* I'm not an object") (-map #'org-ml-get-type)) ;; => '(plain-text) ``` #### org-ml-build-table-row-hline `(&key post-blank)` Return a new rule-typed table-row node. Optionally set **`post-blank`** (a positive integer). ```el (->> (org-ml-build-table (org-ml-build-table-row (org-ml-build-table-cell "text")) (org-ml-build-table-row-hline)) (org-ml-to-trimmed-string)) ;; => "| text | ; |------|" ``` #### org-ml-build-timestamp-diary `(form &key start end post-blank)` Return a new diary-sexp timestamp node from **`form`**. `time1` and `time1` are lists like (hour min) which specify the time(s) of the diary timestamp. If `time2` is provided, `time1` must also be provided and the timestamp will be ranged. Optionally set **`post-blank`** (a positive integer). ```el (->> (org-ml-build-timestamp-diary '(diary-float t 4 2)) (org-ml-to-string)) ;; => "<%%(diary-float t 4 2)>" (->> (org-ml-build-timestamp-diary '(diary-float t 4 2) :start '(0 0)) (org-ml-to-string)) ;; => "<%%(diary-float t 4 2) 00:00>" (->> (org-ml-build-timestamp-diary '(diary-float t 4 2) :start '(0 0) :end '(1 0)) (org-ml-to-string)) ;; => "<%%(diary-float t 4 2) 00:00-01:00>" ``` ### Shorthand Builders Build nodes with more convenient/shorter syntax. #### org-ml-build-timestamp! `(start &key end active repeater deadline warning collapsed post-blank)` Return a new timestamp node. **`start`** specifies the start time and is a list of integers in one of the following forms: - `(year month day)`: short form - `(year month day nil nil)`: short form - `(year month day hour minute)`: long form **`end`** (if supplied) will add the ending time, and follows the same formatting rules as **`start`**. **`active`** is a boolean where t signifies the type is `active`, else `inactive` (the range suffix will be added if an end time is supplied). **`repeater`**, **`deadline`**, and **`warning`** are lists corresponding to those required for [`org-ml-timestamp-set-repeater`](#org-ml-timestamp-set-repeater-repeater-timestamp), [`org-ml-timestamp-set-deadline`](#org-ml-timestamp-set-deadline-deadline-timestamp), and [`org-ml-timestamp-set-warning`](#org-ml-timestamp-set-warning-warning-timestamp) respectively. Building a diary sexp timestamp is not possible with this function. ```el (->> (org-ml-build-timestamp! '(2019 1 1)) (org-ml-to-string)) ;; => "[2019-01-01 Tue]" (->> (org-ml-build-timestamp! '(2019 1 1 12 0) :active t :warning '(all 1 day) :repeater '(cumulate 1 month)) (org-ml-to-string)) ;; => "<2019-01-01 Tue 12:00 +1m -1d>" (->> (org-ml-build-timestamp! '(2019 1 1) :end '(2019 1 2)) (org-ml-to-string)) ;; => "[2019-01-01 Tue]--[2019-01-02 Wed]" ``` #### org-ml-build-clock! `(start &key end post-blank)` Return a new clock node. **`start`** and **`end`** follow the same rules as their respective arguments in [`org-ml-build-timestamp!`](#org-ml-build-timestamp-start-key-end-active-repeater-deadline-warning-collapsed-post-blank). ```el (->> (org-ml-build-clock! '(2019 1 1)) (org-ml-to-trimmed-string)) ;; => "CLOCK: [2019-01-01 Tue]" (->> (org-ml-build-clock! '(2019 1 1 12 0)) (org-ml-to-trimmed-string)) ;; => "CLOCK: [2019-01-01 Tue 12:00]" (->> (org-ml-build-clock! '(2019 1 1 12 0) :end '(2019 1 1 13 0)) (org-ml-to-trimmed-string)) ;; => "CLOCK: [2019-01-01 Tue 12:00]--[2019-01-01 Tue 13:00] => 1:00" ``` #### org-ml-build-planning! `(&key closed deadline scheduled post-blank)` Return a new planning node. **`deadline`** and **`scheduled`** are lists with the following structure (brackets denote optional members): `(year minute day [hour] [min] [&warning type value unit] [&repeater type value unit])` In terms of arguments supplied to [`org-ml-build-timestamp!`](#org-ml-build-timestamp-start-key-end-active-repeater-deadline-warning-collapsed-post-blank), the first five members correspond to the list supplied as `time`, and the `type`, `value`, and `unit` fields correspond to the lists supplied to `warning` and `repeater` arguments. The order of warning and repeater does not matter. **`closed`** is a similar list to above but does not have &warning or &repeater. ```el (->> (org-ml-build-planning! :closed '(2019 1 1)) (org-ml-to-trimmed-string)) ;; => "CLOSED: [2019-01-01 Tue]" (->> (org-ml-build-planning! :closed '(2019 1 1) :scheduled '(2018 1 1)) (org-ml-to-trimmed-string)) ;; => "SCHEDULED: <2018-01-01 Mon> CLOSED: [2019-01-01 Tue]" (->> (org-ml-build-planning! :scheduled '(2019 1 1 &warning all 1 day &repeater cumulate 1 month)) (org-ml-to-trimmed-string)) ;; => "SCHEDULED: <2019-01-01 Tue +1m -1d>" ``` #### org-ml-build-property-drawer! `(&key post-blank &rest keyvals)` Return a new property-drawer node. Each member in **`keyvals`** is a list like `(key val)` where `key` and `val` are both strings, where each list will generate a node-property node in the property-drawer node like `":key: val"`. ```el (->> (org-ml-build-property-drawer! '("key" "val")) (org-ml-to-trimmed-string)) ;; => ":PROPERTIES: ; :key: val ; :END:" ``` #### org-ml-build-headline! `(&key (level 1) title-text todo-keyword tags pre-blank priority commentedp archivedp post-blank planning statistics-cookie section-children &rest subheadlines)` Return a new headline node. **`title-text`** is a oneline string for the title of the headline. **`planning`** is a list like `(planning-type args ...)` where `planning-type` is one of `:closed`, `:deadline`, or `:scheduled`, and `args` are the args supplied to any of the planning types in [`org-ml-build-planning!`](#org-ml-build-planning-key-closed-deadline-scheduled-post-blank). Up to all three planning types can be used in the same list like `(:closed args :deadline args :scheduled args)`. **`statistics-cookie`** is a list following the same format as [`org-ml-build-statistics-cookie`](#org-ml-build-statistics-cookie-value-key-post-blank). **`section-children`** is a list of elements that will go in the headline section. **`subheadlines`** contains zero or more headlines that will go under the created headline. The level of all members in **`subheadlines`** will automatically be adjusted to **`level`** + 1. All arguments not mentioned here follow the same rules as [`org-ml-build-headline`](#org-ml-build-headline-key-archivedp-commentedp-footnote-section-p-level-1-pre-blank-0-priority-tags-title-todo-keyword-post-blank-rest-element-nodes) ```el (->> (org-ml-build-headline! :title-text "really impressive title") (org-ml-to-trimmed-string)) ;; => "* really impressive title" (->> (org-ml-build-headline! :title-text "really impressive title" :statistics-cookie '(0 9000)) (org-ml-to-trimmed-string)) ;; => "* really impressive title [0/9000]" (->> (org-ml-build-headline! :title-text "really impressive title" :section-children (list (org-ml-build-property-drawer! '("key" "val")) (org-ml-build-paragraph! "section text")) (org-ml-build-headline! :title-text "subhead")) (org-ml-to-trimmed-string)) ;; => "* really impressive title ; :PROPERTIES: ; :key: val ; :END: ; section text ; ** subhead" ``` #### org-ml-build-item! `(&key post-blank bullet checkbox tag paragraph counter &rest children)` Return a new item node. **`tag`** is a string representing the tag (make with [`org-ml-build-secondary-string!`](#org-ml-build-secondary-string-string)) . **`paragraph`** is a string that will be the initial text in the item (made with [`org-ml-build-paragraph!`](#org-ml-build-paragraph-string-key-post-blank)). **`children`** contains the nodes that will go under this item after **`paragraph`**. All other arguments follow the same rules as [`org-ml-build-item`](#org-ml-build-item-key-bullet---pre-blank-0-checkbox-counter-tag-post-blank-rest-element-nodes). ```el (->> (org-ml-build-item! :bullet 1 :tag "complicated *tag*" :paragraph "petulant /frenzy/" (org-ml-build-plain-list (org-ml-build-item! :bullet '- :paragraph "below"))) (org-ml-to-trimmed-string)) ;; => "1. complicated *tag* :: petulant /frenzy/ ; - below" ``` #### org-ml-build-paragraph! `(string &key post-blank)` Return a new paragraph node from **`string`**. **`string`** is the text to be parsed into a paragraph and must contain valid textual representations of object nodes. ```el (->> (org-ml-build-paragraph! "stuff /with/ *formatting*" :post-blank 2) (org-ml-to-string)) ;; => "stuff /with/ *formatting* ; ; ; " (->> (org-ml-build-paragraph! "* stuff /with/ *formatting*") (org-ml-to-string)) ;; => "* stuff /with/ *formatting* ; " ``` #### org-ml-build-table-cell! `(string)` Return a new table-cell node. **`string`** is the text to be contained in the table-cell node. It must contain valid textual representations of objects that are allowed in table-cell nodes. ```el (->> (org-ml-build-table-cell! "rage") (org-ml-to-trimmed-string)) ;; => "rage |" (->> (org-ml-build-table-cell! "*rage*") (org-ml-to-trimmed-string)) ;; => "*rage* |" ``` #### org-ml-build-table-row! `(row-list)` Return a new table-row node. **`row-list`** is a list of strings to be built into table-cell nodes via [`org-ml-build-table-cell!`](#org-ml-build-table-cell-string) (see that function for restrictions). Alternatively, **`row-list`** may the symbol `hline` instead of a string to create a rule-typed table-row. ```el (->> (org-ml-build-table-row! '("R" "A" "G" "E")) (org-ml-to-trimmed-string)) ;; => "| R | A | G | E |" (->> (org-ml-build-table-row! '("S" "" "X")) (org-ml-to-trimmed-string)) ;; => "| S | | X |" (->> (org-ml-build-table-row! 'hline) (org-ml-to-trimmed-string)) ;; => "|-" ``` #### org-ml-build-table! `(&key tblfm post-blank &rest row-lists)` Return a new table node. Each member of **`row-lists`** will be converted to a table-row node via [`org-ml-build-table-row!`](#org-ml-build-table-row-row-list) (see that function for restrictions). All other arguments follow the same rules as [`org-ml-build-table`](#org-ml-build-table-key-tblfm-name-plot-header-results-caption-post-blank-rest-element-nodes). ```el (->> (org-ml-build-table! '("R" "A") '("G" "E")) (org-ml-to-trimmed-string)) ;; => "| R | A | ; | G | E |" (->> (org-ml-build-table! '("S" "") '("" "X")) (org-ml-to-trimmed-string)) ;; => "| S | | ; | | X |" (->> (org-ml-build-table! '("L" "O") 'hline '("V" "E")) (org-ml-to-trimmed-string)) ;; => "| L | O | ; |---+---| ; | V | E |" ``` ### Logbook Item Builders Build item nodes for inclusion in headline logbooks #### org-ml-build-log-note `(unixtime note)` Return an item node for a new note log entry. This will format the log entry from the default value for the `note` cell in `org-log-note-headings`. **`unixtime`** is an integer representing the time to be used for all timestamp nodes. **`note`** is a string for the note text. ```el (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-note "noteworthy") (org-ml-to-trimmed-string)) ;; => "- Note taken on [2019-01-01 Tue 00:00] \\\\ ; noteworthy" ``` #### org-ml-build-log-done `(unixtime &optional note)` Return an item node for a done log entry. This will format the log entry from the default value for the `done` cell in `org-log-note-headings`. **`unixtime`** is an integer representing the time to be used for all timestamp nodes. If string **`note`** is supplied, append a note to the log entry. ```el (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-done) (org-ml-to-trimmed-string)) ;; => "- CLOSING NOTE [2019-01-01 Tue 00:00]" (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-done "noteworthy") (org-ml-to-trimmed-string)) ;; => "- CLOSING NOTE [2019-01-01 Tue 00:00] \\\\ ; noteworthy" ``` #### org-ml-build-log-refile `(unixtime &optional note)` Return an item node for a refile log entry. This will format the log entry from the default value for the `deldeadline` cell in `org-log-note-headings`. **`unixtime`** is an integer representing the time to be used for all timestamp nodes. If string **`note`** is supplied, append a note to the log entry. ```el (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-refile) (org-ml-to-trimmed-string)) ;; => "- Refiled on [2019-01-01 Tue 00:00]" (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-refile "noteworthy") (org-ml-to-trimmed-string)) ;; => "- Refiled on [2019-01-01 Tue 00:00] \\\\ ; noteworthy" ``` #### org-ml-build-log-state `(unixtime new-state old-state &optional note)` Return an item node for a state change log entry. This will format the log entry from the default value for the `state` cell in `org-log-note-headings`. **`unixtime`** is an integer representing the time to be used for all timestamp nodes. **`new-state`** and **`old-state`** are strings for the new and old todo keywords respectively. If string **`note`** is supplied, append a note to the log entry. ```el (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-state "HOLD" "TODO") (org-ml-to-trimmed-string)) ;; => "- State \"HOLD\" from \"TODO\" [2019-01-01 Tue 00:00]" (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-state "HOLD" "TODO" "noteworthy") (org-ml-to-trimmed-string)) ;; => "- State \"HOLD\" from \"TODO\" [2019-01-01 Tue 00:00] \\\\ ; noteworthy" ``` #### org-ml-build-log-deldeadline `(unixtime old-timestamp &optional note)` Return an item node for a delete deadline log entry. This will format the log entry from the default value for the `deldeadline` cell in `org-log-note-headings`. **`unixtime`** is an integer representing the time to be used for all timestamp nodes. **`old-timestamp`** is a timestamp node of the deadline that is being deleted. It will always be converted to an inactive timestamp. If string **`note`** is supplied, append a note to the log entry. ```el (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-deldeadline (org-ml-build-timestamp! '(2019 1 2))) (org-ml-to-trimmed-string)) ;; => "- Removed deadline, was \"[2019-01-02 Wed]\" on [2019-01-01 Tue 00:00]" (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-deldeadline (org-ml-build-timestamp! '(2019 1 2)) "noteworthy") (org-ml-to-trimmed-string)) ;; => "- Removed deadline, was \"[2019-01-02 Wed]\" on [2019-01-01 Tue 00:00] \\\\ ; noteworthy" ``` #### org-ml-build-log-delschedule `(unixtime old-timestamp &optional note)` Return an item node for a delete schedule log entry. This will format the log entry from the default value for the `delschedule` cell in `org-log-note-headings`. **`unixtime`** is an integer representing the time to be used for all timestamp nodes. **`old-timestamp`** is a timestamp node of the schedule that is being deleted. It will always be converted to an inactive timestamp. If string **`note`** is supplied, append a note to the log entry. ```el (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-delschedule (org-ml-build-timestamp! '(2019 1 2))) (org-ml-to-trimmed-string)) ;; => "- Not scheduled, was \"[2019-01-02 Wed]\" on [2019-01-01 Tue 00:00]" (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-delschedule (org-ml-build-timestamp! '(2019 1 2)) "noteworthy") (org-ml-to-trimmed-string)) ;; => "- Not scheduled, was \"[2019-01-02 Wed]\" on [2019-01-01 Tue 00:00] \\\\ ; noteworthy" ``` #### org-ml-build-log-redeadline `(unixtime old-timestamp &optional note)` Return an item node for a new deadline log entry. This will format the log entry from the default value for the `redeadline` cell in `org-log-note-headings`. **`unixtime`** is an integer representing the time to be used for all timestamp nodes. **`old-timestamp`** is a timestamp node of the deadline that is being deleted. It will always be converted to an inactive timestamp. If string **`note`** is supplied, append a note to the log entry. ```el (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-redeadline (org-ml-build-timestamp! '(2019 1 2))) (org-ml-to-trimmed-string)) ;; => "- New deadline from \"[2019-01-02 Wed]\" on [2019-01-01 Tue 00:00]" (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-redeadline (org-ml-build-timestamp! '(2019 1 2)) "noteworthy") (org-ml-to-trimmed-string)) ;; => "- New deadline from \"[2019-01-02 Wed]\" on [2019-01-01 Tue 00:00] \\\\ ; noteworthy" ``` #### org-ml-build-log-reschedule `(unixtime old-timestamp &optional note)` Return an item node for a new schedule log entry. This will format the log entry from the default value for the `reschedule` cell in `org-log-note-headings`. **`unixtime`** is an integer representing the time to be used for all timestamp nodes. **`old-timestamp`** is a timestamp node of the schedule that is being deleted. It will always be converted to an inactive timestamp. If string **`note`** is supplied, append a note to the log entry. ```el (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-reschedule (org-ml-build-timestamp! '(2019 1 2))) (org-ml-to-trimmed-string)) ;; => "- Rescheduled from \"[2019-01-02 Wed]\" on [2019-01-01 Tue 00:00]" (-> (- 1546300800 (car (current-time-zone))) (org-ml-build-log-reschedule (org-ml-build-timestamp! '(2019 1 2)) "noteworthy") (org-ml-to-trimmed-string)) ;; => "- Rescheduled from \"[2019-01-02 Wed]\" on [2019-01-01 Tue 00:00] \\\\ ; noteworthy" ``` #### org-ml-build-log-type `(type &key old new unixtime username full-username note)` Return an item for an arbitrary log entry. **`type`** is a symbol corresponding to the car of one of the cells in `org-log-note-headings`. Unlike the other log entry build functions in this package, this function will not use the default value of `org-log-note-headings` which means it can be used for customly formatted log entries. The arguments correspond to the following formatting placeholders (see `org-log-note-headings` for more information on these placeholders): - **`new`**: either a string or timestamp node that will replace the new state/timestamp placeholder (%s) - **`old`**: like **`new`** but for the old state/timestamp placeholder (%S) - **`unixtime`**: an integer corresponding to the time to be used for the timestamp placeholders (%t/%T/%d/%D) - **`username`**: a string for the username (%u) - **`full-username`**: a string for the full username (%U) If any of these arguments are not supplied but their placeholders are present in the heading determined by **`type`**, the placeholders will not be substituted. If string **`note`** is supplied, append a note to the log entry. ```el (let ((org-log-note-headings '((test . "Changed %s from %S on %t by %u"))) (ut (- 1546300800 (car (current-time-zone))))) (->> (org-ml-build-log-type 'test :unixtime ut :old "TODO" :new "DONE" :username "shadowbrokers" :note "We're coming for you") (org-ml-to-trimmed-string))) ;; => "- Changed \"DONE\" from \"TODO\" on [2019-01-01 Tue 00:00] by shadowbrokers \\\\ ; We're coming for you" ``` ## Type Predicates Test node types. #### org-ml-get-type `(node &optional anonymous)` Return the type of **`node`**. ```el ;; Given the following contents: ; *I'm emboldened* (->> (org-ml-parse-this-object) (org-ml-get-type)) ;; => 'bold ;; Given the following contents: ; * I'm the headliner (->> (org-ml-parse-this-element) (org-ml-get-type)) ;; => 'headline ;; Given the following contents: ; [2112-12-21 Wed] (->> (org-ml-parse-this-object) (org-ml-get-type)) ;; => 'timestamp ``` #### org-ml-is-type `(type node)` Return t if the type of **`node`** is **`type`** (a symbol). ```el ;; Given the following contents: ; *ziltoid* (->> (org-ml-parse-this-object) (org-ml-is-type 'bold)) ;; => t (->> (org-ml-parse-this-object) (org-ml-is-type 'italic)) ;; => nil ``` #### org-ml-is-any-type `(types node)` Return t if the type of **`node`** is in **`types`** (a list of symbols). ```el ;; Given the following contents: ; *ziltoid* (->> (org-ml-parse-this-object) (org-ml-is-any-type '(bold))) ;; => t (->> (org-ml-parse-this-object) (org-ml-is-any-type '(bold italic))) ;; => t (->> (org-ml-parse-this-object) (org-ml-is-any-type '(italic))) ;; => nil ``` #### org-ml-is-element `(node)` Return t if **`node`** is an element class. ```el ;; Given the following contents: ; *ziltoid* ;; Parsing this text as an element node gives a paragraph node (->> (org-ml-parse-this-element) (org-ml-is-element)) ;; => t ;; Parsing the same text as an object node gives a bold node (->> (org-ml-parse-this-object) (org-ml-is-element)) ;; => nil ``` #### org-ml-is-branch-node `(node)` Return t if **`node`** is a branch node. ```el ;; Given the following contents: ; *ziltoid* ;; Parsing this as an element node gives a paragraph node (a branch node) (->> (org-ml-parse-this-element) (org-ml-is-branch-node)) ;; => t ;; Parsing this as an object node gives a bold node (also a branch node) (->> (org-ml-parse-this-object) (org-ml-is-branch-node)) ;; => t ;; Given the following contents: ; ~ziltoid~ ;; Parsing this as an object node gives a code node (not a branch node) (->> (org-ml-parse-this-object) (org-ml-is-branch-node)) ;; => nil ;; Given the following contents: ; # ziltoid ;; Parsing this as an element node gives a comment node (also not a branch node) (->> (org-ml-parse-this-element) (org-ml-is-branch-node)) ;; => nil ;; Given the following contents: ; * I'm so great ;; Parsing this as an element node gives a headline node (a branch node) (->> (org-ml-parse-this-element) (org-ml-is-branch-node)) ;; => t ``` #### org-ml-node-may-have-child-objects `(node)` Return t if **`node`** is a branch node that may have child objects. ```el ;; Given the following contents: ; *ziltoid* ;; Parsing this as an element node gives a paragraph node (can have child object ;; nodes) (->> (org-ml-parse-this-element) (org-ml-node-may-have-child-objects)) ;; => t ;; Parsing this as an object node gives a bold node (also can have child object ;; nodes) (->> (org-ml-parse-this-object) (org-ml-node-may-have-child-objects)) ;; => t ;; Given the following contents: ; ~ziltoid~ ;; Parsing this as an object node gives a code node (not a branch node) (->> (org-ml-parse-this-object) (org-ml-node-may-have-child-objects)) ;; => nil ;; Given the following contents: ; # ziltoid ;; Parsing this as an element node gives a comment node (not a branch node) (->> (org-ml-parse-this-element) (org-ml-node-may-have-child-objects)) ;; => nil ;; Given the following contents: ; * I'm so great ;; Parsing this as an element node gives a headline node (can only have child ;; element nodes) (->> (org-ml-parse-this-element) (org-ml-node-may-have-child-objects)) ;; => nil ``` #### org-ml-node-may-have-child-elements `(node)` Return t if **`node`** is a branch node that may have child elements. Note this implies that **`node`** is also of class element since only elements may have other elements as children. ```el ;; Given the following contents: ; * I'm so great ;; Parsing this as an element node gives a headline node (can have child element ;; nodes) (->> (org-ml-parse-this-element) (org-ml-node-may-have-child-elements)) ;; => t ;; Given the following contents: ; *ziltoid* ;; Parsing this as an element node gives a paragraph node (can only have child ;; object nodes) (->> (org-ml-parse-this-element) (org-ml-node-may-have-child-elements)) ;; => nil ;; Given the following contents: ; # ziltoid ;; Parsing this as an element node gives a comment node (not a branch node) (->> (org-ml-parse-this-element) (org-ml-node-may-have-child-elements)) ;; => nil ``` ## Property Manipulation Set, get, and map properties of nodes. ### Generic #### org-ml-contains-point-p `(point node)` Return t if **`point`** is within the boundaries of **`node`**. ```el ;; Given the following contents: ; *findme* (->> (org-ml-parse-this-object) (org-ml-contains-point-p 2)) ;; => t (->> (org-ml-parse-this-object) (org-ml-contains-point-p 10)) ;; => nil ``` #### org-ml-set-property `(prop value node)` Return **`node`** with **`prop`** set to **`value`**. See builder functions for a list of properties and their rules for each type. ```el ;; Given the following contents: ; #+call: ktulu() (org-ml->> (org-ml-parse-this-element) (org-ml-set-property :call "cthulhu") (org-ml-set-property :inside-header '(:cache no)) (org-ml-set-property :arguments '("x=4")) (org-ml-set-property :end-header '(:exports results)) (org-ml-to-trimmed-string)) ;; => "#+call: cthulhu[:cache no](x=4) :exports results" ;; Given the following contents: ; call_kthulu() (org-ml->> (org-ml-parse-this-object) (org-ml-set-property :call "cthulhu") (org-ml-set-property :inside-header '(:cache no)) (org-ml-set-property :arguments '("x=4")) (org-ml-set-property :end-header '(:exports results)) (org-ml-to-trimmed-string)) ;; => "call_cthulhu[:cache no](x=4)[:exports results]" ;; Given the following contents: ; src_emacs{(print 'yeah-boi)} (org-ml->> (org-ml-parse-this-object) (org-ml-set-property :language "python") (org-ml-set-property :parameters '(:cache no)) (org-ml-set-property :value "print \"yeah boi\"") (org-ml-to-trimmed-string)) ;; => "src_python[:cache no]{print \"yeah boi\"}" ;; Given the following contents: ; - thing (org-ml->> (org-ml-parse-this-item) (org-ml-set-property :bullet 1) (org-ml-set-property :checkbox 'on) (org-ml-set-property :counter 2) (org-ml-set-property :tag '("tmsu")) (org-ml-to-trimmed-string)) ;; => "1. [@2] [X] tmsu :: thing" ;; Given the following contents: ; * not valuable ;; Throw error when setting a property that doesn't exist (org-ml->> (org-ml-parse-this-headline) (org-ml-set-property :value "wtf") (org-ml-to-trimmed-string)) Error ;; Throw error when setting to an improper type (org-ml->> (org-ml-parse-this-headline) (org-ml-set-property :title 666) (org-ml-to-trimmed-string)) Error ``` #### org-ml-get-property `(prop node)` Return the value of **`prop`** of **`node`**. ```el ;; Given the following contents: ; #+call: ktulu(x=4) :exports results (->> (org-ml-parse-this-element) (org-ml-get-property :call)) ;; => "ktulu" (->> (org-ml-parse-this-element) (org-ml-get-property :inside-header)) ;; => nil ;; Given the following contents: ; * not arguable ;; Throw error when requesting a property that doesn't exist (->> (org-ml-parse-this-headline) (org-ml-get-property :value)) Error ``` #### org-ml-map-property `(prop fun node)` Return **`node`** with **`fun`** applied to the value of **`prop`**. **`fun`** is a unary function which takes the current value of **`prop`** and returns a new value to which **`prop`** will be set. See builder functions for a list of properties and their rules for each type. ```el ;; Given the following contents: ; ~learn to~ (org-ml->> (org-ml-parse-this-object) (org-ml-map-property :value #'s-upcase) (org-ml-to-trimmed-string)) ;; => "~LEARN TO~" ;; Throw error if property doesn't exist (org-ml->> (org-ml-parse-this-object) (org-ml-map-property :title #'s-upcase) (org-ml-to-trimmed-string)) Error ;; Throw error if function doesn't return proper type (org-ml->> (org-ml-parse-this-object) (org-ml-map-property* :value (if it 1 0)) (org-ml-to-trimmed-string)) Error ``` #### org-ml-toggle-property `(prop node)` Return **`node`** with the value of **`prop`** flipped. This function only applies to properties that are booleans. (fn **`prop`** **`node`**) The following types and properties are supported: entity - :use-brackets-p example-block - :preserve-indent headline - :archivedp - :commentedp - :footnote-section-p src-block - :preserve-indent subscript - :use-brackets-p ```el ;; Given the following contents: ; \pi (org-ml->> (org-ml-parse-this-object) (org-ml-toggle-property :use-brackets-p) (org-ml-to-trimmed-string)) ;; => "\\pi{}" ;; Given the following contents: ; - [ ] nope ;; Throw an error when trying to toggle a non-boolean property (org-ml->> (org-ml-parse-this-item) (org-ml-toggle-property :checkbox) (org-ml-to-trimmed-string)) Error ``` #### org-ml-shift-property `(prop n node)` Return **`node`** with **`prop`** shifted by **`n`** (an integer). This only applies the properties that are represented as integers. (fn **`prop`** **`n`** **`node`**) The following types and properties are supported: all elements - :post-blank footnote-definition - :pre-blank headline - :level - :pre-blank - :priority item ```el ;; Given the following contents: ; * no priorities ;; Do nothing if there is nothing to shift. (org-ml->> (org-ml-parse-this-headline) (org-ml-shift-property :priority 1) (org-ml-to-trimmed-string)) ;; => "* no priorities" ;; Given the following contents: ; * [#A] priorities (org-ml->> (org-ml-parse-this-headline) (org-ml-shift-property :priority -1) (org-ml-to-trimmed-string)) ;; => "* [#B] priorities" ;; Wrap priority around when crossing the min or max (org-ml->> (org-ml-parse-this-headline) (org-ml-shift-property :priority 1) (org-ml-to-trimmed-string)) ;; => "* [#C] priorities" ;; Given the following contents: ; * TODO or not todo ;; Throw error when shifting an unshiftable property (org-ml->> (org-ml-parse-this-headline) (org-ml-shift-property :todo-keyword 1) (org-ml-to-string)) Error ``` #### org-ml-insert-into-property `(prop index string node)` Return **`node`** with **`string`** inserted at **`index`** into **`prop`**. This only applies to properties that are represented as lists of strings. (fn **`prop`** **`index`** **`string`** **`node`**) The following types and properties are supported: babel-call - :arguments example-block - :switches headline - :tags inline-babel-call - :arguments macro - :args src-block - :switches ```el ;; Given the following contents: ; #+call: ktulu(y=1) (org-ml->> (org-ml-parse-this-element) (org-ml-insert-into-property :arguments 0 "x=4") (org-ml-to-trimmed-string)) ;; => "#+call: ktulu(x=4,y=1)" ;; Do nothing if the string is already in the list (org-ml->> (org-ml-parse-this-element) (org-ml-insert-into-property :arguments 0 "y=1") (org-ml-to-trimmed-string)) ;; => "#+call: ktulu(y=1)" ;; Throw error when inserting into a property that is not a list of strings (org-ml->> (org-ml-parse-this-element) (org-ml-insert-into-property :end-header 0 "html") (org-ml-to-trimmed-string)) Error ``` #### org-ml-remove-from-property `(prop string node)` Return **`node`** with **`string`** removed from **`prop`** if present. This only applies to properties that are represented as lists of strings. See [`org-ml-insert-into-property`](#org-ml-insert-into-property-prop-index-string-node) for a list of supported elements and properties that may be used with this function. ```el ;; Given the following contents: ; #+call: ktulu(y=1) (org-ml->> (org-ml-parse-this-element) (org-ml-remove-from-property :arguments "y=1") (org-ml-to-trimmed-string)) ;; => "#+call: ktulu()" ;; Do nothing if the string does not exist (org-ml->> (org-ml-parse-this-element) (org-ml-remove-from-property :arguments "d=666") (org-ml-to-trimmed-string)) ;; => "#+call: ktulu(y=1)" ;; Throw error when removing from property that is not a string list (org-ml->> (org-ml-parse-this-element) (org-ml-remove-from-property :end-header ":results") (org-ml-to-trimmed-string)) Error ``` #### org-ml-plist-put-property `(prop key value node)` Return **`node`** with **`value`** corresponding to **`key`** inserted into **`prop`**. **`key`** is a keyword and **`value`** is a symbol. This only applies to properties that are represented as plists. (fn **`prop`** **`key`** **`value`** **`node`**) The following types and properties are supported: babel-call - :inside-header - :end-header dynamic-block - :arguments inline-babel-call - :inside-header - :end-header inline-src-block - :parameters ```el ;; Given the following contents: ; #+call: ktulu[:cache no]() (org-ml->> (org-ml-parse-this-element) (org-ml-plist-put-property :end-header :results 'html) (org-ml-to-trimmed-string)) ;; => "#+call: ktulu[:cache no]() :results html" ;; Change the value of key if it already is present (org-ml->> (org-ml-parse-this-element) (org-ml-plist-put-property :inside-header :cache 'yes) (org-ml-to-trimmed-string)) ;; => "#+call: ktulu[:cache yes]()" ;; Do nothing if the key and value already exist (org-ml->> (org-ml-parse-this-element) (org-ml-plist-put-property :inside-header :cache 'no) (org-ml-to-trimmed-string)) ;; => "#+call: ktulu[:cache no]()" ;; Throw error if setting property that isn't a plist (org-ml->> (org-ml-parse-this-element) (org-ml-plist-put-property :arguments :cache 'no) (org-ml-to-trimmed-string)) Error ``` #### org-ml-plist-remove-property `(prop key node)` Return **`node`** with **`key`** and its corresponding value removed from **`prop`**. **`key`** is a keyword. This only applies to properties that are represented as plists. See [`org-ml-plist-put-property`](#org-ml-plist-put-property-prop-key-value-node) for a list of supported elements and properties that may be used with this function. ```el ;; Given the following contents: ; #+call: ktulu() :results html (org-ml->> (org-ml-parse-this-element) (org-ml-plist-remove-property :end-header :results) (org-ml-to-trimmed-string)) ;; => "#+call: ktulu()" ;; Do nothing if the key is not present (org-ml->> (org-ml-parse-this-element) (org-ml-plist-remove-property :inside-header :cache) (org-ml-to-trimmed-string)) ;; => "#+call: ktulu() :results html" ;; Throw error if trying to remove key from non-plist property (org-ml->> (org-ml-parse-this-element) (org-ml-plist-remove-property :arguments :cache) (org-ml-to-trimmed-string)) Error ``` #### org-ml-get-properties `(props node)` Return all the values of **`props`** from **`node`**. **`props`** is a list of all the properties desired, and the returned list will be the values of these properties in the order requested. To get all properties of **`node`**, use `org-ml--get-all-properties`. ```el ;; Given the following contents: ; call_ktulu[:cache no](x=4)[:exports results] (->> (org-ml-parse-this-object) (org-ml-get-properties '(:call :inside-header :arguments :end-header))) ;; => '("ktulu" (:cache no) ("x=4") (:exports results)) ``` #### org-ml-get-all-properties `(node)` Return the properties list of **`node`**. ```el ;; Given the following contents: ; *bold* (--> (org-ml-parse-this-object) (org-ml-get-all-properties it) (plist-put it :buffer nil) (plist-put it :parent nil)) ;; => (list :begin 1 :post-affiliated nil :contents-begin 2 :contents-end 6 :end 7 :post-blank 0 :secondary nil :mode nil :granularity nil :cached nil :org-element--cache-sync-key nil :robust-begin nil :robust-end nil :true-level nil :buffer nil :deferred nil :structure nil :parent nil) ``` #### org-ml-set-properties `(plist node)` Return **`node`** with all properties set to the values according to **`plist`**. **`plist`** is a list of property-value pairs that corresponds to the property list in **`node`**. See builder functions for a list of properties and their rules for each type. ```el ;; Given the following contents: ; - thing (org-ml->> (org-ml-parse-this-item) (org-ml-set-properties (list :bullet 1 :checkbox 'on :counter 2 :tag '("tmsu"))) (org-ml-to-trimmed-string)) ;; => "1. [@2] [X] tmsu :: thing" ;; Given the following contents: ; - plain (org-ml->> (org-ml-parse-this-element) (org-ml-set-properties (list :name "plain name" :attr_XXX '("tmsu"))) (org-ml-to-trimmed-string)) ;; => "#+name: plain name ; #+attr_xxx: tmsu ; - plain" ``` #### org-ml-map-properties `(plist node)` Return **`node`** with functions applied to the values of properties. **`plist`** is a property list where the keys are properties of **`node`** and its values are unary functions to be mapped to these properties. See builder functions for a list of properties and their rules for each type. ```el ;; Given the following contents: ; #+KEY: VAL (org-ml->> (org-ml-parse-this-element) (org-ml-map-properties (list :key (-partial #'s-prepend "OM_") :value (-partial #'s-prepend "OM_"))) (org-ml-to-trimmed-string)) ;; => "#+om_key: OM_VAL" ;; Throw error if any of the properties are invalid (org-ml->> (org-ml-parse-this-element) (org-ml-map-properties* (:title (s-prepend "OM_" it) :value (s-prepend "OM_" it))) (org-ml-to-trimmed-string)) Error ``` #### org-ml-get-parents `(node)` Return parents of **`node`** as a list. The toplevel parent will be the left-most member, and **`node`** itself will be the rightmost member. ```el ;; Given the following contents: ; * one ; ** two ; *** three (->> (org-ml-parse-this-subtree) (org-ml-get-parents) (--map (org-ml-get-property :begin it))) ;; => '(1) (->> (org-ml-parse-this-subtree) (org-ml-headline-get-subheadlines) (car) (org-ml-headline-get-subheadlines) (car) (org-ml-get-parents) (--map (org-ml-get-property :begin it))) ;; => '(1 7 14) ``` #### org-ml-remove-parent `(node)` Return **`node`** with the :parent property set to nil. Short synopsis: Use this function to declutter a node if you are trying to print its literal list representation or you are running into infinite loops caused by self-referential lists (there are probably other valid reasons but these are the main ones). Gory details: The :parent property refers to the node one level higher in the tree that contains **`node`** as a child. It will be present in a node that is generated from a parse operation with `org-ml-parse-this-buffer` or related. This property offers a nice shortcut to traverse up the node tree from a child. Besides this, it is not necessary as the tree structure itself already encodes all parent-child relationships. Further, it is not used by org-element internally to convert nodes into strings (such as with [`org-ml-to-string`](#org-ml-to-string-node)) and thus can be thought of as a `"read-only"` property. This is why :parent will be set to nil when building a new node with the `"org-ml-build-"` family of functions and why [`org-ml-set-property`](#org-ml-set-property-prop-value-node) forbids setting this property. In many cases, one can safely ignore :parent unless, of course, one actually needs to read it with [`org-ml-get-parents`](#org-ml-get-parents-node) or [`org-ml-get-property`](#org-ml-get-property-prop-node). However, it heavily clutters the list representation of nodes, and therefore it is nice to remove this property whenever literal node lists are printed/visualized (eg for debugging). Note that for deep trees, each parent will itself have a :parent property pointing to its own parent, with this pattern repeating until the top of the tree. Furthermore, each parent will itself contain its own child node, which implies a circular/self-referential list. For the most part, this won't matter. However, some functions don't like dealing with circular lists and will complain about infinite recursion. If this is happening, the :parent property is likely to blame, and setting it to nil has a high probability of fixing the issue. ```el ;; Given the following contents: ; one ;; This is actually a paragraph node, but parsing the object will directly ;; return a plain-text node with the :parent pointing to the paragraph (org-ml->> (org-ml-parse-this-object) (org-ml-remove-parent)) ;; => "one" ;; Given the following contents: ; * headline (org-ml->> (org-ml-parse-this-element) (org-ml-remove-parents) (org-ml-get-property :parent)) ;; => nil ;; Given the following contents: ; - tag :: thingy ``` ### Clock #### org-ml-clock-is-running `(clock)` Return t if **`clock`** element is running (eg is open). ```el ;; Given the following contents: ; CLOCK: [2019-01-01 Tue 00:00] (->> (org-ml-parse-this-element) (org-ml-clock-is-running)) ;; => t ;; Given the following contents: ; CLOCK: [2019-01-01 Tue 00:00]--[2019-01-02 Wed 00:00] => 24:00 (->> (org-ml-parse-this-element) (org-ml-clock-is-running)) ;; => nil ``` ### Entity #### org-ml-entity-get-replacement `(key entity)` Return replacement string or symbol for **`entity`** node. **`key`** is one of: - `:latex` (the entity's latex representation) - `:latex-math-p` (t if the latex representation requires math mode, nil otherwise) - `:html` (the entity's html representation) - `:ascii` (the entity's ascii representation) - `:latin1` (the entity's Latin1 representation) - `:utf-8` (the entity's utf8 representation) Any other keys will trigger an error. ```el ;; Given the following contents: ; \pi{} (->> (org-ml-parse-this-object) (org-ml-entity-get-replacement :latex)) ;; => "\\pi" (->> (org-ml-parse-this-object) (org-ml-entity-get-replacement :latex-math-p)) ;; => t (->> (org-ml-parse-this-object) (org-ml-entity-get-replacement :html)) ;; => "π" (->> (org-ml-parse-this-object) (org-ml-entity-get-replacement :ascii)) ;; => "pi" (->> (org-ml-parse-this-object) (org-ml-entity-get-replacement :latin1)) ;; => "pi" (->> (org-ml-parse-this-object) (org-ml-entity-get-replacement :utf-8)) ;; => "π" ``` ### Headline #### org-ml-headline-set-title! `(title-text stats-cookie-value headline)` Return **`headline`** node with new title. **`title-text`** is a string to be parsed into object nodes for the title via [`org-ml-build-secondary-string!`](#org-ml-build-secondary-string-string) (see that function for restrictions) and **`stats-cookie-value`** is a list described in [`org-ml-build-statistics-cookie`](#org-ml-build-statistics-cookie-value-key-post-blank). ```el ;; Given the following contents: ; * really impressive title (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-title! "really *impressive* title" '(2 3)) (org-ml-to-trimmed-string)) ;; => "* really *impressive* title [2/3]" ``` #### org-ml-headline-is-done `(headline)` Return t if **`headline`** node has a done todo-keyword. ```el ;; Given the following contents: ; * TODO darn (->> (org-ml-parse-this-headline) (org-ml-headline-is-done)) ;; => nil ;; Given the following contents: ; * DONE yay (->> (org-ml-parse-this-headline) (org-ml-headline-is-done)) ;; => t ``` #### org-ml-headline-has-tag `(tag headline)` Return t if **`headline`** node is tagged with **`tag`**. ```el ;; Given the following contents: ; * dummy (->> (org-ml-parse-this-headline) (org-ml-headline-has-tag "tmsu")) ;; => nil ;; Given the following contents: ; * dummy :tmsu: (->> (org-ml-parse-this-headline) (org-ml-headline-has-tag "tmsu")) ;; => t ``` #### org-ml-headline-get-statistics-cookie `(headline)` Return the statistics cookie node from **`headline`** if it exists. ```el ;; Given the following contents: ; * statistically significant [10/10] (->> (org-ml-parse-this-headline) (org-ml-headline-get-statistics-cookie) (org-ml-to-string)) ;; => "[10/10]" ;; Given the following contents: ; * not statistically significant (->> (org-ml-parse-this-headline) (org-ml-headline-get-statistics-cookie)) ;; => nil ``` ### Item #### org-ml-item-toggle-checkbox `(item)` Return **`item`** node with its checkbox state flipped. This only affects item nodes with checkboxes in the `on` or `off` states; return **`item`** node unchanged if the checkbox property is `trans` or nil. ```el ;; Given the following contents: ; - [ ] one (org-ml->> (org-ml-parse-this-item) (org-ml-item-toggle-checkbox) (org-ml-to-trimmed-string)) ;; => "- [X] one" ;; Given the following contents: ; - [-] one ;; Ignore trans state checkboxes (org-ml->> (org-ml-parse-this-item) (org-ml-item-toggle-checkbox) (org-ml-to-trimmed-string)) ;; => "- [-] one" ;; Given the following contents: ; - one ;; Do nothing if there is no checkbox (org-ml->> (org-ml-parse-this-item) (org-ml-item-toggle-checkbox) (org-ml-to-trimmed-string)) ;; => "- one" ``` ### Statistics Cookie #### org-ml-statistics-cookie-is-complete `(statistics-cookie)` Return t is **`statistics-cookie`** node is complete. ```el ;; Given the following contents: ; * statistically significant [10/10] (->> (org-ml-parse-this-headline) (org-ml-headline-get-statistics-cookie) (org-ml-statistics-cookie-is-complete)) ;; => t ;; Given the following contents: ; * statistically significant [1/10] (->> (org-ml-parse-this-headline) (org-ml-headline-get-statistics-cookie) (org-ml-statistics-cookie-is-complete)) ;; => nil ;; Given the following contents: ; * statistically significant [100%] (->> (org-ml-parse-this-headline) (org-ml-headline-get-statistics-cookie) (org-ml-statistics-cookie-is-complete)) ;; => t ;; Given the following contents: ; * statistically significant [33%] (->> (org-ml-parse-this-headline) (org-ml-headline-get-statistics-cookie) (org-ml-statistics-cookie-is-complete)) ;; => nil ``` #### org-ml-timestamp-get-start-time `(timestamp)` Return the time list for start time of **`timestamp`** node. The return value will be a list as specified by the `time` argument in [`org-ml-build-timestamp!`](#org-ml-build-timestamp-start-key-end-active-repeater-deadline-warning-collapsed-post-blank). ```el ;; Given the following contents: ; [2019-01-01 Tue] (->> (org-ml-parse-this-object) (org-ml-timestamp-get-start-time)) ;; => '(2019 1 1 nil nil) ;; Given the following contents: ; [2019-01-01 Tue]--[2019-01-02 Wed] (->> (org-ml-parse-this-object) (org-ml-timestamp-get-start-time)) ;; => '(2019 1 1 nil nil) ;; Given the following contents: ; [2019-01-01 Tue 00:00-12:00] (->> (org-ml-parse-this-object) (org-ml-timestamp-get-start-time)) ;; => '(2019 1 1 0 0) ``` #### org-ml-timestamp-get-end-time `(timestamp)` Return the end time list for end time of **`timestamp`** or nil if not a range. The return value will be a list as specified by the `time` argument in [`org-ml-build-timestamp!`](#org-ml-build-timestamp-start-key-end-active-repeater-deadline-warning-collapsed-post-blank). ```el ;; Given the following contents: ; [2019-01-01 Tue] (->> (org-ml-parse-this-object) (org-ml-timestamp-get-end-time)) ;; => nil ;; Given the following contents: ; [2019-01-01 Tue]--[2019-01-02 Wed] (->> (org-ml-parse-this-object) (org-ml-timestamp-get-end-time)) ;; => '(2019 1 2 nil nil) ;; Given the following contents: ; [2019-01-01 Tue]--[2019-01-01 Tue] (->> (org-ml-parse-this-object) (org-ml-timestamp-get-end-time)) ;; => '(2019 1 1 nil nil) ;; Given the following contents: ; [2019-01-01 Tue 00:00-12:00] (->> (org-ml-parse-this-object) (org-ml-timestamp-get-end-time)) ;; => '(2019 1 1 12 0) ``` #### org-ml-timestamp-get-range `(timestamp)` Return the range of **`timestamp`** node in seconds as an integer. If non-ranged, this function will return 0. If ranged but the start time is in the future relative to end the time, return a negative integer. This function is depreciated. Use `org-ml-timestamp-get-length` instead. ```el ;; Given the following contents: ; [2019-01-01 Tue] (->> (org-ml-parse-this-object) (org-ml-timestamp-get-range)) ;; => 0 ;; Given the following contents: ; [2019-01-01 Tue]--[2019-01-02 Wed] (->> (org-ml-parse-this-object) (org-ml-timestamp-get-range)) ;; => 86400 ;; Given the following contents: ; [2019-01-01 Tue 00:00-12:00] (->> (org-ml-parse-this-object) (org-ml-timestamp-get-range)) ;; => 43200 ``` #### org-ml-timestamp-is-active `(timestamp)` Return t if **`timestamp`** node is active. ```el ;; Given the following contents: ; <2019-01-01 Tue> (->> (org-ml-parse-this-object) (org-ml-timestamp-is-active)) ;; => t ;; Given the following contents: ; [2019-01-01 Tue] (->> (org-ml-parse-this-object) (org-ml-timestamp-is-active)) ;; => nil ``` #### org-ml-timestamp-is-ranged `(timestamp)` Return t if **`timestamp`** node is ranged. ```el ;; Given the following contents: ; [2019-01-01 Tue]--[2019-01-02 Wed] (->> (org-ml-parse-this-object) (org-ml-timestamp-is-ranged)) ;; => t ;; Given the following contents: ; [2019-01-01 Tue 00:00-12:00] (->> (org-ml-parse-this-object) (org-ml-timestamp-is-ranged)) ;; => t ;; Given the following contents: ; [2019-01-01 Tue] (->> (org-ml-parse-this-object) (org-ml-timestamp-is-ranged)) ;; => nil ``` #### org-ml-timestamp-range-contains-p `(unixtime timestamp)` Return t if **`unixtime`** is between start and end time of **`timestamp`** node. The boundaries are inclusive. If **`timestamp`** has a range of zero, then only return t if **`unixtime`** is the same as **`timestamp`**. **`timestamp`** will be interpreted according to the localtime of the operating system. ```el ;; Given the following contents: ; [2019-01-01 Tue 00:00] (let ((ut (org-ml-timelist-to-unixtime '(2019 1 1 0 0)))) (->> (org-ml-parse-this-object) (org-ml-timestamp-range-contains-p ut))) ;; => t (let ((ut (org-ml-timelist-to-unixtime '(2019 1 1 0 30)))) (->> (org-ml-parse-this-object) (org-ml-timestamp-range-contains-p ut))) ;; => nil ;; Given the following contents: ; [2019-01-01 Tue 00:00-01:00] (let ((ut (org-ml-timelist-to-unixtime '(2019 1 1 0 30)))) (->> (org-ml-parse-this-object) (org-ml-timestamp-range-contains-p ut))) ;; => t ``` #### org-ml-timestamp-set-collapsed `(flag timestamp)` Return **`timestamp`** with collapsed set to **`flag`**. Collapsed timestamps are like [yyyy-mm-dd xxx hh:mm-hh:mm]. Uncollapsed timestamp are like [yyyy-mm-dd xxx hh:mm]--[yyyy-mm-dd xxx hh:mm]. **`flag`** may be one of nil, t, or `force`. If nil, uncollapse the timestamp if it is collapsed. The dates in the uncollapsed timestamp will be the same. Has no effect if the timestamp is not collapsed. If t, collapse the timestamp from uncollapsed format if the following conditions are met: 1. the dates are the same 2. start and end hours/minutes are non-nil Has no effect if timestamp id not uncollapsed and these conditions are not met. If `force`, ignore condition 1 above. The date in the collapsed timestamp will be taken from the start date and the end date will be ignored. ```el ;; Given the following contents: ; [2019-01-01 Tue 12:00-13:00] (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-collapsed nil) (org-ml-to-trimmed-string)) ;; => "[2019-01-01 Tue 12:00]--[2019-01-01 Tue 13:00]" ;; Given the following contents: ; [2019-01-01 Tue 12:00-13:00] (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-collapsed nil) (org-ml-timestamp-set-collapsed t) (org-ml-to-trimmed-string)) ;; => "[2019-01-01 Tue 12:00-13:00]" ;; Given the following contents: ; [2019-01-01 Tue 12:00] (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-collapsed nil) (org-ml-to-trimmed-string)) ;; => "[2019-01-01 Tue 12:00]" ;; Given the following contents: ; [2019-01-01 Tue]--[2019-01-02 Wed] (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-collapsed nil) (org-ml-to-trimmed-string)) ;; => "[2019-01-01 Tue]--[2019-01-02 Wed]" ``` #### org-ml-timestamp-get-warning `(timestamp)` Return the warning component of **`timestamp`**. Return a list like `(type value unit)`. ```el ;; Given the following contents: ; [2019-01-01 Tue 12:00] (->> (org-ml-parse-this-object) (org-ml-timestamp-get-warning)) ;; => nil ;; Given the following contents: ; [2019-01-01 Tue 12:00 -1d] (->> (org-ml-parse-this-object) (org-ml-timestamp-get-warning)) ;; => '(all 1 day) ``` #### org-ml-timestamp-set-warning `(warning timestamp)` Set the warning of **`timestamp`** to **`warning`**. **`warning`** is a list like `(type value unit)`. `type` is `all` or `first` `value` and is an integer. `unit` is one of `year`, `month`, `week`, or `day`. ```el ;; Given the following contents: ; [2019-01-01 Tue 12:00] (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-warning nil) (org-ml-to-string)) ;; => "[2019-01-01 Tue 12:00]" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-warning '(all 1 day)) (org-ml-to-string)) ;; => "[2019-01-01 Tue 12:00 -1d]" ;; Given the following contents: ; [2019-01-01 Tue 12:00] (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-warning nil) (org-ml-to-string)) ;; => "[2019-01-01 Tue 12:00]" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-warning '(all 1 year)) (org-ml-to-string)) ;; => "[2019-01-01 Tue 12:00 -1y]" ``` #### org-ml-timestamp-map-warning `(fun timestamp)` Apply **`fun`** to the warning of **`timestamp`**. **`fun`** is a function that takes a warning list like and returns a new warning list. The same rules that apply to [`org-ml-timestamp-set-warning`](#org-ml-timestamp-set-warning-warning-timestamp) and [`org-ml-timestamp-get-warning`](#org-ml-timestamp-get-warning-timestamp) apply here. ```el ;; Given the following contents: ; [2019-01-01 Tue 12:00 -1d] (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-map-warning* (-let (((y v u) it)) `(,y ,(1+ v) ,u))) (org-ml-to-string)) ;; => "[2019-01-01 Tue 12:00 -2d]" ``` #### org-ml-timestamp-get-repeater `(timestamp)` Return the repeater component of **`timestamp`**. Return a list like `(type value unit)` or nil. ```el ;; Given the following contents: ; [2019-01-01 Tue 12:00] (->> (org-ml-parse-this-object) (org-ml-timestamp-get-repeater)) ;; => nil ;; Given the following contents: ; [2019-01-01 Tue 12:00 +1d] (->> (org-ml-parse-this-object) (org-ml-timestamp-get-repeater)) ;; => '(cumulate 1 day) ;; Given the following contents: ; [2019-01-01 Tue 12:00 +1d/3d] (->> (org-ml-parse-this-object) (org-ml-timestamp-get-repeater)) ;; => '(cumulate 1 day) ``` #### org-ml-timestamp-get-deadline `(timestamp)` Return the repeater component of **`timestamp`**. Return a list like `(value unit)` or nil. ```el ;; Given the following contents: ; [2019-01-01 Tue 12:00] (->> (org-ml-parse-this-object) (org-ml-timestamp-get-deadline)) ;; => nil ;; Given the following contents: ; [2019-01-01 Tue 12:00 +1d] (->> (org-ml-parse-this-object) (org-ml-timestamp-get-deadline)) ;; => nil ;; Given the following contents: ; [2019-01-01 Tue 12:00 +1d/3d] (->> (org-ml-parse-this-object) (org-ml-timestamp-get-deadline)) ;; => '(3 day) ``` #### org-ml-timestamp-set-repeater `(repeater timestamp)` Set the repeater of **`timestamp`** to **`repeater`**. **`repeater`** is a list like `(type value unit)`; `type` is one of `cumulate`, `restart`, or `catch-up`. `value` is an integer. `unit` is one of `year`, `month`, `week`, or `day`. Setting **`repeater`** to nil will remove the repeater and its deadline if present. ```el ;; Given the following contents: ; [2019-01-01 Tue 12:00] (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-repeater nil) (org-ml-to-string)) ;; => "[2019-01-01 Tue 12:00]" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-repeater '(restart 1 day)) (org-ml-to-string)) ;; => "[2019-01-01 Tue 12:00 .+1d]" ``` #### org-ml-timestamp-set-deadline `(deadline timestamp)` Set the repeater of **`timestamp`** to **`deadline`**. **`deadline`** is a list like `(value unit)`; `value` is an integer. `unit` is one of `year`, `month`, `week`, or `day`. Setting **`deadline`** to nil will remove the deadline. Will have no effect if repeater is not present. ```el ;; Given the following contents: ; [2019-01-01 Tue 12:00] (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-deadline nil) (org-ml-to-string)) ;; => "[2019-01-01 Tue 12:00]" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-deadline '(3 day)) (org-ml-to-string)) ;; => "[2019-01-01 Tue 12:00]" ;; Given the following contents: ; [2019-01-01 Tue 12:00 .+1d] (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-deadline nil) (org-ml-to-string)) ;; => "[2019-01-01 Tue 12:00 .+1d]" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-deadline '(3 day)) (org-ml-to-string)) ;; => "[2019-01-01 Tue 12:00 .+1d/3d]" ``` #### org-ml-timestamp-map-repeater `(fun timestamp)` Apply **`fun`** to the warning of **`timestamp`**. **`fun`** is a function that takes a repeater list like and returns a new repeater list. The same rules that apply to [`org-ml-timestamp-set-repeater`](#org-ml-timestamp-set-repeater-repeater-timestamp) and [`org-ml-timestamp-get-repeater`](#org-ml-timestamp-get-repeater-timestamp) apply here. ```el ;; Given the following contents: ; [2019-01-01 Tue 12:00 +1d] (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-map-repeater* (-let (((y v u) it)) `(,y ,(1+ v) ,u))) (org-ml-to-string)) ;; => "[2019-01-01 Tue 12:00 +2d]" ``` #### org-ml-timestamp-set-start-time `(time timestamp)` Return **`timestamp`** node with start time set to **`time`**. **`time`** is a list analogous to the same argument specified in [`org-ml-build-timestamp!`](#org-ml-build-timestamp-start-key-end-active-repeater-deadline-warning-collapsed-post-blank). ```el ;; Given the following contents: ; [2019-01-02 Wed] ;; If not a range this will turn into a range by moving only the start time. (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-start-time '(2019 1 1)) (org-ml-to-trimmed-string)) ;; => "[2019-01-01 Tue]--[2019-01-02 Wed]" ;; Set a different time with different precision. (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-start-time '(2019 1 1 10 0)) (org-ml-to-trimmed-string)) ;; => "[2019-01-01 Tue 10:00]--[2019-01-02 Wed]" ;; Given the following contents: ; [2019-01-02 Wed 12:00] ;; If not a range and set within a day, use short format (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-start-time '(2019 1 2 0 0)) (org-ml-to-trimmed-string)) ;; => "[2019-01-02 Wed 00:00-12:00]" ``` #### org-ml-timestamp-set-end-time `(time timestamp)` Return **`timestamp`** node with end time set to **`time`**. **`time`** is a list analogous to the same argument specified in [`org-ml-build-timestamp!`](#org-ml-build-timestamp-start-key-end-active-repeater-deadline-warning-collapsed-post-blank). ```el ;; Given the following contents: ; [2019-01-01 Tue] ;; Add the end time (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-end-time '(2019 1 2)) (org-ml-to-trimmed-string)) ;; => "[2019-01-01 Tue]--[2019-01-02 Wed]" ;; Given the following contents: ; [2019-01-01 Tue]--[2019-01-02 Wed] ;; Remove the end time (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-end-time nil) (org-ml-to-trimmed-string)) ;; => "[2019-01-01 Tue]" ;; Given the following contents: ; [2019-01-01 Tue 12:00] ;; Use short range format (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-end-time '(2019 1 1 13 0)) (org-ml-to-trimmed-string)) ;; => "[2019-01-01 Tue 12:00-13:00]" ``` #### org-ml-timestamp-set-single-time `(time timestamp)` Return **`timestamp`** node with start and end times set to **`time`**. **`time`** is a list analogous to the same argument specified in [`org-ml-build-timestamp!`](#org-ml-build-timestamp-start-key-end-active-repeater-deadline-warning-collapsed-post-blank). ```el ;; Given the following contents: ; [2019-01-01 Tue] ;; Don't make a range (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-single-time '(2019 1 2)) (org-ml-to-trimmed-string)) ;; => "[2019-01-02 Wed]" ;; Given the following contents: ; [2019-01-01 Tue]--[2019-01-02 Wed] ;; Output is not a range despite input being ranged (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-single-time '(2019 1 3)) (org-ml-to-trimmed-string)) ;; => "[2019-01-03 Thu]" ``` #### org-ml-timestamp-set-double-time `(time1 time2 timestamp)` Return **`timestamp`** node with start/end times set to **`time1`**/**`time2`** respectively. **`time1`** and **`time2`** are lists analogous to the `time` argument specified in [`org-ml-build-timestamp!`](#org-ml-build-timestamp-start-key-end-active-repeater-deadline-warning-collapsed-post-blank). ```el ;; Given the following contents: ; [2019-01-01 Tue] ;; Make a range (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-double-time '(2019 1 2) '(2019 1 3)) (org-ml-to-trimmed-string)) ;; => "[2019-01-02 Wed]--[2019-01-03 Thu]" ;; Given the following contents: ; [2019-01-01 Tue]--[2019-01-03 Wed] (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-double-time '(2019 1 4) '(2019 1 5)) (org-ml-to-trimmed-string)) ;; => "[2019-01-04 Fri]--[2019-01-05 Sat]" ;; Given the following contents: ; [2019-01-01 Tue]--[2019-01-03 Wed] (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-double-time '(2019 1 1 0 0) '(2019 1 1 1 0)) (org-ml-to-trimmed-string)) ;; => "[2019-01-01 Tue 00:00]--[2019-01-01 Tue 01:00]" ``` #### org-ml-timestamp-set-range `(n timestamp)` Return **`timestamp`** node with range set to **`n`** seconds. If **`timestamp`** is ranged, keep start time the same and adjust the end time. If not, make a new end time. The units for `range` are in minutes if **`timestamp`** is in long format and days if **`timestamp`** is in short format. This function is depreciated. Use `org-ml-timestamp-set-length` instead. ```el ;; Given the following contents: ; [2019-01-01 Tue] ;; Use days as the unit for short format (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-range 1 'day) (org-ml-to-trimmed-string)) ;; => "[2019-01-01 Tue]--[2019-01-02 Wed]" ;; Given the following contents: ; [2019-01-01 Tue 00:00] ;; Use minutes as the unit for long format (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-range 3 'minute) (org-ml-to-trimmed-string)) ;; => "[2019-01-01 Tue 00:00-00:03]" ;; Given the following contents: ; [2019-01-01 Tue]--[2019-01-03 Wed] ;; Set range to 0 to remove end time (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-range 0 'day) (org-ml-to-trimmed-string)) ;; => "[2019-01-01 Tue]" ``` #### org-ml-timestamp-set-active `(flag timestamp)` Return **`timestamp`** node with active type if **`flag`** is t. ```el ;; Given the following contents: ; [2019-01-01 Tue] (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-active t) (org-ml-to-trimmed-string)) ;; => "<2019-01-01 Tue>" ;; Given the following contents: ; <2019-01-01 Tue> (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-set-active nil) (org-ml-to-trimmed-string)) ;; => "[2019-01-01 Tue]" ``` #### org-ml-timestamp-shift `(n unit timestamp)` Return **`timestamp`** node with time shifted by **`n`** **`unit`**`s. This function will move the start and end times together; therefore ranged inputs will always output ranged timestamps and same for non-ranged. To move the start and end time independently, use [`org-ml-timestamp-shift-start`](#org-ml-timestamp-shift-start-n-unit-timestamp) or [`org-ml-timestamp-shift-end`](#org-ml-timestamp-shift-end-n-unit-timestamp). **`n`** is a positive or negative integer and **`unit`** is one of `minute`, `hour`, `day`, `month`, or `year`. Overflows will wrap around transparently; for instance, supplying `minute` for **`unit`** and 90 for **`n`** will increase the hour property by 1 and the minute property by 30. ```el ;; Given the following contents: ; [2019-01-01 Tue 12:00] ;; Change each unit, and wrap around to the next unit as needed. (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-shift 30 'minute) (org-ml-to-trimmed-string)) ;; => "[2019-01-01 Tue 12:30]" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-shift 13 'month) (org-ml-to-trimmed-string)) ;; => "[2020-02-01 Sat 12:00]" ;; Given the following contents: ; [2019-01-01 Tue] ;; Error when shifting hour/minute in short format (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-shift 30 'minute) (org-ml-to-trimmed-string)) Error ``` #### org-ml-timestamp-shift-start `(n unit timestamp)` Return **`timestamp`** node with start time shifted by **`n`** **`unit`**`s. **`n`** and **`unit`** behave the same as those in [`org-ml-timestamp-shift`](#org-ml-timestamp-shift-n-unit-timestamp). If **`timestamp`** is not range, the output will be a ranged timestamp with the shifted start time and the end time as that of **`timestamp`**. If this behavior is not desired, use [`org-ml-timestamp-shift`](#org-ml-timestamp-shift-n-unit-timestamp). ```el ;; Given the following contents: ; [2019-01-01 Tue 12:00] ;; If not a range, change start time and leave implicit end time. (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-shift-start -1 'year) (org-ml-to-trimmed-string)) ;; => "[2018-01-01 Mon 12:00]--[2019-01-01 Tue 12:00]" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-shift-start -1 'hour) (org-ml-to-trimmed-string)) ;; => "[2019-01-01 Tue 11:00-12:00]" ;; Given the following contents: ; [2019-01-01 Tue]--[2019-01-03 Thu] ;; Change only start time if a range (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-shift-start 1 'day) (org-ml-to-trimmed-string)) ;; => "[2019-01-02 Wed]--[2019-01-03 Thu]" ``` #### org-ml-timestamp-shift-end `(n unit timestamp)` Return **`timestamp`** node with end time shifted by **`n`** **`unit`**`s. **`n`** and **`unit`** behave the same as those in [`org-ml-timestamp-shift`](#org-ml-timestamp-shift-n-unit-timestamp). If **`timestamp`** is not range, the output will be a ranged timestamp with the shifted end time and the start time as that of **`timestamp`**. If this behavior is not desired, use [`org-ml-timestamp-shift`](#org-ml-timestamp-shift-n-unit-timestamp). ```el ;; Given the following contents: ; [2019-01-01 Tue] ;; Shift implicit end time if not a range. (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-shift-end 1 'day) (org-ml-to-trimmed-string)) ;; => "[2019-01-01 Tue]--[2019-01-02 Wed]" ;; Given the following contents: ; [2019-01-01 Tue]--[2019-01-02 Wed] ;; Move only the second time if a range. (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-shift-end 1 'day) (org-ml-to-trimmed-string)) ;; => "[2019-01-01 Tue]--[2019-01-03 Thu]" ``` #### org-ml-timestamp-toggle-active `(timestamp)` Return **`timestamp`** node with its active/inactive type flipped. ```el ;; Given the following contents: ; [2019-01-01 Tue] (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-toggle-active) (org-ml-to-trimmed-string)) ;; => "<2019-01-01 Tue>" ;; Given the following contents: ; <2019-01-01 Tue>--<2019-01-02 Wed> (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-toggle-active) (org-ml-to-trimmed-string)) ;; => "[2019-01-01 Tue]--[2019-01-02 Wed]" ``` #### org-ml-timestamp-truncate `(timestamp)` Return **`timestamp`** node with start/end times forced to short format. ```el ;; Given the following contents: ; [2019-01-01 Tue]--[2019-01-02 Wed] (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-truncate) (org-ml-to-trimmed-string)) ;; => "[2019-01-01 Tue]--[2019-01-02 Wed]" ;; Given the following contents: ; [2019-01-01 Tue 12:00]--[2019-01-02 Wed 13:00] (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-truncate) (org-ml-to-trimmed-string)) ;; => "[2019-01-01 Tue]--[2019-01-02 Wed]" ``` #### org-ml-timestamp-truncate-start `(timestamp)` Return **`timestamp`** node with start time forced to short format. Collapsed timestamps will become uncollapsed. ```el ;; Given the following contents: ; [2019-01-01 Tue 12:00] (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-truncate-start) (org-ml-to-trimmed-string)) ;; => "[2019-01-01 Tue]" ;; Given the following contents: ; [2019-01-01 Tue 12:00]--[2019-01-02 Wed 12:00] (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-truncate-start) (org-ml-to-trimmed-string)) ;; => "[2019-01-01 Tue]--[2019-01-02 Wed 12:00]" ;; Given the following contents: ; [2019-01-01 Tue] (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-truncate-start) (org-ml-to-trimmed-string)) ;; => "[2019-01-01 Tue]" ``` #### org-ml-timestamp-truncate-end `(timestamp)` Return **`timestamp`** node with end time forced to short format. Collapsed timestamps will become uncollapsed. ```el ;; Given the following contents: ; [2019-01-01 Tue]--[2019-01-02 Wed] (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-truncate-end) (org-ml-to-trimmed-string)) ;; => "[2019-01-01 Tue]--[2019-01-02 Wed]" ;; Given the following contents: ; [2019-01-01 Tue 12:00]--[2019-01-02 Wed 13:00] (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-truncate-end) (org-ml-to-trimmed-string)) ;; => "[2019-01-01 Tue 12:00]--[2019-01-02 Wed]" ;; Given the following contents: ; [2019-01-01 Tue 12:00] (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-truncate-end) (org-ml-to-trimmed-string)) ;; => "[2019-01-01 Tue 12:00]" ``` ### Timestamp (diary) #### org-ml-timestamp-diary-set-value `(form timestamp-diary)` Return **`timestamp-diary`** node with value set to **`form`**. The node must have a type `eq` to `diary`. **`form`** is a quoted list. ```el ;; Given the following contents: ; <%%(diary-float t 4 2)> (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-value '(diary-float 1 3 2)) (org-ml-to-string)) ;; => "<%%(diary-float 1 3 2)>" ``` #### org-ml-timestamp-diary-set-single-time `(time timestamp-diary)` Return **`timestamp-diary`** node with start/end time set to **`time`**. The node must have a type `eq` to `diary`. **`time`** is a list like (hour min). If **`time`** is nil remove the time. ```el ;; Given the following contents: ; <%%(diary-float t 4 2)> (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-single-time '(0 0)) (org-ml-to-string)) ;; => "<%%(diary-float t 4 2) 00:00>" ;; Given the following contents: ; <%%(diary-float t 4 2) 00:01> (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-single-time nil) (org-ml-to-string)) ;; => "<%%(diary-float t 4 2)>" ``` #### org-ml-timestamp-diary-set-double-time `(time1 time2 timestamp-diary)` Return **`timestamp-diary`** node with time set to **`time1`** and **`time2`**. The node must have a type `eq` to `diary`. **`time1`** and **`time2`** are lists like (hour min). Either time may be nil, but if **`time1`** is nil then **`time2`** must also be nil. ```el ;; Given the following contents: ; <%%(diary-float t 4 2)> (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-double-time '(0 0) '(0 1)) (org-ml-to-string)) ;; => "<%%(diary-float t 4 2) 00:00-00:01>" ;; Given the following contents: ; <%%(diary-float t 4 2) 00:00-00:01> (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-double-time '(1 0) '(2 0)) (org-ml-to-string)) ;; => "<%%(diary-float t 4 2) 01:00-02:00>" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-double-time '(1 0) nil) (org-ml-to-string)) ;; => "<%%(diary-float t 4 2) 01:00>" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-double-time nil nil) (org-ml-to-string)) ;; => "<%%(diary-float t 4 2)>" (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-double-time nil '(2 0)) (org-ml-to-string)) Error ``` #### org-ml-timestamp-diary-get-start-time `(timestamp-diary)` Return start time for **`timestamp-diary`** or nil. ```el ;; Given the following contents: ; <%%(diary-float t 4 2)> (->> (org-ml-parse-this-object) (org-ml-timestamp-diary-get-start-time)) ;; => nil ;; Given the following contents: ; <%%(diary-float t 4 2) 12:00-13:00> (->> (org-ml-parse-this-object) (org-ml-timestamp-diary-get-start-time)) ;; => '(12 0) ``` #### org-ml-timestamp-diary-set-start-time `(time timestamp-diary)` Return **`timestamp-diary`** node with start time set to **`time`**. The node must have a type `eq` to `diary`. **`time`** is a list like (hour min). **`time`** may not be nil ```el ;; Given the following contents: ; <%%(diary-float t 4 2)> (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-start-time '(0 0)) (org-ml-to-string)) ;; => "<%%(diary-float t 4 2) 00:00>" ;; Given the following contents: ; <%%(diary-float t 4 2) 12:00> (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-start-time '(1 0)) (org-ml-to-string)) ;; => "<%%(diary-float t 4 2) 01:00-12:00>" ``` #### org-ml-timestamp-diary-get-end-time `(timestamp-diary)` Return end time for **`timestamp-diary`** or nil. ```el ;; Given the following contents: ; <%%(diary-float t 4 2)> (->> (org-ml-parse-this-object) (org-ml-timestamp-diary-get-end-time)) ;; => nil ;; Given the following contents: ; <%%(diary-float t 4 2) 12:00-13:00> (->> (org-ml-parse-this-object) (org-ml-timestamp-diary-get-end-time)) ;; => '(13 0) ``` #### org-ml-timestamp-diary-set-end-time `(time timestamp-diary)` Return **`timestamp-diary`** node with end time set to **`time`**. The node must have a type `eq` to `diary`. **`time`** is a list like (hour min). If **`time`** is nil then remove the end time. If start time is not set, return node unchanged. ```el ;; Given the following contents: ; <%%(diary-float t 4 2)> (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-end-time '(0 0)) (org-ml-to-string)) ;; => "<%%(diary-float t 4 2)>" ;; Given the following contents: ; <%%(diary-float t 4 2) 12:00> (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-end-time '(13 0)) (org-ml-to-string)) ;; => "<%%(diary-float t 4 2) 12:00-13:00>" ``` #### org-ml-timestamp-diary-set-length `(n unit timestamp-diary)` Return **`timestamp-diary`** node with range set to **`n`** UNITs. If **`timestamp-diary`** is ranged, keep start time the same and adjust the end time. If not, make a new end time. ```el ;; Given the following contents: ; <%%(diary-float t 4 2)> (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-length 1 'hour) (org-ml-to-string)) ;; => "<%%(diary-float t 4 2)>" ;; Given the following contents: ; <%%(diary-float t 4 2) 12:00> (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-length 1 'hour) (org-ml-to-string)) ;; => "<%%(diary-float t 4 2) 12:00-13:00>" ;; Given the following contents: ; <%%(diary-float t 4 2) 12:00-13:00> (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-set-length 0 'hour) (org-ml-to-string)) ;; => "<%%(diary-float t 4 2) 12:00>" ``` #### org-ml-timestamp-diary-shift `(n unit timestamp-diary)` Return **`timestamp-diary`** node with time shifted by **`n`** UNITs. This function will move the start and end times together; therefore ranged inputs will always output ranged timestamps and same for non-ranged. To move the start and end time independently, use [`org-ml-timestamp-diary-shift-start`](#org-ml-timestamp-diary-shift-start-n-unit-timestamp-diary) or [`org-ml-timestamp-shift-end`](#org-ml-timestamp-shift-end-n-unit-timestamp). **`n`** is a positive or negative integer and **`unit`** is one of `minute`, `hour`, `day`, `month`, or `year`. Overflows will wrap around transparently; for instance, supplying `minute` for **`unit`** and 90 for **`n`** will increase the hour property by 1 and the minute property by 30. ```el ;; Given the following contents: ; <%%(diary-float t 4 2)> (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-shift 1 'hour) (org-ml-to-string)) ;; => "<%%(diary-float t 4 2)>" ;; Given the following contents: ; <%%(diary-float t 4 2) 12:00> (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-shift 1 'hour) (org-ml-to-string)) ;; => "<%%(diary-float t 4 2) 13:00>" ``` #### org-ml-timestamp-diary-shift-start `(n unit timestamp-diary)` Return **`timestamp-diary`** node with start time shifted by **`n`** UNITs. **`n`** and **`unit`** behave the same as those in [`org-ml-timestamp-diary-shift`](#org-ml-timestamp-diary-shift-n-unit-timestamp-diary). If **`timestamp-diary`** is not range, the output will be a ranged timestamp with the shifted start time and the end time as that of **`timestamp-diary`**. If this behavior is not desired, use [`org-ml-timestamp-diary-shift`](#org-ml-timestamp-diary-shift-n-unit-timestamp-diary). ```el ;; Given the following contents: ; <%%(diary-float t 4 2)> (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-shift-start 1 'hour) (org-ml-to-string)) ;; => "<%%(diary-float t 4 2)>" ;; Given the following contents: ; <%%(diary-float t 4 2) 12:00> (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-shift-start -1 'hour) (org-ml-to-string)) ;; => "<%%(diary-float t 4 2) 11:00-12:00>" ``` #### org-ml-timestamp-diary-shift-end `(n unit timestamp-diary)` Return **`timestamp-diary`** node with end time shifted by **`n`** UNITs. **`n`** and **`unit`** behave the same as those in [`org-ml-timestamp-diary-shift`](#org-ml-timestamp-diary-shift-n-unit-timestamp-diary). If **`timestamp-diary`** is not range, the output will be a ranged timestamp with the shifted end time and the start time as that of **`timestamp-diary`**. If this behavior is not desired, use [`org-ml-timestamp-diary-shift`](#org-ml-timestamp-diary-shift-n-unit-timestamp-diary). ```el ;; Given the following contents: ; <%%(diary-float t 4 2)> (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-shift-end 1 'hour) (org-ml-to-string)) ;; => "<%%(diary-float t 4 2)>" ;; Given the following contents: ; <%%(diary-float t 4 2) 12:00> (org-ml->> (org-ml-parse-this-object) (org-ml-timestamp-diary-shift-end 1 'hour) (org-ml-to-string)) ;; => "<%%(diary-float t 4 2) 12:00-13:00>" ``` ## Branch/Child Manipulation Set, get, and map the children of branch nodes. ### Polymorphic #### org-ml-children-contain-point `(point branch-node)` Return t if **`point`** is within the boundaries of **`branch-node`**`s children. ```el ;; Given the following contents: ; * headline ; findme (->> (org-ml-parse-this-headline) (org-ml-children-contain-point 2)) ;; => nil (->> (org-ml-parse-this-headline) (org-ml-children-contain-point 15)) ;; => t ``` #### org-ml-get-children `(branch-node)` Return the children of **`branch-node`** as a list. ```el ;; Given the following contents: ; /this/ is a *paragraph* ;; Return child nodes for branch nodes (->> (org-ml-parse-this-element) (org-ml-get-children) (-map #'org-ml-get-type)) ;; => '(italic plain-text bold) ;; Given the following contents: ; * headline ;; Return nil if no children (->> (org-ml-parse-this-subtree) (org-ml-get-children) (-map #'org-ml-get-type)) ;; => nil ``` #### org-ml-set-children `(children branch-node)` Return **`branch-node`** with its children set to **`children`**. **`children`** is a list of nodes; the types permitted in this list depend on the type of `node`. ```el ;; Given the following contents: ; /this/ is a *paragraph* ;; Set children for branch object (org-ml->> (org-ml-parse-this-element) (org-ml-set-children (list "this is lame")) (org-ml-to-trimmed-string)) ;; => "this is lame" ;; Given the following contents: ; * headline ;; Set children for branch element nodes (org-ml->> (org-ml-parse-this-subtree) (org-ml-set-children (list (org-ml-build-headline! :title-text "only me" :level 2))) (org-ml-to-trimmed-string)) ;; => "* headline ; ** only me" ``` #### org-ml-map-children `(fun branch-node)` Return **`branch-node`** with **`fun`** applied to its children. **`fun`** is a unary function that takes the current list of children and returns a modified list of children. ```el ;; Given the following contents: ; /this/ is a *paragraph* (org-ml->> (org-ml-parse-this-element) (org-ml-map-children (lambda (objs) (append objs (list " ...yeah")))) (org-ml-to-trimmed-string)) ;; => "/this/ is a *paragraph* ...yeah" ;; Given the following contents: ; * headline ; ** subheadline (org-ml->> (org-ml-parse-this-subtree) (org-ml-map-children* (--map (org-ml-shift-property :level 1 it) it)) (org-ml-to-trimmed-string)) ;; => "* headline ; *** subheadline" ``` #### org-ml-is-childless `(branch-node)` Return t if **`branch-node`** has no children. ```el ;; Given the following contents: ; * dummy ; filled with useless knowledge (->> (org-ml-parse-this-headline) (org-ml-is-childless)) ;; => nil ;; Given the following contents: ; * dummy (->> (org-ml-parse-this-headline) (org-ml-is-childless)) ;; => t ``` ### Object Nodes #### org-ml-unwrap `(object-node)` Return the children of **`object-node`** as a secondary string. If **`object-node`** is a plain-text node, wrap it in a list and return. Else add the post-blank property of **`object-node`** to the last member of its children and return children as a secondary string. ```el ;; Given the following contents: ; _1 *2* 3 */4/* 5 /6/_ ;; Remove the outer underline formatting (org-ml->> (org-ml-parse-this-object) (org-ml-unwrap) (apply #'org-ml-build-paragraph) (org-ml-to-trimmed-string)) ;; => "1 *2* 3 */4/* 5 /6/" ``` #### org-ml-unwrap-types-deep `(types object-node)` Return the children of **`object-node`** as a secondary string. If **`object-node`** is a plain-text node, wrap it in a list and return. Else recursively descend into the children of **`object-node`** and splice the children of nodes with type in **`types`** in place of said node and return the result as a secondary string. ```el ;; Given the following contents: ; _1 *2* 3 */4/* 5 /6/_ ;; Remove bold formatting at any level (org-ml->> (org-ml-parse-this-object) (org-ml-unwrap-types-deep '(bold)) (apply #'org-ml-build-paragraph) (org-ml-to-trimmed-string)) ;; => "_1 2 3 /4/ 5 /6/_" ``` #### org-ml-unwrap-deep `(object-node)` Return the children of **`object-node`** as plain-text wrapped in a list. ```el ;; Given the following contents: ; _1 *2* 3 */4/* 5 /6/_ ;; Remove all formatting (org-ml->> (org-ml-parse-this-object) (org-ml-unwrap-deep) (apply #'org-ml-build-paragraph) (org-ml-to-trimmed-string)) ;; => "1 2 3 4 5 6" ``` ### Secondary Strings #### org-ml-flatten `(secondary-string)` Return **`secondary-string`** with its first level unwrapped. The unwrap operation will be done with [`org-ml-unwrap`](#org-ml-unwrap-object-node). ```el ;; Given the following contents: ; This (1 *2* 3 */4/* 5 /6/) is randomly formatted ;; Remove first level of formatting (org-ml->> (org-ml-parse-this-element) (org-ml-map-children #'org-ml-flatten) (org-ml-to-trimmed-string)) ;; => "This (1 2 3 /4/ 5 6) is randomly formatted" ``` #### org-ml-flatten-types-deep `(types secondary-string)` Return **`secondary-string`** with object nodes in **`types`** unwrapped. The unwrap operation will be done with [`org-ml-unwrap-types-deep`](#org-ml-unwrap-types-deep-types-object-node). ```el ;; Given the following contents: ; This (1 *2* 3 */4/* 5 /6/) is randomly formatted ;; Remove italic formatting at any level (org-ml->> (org-ml-parse-this-element) (org-ml-map-children* (org-ml-flatten-types-deep '(italic) it)) (org-ml-to-trimmed-string)) ;; => "This (1 *2* 3 *4* 5 6) is randomly formatted" ``` #### org-ml-flatten-deep `(secondary-string)` Return **`secondary-string`** with all object nodes unwrapped to plain-text. The unwrap operation will be done with [`org-ml-unwrap-deep`](#org-ml-unwrap-deep-object-node). ```el ;; Given the following contents: ; This (1 *2* 3 */4/* 5 /6/) is randomly formatted ;; Remove italic formatting at any level (org-ml->> (org-ml-parse-this-element) (org-ml-map-children #'org-ml-flatten-deep) (org-ml-to-trimmed-string)) ;; => "This (1 2 3 4 5 6) is randomly formatted" ``` ### Item #### org-ml-item-get-paragraph `(item)` Return the first paragraph's children of **`item`** or nil if none. ```el ;; Given the following contents: ; - one (->> (org-ml-parse-this-item) (org-ml-item-get-paragraph)) ;; => '("one") ;; Given the following contents: ; - (->> (org-ml-parse-this-item) (org-ml-item-get-paragraph)) ;; => nil ``` #### org-ml-item-set-paragraph `(secondary-string item)` Set the first paragraph's children of **`item`** to **`secondary-string`**. ```el ;; Given the following contents: ; - one (org-ml->> (org-ml-parse-this-item) (org-ml-item-set-paragraph '("two")) (org-ml-to-string)) ;; => "- two ; " ;; Given the following contents: ; - one (org-ml->> (org-ml-parse-this-item) (org-ml-item-set-paragraph nil) (org-ml-to-string)) ;; => "- ; " ``` #### org-ml-item-map-paragraph `(fun item)` Apply **`fun`** to the first paragraph's children in **`item`**. **`fun`** is a `unary` function that takes the secondary-string of the first paragraph and returns modified secondary-string. ```el ;; Given the following contents: ; - one (org-ml->> (org-ml-parse-this-item) (org-ml-item-map-paragraph* (-map #'upcase it)) (org-ml-to-string)) ;; => "- ONE ; " ``` ### Headline #### org-ml-headline-get-section `(headline)` Return children of section node in **`headline`** node or nil if none. ```el ;; Given the following contents: ; * headline 1 ; sectional stuff ; ** headline 2 ; ** headline 3 (->> (org-ml-parse-this-subtree) (org-ml-headline-get-section) (-map #'org-ml-to-trimmed-string)) ;; => '("sectional stuff") ;; Given the following contents: ; * headline 1 ; ** headline 2 ; ** headline 3 (->> (org-ml-parse-this-subtree) (org-ml-headline-get-section) (org-ml-to-trimmed-string)) ;; => "" ``` #### org-ml-headline-set-section `(children headline)` Return **`headline`** with section node containing **`children`**. If **`children`** is nil, return **`headline`** with no section node. ```el ;; Given the following contents: ; * headline (org-ml->> (org-ml-parse-this-subtree) (org-ml-headline-set-section (list (org-ml-build-paragraph! "x-section"))) (org-ml-to-trimmed-string)) ;; => "* headline ; x-section" ;; Given the following contents: ; * headline ; x-section (org-ml->> (org-ml-parse-this-subtree) (org-ml-headline-set-section (list (org-ml-build-paragraph! "x-guard"))) (org-ml-to-trimmed-string)) ;; => "* headline ; x-guard" (org-ml->> (org-ml-parse-this-subtree) (org-ml-headline-set-section nil) (org-ml-to-trimmed-string)) ;; => "* headline" ``` #### org-ml-headline-map-section `(fun headline)` Return **`headline`** node with child section node modified by **`fun`**. **`fun`** is a unary function that takes a section node's children as a list returns a modified child list. ```el ;; Given the following contents: ; * headline ; x-section (org-ml->> (org-ml-parse-this-subtree) (org-ml-headline-map-section* (cons (org-ml-build-planning! :closed '(2019 1 1)) it)) (org-ml-to-trimmed-string)) ;; => "* headline ; CLOSED: [2019-01-01 Tue] ; x-section" ``` #### org-ml-headline-get-subheadlines `(headline)` Return list of child headline nodes in **`headline`** node or nil if none. ```el ;; Given the following contents: ; * headline 1 ; sectional stuff ; ** headline 2 ; ** headline 3 (org-ml->> (org-ml-parse-this-subtree) (org-ml-headline-get-subheadlines) (-map #'org-ml-to-trimmed-string)) ;; => '("** headline 2" "** headline 3") ;; Given the following contents: ; * headline 1 ; sectional stuff (org-ml->> (org-ml-parse-this-subtree) (org-ml-headline-get-subheadlines) (-map #'org-ml-to-trimmed-string)) ;; => nil ``` #### org-ml-headline-set-subheadlines `(subheadlines headline)` Return **`headline`** node with **`subheadlines`** set to child subheadlines. ```el ;; Given the following contents: ; * headline 1 ; sectional stuff ; ** headline 2 ; ** headline 3 (org-ml->> (org-ml-parse-this-subtree) (org-ml-headline-set-subheadlines (list (org-ml-build-headline! :level 2 :title-text "headline x"))) (org-ml-to-trimmed-string)) ;; => "* headline 1 ; sectional stuff ; ** headline x" (org-ml->> (org-ml-parse-this-subtree) (org-ml-headline-set-subheadlines nil) (org-ml-to-trimmed-string)) ;; => "* headline 1 ; sectional stuff" ``` #### org-ml-headline-map-subheadlines `(fun headline)` Return **`headline`** node with child headline nodes modified by **`fun`**. **`fun`** is a unary function that takes a list of headlines and returns a modified list of headlines. ```el ;; Given the following contents: ; * headline 1 ; ** headline 2 ; ** headline 3 (org-ml->> (org-ml-parse-this-subtree) (org-ml-headline-map-subheadlines* (--map (org-ml-set-property :todo-keyword "TODO" it) it)) (org-ml-to-trimmed-string)) ;; => "* headline 1 ; ** TODO headline 2 ; ** TODO headline 3" ``` ### Headline (metadata) #### org-ml-headline-get-planning `(headline)` Return the planning node in **`headline`** or nil if none. ```el ;; Given the following contents: ; * headline ; CLOSED: [2019-01-01 Tue] (->> (org-ml-parse-this-headline) (org-ml-headline-get-planning)) ;; => '(:closed (2019 1 1 nil nil) :scheduled nil :deadline nil) ;; Given the following contents: ; * headline (->> (org-ml-parse-this-headline) (org-ml-headline-get-planning)) ;; => nil ``` #### org-ml-headline-set-planning `(planning headline)` Return **`headline`** node with planning components set to **`planning`** node. ```el ;; Given the following contents: ; * headline (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-planning '(:closed (2019 1 1))) (org-ml-to-trimmed-string)) ;; => "* headline ; CLOSED: [2019-01-01 Tue]" ;; Given the following contents: ; * headline ; CLOSED: [2019-01-01 Tue] (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-planning '(:scheduled (2019 1 1))) (org-ml-to-trimmed-string)) ;; => "* headline ; SCHEDULED: <2019-01-01 Tue>" ;; Given the following contents: ; * headline ; CLOSED: [2019-01-01 Tue] (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-planning nil) (org-ml-to-trimmed-string)) ;; => "* headline" ``` #### org-ml-headline-map-planning `(fun headline)` Return **`headline`** node with planning node modified by **`fun`**. **`fun`** is a unary function that takes a planning node and returns a modified planning node. ```el ;; Given the following contents: ; * headline ; CLOSED: [2019-01-01 Tue] (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-map-planning* (list :closed (org-ml-timelist-shift 1 'day (plist-get it :closed)))) (org-ml-to-trimmed-string)) ;; => "* headline ; CLOSED: [2019-01-02 Wed]" ``` #### org-ml-headline-get-node-properties `(headline)` Return a list of node-properties nodes in **`headline`** or nil if none. ```el ;; Given the following contents: ; * headline ; :PROPERTIES: ; :Effort: 1:00 ; :ID: minesfake ; :END: (->> (org-ml-parse-this-headline) (org-ml-headline-get-node-properties)) ;; => '(("Effort" "1:00") ("ID" "minesfake")) ;; Given the following contents: ; * headline (->> (org-ml-parse-this-headline) (org-ml-headline-get-node-properties) (-map #'org-ml-to-trimmed-string)) ;; => nil ``` #### org-ml-headline-set-node-properties `(node-properties headline)` Return **`headline`** node with property drawer containing **`node-properties`**. **`node-properties`** is a list of (key . value) pairs (both strings). ```el ;; Given the following contents: ; * headline ; :PROPERTIES: ; :Effort: 1:00 ; :ID: minesfake ; :END: (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-node-properties '(("Effort" "0:01") ("ID" "easy"))) (org-ml-to-trimmed-string)) ;; => "* headline ; :PROPERTIES: ; :Effort: 0:01 ; :ID: easy ; :END:" (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-node-properties nil) (org-ml-to-trimmed-string)) ;; => "* headline" ``` #### org-ml-headline-map-node-properties `(fun headline)` Return **`headline`** node with property-drawer node modified by **`fun`**. **`fun`** is a unary function that takes a property-drawer node and returns a modified property-drawer node. ```el ;; Given the following contents: ; * headline ; :PROPERTIES: ; :Effort: 1:00 ; :ID: minesfake ; :END: (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-map-node-properties* (cons (list "New" "world man") it)) (org-ml-to-trimmed-string)) ;; => "* headline ; :PROPERTIES: ; :New: world man ; :Effort: 1:00 ; :ID: minesfake ; :END:" ``` #### org-ml-headline-get-node-property `(key headline)` Return value of property with **`key`** in **`headline`** or nil if not found. If multiple properties with **`key`** are present, only return the first. ```el ;; Given the following contents: ; * headline ; :PROPERTIES: ; :ID: fake ; :END: (->> (org-ml-parse-this-headline) (org-ml-headline-get-node-property "ID")) ;; => "fake" ;; Given the following contents: ; * headline ; :PROPERTIES: ; :ID: fake ; :END: (->> (org-ml-parse-this-headline) (org-ml-headline-get-node-property "READ_ID")) ;; => nil ``` #### org-ml-headline-set-node-property `(key value headline)` Return **`headline`** with node property matching **`key`** set to **`value`**. If a property matching **`key`** is present, set it to **`value`**. If multiple properties matching **`key`** are present, only set the first. ```el ;; Given the following contents: ; * headline ; :PROPERTIES: ; :ID: fake ; :END: (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-node-property "ID" "real") (org-ml-to-trimmed-string)) ;; => "* headline ; :PROPERTIES: ; :ID: real ; :END:" ;; Given the following contents: ; * headline (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-node-property "ID" "real") (org-ml-to-trimmed-string)) ;; => "* headline ; :PROPERTIES: ; :ID: real ; :END:" (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-node-property "ID" nil) (org-ml-to-trimmed-string)) ;; => "* headline" ;; Given the following contents: ; * headline ; :PROPERTIES: ; :ID: real ; :END: (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-node-property "ID" nil) (org-ml-to-trimmed-string)) ;; => "* headline" ``` #### org-ml-headline-map-node-property `(key fun headline)` Return **`headline`** node with property value matching **`key`** modified by **`fun`**. **`fun`** is a unary function that takes a node-property value and returns a modified node-property value. ```el ;; Given the following contents: ; * headline ; :PROPERTIES: ; :ID: fake ; :END: (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-map-node-property "ID" #'s-upcase) (org-ml-to-trimmed-string)) ;; => "* headline ; :PROPERTIES: ; :ID: FAKE ; :END:" ``` ### Headline (logbook and contents) #### org-ml-headline-get-supercontents `(config headline)` Return the supercontents of **`headline`** node. Supercontents will be a plist like: ( :planning `planning` :node-props `props` :logbook `lb` :blank `blank` :contents `contents` ) `planning` is a plist like the analogous argument of [`org-ml-build-planning!`](#org-ml-build-planning-key-closed-deadline-scheduled-post-blank) or nil if non-existent. `props` is a list of node-property nodes. `lb` is the logbook, which is another plist (see below). `blank` is the value of any whitespace after the planning, property-drawer, or logbook (assuming any exist) or the :pre-blank value of the encapsulating headline (if they don't exist). `contents` is a list of nodes after all the other stuff above. The logbook will be have keys :items, :clocks, and :unknown, where the first two will include the item and clock nodes of the logbook respectively, and the third will contain anything that could not be identified as a valid logbook entry. Note that items are actually stored under a plain-list node but will be returned here as a flat list of items for convenience. Also note that the :clocks slot can also include item nodes if clock notes are returned. **`config`** is a plist representing the logbook configuration to target and will contain the following keys; - :log-into-drawer - corresponds to the value of symbol `org-log-into-drawer` and carriers the same meaning - :clock-into-drawer - corresponds to the value of symbol `org-clock-into-drawer` and carriers the same meaning - :clock-out-notes - corresponds to the value of `org-log-note-clock-out` Any values not given will default to nil. Note that there is no way to infer what the logbook configuration should be, and thus this controls how the logbook will be parsed; this means it also determines which nodes will be returned in the :items/:clocks slots and which will be deemed :unknown (see above) so be sure this plist is set according to your desired target configuration. ```el ;; Given the following contents: ; * headline ; CLOSED: [2019-01-01 Tue 00:00] ; :PROPERTIES: ; :Effort: 0:30 ; :END: ; :LOGGING: ; - Note taken on [2018-12-31 Mon 00:00] \\ ; log note ; :END: ; :CLOCKING: ; CLOCK: [2019-01-01 Tue 00:00] ; :END: ; contents (let ((config (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING"))) (->> (org-ml-parse-this-headline) (org-ml-headline-get-supercontents config) (org-ml-supercontents-get-logbook) (org-ml-logbook-get-items) (-map #'org-ml-to-trimmed-string))) ;; => '("- Note taken on [2018-12-31 Mon 00:00] \\\\ ; log note") (let ((config (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING"))) (->> (org-ml-parse-this-headline) (org-ml-headline-get-supercontents config) (org-ml-supercontents-get-logbook) (org-ml-logbook-get-clocks) (-map #'org-ml-to-trimmed-string))) ;; => '("CLOCK: [2019-01-01 Tue 00:00]") (let ((config (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING"))) (->> (org-ml-parse-this-headline) (org-ml-headline-get-supercontents config) (org-ml-supercontents-get-logbook) (alist-get :unknown) (-map #'org-ml-to-trimmed-string))) ;; => nil (let ((config (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING"))) (->> (org-ml-parse-this-headline) (org-ml-headline-get-supercontents config) (org-ml-supercontents-get-contents) (-map #'org-ml-to-trimmed-string))) ;; => '("contents") ``` #### org-ml-headline-set-supercontents `(config supercontents headline)` Set logbook and contents of **`headline`** according to **`supercontents`**. See [`org-ml-headline-get-supercontents`](#org-ml-headline-get-supercontents-config-headline) for the meaning of **`config`** and the structure of the **`supercontents`** list. ```el ;; Given the following contents: ; * headline ; CLOSED: [2019-01-01 Tue 00:00] ; :PROPERTIES: ; :Effort: 0:30 ; :END: ; :LOGGING: ; - Note taken on [2018-12-31 Mon 00:00] \\ ; log note ; :END: ; :CLOCKING: ; CLOCK: [2019-01-01 Tue 00:00] ; :END: ; contents (let ((config (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING"))) (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-supercontents config `(:blank 0 :contents ,(list (org-ml-build-paragraph! "new contents")))) (org-ml-to-trimmed-string))) ;; => "* headline ; new contents" ``` #### org-ml-headline-map-supercontents `(config fun headline)` Map a function over the supercontents of **`headline`**. **`fun`** is a unary function that takes a supercontents list and returns a modified supercontents list. See [`org-ml-headline-get-supercontents`](#org-ml-headline-get-supercontents-config-headline) for the meaning of **`config`** and the structure of the supercontents list. ```el ;; Given the following contents: ; * headline ; CLOSED: [2019-01-01 Tue 00:00] ; :PROPERTIES: ; :Effort: 0:30 ; :END: ; :LOGGING: ; - Note taken on [2018-12-31 Mon 00:00] \\ ; log note ; :END: ; :CLOCKING: ; CLOCK: [2019-01-01 Tue 00:00] ; :END: ; contents (let ((config (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING"))) (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-map-supercontents* config (org-ml-supercontents-map-contents* (cons (org-ml-build-paragraph! "new contents") it) it)) (org-ml-to-trimmed-string))) ;; => "* headline ; CLOSED: [2019-01-01 Tue 00:00] ; :PROPERTIES: ; :Effort: 0:30 ; :END: ; :LOGGING: ; - Note taken on [2018-12-31 Mon 00:00] \\\\ ; log note ; :END: ; :CLOCKING: ; CLOCK: [2019-01-01 Tue 00:00] ; :END: ; new contents ; contents" ``` #### org-ml-headline-get-logbook-items `(config headline)` Return the logbook items of **`headline`**. See [`org-ml-headline-get-supercontents`](#org-ml-headline-get-supercontents-config-headline) for the meaning of **`config`**. The returned items will be a flat list of item nodes, not a plain-list node. ```el ;; Given the following contents: ; * headline ; CLOSED: [2019-01-01 Tue 00:00] ; :PROPERTIES: ; :Effort: 0:30 ; :END: ; :LOGGING: ; - Note taken on [2018-12-31 Mon 00:00] \\ ; log note ; :END: ; :CLOCKING: ; CLOCK: [2019-01-01 Tue 00:00] ; :END: ; contents (let ((config (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING"))) (->> (org-ml-parse-this-headline) (org-ml-headline-get-logbook-items config) (-map #'org-ml-to-trimmed-string))) ;; => '("- Note taken on [2018-12-31 Mon 00:00] \\\\ ; log note") ``` #### org-ml-headline-set-logbook-items `(config items headline)` Set the logbook items of **`headline`** to **`items`**. See [`org-ml-headline-get-supercontents`](#org-ml-headline-get-supercontents-config-headline) for the meaning of **`config`**. **`items`** must be supplied as a flat list of valid logbook item nodes, not as a plain-list node. ```el ;; Given the following contents: ; * headline ; CLOSED: [2019-01-01 Tue 00:00] ; :PROPERTIES: ; :Effort: 0:30 ; :END: ; :LOGGING: ; - Note taken on [2018-12-31 Mon 00:00] \\ ; log note ; :END: ; :CLOCKING: ; CLOCK: [2019-01-01 Tue 00:00] ; :END: ; contents (let ((config (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING"))) (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-logbook-items config nil) (org-ml-to-trimmed-string))) ;; => "* headline ; CLOSED: [2019-01-01 Tue 00:00] ; :PROPERTIES: ; :Effort: 0:30 ; :END: ; :CLOCKING: ; CLOCK: [2019-01-01 Tue 00:00] ; :END: ; contents" ``` #### org-ml-headline-map-logbook-items `(config fun headline)` Map a function over the logbook items of **`headline`**. **`fun`** is a unary function that takes a list of item nodes and returns a modified list of item nodes. See [`org-ml-headline-get-supercontents`](#org-ml-headline-get-supercontents-config-headline) for the meaning of **`config`**. ```el ;; Given the following contents: ; * headline ; CLOSED: [2019-01-01 Tue 00:00] ; :PROPERTIES: ; :Effort: 0:30 ; :END: ; :LOGGING: ; - Note taken on [2018-12-31 Mon 00:00] \\ ; log note ; :END: ; :CLOCKING: ; CLOCK: [2019-01-01 Tue 00:00] ; :END: ; contents (let ((config (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING"))) (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-map-logbook-items* config (--map (org-ml-map-children* (--map (org-ml-map-children* (--map-when (org-ml-is-type 'plain-text it) (upcase it) it) it) it) it) it)) (org-ml-to-trimmed-string))) ;; => "* headline ; CLOSED: [2019-01-01 Tue 00:00] ; :PROPERTIES: ; :Effort: 0:30 ; :END: ; :LOGGING: ; - NOTE TAKEN ON [2018-12-31 Mon 00:00] \\\\ ; LOG NOTE ; :END: ; :CLOCKING: ; CLOCK: [2019-01-01 Tue 00:00] ; :END: ; contents" ``` #### org-ml-headline-get-logbook-clocks `(config headline)` Return the logbook clocks of **`headline`**. See [`org-ml-headline-get-supercontents`](#org-ml-headline-get-supercontents-config-headline) for the meaning of **`config`**. The returned list will include clock nodes and maybe item nodes if :clock-out-notes is t in **`config`**. ```el ;; Given the following contents: ; * headline ; CLOSED: [2019-01-01 Tue 00:00] ; :PROPERTIES: ; :Effort: 0:30 ; :END: ; :LOGGING: ; - Note taken on [2018-12-31 Mon 00:00] \\ ; log note ; :END: ; :CLOCKING: ; CLOCK: [2019-01-01 Tue 00:00] ; :END: ; contents (let ((config (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING"))) (->> (org-ml-parse-this-headline) (org-ml-headline-get-logbook-clocks config) (-map #'org-ml-to-trimmed-string))) ;; => '("CLOCK: [2019-01-01 Tue 00:00]") ``` #### org-ml-headline-set-logbook-clocks `(config clocks headline)` Set the logbook clocks of **`headline`** to **`clocks`**. See [`org-ml-headline-get-supercontents`](#org-ml-headline-get-supercontents-config-headline) for the meaning of **`config`**. **`clocks`** must be supplied as a flat list of valid clock nodes and optionally item nodes if :clock-out-notes is t in **`config`**. ```el ;; Given the following contents: ; * headline ; CLOSED: [2019-01-01 Tue 00:00] ; :PROPERTIES: ; :Effort: 0:30 ; :END: ; :LOGGING: ; - Note taken on [2018-12-31 Mon 00:00] \\ ; log note ; :END: ; :CLOCKING: ; CLOCK: [2019-01-01 Tue 00:00] ; :END: ; contents (let ((config (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING"))) (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-logbook-clocks config nil) (org-ml-to-trimmed-string))) ;; => "* headline ; CLOSED: [2019-01-01 Tue 00:00] ; :PROPERTIES: ; :Effort: 0:30 ; :END: ; :LOGGING: ; - Note taken on [2018-12-31 Mon 00:00] \\\\ ; log note ; :END: ; contents" ``` #### org-ml-headline-map-logbook-clocks `(config fun headline)` Map a function over the logbook clocks of **`headline`**. **`fun`** is a unary function that takes a list of clock nodes and optionally item nodes to represent the clock notes and returns a modified list of said nodes. [`org-ml-headline-get-supercontents`](#org-ml-headline-get-supercontents-config-headline) for the meaning of **`config`**. ```el ;; Given the following contents: ; * headline ; CLOSED: [2019-01-01 Tue 00:00] ; :PROPERTIES: ; :Effort: 0:30 ; :END: ; :LOGGING: ; - Note taken on [2018-12-31 Mon 00:00] \\ ; log note ; :END: ; :CLOCKING: ; CLOCK: [2019-01-01 Tue 00:00] ; :END: ; contents (let ((config (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING"))) (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-map-logbook-clocks* config (--map (org-ml-map-property* :value (org-ml-timestamp-shift 1 'day it) it) it)) (org-ml-to-trimmed-string))) ;; => "* headline ; CLOSED: [2019-01-01 Tue 00:00] ; :PROPERTIES: ; :Effort: 0:30 ; :END: ; :LOGGING: ; - Note taken on [2018-12-31 Mon 00:00] \\\\ ; log note ; :END: ; :CLOCKING: ; CLOCK: [2019-01-02 Wed 00:00] ; :END: ; contents" ``` #### org-ml-headline-get-contents `(config headline)` Return the contents of **`headline`**. Contents is everything in the headline after the logbook and will be returned as a flat list of nodes. See [`org-ml-headline-get-supercontents`](#org-ml-headline-get-supercontents-config-headline) for the meaning of **`config`**. ```el ;; Given the following contents: ; * headline (->> (org-ml-parse-this-headline) (org-ml-headline-get-contents (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t)) (-map #'org-ml-to-trimmed-string)) ;; => nil ;; Given the following contents: ; * headline ; something (->> (org-ml-parse-this-headline) (org-ml-headline-get-contents (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t)) (-map #'org-ml-to-trimmed-string)) ;; => '("something") ;; Given the following contents: ; * headline ; CLOSED: [2019-01-01 Tue 00:00] ; :LOGBOOK: ; - Note taken on [2018-12-31 Mon 00:00] \\ ; log note ; CLOCK: [2019-01-01 Tue 00:00] ; :END: ; ; - not log (->> (org-ml-parse-this-headline) (org-ml-headline-get-contents (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t)) (-map #'org-ml-to-trimmed-string)) ;; => '("- not log") ;; Given the following contents: ; * headline ; CLOSED: [2019-01-01 Tue 00:00] ; :LOGGING: ; - Note taken on [2018-12-31 Mon 00:00] \\ ; log note ; :END: ; :CLOCKING: ; CLOCK: [2019-01-01 Tue 00:00] ; :END: ; ; - not log (->> (org-ml-parse-this-headline) (org-ml-headline-get-contents (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING")) (-map #'org-ml-to-trimmed-string)) ;; => '("- not log") ``` #### org-ml-headline-set-contents `(config contents headline)` Set the contents of **`headline`** to **`contents`**. Contents is everything in the headline after the logbook, and **`contents`** must be a flat list of nodes. See [`org-ml-headline-get-supercontents`](#org-ml-headline-get-supercontents-config-headline) for the meaning of **`config`**. ```el ;; Given the following contents: ; * headline (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-contents (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t) (list (org-ml-build-paragraph! "I'm new"))) (org-ml-to-trimmed-string)) ;; => "* headline ; I'm new" ;; Given the following contents: ; * headline ; something (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-contents (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t) (list (org-ml-build-paragraph! "I'm new"))) (org-ml-to-trimmed-string)) ;; => "* headline ; I'm new" ;; Given the following contents: ; * headline ; :LOGBOOK: ; - Note taken on [2018-12-31 Mon 00:00] \\ ; log1 ; :END: ; something (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-contents (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t) (list (org-ml-build-paragraph! "I'm new"))) (org-ml-to-trimmed-string)) ;; => "* headline ; :LOGBOOK: ; - Note taken on [2018-12-31 Mon 00:00] \\\\ ; log1 ; :END: ; I'm new" ;; Given the following contents: ; * headline ; :LOGBOOK: ; - Note taken on [2018-12-31 Mon 00:00] \\ ; log1 ; :END: ; something (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-set-contents (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t) nil) (org-ml-to-trimmed-string)) ;; => "* headline ; :LOGBOOK: ; - Note taken on [2018-12-31 Mon 00:00] \\\\ ; log1 ; :END:" ``` #### org-ml-headline-map-contents `(config fun headline)` Map a function over the contents of **`headline`**. Contents is everything in the headline after the logbook. **`fun`** is a unary function that takes a list of nodes representing the contents and returns a modified list of nodes. See [`org-ml-headline-get-supercontents`](#org-ml-headline-get-supercontents-config-headline) for the meaning of **`config`**. ```el ;; Given the following contents: ; * headline ; something (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-map-contents* (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t) (cons (org-ml-build-paragraph! "I'm new") it)) (org-ml-to-trimmed-string)) ;; => "* headline ; I'm new ; something" ``` #### org-ml-headline-logbook-append-item `(config item headline)` Append **`item`** to the logbook of **`headline`**. See [`org-ml-headline-get-supercontents`](#org-ml-headline-get-supercontents-config-headline) for the meaning of **`config`**. **`item`** must be a valid logbook item. The logbook will be started if it does not already exist, else **`item`** will be added in chronological order. ```el ;; Given the following contents: ; * headline (let ((ut (- 1546300800 (car (current-time-zone))))) (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-logbook-append-item (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t) (org-ml-build-log-note ut "new note")) (org-ml-to-trimmed-string))) ;; => "* headline ; :LOGBOOK: ; - Note taken on [2019-01-01 Tue 00:00] \\\\ ; new note ; :END:" ;; Given the following contents: ; * headline ; :LOGBOOK: ; - Note taken on [2018-12-31 Mon 00:00] \\ ; old note ; :END: (let ((ut (- 1546300800 (car (current-time-zone))))) (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-logbook-append-item (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t) (org-ml-build-log-note ut "new note")) (org-ml-to-trimmed-string))) ;; => "* headline ; :LOGBOOK: ; - Note taken on [2019-01-01 Tue 00:00] \\\\ ; new note ; - Note taken on [2018-12-31 Mon 00:00] \\\\ ; old note ; :END:" ;; Given the following contents: ; * headline ; :LOGGING: ; - Note taken on [2018-12-31 Mon 00:00] \\ ; old note ; :END: ; :CLOCKING: ; CLOCK: [2112-01-01 Fri] ; :END: (let ((ut (- 1546300800 (car (current-time-zone))))) (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-logbook-append-item (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING") (org-ml-build-log-note ut "new note")) (org-ml-to-trimmed-string))) ;; => "* headline ; :LOGGING: ; - Note taken on [2019-01-01 Tue 00:00] \\\\ ; new note ; - Note taken on [2018-12-31 Mon 00:00] \\\\ ; old note ; :END: ; :CLOCKING: ; CLOCK: [2112-01-01 Fri] ; :END:" ``` #### org-ml-headline-logbook-append-open-clock `(config unixtime headline)` Append an open clock to the logbook of **`headline`**. See [`org-ml-headline-get-supercontents`](#org-ml-headline-get-supercontents-config-headline) for the meaning of **`config`**. **`unixtime`** will set the start time of the clock. The logbook will be started if it does not already exist, else the new clock will be added in chronological order. ```el ;; Given the following contents: ; * headline (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-logbook-append-open-clock (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t) (- 1546300800 (car (current-time-zone)))) (org-ml-to-trimmed-string)) ;; => "* headline ; :LOGBOOK: ; CLOCK: [2019-01-01 Tue 00:00] ; :END:" ;; Given the following contents: ; * headline ; :LOGBOOK: ; - note taken on [2018-12-30 Sun 00:00] ; :END: (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-logbook-append-open-clock (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t) (- 1546300800 (car (current-time-zone)))) (org-ml-to-trimmed-string)) ;; => "* headline ; :LOGBOOK: ; CLOCK: [2019-01-01 Tue 00:00] ; - note taken on [2018-12-30 Sun 00:00] ; :END:" ;; Given the following contents: ; * headline ; :LOGGING: ; - note taken on [2018-12-30 Sun 00:00] ; :END: (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-logbook-append-open-clock (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING") (- 1546300800 (car (current-time-zone)))) (org-ml-to-trimmed-string)) ;; => "* headline ; :LOGGING: ; - note taken on [2018-12-30 Sun 00:00] ; :END: ; :CLOCKING: ; CLOCK: [2019-01-01 Tue 00:00] ; :END:" ``` #### org-ml-headline-logbook-close-open-clock `(config unixtime note headline)` Close an open clock to the logbook of **`headline`**. See [`org-ml-headline-get-supercontents`](#org-ml-headline-get-supercontents-config-headline) for the meaning of **`config`**. **`unixtime`** will set the end time of the clock. This will only close an open clock if it is the most recent clock; else it will do nothing. **`note`** is a string representing the clock-out note (or nil if not desired). Note that supplying a non-nil clock-note when it is not allowed by **`config`** will trigger an error. ```el ;; Given the following contents: ; * headline ; :LOGBOOK: ; - note taken on [2018-12-30 Sun 00:00] ; :END: (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-logbook-close-open-clock (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t) (- 1546300800 (car (current-time-zone))) nil) (org-ml-to-trimmed-string)) ;; => "* headline ; :LOGBOOK: ; - note taken on [2018-12-30 Sun 00:00] ; :END:" ;; Given the following contents: ; * headline ; :LOGBOOK: ; CLOCK: [2018-12-31 Mon 00:00] ; - note taken on [2018-12-30 Sun 00:00] ; :END: (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-logbook-close-open-clock (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t) (- 1546300800 (car (current-time-zone))) nil) (org-ml-to-trimmed-string)) ;; => "* headline ; :LOGBOOK: ; CLOCK: [2018-12-31 Mon 00:00]--[2019-01-01 Tue 00:00] => 24:00 ; - note taken on [2018-12-30 Sun 00:00] ; :END:" (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-logbook-close-open-clock (list :log-into-drawer t :clock-into-drawer t :clock-out-notes t) (- 1546300800 (car (current-time-zone))) "new note") (org-ml-to-trimmed-string)) ;; => "* headline ; :LOGBOOK: ; CLOCK: [2018-12-31 Mon 00:00]--[2019-01-01 Tue 00:00] => 24:00 ; - new note ; - note taken on [2018-12-30 Sun 00:00] ; :END:" ;; Given the following contents: ; * headline ; :LOGGING: ; - note taken on [2018-12-30 Sun 00:00] ; :END: ; :CLOCKING: ; CLOCK: [2018-12-31 Mon 00:00] ; :END: (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-logbook-close-open-clock (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING" :clock-out-notes t) (- 1546300800 (car (current-time-zone))) nil) (org-ml-to-trimmed-string)) ;; => "* headline ; :LOGGING: ; - note taken on [2018-12-30 Sun 00:00] ; :END: ; :CLOCKING: ; CLOCK: [2018-12-31 Mon 00:00]--[2019-01-01 Tue 00:00] => 24:00 ; :END:" ``` #### org-ml-headline-logbook-convert-config `(config1 config2 headline)` Convert the logbook of **`headline`** to a new configuration. **`config1`** is the current config and **`config2`** is the target config. Note that any logbook nodes that are invalid under **`config1`** will be silently dropped, and nodes which do not conform to **`config2`** will trigger an error. See [`org-ml-headline-get-supercontents`](#org-ml-headline-get-supercontents-config-headline) for the structure of both config lists. ```el ;; Given the following contents: ; * headline ; CLOCK: [2018-12-31 Mon 00:00]--[2019-01-01 Tue 00:00] => 24:00 ; - note taken on [2018-12-30 Sun 00:00] (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-logbook-convert-config nil (list :log-into-drawer t :clock-into-drawer t)) (org-ml-to-trimmed-string)) ;; => "* headline ; :LOGBOOK: ; CLOCK: [2018-12-31 Mon 00:00]--[2019-01-01 Tue 00:00] => 24:00 ; - note taken on [2018-12-30 Sun 00:00] ; :END:" (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-logbook-convert-config nil (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING")) (org-ml-to-trimmed-string)) ;; => "* headline ; :LOGGING: ; - note taken on [2018-12-30 Sun 00:00] ; :END: ; :CLOCKING: ; CLOCK: [2018-12-31 Mon 00:00]--[2019-01-01 Tue 00:00] => 24:00 ; :END:" ;; Given the following contents: ; * headline ; :LOGBOOK: ; CLOCK: [2018-12-31 Mon 00:00]--[2019-01-01 Tue 00:00] => 24:00 ; - note taken on [2018-12-30 Sun 00:00] ; :END: (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-logbook-convert-config (list :log-into-drawer t :clock-into-drawer t) (list :log-into-drawer "LOGGING" :clock-into-drawer "CLOCKING")) (org-ml-to-trimmed-string)) ;; => "* headline ; :LOGGING: ; - note taken on [2018-12-30 Sun 00:00] ; :END: ; :CLOCKING: ; CLOCK: [2018-12-31 Mon 00:00]--[2019-01-01 Tue 00:00] => 24:00 ; :END:" ``` ### Headline (misc) #### org-ml-headline-get-path `(headline)` Return tree path of **`headline`** node. The return value is a list of headline titles (including that from **`headline`**) leading to the root node. ```el ;; Given the following contents: ; * one ; ** two ; *** three (->> (org-ml-parse-this-subtree) (org-ml-headline-get-path)) ;; => '("one") (->> (org-ml-parse-this-subtree) (org-ml-headline-get-subheadlines) (car) (org-ml-headline-get-subheadlines) (car) (org-ml-headline-get-path)) ;; => '("one" "two" "three") ``` #### org-ml-headline-update-item-statistics `(headline)` Return **`headline`** node with updated statistics cookie via items. The percent/fraction will be computed as the number of checked items over the number of items with checkboxes (non-checkbox items will not be considered). ```el ;; Given the following contents: ; * statistically significant [/] ; - irrelevant data ; - [ ] good data ; - [X] bad data (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-update-item-statistics) (org-ml-to-trimmed-string)) ;; => "* statistically significant [1/2] ; - irrelevant data ; - [ ] good data ; - [X] bad data" ;; Given the following contents: ; * statistically significant ; - irrelevant data ; - [ ] good data ; - [X] bad data ;; Do nothing if nothing to update (org-ml->> (org-ml-parse-this-headline) (org-ml-headline-update-item-statistics) (org-ml-to-trimmed-string)) ;; => "* statistically significant ; - irrelevant data ; - [ ] good data ; - [X] bad data" ``` #### org-ml-headline-update-todo-statistics `(headline)` Return **`headline`** node with updated statistics cookie via subheadlines. The percent/fraction will be computed as the number of done subheadlines over the number of todo subheadlines (eg non-todo subheadlines will not be counted). ```el ;; Given the following contents: ; * statistically significant [/] ; ** irrelevant data ; ** TODO good data ; ** DONE bad data (org-ml->> (org-ml-parse-this-subtree) (org-ml-headline-update-todo-statistics) (org-ml-to-trimmed-string)) ;; => "* statistically significant [1/2] ; ** irrelevant data ; ** TODO good data ; ** DONE bad data" ;; Given the following contents: ; * statistically significant ; ** irrelevant data ; ** TODO good data ; ** DONE bad data ;; Do nothing if nothing to update (org-ml->> (org-ml-parse-this-subtree) (org-ml-headline-update-todo-statistics) (org-ml-to-trimmed-string)) ;; => "* statistically significant ; ** irrelevant data ; ** TODO good data ; ** DONE bad data" ``` #### org-ml-headline-demote-subheadline `(index headline)` Return **`headline`** node with child headline at **`index`** demoted. Unlike [`org-ml-headline-demote-subtree`](#org-ml-headline-demote-subtree-index-headline) this will not demote the demoted headline node's children. ```el ;; Given the following contents: ; * one ; ** two ; ** three ; *** four (org-ml->> (org-ml-parse-element-at 1) (org-ml-headline-demote-subheadline 0) (org-ml-to-trimmed-string)) Error (org-ml->> (org-ml-parse-element-at 1) (org-ml-headline-demote-subheadline 1) (org-ml-to-trimmed-string)) ;; => "* one ; ** two ; *** three ; *** four" ``` #### org-ml-headline-demote-subtree `(index headline)` Return **`headline`** node with child headline at **`index`** demoted. Unlike [`org-ml-headline-demote-subheadline`](#org-ml-headline-demote-subheadline-index-headline) this will also demote the demoted headline node's children. ```el ;; Given the following contents: ; * one ; ** two ; ** three ; *** four (org-ml->> (org-ml-parse-element-at 1) (org-ml-headline-demote-subtree 1) (org-ml-to-trimmed-string)) ;; => "* one ; ** two ; *** three ; **** four" ``` #### org-ml-headline-promote-subheadline `(index child-index headline)` Return **`headline`** node with a child headline under **`index`** promoted. The specific child headline to promote is selected by **`child-index`**. ```el ;; Given the following contents: ; * one ; ** two ; ** three ; *** four ; *** four ; *** four (org-ml->> (org-ml-parse-element-at 1) (org-ml-headline-promote-subheadline 1 1) (org-ml-to-trimmed-string)) ;; => "* one ; ** two ; ** three ; *** four ; ** four ; *** four" ``` #### org-ml-headline-promote-all-subheadlines `(index headline)` Return **`headline`** node with all child headlines under **`index`** promoted. ```el ;; Given the following contents: ; * one ; ** two ; ** three ; *** four ; *** four ; *** four (org-ml->> (org-ml-parse-element-at 1) (org-ml-headline-promote-all-subheadlines 1) (org-ml-to-trimmed-string)) ;; => "* one ; ** two ; ** three ; ** four ; ** four ; ** four" ``` ### Plain List #### org-ml-plain-list-set-type `(type plain-list)` Return **`plain-list`** node with type property set to **`type`**. **`type`** is one of the symbols `unordered` or `ordered`. ```el ;; Given the following contents: ; - [ ] one ; - [X] two (org-ml->> (org-ml-parse-this-element) (org-ml-plain-list-set-type 'ordered) (org-ml-to-trimmed-string)) ;; => "1. [ ] one ; 2. [X] two" ;; Given the following contents: ; 1. [ ] one ; 2. [X] two (org-ml->> (org-ml-parse-this-element) (org-ml-plain-list-set-type 'unordered) (org-ml-to-trimmed-string)) ;; => "- [ ] one ; - [X] two" ``` #### org-ml-plain-list-indent-item `(index plain-list)` Return **`plain-list`** node with child item at **`index`** indented. Unlike `org-ml-item-indent-item-tree` this will not indent the indented item node's children. ```el ;; Given the following contents: ; - one ; - two ; - three ; - four ;; It makes no sense to indent the first item (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-indent-item 0) (org-ml-to-trimmed-string)) Error (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-indent-item 1) (org-ml-to-trimmed-string)) ;; => "- one ; - two ; - three ; - four" (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-indent-item 2) (org-ml-to-trimmed-string)) ;; => "- one ; - two ; - three ; - four" ``` #### org-ml-plain-list-indent-item-tree `(index plain-list)` Return **`plain-list`** node with child item at **`index`** indented. Unlike `org-ml-item-indent-item` this will also indent the indented item node's children. ```el ;; Given the following contents: ; - one ; - one-ish ; - two ; - three ; - four (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-indent-item-tree 1) (org-ml-to-trimmed-string)) ;; => "- one ; - one-ish ; - two ; - three ; - four" ``` #### org-ml-plain-list-outdent-item `(index child-index plain-list)` Return **`plain-list`** node with a child item under **`index`** outdented. The specific child item to outdent is selected by **`child-index`**. ```el ;; Given the following contents: ; - one ; - two ; - three ; - three ; - three ; - four (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-outdent-item 1 0) (org-ml-to-trimmed-string)) ;; => "- one ; - two ; - three ; - three ; - three ; - four" (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-outdent-item 1 1) (org-ml-to-trimmed-string)) ;; => "- one ; - two ; - three ; - three ; - three ; - four" (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-outdent-item 2 1) (org-ml-to-trimmed-string)) ;; => "- one ; - two ; - three ; - three ; - three ; - four" ``` #### org-ml-plain-list-outdent-all-items `(index plain-list)` Return **`plain-list`** node with all child items under **`index`** outdented. ```el ;; Given the following contents: ; - one ; - two ; - three ; - three ; - three ; - four (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-outdent-all-items 1) (org-ml-to-trimmed-string)) ;; => "- one ; - two ; - three ; - three ; - three ; - four" (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-outdent-all-items 2) (org-ml-to-trimmed-string)) ;; => "- one ; - two ; - three ; - three ; - three ; - four" ;; Given the following contents: ; - one ; - two ; - three ; - three ; - three ; - three-ish ; - four (org-ml->> (org-ml-parse-element-at 1) (org-ml-plain-list-outdent-all-items 1) (org-ml-to-trimmed-string)) ;; => "- one ; - two ; - three ; - three ; - three ; - three-ish ; - four" ``` ### Table #### org-ml-table-get-cell `(row-index column-index table)` Return table-cell node at **`row-index`** and **`column-index`** in **`table`** node. Rule-type rows do not count toward row indices. ```el ;; Given the following contents: ; | 1 | 2 | 3 | ; |---+---+---| ; | a | b | c | (->> (org-ml-parse-this-element) (org-ml-table-get-cell 0 0) (org-ml-get-children) (car)) ;; => "1" (->> (org-ml-parse-this-element) (org-ml-table-get-cell 1 1) (org-ml-get-children) (car)) ;; => "b" (->> (org-ml-parse-this-element) (org-ml-table-get-cell -1 -1) (org-ml-get-children) (car)) ;; => "c" ``` #### org-ml-table-delete-column `(column-index table)` Return **`table`** node with column at **`column-index`** deleted. ```el ;; Given the following contents: ; | a | b | ; |---+---| ; | c | d | (org-ml->> (org-ml-parse-this-element) (org-ml-table-delete-column 0) (org-ml-to-trimmed-string)) ;; => "| b | ; |---| ; | d |" (org-ml->> (org-ml-parse-this-element) (org-ml-table-delete-column 1) (org-ml-to-trimmed-string)) ;; => "| a | ; |---| ; | c |" (org-ml->> (org-ml-parse-this-element) (org-ml-table-delete-column -1) (org-ml-to-trimmed-string)) ;; => "| a | ; |---| ; | c |" ``` #### org-ml-table-delete-row `(row-index table)` Return **`table`** node with row at **`row-index`** deleted. ```el ;; Given the following contents: ; | a | b | ; |---+---| ; | c | d | (org-ml->> (org-ml-parse-this-element) (org-ml-table-delete-row 0) (org-ml-to-trimmed-string)) ;; => "|---+---| ; | c | d |" (org-ml->> (org-ml-parse-this-element) (org-ml-table-delete-row 1) (org-ml-to-trimmed-string)) ;; => "| a | b | ; | c | d |" (org-ml->> (org-ml-parse-this-element) (org-ml-table-delete-row -1) (org-ml-to-trimmed-string)) ;; => "| a | b | ; |---+---|" ``` #### org-ml-table-insert-column! `(column-index column-text table)` Return **`table`** node with **`column-text`** inserted at **`column-index`**. **`column-index`** is the index of the column and **`column-text`** is a list of strings to be made into table-cells to be inserted following the same syntax as [`org-ml-build-table-cell!`](#org-ml-build-table-cell-string). ```el ;; Given the following contents: ; | a | b | ; |---+---| ; | c | d | (org-ml->> (org-ml-parse-this-element) (org-ml-table-insert-column! 1 '("x" "y")) (org-ml-to-trimmed-string)) ;; => "| a | x | b | ; |---+---+---| ; | c | y | d |" (org-ml->> (org-ml-parse-this-element) (org-ml-table-insert-column! -1 '("x" "y")) (org-ml-to-trimmed-string)) ;; => "| a | b | x | ; |---+---+---| ; | c | d | y |" ``` #### org-ml-table-insert-row! `(row-index row-text table)` Return **`table`** node with **`row-text`** inserted at **`row-index`**. **`row-index`** is the index of the column and **`row-text`** is a list of strings to be made into table-cells to be inserted following the same syntax as [`org-ml-build-table-row!`](#org-ml-build-table-row-row-list). ```el ;; Given the following contents: ; | a | b | ; |---+---| ; | c | d | (org-ml->> (org-ml-parse-this-element) (org-ml-table-insert-row! 1 '("x" "y")) (org-ml-to-trimmed-string)) ;; => "| a | b | ; | x | y | ; |---+---| ; | c | d |" (org-ml->> (org-ml-parse-this-element) (org-ml-table-insert-row! 2 '("x" "y")) (org-ml-to-trimmed-string)) ;; => "| a | b | ; |---+---| ; | x | y | ; | c | d |" (org-ml->> (org-ml-parse-this-element) (org-ml-table-insert-row! -1 '("x" "y")) (org-ml-to-trimmed-string)) ;; => "| a | b | ; |---+---| ; | c | d | ; | x | y |" ``` #### org-ml-table-replace-cell! `(row-index column-index cell-text table)` Return **`table`** node with a table-cell node replaced by **`cell-text`**. If **`cell-text`** is a string, it will replace the children of the table-cell at **`row-index`** and **`column-index`** in **`table`**. **`cell-text`** will be processed the same as the argument given to [`org-ml-build-table-cell!`](#org-ml-build-table-cell-string). If **`cell-text`** is nil, it will set the cell to an empty string. ```el ;; Given the following contents: ; | 1 | 2 | ; |---+---| ; | a | b | (org-ml->> (org-ml-parse-this-element) (org-ml-table-replace-cell! 0 0 "2") (org-ml-to-trimmed-string)) ;; => "| 2 | 2 | ; |---+---| ; | a | b |" (org-ml->> (org-ml-parse-this-element) (org-ml-table-replace-cell! 0 0 nil) (org-ml-to-trimmed-string)) ;; => "| | 2 | ; |---+---| ; | a | b |" (org-ml->> (org-ml-parse-this-element) (org-ml-table-replace-cell! -1 -1 "B") (org-ml-to-trimmed-string)) ;; => "| 1 | 2 | ; |---+---| ; | a | B |" ``` #### org-ml-table-replace-column! `(column-index column-text table)` Return **`table`** node with the column at **`column-index`** replaced by **`column-text`**. If **`column-text`** is a list of strings, it will replace the table-cells at **`column-index`**. Each member of **`column-text`** will be processed the same as the argument given to [`org-ml-build-table-cell!`](#org-ml-build-table-cell-string). If **`column-text`** is nil, it will clear all cells at **`column-index`**. ```el ;; Given the following contents: ; | a | b | ; |---+---| ; | c | d | (org-ml->> (org-ml-parse-this-element) (org-ml-table-replace-column! 0 '("A" "B")) (org-ml-to-trimmed-string)) ;; => "| A | b | ; |---+---| ; | B | d |" (org-ml->> (org-ml-parse-this-element) (org-ml-table-replace-column! 0 nil) (org-ml-to-trimmed-string)) ;; => "| | b | ; |---+---| ; | | d |" (org-ml->> (org-ml-parse-this-element) (org-ml-table-replace-column! -1 '("A" "B")) (org-ml-to-trimmed-string)) ;; => "| a | A | ; |---+---| ; | c | B |" ``` #### org-ml-table-replace-row! `(row-index row-text table)` Return **`table`** node with the row at **`row-index`** replaced by **`row-text`**. If **`row-text`** is a list of strings, it will replace the cells at **`row-index`**. Each member of **`row-text`** will be processed the same as the argument given to [`org-ml-build-table-row!`](#org-ml-build-table-row-row-list). If **`row-text`** is nil, it will clear all cells at **`row-index`**. ```el ;; Given the following contents: ; | a | b | ; |---+---| ; | c | d | (org-ml->> (org-ml-parse-this-element) (org-ml-table-replace-row! 0 '("A" "B")) (org-ml-to-trimmed-string)) ;; => "| A | B | ; |---+---| ; | c | d |" (org-ml->> (org-ml-parse-this-element) (org-ml-table-replace-row! 0 nil) (org-ml-to-trimmed-string)) ;; => "| | | ; |---+---| ; | c | d |" (org-ml->> (org-ml-parse-this-element) (org-ml-table-replace-row! -1 '("A" "B")) (org-ml-to-trimmed-string)) ;; => "| a | b | ; |---+---| ; | A | B |" ``` ## Node Matching Use pattern-matching to selectively perform operations on nodes in trees. #### org-ml-match `(pattern node)` Return a list of child nodes matching **`pattern`** in **`node`**. **`pattern`** is a list like `([slicer [x] [y]] [sub1 ...])`. `slicer` is an optional prefix to the pattern describing how many and which matches to return. If not given, all matches are returned. Possible values are: - `:first` - return the first match - `:last` - return the last match - `:nth` `x` - return the nth match where `x` is an integer denoting the index to return (starting at 0). `x` may be a negative number to start counting at the end of the match list, in which case -1 is the last index. Using 0 and -1 for `x` is equivalent to using `:first` and `:last` respectively - `:sub` `x` `y` - return a sublist between indices `x` and `y`. `x` may not be greater than `y`, and both must either be non-negative integers or negative integers. In the case of negative integers, the indices refer to the same counterparts as described in `:nth`. If `x` and `y` are equal, this slicer has the same behavior as `:nth`. `subx` denotes subpatterns that that match nodes in the parse tree. Subpatterns may either be wildcards or conditions. Conditions match exactly one level of the node tree being searched based on the node's type (the symbol returned by [`org-ml-get-type`](#org-ml-get-type-node-optional-anonymous)), properties (the value returned by [`org-ml-get-property`](#org-ml-get-property-prop-node) for a valid property keyword), and index (the position of the node in the list returned by [`org-ml-get-children`](#org-ml-get-children-branch-node)). For index, both left indices (where zero refers to the left end of the list) and right indices (where -1 refers to the right end of the list) are understood. Conditions may either be atomic or compound, where compound conditions are themselves composed of atomic or compound conditions. The types of atomic conditions are: - `type` - match when the node's type is `eq` to `type` (a symbol) - `index` - match when the node's index is `=` to `index` (an integer) - `(op index)` - match when `(op node-index index)` returns t. `op` is one of `<`, `>`, `<=`, or `>=` and `node-index` is the index of the node being evaluated - `(prop val)` - match nodes whose property `prop` (a keyword) is `equal` to `val`; `val` is obtained by evaluating [`org-ml-get-property`](#org-ml-get-property-prop-node) with `prop` and the current node; if `prop` is invalid, an error will be thrown - `(:pred pred)` - match when `pred` evaluates to t; `pred` is a symbol for a unary function that takes the current node as its argument Compound conditions start with an operator followed by their component conditions. The types of compound conditions are: - `(:and c1 c2 [c3 ...])` - match when all ``c`` are true - `(:or c1 c2 [c3 ...])` - match when at least one ``c`` is true - `(:not c)` - match when ``c`` is not true In addition, `subx` may be a wildcard keyword or symbol. These are analogous to the special characters found in `posix` extended regular expression syntax. Specifically, `[` and `]` correspond to `{` and `}` respectively and `:any` corresponds to the `.` operator. All other characters have the same meaning between this function and `posix` extended regular expressions.: - `:any` - always match exactly one node - `sub` `?` - match `sub` zero or once - `sub` `*` - match `sub` zero or more times - `sub` `+` - match `sub` one or more times - `sub` [`n`] - match `sub` `n` times - `sub` [`m` `n`] - match `sub` `m` to `n` times (inclusive); if `m` or `n` is nil, this will match `"at most `n` times"` or `"at least `m` times"` respectively - `(alt-a1 [alt-a2 ...] | alt-b1 [alt-b2 ...] [| ...])` - match any of the `alt` expressions separated by `|` where `alt` is a list of subpatterns as described above or nil to match nothing; these expressions may be nested If **`pattern`** is nil, return **`node`**. Likewise, if any wildcard patterns match the nil pattern, also return **`node`** along with anything else the wildcard matches. Examples of this would be `(sub *)`, `(sub ?)`, and `((nil | sub))`. For increased performance, this function (and all others that consume a **`pattern`** parameter) can be memoized using `org-ml-memoize-match-patterns`. If nil, **`pattern`** is processed into a lambda form for every function call. If t, the resulting lambda forms are cached for each unique **`pattern`**, running generation step only once if multiple instances of the same **`pattern`** are used. Note that `org-ml-memoize-match-patterns` is shared between all functions that consume a **`pattern`** parameter. ```el ;; Given the following contents: ; * headline 1 ; ** TODO headline 2 ; stuff ; - item 1 ; - item 2 ; - item 3 ; ** DONE headline 3 ; - item 4 ; - item 5 ; - item 6 ; ** TODO COMMENT headline 4 ; - item 7 ; - item 8 ; - item 9 ;; Match items (excluding the first) in headlines that are marked "TODO" and not ;; commented. The :many keyword matches the section and plain-list nodes holding ;; the items. (->> (org-ml-parse-this-subtree) (org-ml-match (quote ((:and (:todo-keyword "TODO") (:commentedp nil)) :any * (:and item (> 0))))) (-map #'org-ml-to-trimmed-string)) ;; => '("- item 2" "- item 3") ;; Given the following contents: ; *one* *two* *three* *four* *five* *six* ;; Return all bold nodes (->> (org-ml-parse-this-element) (org-ml-match '(bold)) (-map #'org-ml-to-trimmed-string)) ;; => '("*one*" "*two*" "*three*" "*four*" "*five*" "*six*") ;; Return first bold node (->> (org-ml-parse-this-element) (org-ml-match '(:first bold)) (-map #'org-ml-to-trimmed-string)) ;; => '("*one*") ;; Return last bold node (->> (org-ml-parse-this-element) (org-ml-match '(:last bold)) (-map #'org-ml-to-trimmed-string)) ;; => '("*six*") ;; Return a select bold node (->> (org-ml-parse-this-element) (org-ml-match '(:nth 2 bold)) (-map #'org-ml-to-trimmed-string)) ;; => '("*three*") ;; Return a sublist of matched bold nodes (->> (org-ml-parse-this-element) (org-ml-match '(:sub 1 3 bold)) (-map #'org-ml-to-trimmed-string)) ;; => '("*two*" "*three*" "*four*") ``` #### org-ml-match-delete `(pattern node)` Return **`node`** without children matching **`pattern`**. **`pattern`** follows the same rules as [`org-ml-match`](#org-ml-match-pattern-node). ```el ;; Given the following contents: ; * headline one ; ** headline two ; ** headline three ; ** headline four ;; Selectively delete headlines (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-delete '(headline)) (org-ml-to-trimmed-string)) ;; => "* headline one" (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-delete '(:first headline)) (org-ml-to-trimmed-string)) ;; => "* headline one ; ** headline three ; ** headline four" (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-delete '(:last headline)) (org-ml-to-trimmed-string)) ;; => "* headline one ; ** headline two ; ** headline three" ``` #### org-ml-match-extract `(pattern node)` Remove nodes matching **`pattern`** from **`node`**. Return cons cell where the car is a list of all removed nodes and the cdr is the modified **`node`**. **`pattern`** follows the same rules as [`org-ml-match`](#org-ml-match-pattern-node). ```el ;; Given the following contents: ; pull me /under/ (--> (org-ml-parse-this-element) (org-ml-match-extract '(:any * italic) it) (cons (-map #'org-ml-to-trimmed-string (car it)) (org-ml-to-trimmed-string (cdr it)))) ;; => '(("/under/") . "pull me") ``` #### org-ml-match-map `(pattern fun node)` Return **`node`** with **`fun`** applied to children matching **`pattern`**. **`fun`** is a unary function that takes a node and returns a new node which will replace the original. **`pattern`** follows the same rules as [`org-ml-match`](#org-ml-match-pattern-node). ```el ;; Given the following contents: ; * headline one ; ** TODO headline two ; ** headline three ; ** headline four ;; Selectively mark headlines as DONE (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-map '(headline) (lambda (it) (org-ml-set-property :todo-keyword "DONE" it))) (org-ml-to-trimmed-string)) ;; => "* headline one ; ** DONE headline two ; ** DONE headline three ; ** DONE headline four" (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-map* '(:first headline) (org-ml-set-property :todo-keyword "DONE" it)) (org-ml-to-trimmed-string)) ;; => "* headline one ; ** DONE headline two ; ** headline three ; ** headline four" (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-map '(:last headline) (-partial #'org-ml-set-property :todo-keyword "DONE")) (org-ml-to-trimmed-string)) ;; => "* headline one ; ** TODO headline two ; ** headline three ; ** DONE headline four" ``` #### org-ml-match-mapcat `(pattern fun node)` Return **`node`** with **`fun`** applied to children matching **`pattern`**. **`fun`** is a unary function that takes a node and returns a list of new nodes which will be spliced in place of the original node. **`pattern`** follows the same rules as [`org-ml-match`](#org-ml-match-pattern-node). ```el ;; Given the following contents: ; * one ; ** two (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-mapcat* '(:first headline) (list (org-ml-build-headline! :title-text "1.5" :level 2) it)) (org-ml-to-trimmed-string)) ;; => "* one ; ** 1.5 ; ** two" ``` #### org-ml-match-replace `(pattern node* node)` Return **`node`** with **`node*`*** in place of children matching **`pattern`**. **`pattern`** follows the same rules as [`org-ml-match`](#org-ml-match-pattern-node). ```el ;; Given the following contents: ; *1* 2 *3* 4 *5* 6 *7* 8 *9* 10 (org-ml->> (org-ml-parse-this-element) (org-ml-match-replace '(:any * bold) (org-ml-build-bold :post-blank 1 "0")) (org-ml-to-trimmed-string)) ;; => "*0* 2 *0* 4 *0* 6 *0* 8 *0* 10" ``` #### org-ml-match-insert-before `(pattern node* node)` Return **`node`** with **`node*`*** inserted before children matching **`pattern`**. **`pattern`** follows the same rules as [`org-ml-match`](#org-ml-match-pattern-node). ```el ;; Given the following contents: ; * one ; ** two ; ** three (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-insert-before '(headline) (org-ml-build-headline! :title-text "new" :level 2)) (org-ml-to-trimmed-string)) ;; => "* one ; ** new ; ** two ; ** new ; ** three" ``` #### org-ml-match-insert-after `(pattern node* node)` Return **`node`** with **`node*`*** inserted after children matching **`pattern`**. **`pattern`** follows the same rules as [`org-ml-match`](#org-ml-match-pattern-node). ```el ;; Given the following contents: ; * one ; ** two ; ** three (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-insert-after '(headline) (org-ml-build-headline! :title-text "new" :level 2)) (org-ml-to-trimmed-string)) ;; => "* one ; ** two ; ** new ; ** three ; ** new" ``` #### org-ml-match-insert-within `(pattern index node* node)` Return **`node`** with **`node*`*** inserted at **`index`** in children matching **`pattern`**. **`pattern`** follows the same rules as [`org-ml-match`](#org-ml-match-pattern-node) with the exception that **`pattern`** may be nil. In this case **`node*`*** will be inserted at **`index`** in the immediate, top level children of **`node`**. ```el ;; Given the following contents: ; * one ; ** two ; ** three (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-insert-within '(headline) 0 (org-ml-build-headline! :title-text "new" :level 3)) (org-ml-to-trimmed-string)) ;; => "* one ; ** two ; *** new ; ** three ; *** new" ;; The nil pattern denotes top-level element (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-insert-within nil 1 (org-ml-build-headline! :title-text "new" :level 2)) (org-ml-to-trimmed-string)) ;; => "* one ; ** two ; ** new ; ** three" ``` #### org-ml-match-splice `(pattern nodes* node)` Return **`node`** with **`nodes*`*** spliced in place of children matching **`pattern`**. **`nodes*`*** is a list of nodes. **`pattern`** follows the same rules as [`org-ml-match`](#org-ml-match-pattern-node). ```el ;; Given the following contents: ; * one ; ** two ; ** three (let ((L (list (org-ml-build-headline! :title-text "new0" :level 2) (org-ml-build-headline! :title-text "new1" :level 2)))) (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-splice '(0) L) (org-ml-to-trimmed-string))) ;; => "* one ; ** new0 ; ** new1 ; ** three" ``` #### org-ml-match-splice-before `(pattern nodes* node)` Return **`node`** with **`nodes*`*** spliced before children matching **`pattern`**. **`nodes*`*** is a list of nodes. **`pattern`** follows the same rules as [`org-ml-match`](#org-ml-match-pattern-node). ```el ;; Given the following contents: ; * one ; ** two ; ** three (let ((L (list (org-ml-build-headline! :title-text "new0" :level 2) (org-ml-build-headline! :title-text "new1" :level 2)))) (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-splice-before '(0) L) (org-ml-to-trimmed-string))) ;; => "* one ; ** new0 ; ** new1 ; ** two ; ** three" ``` #### org-ml-match-splice-after `(pattern nodes* node)` Return **`node`** with **`nodes*`*** spliced after children matching **`pattern`**. **`nodes*`*** is a list of nodes. **`pattern`** follows the same rules as [`org-ml-match`](#org-ml-match-pattern-node). ```el ;; Given the following contents: ; * one ; ** two ; ** three (let ((L (list (org-ml-build-headline! :title-text "new0" :level 2) (org-ml-build-headline! :title-text "new1" :level 2)))) (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-splice-after '(0) L) (org-ml-to-trimmed-string))) ;; => "* one ; ** two ; ** new0 ; ** new1 ; ** three" ``` #### org-ml-match-splice-within `(pattern index nodes* node)` Return **`node`** with **`nodes*`*** spliced at **`index`** in children matching **`pattern`**. **`nodes*`*** is a list of nodes. **`pattern`** follows the same rules as [`org-ml-match`](#org-ml-match-pattern-node) with the exception that **`pattern`** may be nil. In this case **`nodes*`*** will be inserted at **`index`** in the immediate, top level children of **`node`**. ```el ;; Given the following contents: ; * one ; ** two ; ** three ; *** four (let ((L (list (org-ml-build-headline! :title-text "new0" :level 3) (org-ml-build-headline! :title-text "new1" :level 3)))) (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-splice-within '(headline) 0 L) (org-ml-to-trimmed-string))) ;; => "* one ; ** two ; *** new0 ; *** new1 ; ** three ; *** new0 ; *** new1 ; *** four" (let ((L (list (org-ml-build-headline! :title-text "new0" :level 2) (org-ml-build-headline! :title-text "new1" :level 2)))) (org-ml->> (org-ml-parse-this-subtree) (org-ml-match-splice-within nil 1 L) (org-ml-to-trimmed-string))) ;; => "* one ; ** two ; ** new0 ; ** new1 ; ** three ; *** four" ``` #### org-ml-match-do `(pattern fun node)` Like [`org-ml-match-map`](#org-ml-match-map-pattern-fun-node) but for side effects only. **`fun`** is a unary function that has side effects and is applied to the matches from **`node`** using **`pattern`**. This function itself returns nil. **`pattern`** follows the same rules as [`org-ml-match`](#org-ml-match-pattern-node). ```el no examples :( ``` ## Buffer Side Effects Map node manipulations into buffers. ### Insert #### org-ml-insert `(point node)` Convert **`node`** to a string and insert at **`point`** in the current buffer. **`node`** may be a node or a list of nodes. Return **`node`**. ```el ;; Given the following contents: ; * one ; ;; Insert single node (->> (org-ml-build-headline! :title-text "two") (org-ml-insert (point-max))) ;; Output these buffer contents ;; $> "* one ; * two" ;; Insert multiple nodes (->> (org-ml-build-headline! :title-text "two") (list (org-ml-build-headline! :title-text "more")) (org-ml-insert (point-max))) ;; Output these buffer contents ;; $> "* one ; * more ; * two" ;; Given the following contents: ; a *game* or a /boy/ (->> (org-ml-build-paragraph! "we don't care if you're") (org-ml-insert (point-min))) ;; Output these buffer contents ;; $> "we don't care if you're ; a *game* or a /boy/" ``` #### org-ml-insert-tail `(point node)` Like [`org-ml-insert`](#org-ml-insert-point-node) but insert **`node`** at **`point`** and move to end of insertion. ```el no examples :( ``` ### Update #### org-ml-update `(fun node)` Replace **`node`** in the current buffer with a new one. **`fun`** is a unary function that takes **`node`** and returns a modified node or list of nodes. The modified **`node`** will be converted to a string and then compared to the old buffer string using the Myers diff algorithm. This has an average time complexity of `o`(`m`+`n`+`d`^2) where `m` and `n` are the lengths of the old and new strings respectively and `d` is the number of inserts or deletes required to change one into the other. At the cost of performance, only the parts of the buffer that need to be modified will actually be changed, which is less likely to disturb overlays and move the cursor (and is also more like how org-mode's build-in imperative functions behave). If one does not need this level of precision, use the function `org-ml~update` and supply nil for the `diff-mode` argument. This will simply replace the old node's string representation with the modified node's string in its entirety. This will likely be faster but could destroy overlays (eg folding) and will reposition the cursor to the beginning of **`node`** if it is in the middle of **`node`**. ```el ;; Given the following contents: ; * TODO win grammy (org-ml->> (org-ml-parse-this-headline) (org-ml-update (lambda (hl) (org-ml-set-property :todo-keyword "DONE" hl)))) ;; Output these buffer contents ;; $> "* DONE win grammy" ;; Given the following contents: ; * win grammy [0/0] ; - [ ] write punk song ; - [ ] get new vocalist ; - [ ] sell 2 singles (org-ml->> (org-ml-parse-this-headline) (org-ml-update* (->> (org-ml-match-map '(:any * item) #'org-ml-item-toggle-checkbox it) (org-ml-headline-update-item-statistics)))) ;; Output these buffer contents ;; $> "* win grammy [3/3] ; - [X] write punk song ; - [X] get new vocalist ; - [X] sell 2 singles" ``` #### org-ml-update-object-at `(point fun)` Update object under **`point`** using **`fun`**. **`fun`** takes an object and returns a modified object This function uses the Myers diff algorithm. See [`org-ml-update`](#org-ml-update-fun-node) for what this means. ```el ;; Given the following contents: ; [[http://example.com][desc]] (org-ml-update-object-at* (point) (org-ml-set-property :path "//buymoreram.com" it)) ;; Output these buffer contents ;; $> "[[http://buymoreram.com][desc]]" ``` #### org-ml-update-element-at `(point fun)` Update element under **`point`** using **`fun`**. **`fun`** takes an element and returns a modified element This function uses the Myers diff algorithm. See [`org-ml-update`](#org-ml-update-fun-node) for what this means. ```el ;; Given the following contents: ; #+call: ktulu() (org-ml-update-element-at* (point) (org-ml-set-properties (list :call "cthulhu" :inside-header '(:cache no) :arguments '("x=4") :end-header '(:results html)) it)) ;; Output these buffer contents ;; $> "#+call: cthulhu[:cache no](x=4) :results html" ``` #### org-ml-update-table-row-at `(point fun)` Update table-row under **`point`** using **`fun`**. **`fun`** takes an table-row and returns a modified table-row This function uses the Myers diff algorithm. See [`org-ml-update`](#org-ml-update-fun-node) for what this means. ```el ;; Given the following contents: ; | a | b | (org-ml-update-table-row-at* (point) (org-ml-map-children* (cons (org-ml-build-table-cell! "0") it) it)) ;; Output these buffer contents ;; $> "| 0 | a | b |" ``` #### org-ml-update-item-at `(point fun)` Update item under **`point`** using **`fun`**. **`fun`** takes an item and returns a modified item This function uses the Myers diff algorithm. See [`org-ml-update`](#org-ml-update-fun-node) for what this means. ```el ;; Given the following contents: ; - [ ] thing (org-ml-update-item-at* (point) (org-ml-item-toggle-checkbox it)) ;; Output these buffer contents ;; $> "- [X] thing" ``` #### org-ml-update-headline-at `(point fun)` Update headline under **`point`** using **`fun`**. **`fun`** takes an headline and returns a modified headline This function uses the Myers diff algorithm. See [`org-ml-update`](#org-ml-update-fun-node) for what this means. ```el ;; Given the following contents: ; * TODO might get done ; * DONE no need to update (org-ml-update-headline-at* (point) (org-ml-set-property :todo-keyword "DONE" it)) ;; Output these buffer contents ;; $> "* DONE might get done ; * DONE no need to update" ``` #### org-ml-update-subtree-at `(point fun)` Update subtree under **`point`** using **`fun`**. **`fun`** takes an subtree and returns a modified subtree This function uses the Myers diff algorithm. See [`org-ml-update`](#org-ml-update-fun-node) for what this means. ```el ;; Given the following contents: ; * one ; ** two ; ** three ; * not updated (org-ml-update-subtree-at* (point) (org-ml-headline-demote-subheadline 1 it)) ;; Output these buffer contents ;; $> "* one ; ** two ; *** three ; * not updated" ``` #### org-ml-update-section-at `(point fun)` Update section under **`point`** using **`fun`**. **`fun`** takes an section and returns a modified section This function uses the Myers diff algorithm. See [`org-ml-update`](#org-ml-update-fun-node) for what this means. ```el ;; Given the following contents: ; #+key1: VAL1 ; #+key2: VAL2 ; * irrelevant headline ;; Update the top buffer section before the headlines start (org-ml-update-section-at* (point) (org-ml-map-children* (--map (org-ml-map-property :value #'s-downcase it) it) it)) ;; Output these buffer contents ;; $> "#+key1: val1 ; #+key2: val2 ; * irrelevant headline" ``` #### org-ml-update-headlines `(which fun)` Update some headlines in the current using **`fun`**. See [`org-ml-parse-headlines`](#org-ml-parse-headlines-which) for the meaning of **`which`**. Headlines are updated using `org-ml~update` with `diff-arg` set to nil (see this for use and meaning of **`fun`**). ```el ;; Given the following contents: ; * one ; * two ; * three (org-ml-update-headlines* 0 (org-ml-set-property :todo-keyword "DONE" it)) ;; Output these buffer contents ;; $> "* DONE one ; * two ; * three" (org-ml-update-headlines* '(0 1) (org-ml-set-property :todo-keyword "DONE" it)) ;; Output these buffer contents ;; $> "* DONE one ; * DONE two ; * three" (org-ml-update-headlines* [2 nil] (org-ml-set-property :todo-keyword "DONE" it)) ;; Output these buffer contents ;; $> "* one ; * DONE two ; * DONE three" (org-ml-update-headlines* [2 10] (org-ml-set-property :todo-keyword "DONE" it)) ;; Output these buffer contents ;; $> "* one ; * DONE two ; * three" ;; Given the following contents: ; * one ; * two ; * three (org-ml-update-headlines* 'all (org-ml-set-property :todo-keyword "DONE" it)) ;; Output these buffer contents ;; $> "* DONE one ; * DONE two ; * DONE three" ``` #### org-ml-update-subtrees `(which fun)` Update some toplevel subtrees in the current buffer using **`fun`**. See [`org-ml-parse-subtrees`](#org-ml-parse-subtrees-which) for the meaning of **`which`**. Subtrees are updated using `org-ml~update` with `diff-arg` set to nil (see this for use and meaning of **`fun`**). ```el ;; Given the following contents: ; * one [/] ; ** DONE _one ; * two [/] ; ** DONE _one ; * three [/] ; ** DONE _one (org-ml-update-subtrees* 0 (org-ml-headline-update-todo-statistics it)) ;; Output these buffer contents ;; $> "* one [1/1] ; ** DONE _one ; * two [/] ; ** DONE _one ; * three [/] ; ** DONE _one" (org-ml-update-subtrees* '(0 1) (org-ml-headline-update-todo-statistics it)) ;; Output these buffer contents ;; $> "* one [1/1] ; ** DONE _one ; * two [1/1] ; ** DONE _one ; * three [/] ; ** DONE _one" (org-ml-update-subtrees* [2 nil] (org-ml-headline-update-todo-statistics it)) ;; Output these buffer contents ;; $> "* one [/] ; ** DONE _one ; * two [1/1] ; ** DONE _one ; * three [1/1] ; ** DONE _one" (org-ml-update-subtrees* [nil 5] (org-ml-headline-update-todo-statistics it)) ;; Output these buffer contents ;; $> "* one [1/1] ; ** DONE _one ; * two [/] ; ** DONE _one ; * three [/] ; ** DONE _one" ;; Given the following contents: ; * one [/] ; ** DONE _one ; ** DONE _two ; * two [/] ; ** DONE _one ; ** DONE _two ``` #### org-ml-update-supercontents `(config which fun)` Update some headline supercontents in the current using **`fun`**. See [`org-ml-parse-headlines`](#org-ml-parse-headlines-which) for the meaning of **`which`**. Headlines are updated using `org-ml~update` with `diff-arg` set to nil (see this for use and meaning of **`fun`**). ```el ;; Given the following contents: ; * one (let ((pl '(:scheduled (2000 1 1)))) (org-ml-wrap-impure (org-ml-update-supercontents* nil 'all (org-ml-supercontents-set-planning pl it)))) ;; Output these buffer contents ;; $> "* one ; SCHEDULED: <2000-01-01 Sat>" ;; Given the following contents: ; * one ; ; something (let ((pl '(:scheduled (2000 1 1)))) (org-ml-wrap-impure (org-ml-update-supercontents* nil 'all (org-ml-supercontents-set-planning pl it)))) ;; Output these buffer contents ;; $> "* one ; SCHEDULED: <2000-01-01 Sat> ; ; something" ;; Given the following contents: ; * one ; ** two (let ((pl '(:scheduled (2000 1 1)))) (org-ml-wrap-impure (org-ml-update-supercontents* nil 'all (org-ml-supercontents-set-planning pl it)))) ;; Output these buffer contents ;; $> "* one ; SCHEDULED: <2000-01-01 Sat> ; ** two ; SCHEDULED: <2000-01-01 Sat>" ;; Given the following contents: ; * one ; ** two ; stuff (let ((pl '(:scheduled (2000 1 1)))) (org-ml-wrap-impure (org-ml-update-supercontents* nil 'all (org-ml-supercontents-set-planning pl it)))) ;; Output these buffer contents ;; $> "* one ; SCHEDULED: <2000-01-01 Sat> ; ** two ; SCHEDULED: <2000-01-01 Sat> ; stuff" ;; Given the following contents: ; * one ; stuff (let ((pl '(:scheduled (2000 1 1)))) (org-ml-wrap-impure (org-ml-update-supercontents* nil 'all (org-ml-supercontents-set-planning pl it)))) ;; Output these buffer contents ;; $> "* one ; SCHEDULED: <2000-01-01 Sat> ; stuff" ``` ### Misc #### org-ml-fold `(node)` Fold the children of **`node`** if they exist. ```el no examples :( ``` #### org-ml-unfold `(node)` Unfold the children of **`node`** if they exist. ```el no examples :( ``` Version: 5.8.8 ================================================ FILE: docs/cookbook.md ================================================ # org-ml cookbook The following are a list of common use cases and formulationsfor `org-ml`. If a function is not available straight from theAPI it may be here. ## Adding created time This will add a property called CREATED with a timestamp (which could be modified to hold the current time).. ```el ;; Given the following contents: ; * headine (let ((ts (org-ml-to-string (org-ml-build-timestamp! '(2020 1 1 0 0))))) (->> (org-ml-parse-this-headline) (org-ml-headline-set-node-property "CREATED" ts) (org-ml-to-string))) ;; => "* headline ; :PROPERTIES: ; :CREATED: [2020-01-01 Wed 00:00] ; :END:" ``` ================================================ FILE: env-28.2.yml ================================================ name: org-ml-28.2 channels: - conda-forge dependencies: - _libgcc_mutex=0.1=conda_forge - _openmp_mutex=4.5=2_gnu - adwaita-icon-theme=46.2=unix_0 - at-spi2-atk=2.38.0=h0630a04_3 - at-spi2-core=2.40.3=h0630a04_0 - atk-1.0=2.38.0=h04ea711_2 - bzip2=1.0.8=hd590300_5 - ca-certificates=2024.6.2=hbcca054_0 - cairo=1.18.0=h3faef2a_0 - dbus=1.13.6=h5008d03_3 - emacs=28.2=h41efbed_4 - epoxy=1.5.10=h166bdaf_1 - expat=2.6.2=h59595ed_0 - font-ttf-dejavu-sans-mono=2.37=hab24e00_0 - font-ttf-inconsolata=3.000=h77eed37_0 - font-ttf-source-code-pro=2.038=h77eed37_0 - font-ttf-ubuntu=0.83=h77eed37_2 - fontconfig=2.14.2=h14ed4e7_0 - fonts-conda-ecosystem=1=0 - fonts-conda-forge=1=0 - freetype=2.12.1=h267a509_2 - fribidi=1.0.10=h36c2ea0_0 - gdk-pixbuf=2.42.10=h6b639ba_2 - gettext=0.22.5=h59595ed_2 - gettext-tools=0.22.5=h59595ed_2 - giflib=5.2.2=hd590300_0 - glib=2.80.2=h8a4344b_1 - glib-tools=2.80.2=h73ef956_1 - gmp=6.3.0=h59595ed_1 - gnutls=3.7.9=hb077bed_0 - graphite2=1.3.13=h59595ed_1003 - gtk3=3.24.41=h280cfa0_0 - harfbuzz=8.5.0=hfac3d4d_0 - hicolor-icon-theme=0.17=ha770c72_2 - icu=73.2=h59595ed_0 - keyutils=1.6.1=h166bdaf_0 - krb5=1.21.2=h659d440_0 - ld_impl_linux-64=2.40=hf3520f5_7 - lerc=4.0.0=h27087fc_0 - libasprintf=0.22.5=h661eb56_2 - libasprintf-devel=0.22.5=h661eb56_2 - libcups=2.3.3=h4637d8d_4 - libdeflate=1.18=h0b41bf4_0 - libedit=3.1.20191231=he28a2e2_2 - libexpat=2.6.2=h59595ed_0 - libffi=3.4.2=h7f98852_5 - libgcc-ng=13.2.0=h77fa898_10 - libgettextpo=0.22.5=h59595ed_2 - libgettextpo-devel=0.22.5=h59595ed_2 - libglib=2.80.2=h8a4344b_1 - libgomp=13.2.0=h77fa898_10 - libiconv=1.17=hd590300_2 - libidn2=2.3.7=hd590300_0 - libjpeg-turbo=2.1.5.1=hd590300_1 - libnsl=2.0.1=hd590300_0 - libpng=1.6.43=h2797004_0 - librsvg=2.58.0=hadf69e7_1 - libsqlite=3.46.0=hde9e2c9_0 - libstdcxx-ng=13.2.0=hc0a3c3a_10 - libtasn1=4.19.0=h166bdaf_0 - libtiff=4.5.1=h8b53f26_1 - libunistring=0.9.10=h7f98852_0 - libuuid=2.38.1=h0b41bf4_0 - libwebp-base=1.4.0=hd590300_0 - libxcb=1.15=h0b41bf4_0 - libxcrypt=4.4.36=hd590300_1 - libxkbcommon=1.7.0=h662e7e4_0 - libxml2=2.12.7=hc051c1a_1 - libzlib=1.3.1=h4ab18f5_1 - ncurses=6.5=h59595ed_0 - nettle=3.9.1=h7ab15ed_0 - openssl=3.3.1=h4ab18f5_0 - p11-kit=0.24.1=hc5aa10d_0 - pango=1.54.0=h84a9a3c_0 - pcre2=10.44=h0f59acf_0 - pip=24.0=pyhd8ed1ab_0 - pixman=0.43.2=h59595ed_0 - pthread-stubs=0.4=h36c2ea0_1001 - python=3.12.4=h194c7f8_0_cpython - readline=8.2=h8228510_1 - setuptools=70.0.0=pyhd8ed1ab_0 - tk=8.6.13=noxft_h4845f30_101 - tzdata=2024a=h0c530f3_0 - wayland=1.23.0=h5291e77_0 - wheel=0.43.0=pyhd8ed1ab_1 - xkeyboard-config=2.42=h4ab18f5_0 - xorg-compositeproto=0.4.2=h7f98852_1001 - xorg-damageproto=1.2.1=h7f98852_1002 - xorg-fixesproto=5.0=h7f98852_1002 - xorg-inputproto=2.3.2=h7f98852_1002 - xorg-kbproto=1.0.7=h7f98852_1002 - xorg-libice=1.1.1=hd590300_0 - xorg-libsm=1.2.4=h7391055_0 - xorg-libx11=1.8.9=h8ee46fc_0 - xorg-libxau=1.0.11=hd590300_0 - xorg-libxaw=1.0.14=h7f98852_1 - xorg-libxcomposite=0.4.6=h0b41bf4_1 - xorg-libxcursor=1.2.0=h0b41bf4_1 - xorg-libxdamage=1.1.5=h7f98852_1 - xorg-libxdmcp=1.1.3=h7f98852_0 - xorg-libxext=1.3.4=h0b41bf4_2 - xorg-libxfixes=5.0.3=h7f98852_1004 - xorg-libxft=2.3.8=hf69aa0a_0 - xorg-libxi=1.7.10=h7f98852_0 - xorg-libxinerama=1.1.5=h27087fc_0 - xorg-libxmu=1.1.3=h4ab18f5_1 - xorg-libxpm=3.5.17=hd590300_0 - xorg-libxrandr=1.5.2=h7f98852_1 - xorg-libxrender=0.9.11=hd590300_0 - xorg-libxt=1.3.0=hd590300_1 - xorg-libxtst=1.2.3=h7f98852_1002 - xorg-randrproto=1.5.0=h7f98852_1001 - xorg-recordproto=1.14.2=h7f98852_1002 - xorg-renderproto=0.11.1=h7f98852_1002 - xorg-util-macros=1.19.3=h7f98852_0 - xorg-xextproto=7.3.0=h0b41bf4_1003 - xorg-xineramaproto=1.2.1=h7f98852_1001 - xorg-xproto=7.0.31=h7f98852_1007 - xz=5.2.6=h166bdaf_0 - zlib=1.3.1=h4ab18f5_1 - zstd=1.5.6=ha6fb4c9_0 ================================================ FILE: env-29.3.yml ================================================ name: org-ml-29.3 channels: - conda-forge dependencies: - _libgcc_mutex=0.1=conda_forge - _openmp_mutex=4.5=2_gnu - adwaita-icon-theme=46.2=unix_0 - at-spi2-atk=2.38.0=h0630a04_3 - at-spi2-core=2.40.3=h0630a04_0 - atk-1.0=2.38.0=h04ea711_2 - bzip2=1.0.8=hd590300_5 - ca-certificates=2024.6.2=hbcca054_0 - cairo=1.18.0=h3faef2a_0 - dbus=1.13.6=h5008d03_3 - emacs=29.3=hc93ec10_0 - epoxy=1.5.10=h166bdaf_1 - expat=2.6.2=h59595ed_0 - font-ttf-dejavu-sans-mono=2.37=hab24e00_0 - font-ttf-inconsolata=3.000=h77eed37_0 - font-ttf-source-code-pro=2.038=h77eed37_0 - font-ttf-ubuntu=0.83=h77eed37_2 - fontconfig=2.14.2=h14ed4e7_0 - fonts-conda-ecosystem=1=0 - fonts-conda-forge=1=0 - freetype=2.12.1=h267a509_2 - fribidi=1.0.10=h36c2ea0_0 - gdk-pixbuf=2.42.12=hb9ae30d_0 - gettext=0.22.5=h59595ed_2 - gettext-tools=0.22.5=h59595ed_2 - giflib=5.2.2=hd590300_0 - glib=2.80.2=h8a4344b_1 - glib-tools=2.80.2=h73ef956_1 - gmp=6.3.0=h59595ed_1 - gnutls=3.7.9=hb077bed_0 - graphite2=1.3.13=h59595ed_1003 - gtk3=3.24.42=h6d40eaa_0 - harfbuzz=8.5.0=hfac3d4d_0 - hicolor-icon-theme=0.17=ha770c72_2 - icu=73.2=h59595ed_0 - jansson=2.14=h0b41bf4_1 - keyutils=1.6.1=h166bdaf_0 - krb5=1.21.2=h659d440_0 - ld_impl_linux-64=2.40=hf3520f5_7 - lerc=4.0.0=h27087fc_0 - libasprintf=0.22.5=h661eb56_2 - libasprintf-devel=0.22.5=h661eb56_2 - libcups=2.3.3=h4637d8d_4 - libdeflate=1.20=hd590300_0 - libedit=3.1.20191231=he28a2e2_2 - libexpat=2.6.2=h59595ed_0 - libffi=3.4.2=h7f98852_5 - libgcc-ng=13.2.0=h77fa898_10 - libgettextpo=0.22.5=h59595ed_2 - libgettextpo-devel=0.22.5=h59595ed_2 - libglib=2.80.2=h8a4344b_1 - libgomp=13.2.0=h77fa898_10 - libiconv=1.17=hd590300_2 - libidn2=2.3.7=hd590300_0 - libjpeg-turbo=3.0.0=hd590300_1 - libnsl=2.0.1=hd590300_0 - libpng=1.6.43=h2797004_0 - librsvg=2.58.1=hadf69e7_0 - libsqlite=3.46.0=hde9e2c9_0 - libstdcxx-ng=13.2.0=hc0a3c3a_10 - libtasn1=4.19.0=h166bdaf_0 - libtiff=4.6.0=h1dd3fc0_3 - libtree-sitter=0.20.8=hd590300_0 - libunistring=0.9.10=h7f98852_0 - libuuid=2.38.1=h0b41bf4_0 - libwebp-base=1.4.0=hd590300_0 - libxcb=1.15=h0b41bf4_0 - libxcrypt=4.4.36=hd590300_1 - libxkbcommon=1.7.0=h662e7e4_0 - libxml2=2.12.7=hc051c1a_1 - libzlib=1.3.1=h4ab18f5_1 - ncurses=6.5=h59595ed_0 - nettle=3.9.1=h7ab15ed_0 - openssl=3.3.1=h4ab18f5_0 - p11-kit=0.24.1=hc5aa10d_0 - pango=1.54.0=h84a9a3c_0 - pcre2=10.44=h0f59acf_0 - pip=24.0=pyhd8ed1ab_0 - pixman=0.43.2=h59595ed_0 - pthread-stubs=0.4=h36c2ea0_1001 - python=3.12.4=h194c7f8_0_cpython - readline=8.2=h8228510_1 - setuptools=70.0.0=pyhd8ed1ab_0 - tk=8.6.13=noxft_h4845f30_101 - tzdata=2024a=h0c530f3_0 - wayland=1.23.0=h5291e77_0 - wheel=0.43.0=pyhd8ed1ab_1 - xkeyboard-config=2.42=h4ab18f5_0 - xorg-compositeproto=0.4.2=h7f98852_1001 - xorg-damageproto=1.2.1=h7f98852_1002 - xorg-fixesproto=5.0=h7f98852_1002 - xorg-inputproto=2.3.2=h7f98852_1002 - xorg-kbproto=1.0.7=h7f98852_1002 - xorg-libice=1.1.1=hd590300_0 - xorg-libsm=1.2.4=h7391055_0 - xorg-libx11=1.8.9=h8ee46fc_0 - xorg-libxau=1.0.11=hd590300_0 - xorg-libxaw=1.0.14=h7f98852_1 - xorg-libxcomposite=0.4.6=h0b41bf4_1 - xorg-libxcursor=1.2.0=h0b41bf4_1 - xorg-libxdamage=1.1.5=h7f98852_1 - xorg-libxdmcp=1.1.3=h7f98852_0 - xorg-libxext=1.3.4=h0b41bf4_2 - xorg-libxfixes=5.0.3=h7f98852_1004 - xorg-libxft=2.3.8=hf69aa0a_0 - xorg-libxi=1.7.10=h7f98852_0 - xorg-libxinerama=1.1.5=h27087fc_0 - xorg-libxmu=1.1.3=h4ab18f5_1 - xorg-libxpm=3.5.17=hd590300_0 - xorg-libxrandr=1.5.2=h7f98852_1 - xorg-libxrender=0.9.11=hd590300_0 - xorg-libxt=1.3.0=hd590300_1 - xorg-libxtst=1.2.3=h7f98852_1002 - xorg-randrproto=1.5.0=h7f98852_1001 - xorg-recordproto=1.14.2=h7f98852_1002 - xorg-renderproto=0.11.1=h7f98852_1002 - xorg-util-macros=1.19.3=h7f98852_0 - xorg-xextproto=7.3.0=h0b41bf4_1003 - xorg-xineramaproto=1.2.1=h7f98852_1001 - xorg-xproto=7.0.31=h7f98852_1007 - xz=5.2.6=h166bdaf_0 - zlib=1.3.1=h4ab18f5_1 - zstd=1.5.6=ha6fb4c9_0 ================================================ FILE: env-30.1.yml ================================================ name: org-ml-30.1 channels: - conda-forge dependencies: - _libgcc_mutex=0.1=conda_forge - _openmp_mutex=4.5=2_gnu - adwaita-icon-theme=48.0=unix_0 - at-spi2-atk=2.38.0=h0630a04_3 - at-spi2-core=2.40.3=h0630a04_0 - atk-1.0=2.38.0=h04ea711_2 - binutils=2.43=h4852527_4 - binutils_impl_linux-64=2.43=h4bf12b8_4 - bzip2=1.0.8=h4bc722e_7 - ca-certificates=2025.1.31=hbcca054_0 - cairo=1.18.4=h3394656_0 - dbus=1.13.6=h5008d03_3 - emacs=30.1=h9508cbc_4 - epoxy=1.5.10=h166bdaf_1 - expat=2.7.0=h5888daf_0 - font-ttf-dejavu-sans-mono=2.37=hab24e00_0 - font-ttf-inconsolata=3.000=h77eed37_0 - font-ttf-source-code-pro=2.038=h77eed37_0 - font-ttf-ubuntu=0.83=h77eed37_3 - fontconfig=2.15.0=h7e30c49_1 - fonts-conda-ecosystem=1=0 - fonts-conda-forge=1=0 - freetype=2.13.3=h48d6fc4_0 - fribidi=1.0.10=h36c2ea0_0 - gdk-pixbuf=2.42.12=hb9ae30d_0 - gettext=0.23.1=h5888daf_0 - gettext-tools=0.23.1=h5888daf_0 - giflib=5.2.2=hd590300_0 - glib=2.84.1=h07242d1_0 - glib-tools=2.84.1=h4833e2c_0 - gmp=6.3.0=hac33072_2 - gnutls=3.8.9=h5746830_0 - graphite2=1.3.13=h59595ed_1003 - gtk3=3.24.43=h0c6a113_5 - harfbuzz=11.0.0=h76408a6_0 - hicolor-icon-theme=0.17=ha770c72_2 - icu=75.1=he02047a_0 - jansson=2.14.1=hb9d3cd8_0 - kernel-headers_linux-64=3.10.0=he073ed8_18 - keyutils=1.6.1=h166bdaf_0 - krb5=1.21.3=h659f571_0 - ld_impl_linux-64=2.43=h712a8e2_4 - lerc=4.0.0=h27087fc_0 - libasprintf=0.23.1=h8e693c7_0 - libasprintf-devel=0.23.1=h8e693c7_0 - libcups=2.3.3=h4637d8d_4 - libdeflate=1.23=h4ddbbb0_0 - libedit=3.1.20250104=pl5321h7949ede_0 - libexpat=2.7.0=h5888daf_0 - libffi=3.4.6=h2dba641_1 - libgcc=14.2.0=h767d61c_2 - libgcc-ng=14.2.0=h69a702a_2 - libgettextpo=0.23.1=h5888daf_0 - libgettextpo-devel=0.23.1=h5888daf_0 - libglib=2.84.1=h2ff4ddf_0 - libgomp=14.2.0=h767d61c_2 - libiconv=1.18=h4ce23a2_1 - libidn2=2.3.8=ha4ef2c3_0 - libjpeg-turbo=3.0.0=hd590300_1 - liblzma=5.8.1=hb9d3cd8_0 - libmpdec=4.0.0=h4bc722e_0 - libpng=1.6.47=h943b412_0 - librsvg=2.58.4=he92a37e_3 - libsqlite=3.49.1=hee588c1_2 - libstdcxx=14.2.0=h8f9b012_2 - libstdcxx-ng=14.2.0=h4852527_2 - libtasn1=4.20.0=hb9d3cd8_0 - libtiff=4.7.0=hd9ff511_3 - libtree-sitter=0.25.3=hd0c01bc_0 - libunistring=0.9.10=h7f98852_0 - libuuid=2.38.1=h0b41bf4_0 - libwebp-base=1.5.0=h851e524_0 - libxcb=1.17.0=h8a09558_0 - libxkbcommon=1.8.1=hc4a0caf_0 - libxml2=2.13.7=h4bc477f_1 - libzlib=1.3.1=hb9d3cd8_2 - mpc=1.3.1=h24ddda3_1 - mpfr=4.2.1=h90cbb55_3 - ncurses=6.5=h2d0b736_3 - nettle=3.9.1=h7ab15ed_0 - openssl=3.4.1=h7b32b05_0 - p11-kit=0.24.1=hc5aa10d_0 - packaging=24.2=pyhd8ed1ab_2 - pango=1.56.3=h9ac818e_1 - pcre2=10.44=hba22ea6_2 - pip=25.0.1=pyh145f28c_0 - pixman=0.44.2=h29eaf8c_0 - pthread-stubs=0.4=hb9d3cd8_1002 - python=3.13.2=hf636f53_101_cp313 - python_abi=3.13=6_cp313 - readline=8.2=h8c095d6_2 - sysroot_linux-64=2.17=h0157908_18 - tk=8.6.13=noxft_h4845f30_101 - tzdata=2025b=h78e105d_0 - wayland=1.23.1=h3e06ad9_0 - xkeyboard-config=2.43=hb9d3cd8_0 - xorg-libice=1.1.2=hb9d3cd8_0 - xorg-libsm=1.2.6=he73a12e_0 - xorg-libx11=1.8.12=h4f16b4b_0 - xorg-libxau=1.0.12=hb9d3cd8_0 - xorg-libxaw=1.0.16=hb9d3cd8_0 - xorg-libxcomposite=0.4.6=hb9d3cd8_2 - xorg-libxcursor=1.2.3=hb9d3cd8_0 - xorg-libxdamage=1.1.6=hb9d3cd8_0 - xorg-libxdmcp=1.1.5=hb9d3cd8_0 - xorg-libxext=1.3.6=hb9d3cd8_0 - xorg-libxfixes=6.0.1=hb9d3cd8_0 - xorg-libxft=2.3.8=ha04879e_1 - xorg-libxi=1.8.2=hb9d3cd8_0 - xorg-libxinerama=1.1.5=h5888daf_1 - xorg-libxmu=1.2.1=hb9d3cd8_1 - xorg-libxpm=3.5.17=hb9d3cd8_1 - xorg-libxrandr=1.5.4=hb9d3cd8_0 - xorg-libxrender=0.9.12=hb9d3cd8_0 - xorg-libxt=1.3.1=hb9d3cd8_0 - xorg-libxtst=1.2.5=hb9d3cd8_3 - xorg-xorgproto=2024.1=hb9d3cd8_1 - zlib=1.3.1=hb9d3cd8_2 - zstd=1.5.7=hb8e6e7a_2 ================================================ FILE: init.el ================================================ (defun fix-null-term (s) "Fix string S with extra wonky null terminators. For whatever reason this affects certain strings in the conda package for Emacs. These look like `blabla\0\0\0\0\0\0\0`." (declare (pure t) (side-effect-free t)) (save-match-data (if (string-match "\0+" s) (replace-match "" t t s) s))) ;; HACK stuff won't install unless this string is fixed (if (< (round (string-to-number emacs-version)) 29) (setq Info-default-directory-list (cons (fix-null-term (car Info-default-directory-list)) (cdr Info-default-directory-list))) (setq configure-info-directory (fix-null-term configure-info-directory))) (setq package-enable-at-startup nil) (setq user-emacs-directory (file-name-concat (expand-file-name ".emacs") emacs-version)) (defvar bootstrap-version) (let ((bootstrap-file (file-name-concat user-emacs-directory "straight/repos/straight.el/bootstrap.el")) (bootstrap-version 7)) (unless (file-exists-p bootstrap-file) (with-current-buffer (url-retrieve-synchronously "https://raw.githubusercontent.com/radian-software/straight.el/develop/install.el" 'silent 'inhibit-cookies) (goto-char (point-max)) (eval-print-last-sexp))) (load bootstrap-file nil 'nomessage)) (straight-use-package 's) (straight-use-package 'dash) (straight-use-package 'buttercup) (straight-use-package 'org) (defun compile-target () "Compile org-ml." (byte-compile-file "org-ml-macs.el") (byte-compile-file "org-ml.el")) ================================================ FILE: org-ml-macs.el ================================================ ;;; org-ml-macs.el --- Macros for org-ml -*- lexical-binding: t; -*- ;; Author: Nathan Dwarshuis ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; This file contains macros essential for the `org-ml' package. The ;; following functionality is implemented: ;; - automatic anaphoric form generation (`org-ml--defun*'): this macro will ;; define an anaphoric form along with a regular function definition ;; - defun with &rest + &keys support (`org-ml--defun-kw'): this macro allows ;; writing function definitions that accept &key and &rest arguments at the ;; same time, which `cl-defun' does not (and likely will never) support ;;; Code: (require 'dash) (require 's) (eval-when-compile (require 'cl-lib)) ;;; ANAPHORIC FUNCTIONS (defun org-ml--defun-partition-body (body) "Return ARGS as a list like (DOCSTRING DECLS BODY). DOCSTRING is the first string in BODY if present and it succeeded by more forms. DECLS is a list of declarations in the DECLARE statement if present after the docstring. Everything else is BODY." ;; macroexp-parse-body doesn't seem to retain declare (cl-flet ((is-declare (form) (eq 'declare (car form)))) (let ((first (car body)) (second (cadr body)) (rest (cddr body))) (cond ((and (stringp first) (is-declare second)) (list first (cdr second) rest)) ((and (stringp first) second) (list first nil (cons second rest))) ((and (is-declare first) second) (list nil (cdr first) (cons second rest))) (t (list nil nil body)))))) (defun org-ml--defun-make-indent-declare (decl pos) "Return declare form with indent set to POS if not present already. DECL is a list of declarations." (let ((indent (or (assoc 'indent decl) `(indent ,pos))) (decl (--remove (eq 'indent (car it)) decl))) `(declare ,@decl ,indent))) (defun org-ml--defun-make-anaphoric-docstring (name docstring) "Return DOCSTRING adapted for anaphoric version of definition NAME. This includes adding a short string to the front indicating it is an anaphoric version and replacing all instances of \"FUN\" with \"FORM\"." (let ((case-fold-search nil)) (->> (s-replace "FUN" "FORM" docstring) (format "Anaphoric form of `%s'.\n\n%s" name)))) (defmacro org-ml--defun* (name arglist &rest args) "Return a function definition for NAME, ARGLIST, and ARGS. This will also make a mirrored anaphoric form macro definition. This assumes that `fun' represents a unary function which will be used somewhere in the definition's body. When making the anaphoric form, `fun' will be replaced by the symbol `form', and `form' will be wrapped in a lambda call binding the unary argument to the symbol `it'." (declare (doc-string 3) (indent 2)) (-let* (((docstring decls body) (org-ml--defun-partition-body args)) (name* (intern (format "%s*" name))) (arglist* (-replace 'fun 'form arglist)) (docstring* (org-ml--defun-make-anaphoric-docstring name docstring)) (funargs (--map (if (eq it 'fun) '(lambda (it) (\, form)) (cons '\, (list it))) arglist)) (body* (cdr (backquote-process (backquote (,name ,@funargs))))) (debug* (->> arglist (--map (if (eq it 'fun) 'def-form 'form)) (list 'debug))) (dec (org-ml--defun-make-indent-declare decls (-elem-index 'fun arglist))) (dec* (org-ml--defun-make-indent-declare (cons debug* decls) (-elem-index 'fun arglist)))) `(progn (defmacro ,name* ,arglist* ,docstring* ,dec* ,body*) (defun ,name ,arglist ,docstring ,dec ,@body)))) (defun org-ml--replace-funcall (sym form) "Replace all instances of (funcall fun X) with SYM in FORM." (pcase form (`(funcall fun it) (list '\, sym)) (`(funcall fun ,f) (list 'let `((it ,f)) (list '\, sym))) ((pred consp) (--map (org-ml--replace-funcall sym it) form)) (f f))) (defun org-ml--get-let-symbols (let-syms form) "Return the symbols that should be bound in let forms from FORM. The symbols to search for are LET-SYMS, and the returned list will contain all symbols in LET-SYMS that appear more than once in FORM." (->> (-tree-seq #'consp #'identity form) (-filter #'symbolp) (-remove #'keywordp) (-remove #'fboundp) (--filter (memq it let-syms)) (-group-by #'identity) (--filter (< 1 (length (cdr it)))) (-map #'car))) (defun org-ml--replace-syms (let-syms privatize? form) "Replace symbols in FORM. The symbols to replace are in LET-SYMS, and the value to replace the symbol will with be (\\, SYM). If PRIVATIZE? is non-nil, also privatize any sym along with replacing it." (pcase form ((pred consp) (--map (org-ml--replace-syms let-syms privatize? it) form)) ((pred symbolp) (if (not (memq form let-syms)) form (list '\, (if (not privatize?) form (org-ml--make-private-sym form))))) (f f))) (defun org-ml--make-private-sym (sym) "Return SYM prefixed with two dashes." (intern (format "--%s" sym))) (defun org-ml--make-anaphoric-form (arglist body) "Make an anaphoric from from BODY. ARGLIST is the argument list from the non-anaphoric form." (let* ((body* (->> (-map #'macroexpand-all body) (org-ml--replace-funcall 'form))) (arglist* (-remove-item 'fun arglist))) (-if-let (let-syms (org-ml--get-let-symbols arglist* body*)) (let* ((nonlet-syms (-difference arglist* let-syms)) (body** (->> (org-ml--replace-syms nonlet-syms nil body*) (org-ml--replace-syms let-syms t))) (private-syms (-map #'org-ml--make-private-sym let-syms)) (mk-sym-forms (--map `(make-symbol ,(symbol-name it)) private-syms)) (outer-forms (--zip-with `(,it ,other) private-syms mk-sym-forms)) (inner-forms (--zip-with `(,(list '\, it) ,(list '\, other)) private-syms let-syms))) `(let (,@outer-forms) (backquote (let (,@inner-forms) ,@body**)))) (let ((body** (org-ml--replace-syms arglist* nil body*))) `(backquote ,body**))))) (defmacro org-ml--defun-anaphoric* (name arglist &rest args) "Return a function definition for NAME, ARGLIST, and ARGS. This will also make a mirrored anaphoric form macro definition. This assumes that `fun' represents a unary function which will be used somewhere in the definition's body. When making the anaphoric form, `fun' will be replaced by the symbol `form', and `form' will be wrapped in a lambda call binding the unary argument to the symbol `it'." (declare (doc-string 3) (indent 2)) (-let* (((docstring decls body) (org-ml--defun-partition-body args)) (dec (org-ml--defun-make-indent-declare decls (-elem-index 'fun arglist))) (name* (intern (format "%s*" name))) (arglist* (-replace 'fun 'form arglist)) (docstring* (org-ml--defun-make-anaphoric-docstring name docstring)) (debug* (->> arglist (--map (if (eq it 'fun) 'def-form 'form)) (list 'debug))) (dec* (org-ml--defun-make-indent-declare (cons debug* decls) (-elem-index 'fun arglist))) (body* (org-ml--make-anaphoric-form arglist body))) `(progn (defmacro ,name* ,arglist* ,docstring* ,dec* ;; (backquote ,body*)) ,body*) (defun ,name ,arglist ,docstring ,dec ,@body)))) ;;; BETTER CL-DEFUN ;; Some functions here require a clean way to use &rest and &key at the same ;; time, which `cl-defun' does not do. For a given external function signature ;; like (P1 ... &key K1 ... &rest R), this framework will make a function with ;; the internal signature (P1 ... &rest --rest-args) where PX are positional ;; arguments matching exactly those in the external signature and --rest-args ;; will bind the list contain the key-val pairs and rest arguments. This will be ;; partitioned into keyword arguments like KX VAL rest arguments R internally. (defun org-ml--symbol-to-keyword (symbol) "Convert SYMBOL to keyword if not already." (if (keywordp symbol) symbol (->> (symbol-name symbol) (s-prepend ":") (intern)))) (defun org-ml--process-pos-args (pos-args) "Process POS-ARGS and return if valid." (if (--all? (or (symbolp it) (consp it)) pos-args) pos-args (error "Positional args must be either cons cells or symbols"))) (defun org-ml--process-rest-arg (rest-arg) "Process REST-ARG and return if valid." (pcase rest-arg (`(,(and (pred symbolp) sym) . nil) sym) (`nil nil) (_ (error "Rest argument must only have one symbol")))) (defun org-ml--make-kwarg-let (kws-sym kwarg) "Return cell for KWARG like (KW . LET-FORM). KWARG is a keyword argument in the signature of a function definition \(see `org-ml--defun-kw' for valid configurations of this). In the returned cell, KW is keyword representing the key to be used in a function call, and LET-FORM is a form to be used in a let binding that will retrieve the value for KW from a plist bound to KWS-SYM (which is a non-interned symbol to be bound to the keywords in a function call)." (cl-flet ((make-plist (arg init) (let* ((kw (org-ml--symbol-to-keyword arg)) (kw-get `(cadr (plist-member ,kws-sym ',kw))) (val (if init `(or ,kw-get ,init) kw-get))) (cons kw `(,arg ,val))))) (pcase kwarg (`(,arg ,init) (make-plist arg init)) ((and (pred symbolp) arg) (make-plist arg nil)) (_ (error "Invalid keyword argument: %s" kwarg))))) (defmacro org-ml--throw-kw-error (msg kws) "Throw an error with MSG with formatted list of KWS." `(when ,kws (->> (-map #'symbol-name ,kws) (s-join ", ") (error (concat ,msg ": %s"))))) (defmacro org-ml--partition-rest-args (args) "Partition ARGS into two keyword and rest argument lists. The keyword list is determined by partitioning all keyword-value pairs until this pattern is broken. Whatever is left is put into the rest list. Return a list like (KEYARGS RESTARGS)." `(let ((rest ,args) acc-plist acc-keys) (while (and rest (keywordp (car rest))) (setq acc-plist `(,(cadr rest) ,(car rest) ,@acc-plist) acc-keys (cons (car rest) acc-keys) rest (cddr rest))) (list (nreverse acc-keys) (nreverse acc-plist) rest))) (defmacro org-ml--make-rest-partition-form (argsym kws use-rest?) "Return a form that will partition the args in ARGSYM. ARGSYM is a symbol which is bound to the rest argument list of a function call. KWS is a list of valid keywords to use when deciding which in the argument values is a keyword-value pair, and USE-REST? is a boolean that determines if rest arguments are to be considered." ;; these `make-symbol' calls probably aren't necessary but they ;; ensure the let bindings are leak-proof (let* ((k (make-symbol "--kpart")) (y (make-symbol "--keys")) (r (make-symbol "--rpart")) (inv-msg "Invalid keyword(s) found") (dup-msg "Keyword(s) used multiple times") (rest-msg (s-join " " '("Keyword-value pairs must be immediately" "after positional arguments. These keywords" "were interpreted as rest arguments"))) (tests `((let (invalid unique dups) (--each ,y (if (memq it ',kws) (if (memq it unique) (!cons it dups) (!cons it unique)) (if (memq it invalid) (!cons it dups) (!cons it invalid)))) (when invalid (org-ml--throw-kw-error ,inv-msg invalid)) (when dups (org-ml--throw-kw-error ,dup-msg dups))) ;; ensure that keyword pairs are only used ;; immediately after positional arguments (->> (-filter #'keywordp ,r) (org-ml--throw-kw-error ,rest-msg)))) ;; if rest arguments are used but not allowed in function ;; call, throw error (tests (if use-rest? tests (-snoc tests `(when ,r (error "Too many arguments supplied"))))) ;; return a cons cell of (KEY REST) argument values or ;; just KEY if rest is not used in the function call (return (if (not use-rest?) k `(cons ,k ,r)))) `(-let (((,y ,k ,r) (org-ml--partition-rest-args ,argsym))) ,@tests ,return))) (defun org-ml--make-usage-args (arglist) "Return ARGLIST as it should appear in the usage signature. This will uppercase all symbol names and remove all type keys." (cl-flet* ((ucase-sym (sym) (-> sym (symbol-name) (upcase) (make-symbol))) (unwrap-form-maybe (arg) (ucase-sym (if (consp arg) (cadr arg) arg))) (unwrap-kw-form-maybe (arg) (pcase arg ;; ((PRED KEY) INITFORM) (`((,(and (pred keywordp) _) ,arg) ,init) (list (ucase-sym arg) init)) ;; ((PRED KEY)) (`((,(and (pred keywordp) _) ,arg)) (ucase-sym arg)) ;; (KEY INITFORM) (`(,arg ,init) (list (ucase-sym arg) init)) ;; KEY ((and (pred symbolp) arg) (ucase-sym arg)) (_ (error "This shouldn't happen"))))) (let* ((part(-partition-before-pred (lambda (it) (memq it '(&pos &rest &key))) (cons '&pos arglist))) (pos (-some->> (alist-get '&pos part) (-map #'unwrap-form-maybe))) (kw (-some->> (alist-get '&key part) (-map #'unwrap-kw-form-maybe) (cons '&key))) (rest (-some->> (alist-get '&rest part) (-map #'unwrap-form-maybe) (cons '&rest)))) (append pos kw rest)))) (defun org-ml--make-header (body arglist) "Return a header using docstring from BODY and ARGLIST." (let ((header (caar (macroexp-parse-body body)))) ;; Macro expansion can take place in the middle of ;; apparently harmless computation, so it should not ;; touch the match-data. (save-match-data (let ((print-gensym nil) (print-quoted t) (print-escape-newlines t)) (->> (org-ml--make-usage-args arglist) (cons 'fn) (format "%S") (help--docstring-quote) (help-add-fundoc-usage header)))))) (defun org-ml--transform-lambda (arglist body name) "Make a form for a keyword/rest composite function definition. ARGLIST is the argument signature. BODY is the function body. NAME is the NAME of the function definition. This acts much like `cl-defun' except that it only considers &rest and &key slots. The way the final function call will work beneath the surface is that all positional arguments will be bound to their symbols in ARGLIST (analogous to `defun' and `cl-defun'), and the key and rest arguments will be captured in one rest argument to be partitioned on the fly into key and rest bindings that can be used in BODY." ;; assume &key will always be present if this function is called (let* ((a (make-symbol "--arg-cell")) (k (make-symbol "--kw-args")) (kr (make-symbol "--key-and-rest-args")) (partargs (-partition-before-pred (lambda (it) (memq it '(&pos &rest &key))) (cons '&pos arglist))) (pos-args (->> (alist-get '&pos partargs) (org-ml--process-pos-args))) (kw-alist (->> (alist-get '&key partargs) (--map (org-ml--make-kwarg-let k it)))) (rest-arg (->> (alist-get '&rest partargs) (org-ml--process-rest-arg))) (kws (-map #'car kw-alist)) (kw-lets (-map #'cdr kw-alist)) (arg-form `(,@pos-args &rest ,kr)) (header (org-ml--make-header body arglist)) (let-forms (if rest-arg `((,a (org-ml--make-rest-partition-form ,kr ,kws t)) (,k (car ,a)) (,rest-arg (cdr ,a)) ,@kw-lets) `((,k (org-ml--make-rest-partition-form ,kr ,kws nil)) ,@kw-lets))) (body (->> (macroexp-parse-body body) (cdr) (append `(cl-block ,name))))) ;; if &key is used but no keywords are actually used, slap the ;; programmer in the face (unless kw-alist (error "No keywords used")) `(,arg-form ,header ,(macroexp-let* let-forms (macroexp-progn `(,body)))))) (def-edebug-spec org-ml--defun-key ([&or arg (arg sexp)])) (def-edebug-spec org-ml--defun-lambda-kw-list (([&rest arg] [&optional ["&key" org-ml--defun-key &rest org-ml--defun-key]] &optional ["&rest" arg]))) (defmacro org-ml--defun-kw (name arglist &rest body) "Define NAME as a function with BODY. This is like `cl-defun' except it allows &key to be used in conjunction with &rest without freaking out. ARGLIST can be specified using the following syntax: \([VAR] ... [&key (VAR [INITFORM])...] [&rest VAR]) where VAR is a symbol for the variable identifier and INITFORM is an atom or form that will be the default value for keyword VAR if it is not give in a function call. When calling functions defined with this, keywords can be given in any order as long as they are after all positional arguments, and rest arguments will be interpreted as anything not belonging to a key-val pair (but only if &rest was used to define the function). This implies that keywords may not be used as values for the rest argument in function calls." (declare (doc-string 3) (indent 2) (debug (&define name org-ml--defun-lambda-kw-list lambda-doc [&optional ("declare" &rest sexp)] def-body))) (if (memq '&key arglist) (let ((res (org-ml--transform-lambda arglist body name))) `(defun ,name ,@res)) (error "&key not used, use regular defun"))) ;; COMPILER MACROS (defmacro org-ml--defconst (symbol form &optional docstring) "Like `defconst' but wrapped in `eval-and-compile'. SYMBOL and DOCSTRING have the same meaning as `defconst'. FORM is used to set the init value and is wrapped in `eval-when-compile.'" (declare (indent 1)) `(eval-and-compile (defconst ,symbol (eval-when-compile ,form) ,docstring))) (defmacro org-ml--defvaralias (new-alias base-variable &optional docstring) "Like `defvaralias' but wrapped in `eval-and-compile'. NEW-ALIAS, BASE-VARIABLE, and DOCSTRING have the same meaning as `defconst'." (declare (indent 1)) `(eval-and-compile (defvaralias ,new-alias ,base-variable ,docstring))) ;; FUNCTORS (defmacro org-ml--map-first* (form list) "Return LIST with FORM applied to the first member. The first element is `it' in FORM which returns the modified member." (let ((x (make-symbol "--list"))) `(let ((,x ,list)) (when ,x (cons (let ((it (car ,x))) ,form) (cdr ,x)))))) (defmacro org-ml--map-last* (form list) "Return LIST with FORM applied to the last member. The last element is `it' in FORM which returns the modified member." (let ((x (make-symbol "--list"))) `(let ((,x ,list)) (when ,x (nreverse (org-ml--map-first* ,form (nreverse ,x))))))) (defmacro org-ml--map-at* (n form list) "Return LIST with FORM applied to the member at index N. The nth element is `it' in FORM which returns the modified member." (declare (indent 1)) `(-replace-at ,n (let ((it (nth ,n ,list))) ,form) ,list)) ;; LIST OPERATIONS (defmacro org-ml--reduce2-from* (form init list) "Like `--reduce-from' but iterate over every pair of items in LIST. In FORM, the first of the pair is bound to `it-key' and the second is bound to `it'. INIT has the same meaning." (let ((l (make-symbol "list"))) `(let ((acc ,init) (,l ,list) it it-key) (while ,l (setq it (cadr ,l) it-key (car ,l) acc ,form ,l (cdr (cdr ,l)))) acc))) (provide 'org-ml-macs) ;;; org-ml-macs.el ends here ================================================ FILE: org-ml.el ================================================ ;;; org-ml.el --- Functional Org Mode API -*- lexical-binding: t; -*- ;; Copyright (C) 2020 Nathan Dwarshuis ;; Author: Nathan Dwarshuis ;; Keywords: org-mode, outlines ;; Homepage: https://github.com/ndwarshuis/org-ml ;; Package-Requires: ((emacs "27.1") (org "9.7") (dash "2.17") (s "1.12")) ;; Version: 6.0.2 ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; This is a functional API for org-mode primarily using the `org-element' ;; library. `org-element.el' provides the means for converting an org buffer to ;; a parse-tree data structure. This library contains functions to modify this ;; parse-tree in a more-or-less 'purely' functional manner (with the exception ;; of parsing from the buffer and writing back to the buffer). For the purpose ;; of this package, the resulting parse tree is composed of 'nodes'. ;; This library exposes the following types of functions: ;; - builder: build new nodes to be inserted into a parse tree ;; - property functions: return either property values (get) or nodes with ;; modified properties (set and map) ;; - children functions: return either children of nodes (get) or return a node ;; with modified children (set and map) ;; - node predicates: return t if node meets a condition ;; - pattern matching: return nodes based on a pattern that matches the parse ;; tree (and perform operations on those nodes depending on the function) ;; - parsers: parse a buffer (optionally at current point) and return a parse ;; tree ;; - writers: insert/update the contents of a buffer given a parse tree ;; For examples please see full documentation at: ;; https://github.com/ndwarshuis/org-ml ;;; Code: (require 'org-element) (require 'dash) (require 's) (require 'inline) (eval-when-compile (require 'org-ml-macs)) ;;; NODE TYPE SETS ;; When only considering types, nodes can be arranged in the following ;; sets (where nested sets are mutually exclusive) ;; +---------------------------------------------------+ ;; | nodes | ;; | | ;; | +-----------------------------------------------+ | ;; | | element nodes | | ;; | | (`org-element-all-elements' + 'org-data') | | ;; | | | | ;; | | +-------------------------------------------+ | | ;; | | | leaf nodes | | | ;; | | +-------------------------------------------+ | | ;; | | | | ;; | | +-------------------------------------------+ | | ;; | | | branch nodes | | | ;; | | | | | | ;; | | | +---------------------------------------+ | | | ;; | | | | permitting child element nodes | | | | ;; | | | | (aka "greater elements") | | | | ;; | | | | (`org-element-greater-elements' | | | | ;; | | | | + 'org-data) | | | | ;; | | | +---------------------------------------+ | | | ;; | | | | | | ;; | | | +---------------------------------------+ | | | ;; | | | | permitting child object nodes | | | | ;; | | | | (`org-element-object-containers' - | | | | ;; | | | | `org-element-recursive-objects') | | | | ;; | | | +---------------------------------------+ | | | ;; | | +-------------------------------------------+ | | ;; | +-----------------------------------------------+ | ;; | | ;; | +-----------------------------------------------+ | ;; | | object nodes | | ;; | | (`org-element-all-objects' + 'plain-text') | | ;; | | | | ;; | | +-------------------------------------------+ | | ;; | | | leaf nodes | | | ;; | | +-------------------------------------------+ | | ;; | | | | ;; | | +-------------------------------------------+ | | ;; | | | branch nodes permitting child object | | | ;; | | | nodes (aka "recursive objects") | | | ;; | | | (`org-element-recursive-objects') | | | ;; | | +-------------------------------------------+ | | ;; | +-----------------------------------------------+ | ;; +---------------------------------------------------+ ;; In `org-element.el' the types 'plain-text' and 'org-data' are ;; not mentioned but are required here to make the sets complete. ;; 'plain-text' is consider a leaf node of class object and 'org-data' ;; is considered a branch node of class element that is permitted to ;; hold other element nodes as children (org-ml--defconst org-ml-elements (cons 'org-data org-element-all-elements) "List of all element types including `org-data'.") (org-ml--defconst org-ml-objects (cons 'plain-text org-element-all-objects) "List of all object types including `plain-text'.") (eval-and-compile (defconst org-ml-nodes (append org-ml-elements org-ml-objects) "List of all node types.")) (org-ml--defvaralias 'org-ml-branch-nodes-permitting-child-objects 'org-element-object-containers "List of node types that can have objects as children. These are also known as \"object containers\" in `org-element.el'") (org-ml--defconst org-ml-branch-elements-permitting-child-objects (-intersection org-ml-branch-nodes-permitting-child-objects org-ml-elements) "List of element types that can have objects as children.") (org-ml--defconst org-ml-branch-elements-permitting-child-elements (cons 'org-data org-element-greater-elements) "List of element types that can have elements as children. These are also known as \"greater elements\" in `org-element.el'") (org-ml--defconst org-ml-branch-elements (append org-ml-branch-elements-permitting-child-objects org-ml-branch-elements-permitting-child-elements) "List of element types that can have children.") (org-ml--defvaralias 'org-ml-branch-objects 'org-element-recursive-objects "List of object types that can have objects as children. These are also known as \"recursive objects\" in `org-element.el'") (org-ml--defconst org-ml-branch-nodes (append org-ml-branch-elements org-ml-branch-objects) "List of node types that can have children.") ;;; BRANCH NODE CHILD TYPE RESTRICTIONS ;; `org-element.el' specifies which object nodes may be children of other object ;; nodes but does not have the same thing for element nodes; implement here (org-ml--defconst org-ml--object-restrictions (->> org-element-object-restrictions ;; remove non-object nodes (--remove (memq (car it) '(inlinetask item headline keyword))) ;; add plain-text type to everything except table-row (--map-when (not (eq (car it) 'table-row)) (-snoc it 'plain-text))) "Alist of object node type restrictions for object branch nodes. The types in the cdr of each entry may be children of the type held at the car.") (org-ml--defconst org-ml--element-restrictions ;; TODO add inlinetask ;; this includes all elements except those that are restricted ;; (see comments below) (let ((standard '(babel-call center-block clock comment comment-block diary-sexp drawer dynamic-block example-block export-block fixed-width footnote-definition horizontal-rule keyword latex-environment paragraph plain-list planning property-drawer quote-block special-block src-block table verse-block))) `((center-block ,@(remove 'center-block standard)) (drawer ,@(remove 'drawer standard)) (dynamic-block ,@(remove 'dynamic-block standard)) (footnote-definition ,@(remove 'footnote-definition standard)) ;; headlines can only have headlines and sections (headline headline section) (item ,@standard) ;; plain-lists can only have items (plain-list item) ;; property-drawers can only have node-properties (property-drawer node-property) (quote-block ,@(remove 'quote-block standard)) (section ,@standard) (special-block ,@standard) ;; tables can only have table-rows (table table-row) (org-data headline section))) "Alist of element node type restrictions for element branch nodes. The types in the cdr of each entry may be children of the type held at the car.") (defconst org-ml--node-restrictions (eval-when-compile (append org-ml--element-restrictions org-ml--object-restrictions)) "Alist of all restrictions for containers.") (defconst org-ml--item-tag-restrictions (eval-when-compile (->> org-element-object-restrictions (alist-get 'item) (cons 'plain-text))) "List of node types which may be used in item node tag properties.") (defconst org-ml--headline-title-restrictions (eval-when-compile (->> org-element-object-restrictions (alist-get 'headline) (cons 'plain-text))) "List of node types which may be used in item headline title properties.") ;;; CUSTOM (defcustom org-ml-memoize-match-patterns nil "Memoize patterns in `org-ml-match' and friends. These functions all take a PATTERN parameter that is used to generate a lambda function, which is then used to computationally search for the desired matches. Generating these lambda forms has some overhead (and will increase with increasing pattern complexity). Therefore, this value can be used to memoize (cache) each unique lambda form for each pattern. When enabled, calls to any of the match function using a unique pattern will generate the corresponding lambda form only once, and then subsequent calls will retrieve the form from the cache. This can increase performance if relatively few patterns are used relative to the calls made to pattern-consuming functions. The following values are understood: - nil: do not memoize anything - `compiled': memoize byte-compiled lambda forms - any other non-nil: memoize non-compiled lambda forms" :type 'boolean :group 'org-ml) (defcustom org-ml-memoize-builders nil "Memoize `org-ml-build-*' functions. These functions are pure and thus can be easily memoized. One may wish to do this if one needs to create many nodes that are the same, as node creation is relatively expensive. These functions are also used internally by other parts of `org-ml', thus memoizing these functions can achieve significant speed increases in many scenerios. The downside is each unique node will be stored, which takes space. This variable globally controls memoization for these functions. To control memoization on a per-type basis, see `org-ml-memoize-builder-types'." :type 'boolean :group 'org-ml) (org-ml--defconst org-ml-builder-types (append org-element-all-objects org-element-all-elements)) (defcustom org-ml-memoize-builder-types (-difference org-ml-builder-types org-ml-branch-nodes) "Specify the types for `org-ml-memoize-builders'." :type `(set ,@(--map (list 'const it) org-ml-builder-types)) :group 'org-ml) (defcustom org-ml-memoize-shorthand-builders nil "Memoize `org-ml-build-*!' functions. Like the `org-ml-build-*' functions (no exclamation point), these functions are pure and thus can be easily memoized. One may wish to do this if one needs to create many nodes that are the same, as node creation is relatively expensive. These functions are also used internally by other parts of `org-ml', thus memoizing these functions can achieve significant speed increases in many scenerios. The downside is each unique node will be stored, which takes space. This variable globally controls memoization for these functions. To control memoization on a per-type basis, see `org-ml-memoize-shorthand-builder-types'." :type 'boolean :group 'org-ml) (org-ml--defconst org-ml-shorthand-builder-types '(timestamp clock planning headline paragraph secondary-string item property-drawer table-cell table-row table)) (defcustom org-ml-memoize-shorthand-builder-types (-difference org-ml-shorthand-builder-types '(headline item)) "Specify the types for `org-ml-memoize-shorthand-builders'. Note that these don't perfectly correspond to `org-ml-nodes' since some of these functions are composite node builders. All in `org-ml-shorthand-builder-types' are enabled by default except for `headline' and `item' since these take child nodes are arguments which therefore lead to large key sizes." :type `(set ,@(--map (list 'const it) org-ml-shorthand-builder-types)) :group 'org-ml) (defcustom org-ml-use-impure nil "Run functions in impure mode. For now this means that no function will make a copy of a node, so all changes will be via side effect." :type 'boolean :group 'org-ml) (defcustom org-ml-disable-checks nil "Run functions without checking nodes for proper types." :type 'boolean :group 'org-ml) ;;; AFFILIATED KEYWORD NODES (org-ml--defconst org-ml--element-nodes-with-affiliated (eval-when-compile (-difference org-ml-elements '(org-data comment clock headline inlinetask item node-property planning property-drawer section table-row)))) ;;; LIST OPERATIONS (EXTENDING DASH.el) (defun org-ml--pad-or-truncate (length pad list) "Return padded or truncated list starting from LIST. If length of LIST is greater than LENGTH, truncate LIST to LENGTH and return. If LIST is longer than LENGTH, add PAD to the end of LIST until it's length equals LENGTH and return. Do nothing if length of LIST is equal to LENGTH initially." (let ((blanks (- length (length list)))) (if (< blanks 0) (-take length list) (append list (-repeat blanks pad))))) ;;; plist operations (defun org-ml--plist-get-keys (plist) "Get the keys for PLIST." (-slice plist 0 nil 2)) (defun org-ml--plist-get-vals (plist) "Get the values for PLIST." (-slice plist 1 nil 2)) (defun org-ml--plist-map-values (fun plist) "Map FUN over the values in PLIST. FUN is a unary function that returns a modified value." (nreverse (org-ml--reduce2-from* (cons (funcall fun it) (cons it-key acc)) nil plist))) (defun org-ml--is-plist (x) "Return t if X is a plist." (declare (pure t) (side-effect-free t)) (when (listp x) (let ((is-plist t)) (while (and is-plist (cdr x)) (setq is-plist (keywordp (car x)) x (cdr (cdr x)))) (and (not x) is-plist)))) (defun org-ml--plist-remove (key plist) "Return PLIST with KEY and its value removed." (nreverse (org-ml--reduce2-from* (if (eq key it-key) acc (cons it (cons it-key acc))) nil plist))) ;;; inter-index operations ;; The "inter-index" alludes to the fact that these list operations ;; use an index value that refers to spaces between list members. ;; These functions are enhanced versions of what is provided in ;; `dash.el' and native emacs that handle negative indices and have ;; switches to handle out of bounds errors (defun org-ml--convert-inter-index (n list &optional use-oor) "Return absolute index given N and LIST. N is relative index where positions in LIST are given by the following: - 0: before first member - 1: before second member (and so on) - -1: after last member - -2: after penultimate member (and so on) The absolute index to be returned will be N mapped to a positive integer that refers to the same space in LIST. If USE-OOR (use out-of-range) is t, return the closest valid index if N refers to a location that is outside LIST. Otherwise throw an error." (let* ((N (length list)) (upper N) (lower (- (- N) 1))) (cond ((<= 0 n upper) n) ((>= -1 n lower) (+ 1 N n)) ((and use-oor (< upper n)) upper) ((and use-oor (< n lower)) lower) (t (org-ml--arg-error "Index (%s) out of range; must be between %s and %s" n lower upper))))) (defun org-ml--insert-at (n x list &optional use-oor) "Like `-insert-at' but can insert X at negative indices N in LIST. See `org-ml--convert-inter-index' for the meaning of N and USE-OOR." (-insert-at (org-ml--convert-inter-index n list use-oor) x list)) (defun org-ml--split-at (n list &optional use-oor) "Like `-split-at' except allow negative indices in LIST. See `org-ml--convert-inter-index' for the meaning of N and USE-OOR." (let ((n* (org-ml--convert-inter-index n list use-oor))) (when list (-split-at n* list)))) (defun org-ml--splice-at (n list* list &optional use-oor) "Return LIST with LIST* spliced at index N. See `org-ml--convert-inter-index' for the meaning of N and USE-OOR." (--> (-map #'list list) (org-ml--insert-at n list* it use-oor) (apply #'append it))) ;;; intra-index operations ;; The "intra-index" alludes to the fact that these list operations ;; use an index value that refers to explicit list members. ;; These functions are enhanced versions of what is provided in ;; `dash.el' and native emacs that handle negative indices and have ;; switches to handle out of bounds errors (defun org-ml--convert-intra-index (n list &optional use-oor) "Return absolute index given N and LIST. N is relative index where positions in LIST are given by the following: - 0: first member - 1: second member (and so on) - -1: last member - -2: penultimate member (and so on) The absolute index to be returned is N mapped to a positive integer that refers to the same member in LIST. If USE-OOR (use out-of-range) is non-nil, return the closest valid index if N refers to a position outside of LIST. In cases where LIST is nil, N is meaningless since it will never refer to anything. In this case, return nil if USE-OOR is `permit-empty', and throw an error otherwise (even if USE-OOR it non-nil)." (let* ((N (length list)) (upper (1- N)) (lower (- N))) (cond ((= N 0) (unless (eq use-oor 'permit-empty) (error "List is empty, index is meaningless"))) ((<= 0 n upper) n) ((>= -1 n lower) (+ N n)) ((and use-oor (< upper n)) upper) ((and use-oor (< n lower)) 0) (t (org-ml--arg-error "Index (%s) out of range; must be between %s and %s" n lower upper))))) (defun org-ml--remove-at (n list &optional use-oor) "Like `-remove-at' but honors negative indices N in LIST. See `org-ml--convert-intra-index' for the meaning of N and USE-OOR." (-some-> (org-ml--convert-intra-index n list use-oor) (-remove-at list))) (defun org-ml--replace-at (n x list &optional use-oor) "Like `-replace-at' but can substitute X at negative indices N in LIST. See `org-ml--convert-intra-index' for the meaning of N and USE-OOR." (-some-> (org-ml--convert-intra-index n list use-oor) (-replace-at x list))) (defun org-ml--nth (n list &optional use-oor) "Like `nth' but honors negative indices N in LIST. See `org-ml--convert-intra-index' for the meaning of N and USE-OOR." (-some-> (org-ml--convert-intra-index n list use-oor) (nth list))) ;;; INTERNAL TYPE FUNCTIONS (define-error 'arg-type-error "Argument type error") (defun org-ml--arg-error (string &rest args) "Signal an `arg-type-error'. STRING and ARGS are analogous to `error'." (signal 'arg-type-error `(,(apply #'format-message string args)))) (defun org-ml--is-any-type (types node) "Return t if the type of NODE is in TYPES (a list of symbols)." (declare (pure t) (side-effect-free t)) (if (memq (org-ml-get-type node) types) t)) (defun org-ml--is-node (list) "Return t if LIST is a node." (declare (pure t) (side-effect-free t)) (org-ml--is-any-type org-ml-nodes list)) (defun org-ml--is-type (type node) "Return t if the type of NODE is TYPE (a symbol)." (declare (pure t) (side-effect-free t)) (eq (org-ml-get-type node) type)) (defun org-ml--is-table-row (node) "Return t if NODE is a standard table-row node." (declare (pure t) (side-effect-free t)) (and (org-ml--is-type 'table-row node) (org-ml--property-is-eq :type 'standard node))) (defun org-ml--filter-type (type node) "Return NODE if it is TYPE or nil otherwise." (declare (pure t) (side-effect-free t)) (and (org-ml--is-type type node) node)) (defun org-ml--filter-types (types node) "Return NODE if it is one of TYPES or nil otherwise." (declare (pure t) (side-effect-free t)) (and (org-ml-is-any-type types node) node)) (defun org-ml--is-secondary-string (list) "Return t if LIST is a secondary string." (declare (pure t) (side-effect-free t)) (--none? (org-ml--is-any-type org-ml-elements it) list)) (defun org-ml--check-type (type node) "Check that NODE is TYPE; throw error if not." (unless org-ml-disable-checks (let ((y (org-ml-get-type node))) (unless (equal y type) (org-ml--arg-error "Node must be a %s, got a %s" type y))))) (defun org-ml--check-types (types node) "Check that NODE is one of TYPES; throw error if not." (unless org-ml-disable-checks (let ((y (org-ml-get-type node))) (unless (memq y types) (org-ml--arg-error "Node must be one of %s, got a %s" types y))))) ;;; MISC HELPER FUNCTIONS (defun org-ml--get-head (node) "Return the type and properties cells of NODE." (declare (pure t) (side-effect-free t)) (if (stringp node) node (list (car node) (cadr node)))) (defun org-ml--from-string (string) "Convert STRING to org-element representation." (with-temp-buffer (insert string) (-> (org-ml-parse-this-buffer) (org-element-contents) (car)))) (define-inline org-ml-copy (node &optional keep) "Copy NODE if running in pure mode. KEEP is passed to `org-element-copy'." (inline-letevals (node) (inline-quote (if org-ml-use-impure ,node (org-element-copy ,node ,keep))))) (defmacro org-ml-wrap-impure (&rest body) "Run BODY in impure mode." `(let ((org-ml-use-impure t)) ,@body)) (defmacro org-ml-wrap-check (&rest body) "Run BODY without node type checking." `(let ((org-ml-disable-checks t)) ,@body)) (defmacro org-ml-> (&rest forms) "Thread FORMS using `->' and run in impure mode." (declare (indent 1)) `(org-ml-wrap-impure (-> ,@forms))) (defmacro org-ml->> (&rest forms) "Thread FORMS using `->>' and run in impure mode." (declare (indent 1)) `(org-ml-wrap-impure (->> ,@forms))) (defmacro org-ml--> (&rest forms) "Thread FORMS using `-->' and run in impure mode." (declare (indent 1)) `(org-ml-wrap-impure (--> ,@forms))) (defmacro org-ml-some-> (&rest forms) "Thread FORMS using `-some->' and run in impure mode." (declare (indent 1)) `(org-ml-wrap-impure (-some-> ,@forms))) (defmacro org-ml-some->> (&rest forms) "Thread FORMS using `-some->>' and run in impure mode." (declare (indent 1)) `(org-ml-wrap-impure (-some->> ,@forms))) (defmacro org-ml-some--> (&rest forms) "Thread FORMS using `-some-->' and run in impure mode." (declare (indent 1)) `(org-ml-wrap-impure (-some--> ,@forms))) (defmacro org-ml-as-> (&rest forms) "Thread FORMS using `-some-->' and run in impure mode." (declare (indent 1)) `(org-ml-wrap-impure (-some--> ,@forms))) ;;; INTERNAL PREDICATES (defun org-ml--is-oneline-string (x) "Return t if X is a string with no newlines." (declare (pure t)) (and (stringp x) (not (s-contains? "\n" x)))) (defun org-ml--is-oneline-string-or-nil (x) "Return t if X is a string with no newlines or nil." (declare (pure t)) (or (null x) (org-ml--is-oneline-string x))) (defun org-ml--is-non-neg-integer (x) "Return t if X is a non-negative integer." (declare (pure t)) (and (integerp x) (<= 0 x))) (defun org-ml--is-non-neg-integer-or-nil (x) "Return t if X is a non-negative integer or nil." (declare (pure t)) (or (null x) (org-ml--is-non-neg-integer x))) (defun org-ml--is-pos-integer (x) "Return t if X is a positive integer." (declare (pure t)) (and (integerp x) (< 0 x))) (defun org-ml--is-pos-integer-or-nil (x) "Return t if X is a positive integer or nil." (declare (pure t)) (or (null x) (org-ml--is-pos-integer x))) (defun org-ml--is-string-list (x) "Return t if X is a list of strings without newlines or nil." (declare (pure t)) (or (null x) (and (listp x) (-all? #'org-ml--is-oneline-string x)))) ;;; INTERNAL NODE PROPERTY FUNCTIONS (defun org-ml--get-nonstandard-properties (node) "Return the non-standard properties list of NODE." (if (stringp node) (text-properties-at 0 node) (cddr (nth 1 node)))) (defun org-ml-get-all-properties (node) "Return the properties list of NODE." (if (stringp node) (text-properties-at 0 node) (let ((arr-props (->> org-element--standard-properties (--map (list it (org-element-property it node))) (-flatten-n 1))) (plist-props (->> (nth 1 node) (cddr) (org-ml--plist-get-keys) (--map (list it (org-element-property it node))) (-flatten-n 1)))) (append arr-props plist-props)))) (define-inline org-ml--get-post-blank-text (plain-text) "Return number of trailing spaces in PLAIN-TEXT." (inline-quote (length (car (s-match "[ ]*$" ,plain-text))))) (define-inline org-ml--get-post-blank-textsafe (node) "Return number of trailing spaces in PLAIN-TEXT." (inline-letevals (node) (inline-quote (if (stringp ,node) (org-ml--get-post-blank-text ,node) (org-element-post-blank ,node))))) (define-inline org-ml--set-post-blank (post-blank node) (inline-quote (org-element-put-property-2 :post-blank ,post-blank ,node))) (define-inline org-ml--set-last-post-blank (pb nodes) "Set post-blank of last of NODES by PB." (inline-quote (org-ml--map-last* (org-ml--set-post-blank ,pb it) ,nodes))) (defmacro org-ml--set-properties-raw (node &rest plist) "Set all properties in NODE to the values corresponding to PLIST. PLIST is a list of property-value pairs that correspond to the property list in NODE. This is not meant for plain-text." (declare (indent 1)) (let* ((n (make-symbol "it-node")) (forms (->> (-partition 2 plist) (--map `(org-element-put-property ,n ,(car it) ,(cadr it)))))) `(let ((,n ,node)) ,@forms ,n))) (eval-when-compile (defmacro org-ml--map-property-raw* (prop form node) "Return NODE with FUN applied to the value in PROP. FUN is a form that returns a modified value and contains `it' bound to the property value." (declare (indent 1)) (let ((node* (make-symbol "node"))) `(let ((,node* ,node)) (let ((it (org-element-property-raw ,prop ,node*))) (org-element-put-property-2 ,prop ,form ,node*)))))) (define-inline org-ml--shift-post-blank (n node) "ADD N spaces to the end of NODE. This will not work if NODE is a string." (inline-quote (org-ml--map-property-raw* :post-blank (+ it ,n) ,node))) (define-inline org-ml--shift-last-post-blank (pb nodes) "Shift post-blank of last of NODES by PB." (inline-quote (org-ml--map-last* (org-ml--shift-post-blank ,pb it) ,nodes))) (defun org-ml--shift-post-blank-textsafe (n node) "ADD N spaces to the end of NODE. This will work if NODE is a string." (if (stringp node) (let ((pb (org-ml--get-post-blank-text node))) (concat (substring node (- pb)) (make-string (+ pb n) ?\ ))) (org-ml--shift-post-blank n node))) (define-inline org-ml--property-is-eq (prop val node) "Return t if PROP in NODE is `eq' to VAL." (inline-quote (eq ,val (org-element-property-raw ,prop ,node)))) ;;; NODE PROPERTY TRANSLATION AND CHECKING FRAMEWORK ;; This code provides the internal framework for the following ;; operations where NODE is any node, PROP is a property of NODE, ;; and VALUE is the value of PROP: ;; Get: f(PROP NODE) -> VALUE ;; Set: f(PROP VALUE NODE) -> NODE' ;; Map: f(PROP FUN NODE) -> NODE' where FUN is a function that ;; modifies the value of PROP in NODE and is like: ;; f(VALUE) -> VALUE' ;; Get -> 'read', Set -> 'write', Map -> 'read/write' ;; `org-element.el' doesn't always store values as their native types (like some ;; strings look like plists converted to strings). Here, we make a distinction ;; between VALUE and its internal representation IVALUE (which is actually the ;; value stored in the node list and understood by `org-element.el'), where ;; VALUE may not always be `equal' to IVALUE. When performing any of the ;; operations above, this framework will transparently translate between VALUE ;; and IVALUE (using so called encoders and decodes). Furthermore, the VALUE for ;; any PROP must conform to a 'type' which is enforced by this framework. ;; The center of this framework is the constant ;; `org-ml--property-alist' which holds the relationship of all node ;; types and their properties, type checkers, and encoders/decoders. ;; This alist has the following structure: ;; - car of each member is the type of NODE ;; - cdr of each member is the property alist for the node type ;; - the car of the property alist is the keyword for PROP ;; - the cdr of the property alist is an attribute plist, and the ;; keys of this plist include: ;; - :pred - a predicate function that returns t if VALUE is the correct ;; type for PROP ;; - :type-desc - a string describing the data type for PROP ;; - :encode - a unary function that converts VALUE to IVALUE; if not given ;; this is the identity function ;; - :decode - a function that inverts the function at :encode, if not given ;; this is the identity function ;; - :cis - a unary function that takes NODE and returns a modified NODE; ;; the point of this it to "update" other properties when PROP is changed ;; - :const - a value that PROP should always have ;; - :shift - a binary function that shifts PROP; the first argument takes ;; an integer describing the magnitude and direction of the shift and the ;; second argument is VALUE for PROP; return a new VALUE; this only makes ;; sense the type of PROP is an integer ;; - :require - a boolean telling if PROP is required to be specified when ;; creating a NODE of this type ;; - :string-list - a boolean telling if the type of PROP is a list of ;; strings ;; - :plist - a boolean telling if the type of PROP is a plist ;; - :toggle - a boolean telling if the type of PROP is a boolean ;; In terms of property attributes, the three property operations can be ;; described by the following pseudo code: ;; get: GET(PROP VALUE) -> NODE ;; 1) DECODE(IGET(PROP, NODE)) -> VALUE where IGET retrieves the IVALUE of PROP ;; from NODE ;; set: SET(PROP VALUE NODE) -> NODE ;; 1) if PRED(VALUE) -> t, proceed to 2), else throw error ;; 2) ISET(PROP, ENCODE(VALUE), NODE)) -> NODE' where ISET sets the PROP of NODE ;; to IVALUE ;; 3) If CIS is non-nil, run CIS(NODE') -> NODE'', else return NODE' ;; map: MAP(PROP FUN NODE) -> NODE' ;; 1) GET(PROP NODE) -> VALUE ;; 2) FUN(VALUE) -> VALUE' ;; 3) if PRED(VALUE') -> t proceed to 4), else throw error ;; 4) SET(PROP VALUE' NODE) -> NODE' ;; Thus GET only requires that the property exist in the type (which may be ;; nil, in which case GET returns nil). The decoder doesn't need to be present ;; as the identity function will be used if it isn't present. ;; ;; SET requires that the :pred attribute exists, since it needs to check that ;; the incoming value to assign is valid. If :encoder or :cis are unspecified ;; then these will be identity. ;; ;; MAP obviously requires both. ;;; property value predicates (type specific) (defun org-ml--is-valid-link-format (x) "Return t if X is an allowed value for a link node format property." (memq x '(nil plain angle bracket))) (defun org-ml--is-valid-link-type (x) "Return t if X is an allowed value for a link node type property." (->> '("coderef" "custorg-ml-id" "file" "id" "radio" "fuzzy") (append (org-link-types)) (member x))) (defun org-ml--is-valid-item-checkbox (x) "Return t if X is an allowed value for an item node checkbox property." (memq x '(nil on off trans))) (defun org-ml--is-valid-item-tag (x) "Return t if X is an allowed value for an item node tag property." (and (listp x) (--all? (org-ml--is-any-type org-ml--item-tag-restrictions it) x))) (defun org-ml--is-valid-item-bullet (x) "Return t if X is an allowed value for a item node bullet property." ;; NOTE org mode 9.1.9 has the following limitations: ;; - "+" will be converted to "-" when interpreted ;; - "1)" will be converted to "1." when interpreted ;; - alphanumeric symbols make the interpreter crash (pcase x ((or '- (pred integerp)) t))) (defun org-ml--is-valid-clock-timestamp (x) "Return t if X is an allowed value for a clock node value property." (and (org-ml--is-type 'timestamp x) (memq (org-element-property-raw :type x) '(inactive inactive-range)) (not (org-element-property-raw :repeater-type x)))) (defun org-ml--is-valid-planning-unclosed-timestamp (x) "Return t if X is an allowed value for a planning node timestamp property." (or (null x) (and (org-ml--is-type 'timestamp x) (org-ml--property-is-eq :type 'active x)))) (defun org-ml--is-valid-planning-closed-timestamp (x) "Return t if X is an allowed value for a planning node timestamp property." (or (null x) (and (org-ml--is-type 'timestamp x) (org-ml--property-is-eq :type 'inactive x)))) (defun org-ml--is-valid-entity-name (x) "Return t if X is an allowed value for an entity node name property." (org-entity-get x)) (defun org-ml--is-valid-headline-tags (x) "Return t if X is an allowed value for a headline node tags property." (and (listp x) (-all? #'org-ml--is-oneline-string x) (not (member org-archive-tag x)))) (defun org-ml--is-valid-headline-priority (x) "Return t if X is an allowed value for a headline node priority property." (or (null x) (and (integerp x) (>= org-lowest-priority x org-highest-priority)))) (defun org-ml--is-valid-headline-title (x) "Return t if X is an allowed value for a headline node title property." (and (listp x) (--all? (org-ml--is-any-type org-ml--headline-title-restrictions it) x))) (defun org-ml--is-valid-timestamp-type (x) "Return t if X is an allowed value for a timestamp node type property." (memq x '(inactive inactive-range active active-range))) (defun org-ml--is-valid-timestamp-range-type (x) "Return t if X is an allowed value for a timestamp node range-type property." (memq x '(nil daterange timerange))) (defun org-ml--is-valid-timestamp-repeater-type (x) "Return t if X is an allowed value for a timestamp node repeater-type property." (memq x '(nil catch-up restart cumulate))) (defun org-ml--is-valid-timestamp-warning-type (x) "Return t if X is an allowed value for a timestamp node warning-type property." (memq x '(nil all first))) (defun org-ml--is-valid-timestamp-unit (x) "Return t if X is an allowed value for a timestamp node unit property." (memq x '(nil year month week day hour))) (defun org-ml--is-valid-latex-environment-value (x) "Return t if X is an allowed value for a latex-environment node value property." (pcase x ((or `(,(pred org-ml--is-oneline-string)) `(,(pred org-ml--is-oneline-string) ,(pred stringp))) t))) (defun org-ml--is-valid-statistics-cookie-value (x) "Return t if X is an allowed value for a statistics-cookie node value property." (pcase x ((or `(nil) `(nil nil)) t) (`(,(and (pred integerp) percent)) (<= 0 percent 100)) (`(,(and (pred integerp) numerator) ,(and (pred integerp) denominator)) (and (org-ml--is-non-neg-integer numerator) (org-ml--is-non-neg-integer denominator) (<= numerator denominator))))) (defun org-ml--is-valid-diary-sexp-value (x) "Return t if X is an allowed value for a diary-sexp node value property." (or (null x) (listp x))) (defun org-ml--is-valid-header (x) "Return t if X is an allowed value for a header affiliated keyword property." (and (listp x) (--all? (org-ml--is-plist it) x))) (defun org-ml--is-valid-results (x) "Return t if X is an allowed value for a results affiliated keyword property." (pcase x (`nil t) (`(,(pred stringp) ,(pred stringp)) t) (`(,(pred stringp)) t))) (defun org-ml--is-valid-caption (x) "Return t if X is an allowed value for a caption affiliated keyword property." (and (listp x) (--all? (pcase it ((pred stringp) t) (`(,(pred stringp) ,(pred stringp)) t)) x))) ;;; encode/decode (general) (defun org-ml--decode-boolean (bool) "Return BOOL as either t or nil." (and bool t)) (defun org-ml--encode-string-or-nil (string) "Return STRING as either itself or \"\" if nil." (if (null string) "" string)) (defun org-ml--decode-string-or-nil (string) "Return STRING without text properties if not nil." (when string (substring-no-properties string))) (defun org-ml--encode-string-list-delim (string-list delim) "Return STRING-LIST as string joined by DELIM." (-some->> string-list (s-join delim))) (defun org-ml--decode-string-list-delim (string delim) "Return STRING as list of strings split by DELIM." (-some->> string (s-split delim))) (defun org-ml--encode-string-list-space-delim (string-list) "Return STRING-LIST as string joined by spaces." (org-ml--encode-string-list-delim string-list " ")) (defun org-ml--decode-string-list-space-delim (string) "Return STRING as list of strings split by spaces." (org-ml--decode-string-list-delim string " ")) (defun org-ml--encode-string-list-comma-delim (string-list) "Return STRING-LIST as string joined by commas." (org-ml--encode-string-list-delim string-list ",")) (defun org-ml--decode-string-list-comma-delim (string) "Return STRING as list of strings split by commas." (org-ml--decode-string-list-delim string ",")) (defun org-ml--encode-plist (plist) "Return PLIST as string joined by spaces." (-some->> (--map (format "%S" it) plist) (s-join " "))) (defun org-ml--decode-plist (string) "Return STRING as plist split by spaces." (-map #'intern (org-ml--decode-string-list-space-delim string))) ;;; encode/decode (type specific) (defun org-ml--encode-latex-environment-value (value) "Return VALUE as a string representing a latex-environment. VALUE is a list conforming to `org-ml--is-valid-latex-environment-value'." (-let (((env body) value)) (if body (format "\\begin{%1$s}\n%2$s\n\\end{%1$s}" env body) (format "\\begin{%1$s}\n\\end{%1$s}" env)))) (defun org-ml--decode-latex-environment-value (value) "Return VALUE as a list representing a latex-environment. The return value is a list conforming to `org-ml--is-valid-latex-environment-value'." (let ((m (car (s-match-strings-all "\\\\begin{\\(.+\\)}\n\\(.*\\)\n?\\\\end{\\(.+\\)}" value)))) (list (nth 1 m) (nth 2 m)))) (defun org-ml--encode-item-bullet (bullet) "Return BULLET as a formatted string. BULLET must conform to `org-ml--is-valid-item-bullet'." ;; assume bullet conforms to pcase statement below (pcase bullet ('- "- ") ((pred integerp) (format "%s. " bullet)) (_ (error "This should not happen")))) (defun org-ml--decode-item-bullet (bullet) "Return BULLET as a symbol from a formatted string. Return value will conform to `org-ml--is-valid-item-bullet'." ;; NOTE this must conform to the full range of item bullets since anything ;; could be parsed from an org file. Anything "invalid" should be converted to ;; it's closest "legal" bullet (if (s-matches? "^\\(-\\|+\\)" bullet) '- (let* ((case-fold-search nil)) ; need case-sensitivity (or (-some->> (s-match "^[0-9]+" bullet) (car) (string-to-number)) ;; convert letters to numbers if they are used (-some->> (s-match "^[a-z]+" bullet) (car) (string-to-char) (+ -96)) (-some->> (s-match "^[A-Z]+" bullet) (car) (string-to-char) (+ -64)) (org-ml--arg-error "Invalid bullet found: %s" bullet))))) (defun org-ml--decode-headline-tags (tags) "Return TAGS with `org-archive-tag' removed." (-map #'substring-no-properties (remove org-archive-tag tags))) (defun org-ml--encode-statistics-cookie-value (value) "Return VALUE as formatted string representing the cookie. VALUE must conform to `org-ml--is-valid-statistics-cookie-value'." (cl-flet ((mk-stat (v) (pcase v (`(nil) "%") (`(nil nil) "/") (`(,percent . nil) (format "%s%%" percent)) (`(,numerator . (,denominator . nil)) (format "%s/%s" numerator denominator)) (_ (error "This should never happen"))))) (format "[%s]" (mk-stat value)))) (defun org-ml--decode-statistics-cookie-value (value) "Return VALUE as a list representing the cookie. Return value will conform to `org-ml--is-valid-statistics-cookie-value'." (cond ((equal "[%]" value) '(nil)) ((equal "[/]" value) '(nil nil)) (t (->> (or (s-match-strings-all "\\[\\([0-9]+\\)/\\([0-9]+\\)\\]" value) (s-match-strings-all "\\[\\([0-9]+\\)%\\]" value) (org-ml--arg-error "Invalid stats-cookie: %s" value)) (cdar) (-map #'string-to-number))))) (defun org-ml--encode-diary-sexp-value (value) "Return VALUE as a string. VALUE must conform to `org-ml--is-valid-diary-sexp-value'." (if value (format "%%%%%S" value) "%%()")) (defun org-ml--decode-diary-sexp-value (value) "Return VALUE as a form. Return value will conform to `org-ml--is-valid-diary-sexp-value'." (->> (s-chop-prefix "%%" value) (read))) (defun org-ml--encode-header (plists) "Return PLISTS as a list of strings." (--map (-some->> it (-partition 2) (--map (format "%S %s" (car it) (cadr it))) (s-join " ")) plists)) (defun org-ml--decode-header (headers) "Return HEADERS (a list of strings) as a list of plists." (--map (->> (org-ml--decode-string-list-space-delim it) (--map-indexed (if (cl-evenp it-index) (intern it) it))) headers)) (defun org-ml--encode-results (results) "Return a encoded results affiliated keyword value. RESULTS should conform to `org-ml--is-valid-caption'." (-let (((hash source) results)) (when source `(,source . ,hash)))) (defun org-ml--decode-results (internal-results) "Return a decoded results affiliated keyword value. The returned list will conform to `org-ml--is-valid-caption' given INTERNAL-RESULTS stored in a node." (-let (((source . hash) internal-results)) (if hash (list hash source) source))) (defun org-ml--encode-caption (caption) "Return a encoded caption affiliated keyword value. CAPTION should conform to `org-ml--is-valid-caption'." (->> (reverse caption) (--reduce-from (pcase it ((and (pred stringp) long) (cons `((,long)) acc)) (`(,short ,long) (when long (cons (if short `((,long) ,short) `((,long))) acc)))) nil) (-non-nil))) (defun org-ml--decode-caption (internal-caption) "Return a decoded caption affiliated keyword value. The returned list will conform to `org-ml--is-valid-caption' given INTERNAL-CAPTION stored in a node." (--reduce-from (-let ((((long) short) it)) (-> (if short (list (substring-no-properties short) (substring-no-properties long)) (substring-no-properties long)) (cons acc))) nil (reverse internal-caption))) ;;; cis functions (defun org-ml--update-macro-value (macro) "Return MACRO node with its value property updated. This will be based on MACRO's key and value properties." (let* ((k (org-element-property-raw :key macro)) (as (org-element-property-raw :args macro)) (v (if as (format "%s(%s)" k (s-join "," as)) k))) (org-element-put-property-2 :value (format "{{{%s}}}" v) macro))) (defun org-ml--update-clock-duration-and-status (clock) "Return CLOCK node with its duration and status properties updated. This will be based on CLOCK's value property." (let* ((ts (org-element-property-raw :value clock)) (seconds (org-ml--timestamp-get-length ts))) (if (= seconds 0) (org-ml--set-properties-raw clock :duration nil :status 'running) (let* ((h (-> seconds (/ 3600) (floor))) (m (-> seconds (- (* h 3600)) (/ 60) (floor)))) (org-ml--set-properties-raw clock :duration (format "%2d:%02d" h m) :status 'closed ;; if the clock is going from non-ranged to ranged, it may not be in ;; collapsed form; ensure it is not in collapsed form :value (org-ml--timestamp-set-collapsed nil ts)))))) (defun org-ml--update-headline-tags (headline) "Return HEADLINE node with its tags updated. This will be based on HEADLINE's archivedp property." (org-ml--map-property-raw* :tags (let ((tags* (remove org-archive-tag it))) (if (org-element-property :archivedp headline) (-snoc tags* org-archive-tag) tags*)) (org-element-properties-resolve headline))) (defun org-ml--link-update-type-explicit (link) "Return LINK with `:type-explicit-p' updated." (let ((x (-> (org-element-property-raw :type link) (member (org-link-types)) (null) (not)))) (org-element-put-property-2 :type-explicit-p x link))) ;;; shifters (defun org-ml--shift-pos-integer (n x) "Return X shifted by N (both are integers). If the value to return is less than 1, return 1." (when x (let ((x* (+ x n))) (if (< 0 x*) x* 1)))) (defun org-ml--shift-non-neg-integer (n x) "Return X shifted by N (both are integers). If the value to return is less than 0, return 0." (when x (let ((x* (+ x n))) (if (<= 0 x*) x* 0)))) (defun org-ml--shift-headline-priority (n priority) "Return PRIORITY shifted by N (an integer). If the final value is outside the bounds of `org-highest-priority' and `org-lowest-priority', return as if cycling and wrapping between the priority bounds until the return value is inside the bounds." (when priority (let ((diff (1+ (- org-lowest-priority org-highest-priority))) (offset (- priority org-highest-priority))) (-> (- offset n) (mod diff) (- offset) (+ priority))))) ;;; property alist (org-ml--defconst org-ml--property-alist (let* ((bool (list :pred #'booleanp :decode 'org-ml--decode-boolean :type-desc "nil or t" :toggle t)) (pos-int (list :pred #'org-ml--is-pos-integer :type-desc "a positive integer")) (pos-int-nil (list :pred #'org-ml--is-pos-integer-or-nil :type-desc "a positive integer or nil")) (nn-int (list :pred #'org-ml--is-non-neg-integer :type-desc "a non-negative integer")) (nn-int-nil (list :pred #'org-ml--is-non-neg-integer-or-nil :type-desc "a non-negative integer or nil")) (str (list :pred #'stringp :type-desc "a string")) (str-nil (list :pred #'string-or-null-p :type-desc "a string or nil")) (ol-str (list :pred #'org-ml--is-oneline-string :type-desc "a oneline string")) (ol-str-nil (list :pred #'org-ml--is-oneline-string-or-nil :type-desc "a oneline string or nil")) (plist (list :encode 'org-ml--encode-plist :pred #'org-ml--is-plist :decode 'org-ml--decode-plist :plist t :type-desc "a plist")) (slist (list :pred #'org-ml--is-string-list :string-list t :type-desc "a list of oneline strings")) (slist-com (list :encode 'org-ml--encode-string-list-comma-delim :decode 'org-ml--decode-string-list-comma-delim :pred #'org-ml--is-string-list :string-list t :type-desc "a list of oneline strings")) (slist-spc (list :encode 'org-ml--encode-string-list-space-delim :decode 'org-ml--decode-string-list-space-delim :pred #'org-ml--is-string-list :string-list t :type-desc "a list of oneline strings")) (planning-unclosed (list :pred #'org-ml--is-valid-planning-unclosed-timestamp :type-desc "a zero-range, active timestamp node")) (planning-closed (list :pred #'org-ml--is-valid-planning-closed-timestamp :type-desc "a zero-range, inactive timestamp node")) (ts-unit (list :pred #'org-ml--is-valid-timestamp-unit :type-desc '("nil or a symbol from `year' `month'" "`week' `day', or `hour'")))) (->> `((babel-call (:call ,@ol-str :require t) (:inside-header ,@plist) (:arguments ,@slist-com) (:end-header ,@plist) (:value)) (bold) (center-block) (clock (:value :pred org-ml--is-valid-clock-timestamp :cis org-ml--update-clock-duration-and-status :type-desc ("a ranged or unranged inactive timestamp" "node with no warning or repeater") :require t) (:status) (:duration)) (code (:value ,@str :require t)) (comment (:value ,@str :require t)) (comment-block (:value ,@str :decode s-trim-right :require "")) (drawer (:drawer-name ,@ol-str :require t)) (diary-sexp (:value :encode org-ml--encode-diary-sexp-value :pred org-ml--is-valid-diary-sexp-value :decode org-ml--decode-diary-sexp-value :type-desc "a list form or nil")) (dynamic-block (:arguments ,@plist) (:block-name ,@ol-str :require t)) (entity (:name :pred org-ml--is-valid-entity-name :type-desc "a string that makes `org-entity-get' return non-nil" :require t) (:use-brackets-p ,@bool) (:latex) (:latex-math-p) (:html) (:ascii) (:latin1) (:utf-8)) (example-block (:preserve-indent ,@bool) (:switches ,@slist-spc) (:value ,@str :require "" :decode s-trim-right) ;; TODO some of these are tied to switches, it ;; may be good to set them directly (:number-lines) (:retain-labels) (:use-labels) (:label-fmt)) (export-block (:type ,@ol-str :require t) (:value ,@str :require t)) (export-snippet (:back-end ,@ol-str :require t) (:value ,@str :require t)) (fixed-width (:value ,@ol-str :decode s-trim-right :require t)) (footnote-definition (:label ,@ol-str :require t) (:pre-blank ,@nn-int :shift org-ml--shift-non-neg-integer :require 0)) (footnote-reference (:label ,@ol-str-nil) (:type)) (headline (:archivedp ,@bool :cis org-ml--update-headline-tags) (:commentedp ,@bool) (:footnote-section-p ,@bool) (:level ,@pos-int :shift org-ml--shift-pos-integer :require 1) (:pre-blank ,@nn-int :shift org-ml--shift-non-neg-integer :require 0) ;; ,@robust (:priority :pred org-ml--is-valid-headline-priority :shift org-ml--shift-headline-priority :type-desc ("an integer between (inclusive)" "`org-highest-priority' and" "`org-lowest-priority'")) (:tags :pred org-ml--is-valid-headline-tags :decode org-ml--decode-headline-tags :cis org-ml--update-headline-tags :type-desc "a string list" :string-list t) (:title :pred org-ml--is-valid-headline-title :type-desc "a secondary string") (:todo-keyword ,@ol-str-nil :decode org-ml--decode-string-or-nil) (:raw-value) (:todo-type)) (horizontal-rule) (inline-babel-call (:call ,@ol-str :require t) (:inside-header ,@plist) (:arguments ,@slist-com) (:end-header ,@plist) (:value)) (inline-src-block (:language ,@ol-str :require t) (:parameters ,@plist) (:value ,@str :require "")) ;; (inlinetask) (italic) (item (:bullet :encode org-ml--encode-item-bullet :pred org-ml--is-valid-item-bullet :decode org-ml--decode-item-bullet :type-desc ("a positive integer (ordered)" "or the symbol `-' (unordered)") :require '-) (:pre-blank ,@nn-int :shift org-ml--shift-non-neg-integer :require 0) (:checkbox :pred org-ml--is-valid-item-checkbox :type-desc "nil or the symbols `on', `off', or `trans'") (:counter ,@pos-int-nil :shift org-ml--shift-pos-integer) (:tag :pred org-ml--is-valid-item-tag :type-desc "a secondary string")) ;; (:structure)) (keyword (:key ,@ol-str :require t) (:value ,@ol-str :require t)) (latex-environment (:value :encode org-ml--encode-latex-environment-value :pred org-ml--is-valid-latex-environment-value :decode org-ml--decode-latex-environment-value :type-desc "a list of strings like (ENV BODY) or (ENV)" :require t)) (latex-fragment (:value ,@str :require t)) (line-break) (link (:path ,@ol-str :require t) (:format :pred org-ml--is-valid-link-format :type-desc "the symbol `plain', `bracket' or `angle'") (:type :pred org-ml--is-valid-link-type :cis org-ml--link-update-type-explicit :type-desc ("a oneline string from `org-link-types'" "or \"coderef\", \"custorg-ml-id\"," "\"file\", \"id\", \"radio\", or" "\"fuzzy\"") ;; TODO is fuzzy a good default? :require "fuzzy") (:raw-link) (:application) (:search-option)) (macro (:args ,@slist :cis org-ml--update-macro-value) (:key ,@ol-str :cis org-ml--update-macro-value :require t) (:value)) (node-property (:key ,@ol-str :require t) (:value ,@ol-str :require t)) (paragraph) (plain-list ;;(:structure) (:type)) (plain-text) (planning (:closed ,@planning-closed) (:deadline ,@planning-unclosed) (:scheduled ,@planning-unclosed)) (property-drawer) (quote-block) ;; TODO this should not have multiline strings in it (radio-target (:value)) (section) (special-block (:type ,@ol-str :require t) (:parameters ,@ol-str-nil)) (src-block (:value ,@str :decode s-trim-right :require "") (:language ,@str-nil) (:parameters ,@plist) (:preserve-indent ,@bool) (:switches ,@slist-spc) (:number-lines) (:retain-labels) (:use-labels) (:label-fmt)) (statistics-cookie (:value :encode org-ml--encode-statistics-cookie-value :pred org-ml--is-valid-statistics-cookie-value :decode org-ml--decode-statistics-cookie-value :type-desc ("a list of non-neg integers" "like (PERC) or (NUM DEN)" "which make [NUM/DEN] and" "[PERC%] respectively") :require t)) (strike-through) ;; TODO these should only allow multiline strings if bracketed (subscript (:use-brackets-p ,@bool)) (superscript (:use-brackets-p ,@bool)) (table (:tblfm ,@slist) (:type :const 'org) (:value)) ;; TODO this should not have multiline strings in it (table-cell) (table-row (:type :const 'standard)) (target (:value ,@ol-str :require t)) (timestamp (:type :pred org-ml--is-valid-timestamp-type :type-desc ("a symbol from `inactive'," "`active', `inactive-range', or" "`active-range'") :require t) (:range-type :pred org-ml--is-valid-timestamp-range-type :type-desc ("either symbol `daterange' or" "`timerange' or nil")) (:year-start ,@pos-int :require t) (:month-start ,@pos-int :require t) (:day-start ,@pos-int :require t) (:year-end ,@pos-int :require t) (:month-end ,@pos-int :require t) (:day-end ,@pos-int :require t) (:hour-start ,@nn-int-nil) (:minute-start ,@nn-int-nil) (:hour-end ,@nn-int-nil) (:minute-end ,@nn-int-nil) (:repeater-type :pred org-ml--is-valid-timestamp-repeater-type :type-desc ("nil or a symbol from" "`catch-up', `restart'," "or `cumulate'")) (:repeater-unit ,@ts-unit) (:repeater-value ,@pos-int-nil) (:repeater-deadline-unit ,@ts-unit) (:repeater-deadline-value ,@pos-int-nil) (:warning-type :pred org-ml--is-valid-timestamp-warning-type :type-desc ("nil or a symbol from" "`all' or `first'")) (:warning-unit ,@ts-unit) (:warning-value ,@pos-int-nil) (:raw-value)) (underline) (verbatim (:value ,@str :require t)) (verse-block)) (--map-when (memq (car it) org-ml--element-nodes-with-affiliated) (append it `((:name ,@str-nil) (:plot ,@str-nil) (:header :encode org-ml--encode-header :pred org-ml--is-valid-header :decode org-ml--decode-header :type-desc ("a list of plists where all" "plist values are strings")) (:results :encode org-ml--encode-results :pred org-ml--is-valid-results :decode org-ml--decode-results :type-desc ("a list like (SOURCE) or" "(HASH SOURCE) where HASH" "and SOURCE are strings.")) (:caption :encode org-ml--encode-caption :pred org-ml--is-valid-caption :decode org-ml--decode-caption :type-desc ("a list including (LONG) or" "(SHORT LONG) where SHORT and" "LONG are both strings representing" "the short and long captions")))))))) ;;; node property operations ;; alist functions (eval-when-compile (defun org-ml--flatten-attribute (attr) (->> org-ml--property-alist (--map (cons (car it) (->> (cdr it) (--map (cons (car it) (plist-get (cdr it) attr))) (-filter #'cdr)))) (-filter #'cdr))) (defun org-ml--flatten-attribute-boolean (attr) (->> org-ml--property-alist (--map (cons (car it) (->> (cdr it) (--filter (plist-get (cdr it) attr)) (-map #'car)))) (-filter #'cdr)))) (org-ml--defconst org-ml--property-decoder-functions (--map (cons (car it) (--map (cons (car it) (plist-get (cdr it) :decode)) (cdr it))) org-ml--property-alist)) (org-ml--defconst org-ml--property-encoder-functions (org-ml--flatten-attribute :encode)) (org-ml--defconst org-ml--property-predicate-functions (org-ml--flatten-attribute :pred)) (org-ml--defconst org-ml--property-shifter-functions (org-ml--flatten-attribute :shift)) (org-ml--defconst org-ml--property-updater-functions (org-ml--flatten-attribute :cis)) (org-ml--defconst org-ml--property-type-descriptions (cl-flet ((map-cdr (cell f) (cons (car cell) (funcall f (cdr cell))))) (->> (org-ml--flatten-attribute :type-desc) (--map (map-cdr it (lambda (props) (--map (map-cdr it (lambda (desc) (if (listp desc) (s-join " " desc) desc))) props))))))) (org-ml--defconst org-ml--properties-with-toggle (org-ml--flatten-attribute-boolean :toggle)) (org-ml--defconst org-ml--properties-with-string-list (org-ml--flatten-attribute-boolean :string-list)) (org-ml--defconst org-ml--properties-with-plist (org-ml--flatten-attribute-boolean :plist)) (defun org-ml--get-property-encoder (type prop) "Return the encoder for PROP of node TYPE." (->> (alist-get type org-ml--property-encoder-functions) (alist-get prop))) (defun org-ml--get-property-decoder (type prop) "Return the decoder function for PROP of node TYPE. If TYPE does not exist, return error. If PROP does not exist for TYPE, also return error. If type does exist, return the decoder function or nil if there is none." (-if-let (ps (alist-get type org-ml--property-decoder-functions)) (-if-let (f (assq prop ps)) (cdr f) (org-ml--arg-error "Type '%s' does not have property '%s'" type prop)) (org-ml--arg-error "Tried to query '%s' for non-existent '%s'" prop type))) (defun org-ml--get-property-updater (type prop) "Return the updater for PROP of node TYPE." (->> (alist-get type org-ml--property-updater-functions) (alist-get prop))) (defun org-ml--get-property-type-desc (type prop) "Return the description for PROP of node TYPE." (->> (alist-get type org-ml--property-type-descriptions) (alist-get prop))) (defun org-ml--get-property-shifter (type prop) "Lookup shifter function for TYPE and PROP." (if (eq prop :post-blank) #'org-ml--shift-non-neg-integer (->> (alist-get type org-ml--property-shifter-functions) (alist-get prop)))) (defun org-ml--get-property-predicate (type prop) "Lookup shifter function for TYPE and PROP." (if (eq prop :post-blank) #'org-ml--is-non-neg-integer (->> (alist-get type org-ml--property-predicate-functions) (alist-get prop)))) (defun org-ml--property-memq (alist type prop) "Return t if PROP is in the cdr of TYPE in ALIST." (memq prop (alist-get type alist))) (defun org-ml--property-error-unsettable (prop type) "Throw error signifying that PROP is unsettable of node TYPE." (org-ml--arg-error "Property '%s' is unsettable for type '%s'" prop type)) (defun org-ml--property-error-wrong-type (prop type value) "Throw error signifying that VALUE is wrong for PROP of node TYPE." (let ((msg "Property '%s' in node of type '%s' must be %s. Got '%S'") (correct-type (org-ml--get-property-type-desc type prop))) (org-ml--arg-error msg prop type correct-type value))) (defun org-ml--property-encode (prop value type) "Given TYPE and PROP, return encoded VALUE." (-if-let (pred (org-ml--get-property-predicate type prop)) (if (funcall pred value) (-if-let (encode-fun (org-ml--get-property-encoder type prop)) (funcall encode-fun value) value) (org-ml--property-error-wrong-type prop type value)) (org-ml--property-error-unsettable prop type))) ;;; INTERNAL BRANCH/CHILD MANIPULATION (defun org-ml--get-descendent (indices node) "Return the nested children of NODE as given by INDICES. INDICES is a list of integers specifying the index and level of the nested element to return." (if (not indices) node (->> (org-element-contents node) (nth (car indices)) (org-ml--get-descendent (cdr indices))))) (defun org-ml--set-children-nocheck (children node) "Return NODE with children set to CHILDREN." (let ((head (org-ml--get-head node))) (if children (append head children) head))) (eval-when-compile (defmacro org-ml--map-children-nocheck* (form node) "Return NODE with FORM applied to its children. FORM is a form with `it' bound to the list of children and returns a modified list of children." (declare (debug (form form))) (let ((n (make-symbol "--node"))) `(let* ((,n ,node) (it (org-element-contents ,n))) (org-ml--set-children-nocheck ,form ,n))))) (defun org-ml--set-children-throw-error (type child-types illegal) "Throw an `arg-type-error' for TYPE. In the message specify that allowed child types are CHILD-TYPES and ILLEGAL types were attempted to be set." (cl-flet ((format-types (type-list) (->> type-list (-map #'symbol-name) (s-join ", ")))) (let ((fmt (->> '("Setting illegal child types for node type '%s'" "illegal types found: %s" "allowed types are: %s") (s-join "; "))) (illegal (format-types illegal)) (child-types (format-types child-types))) (org-ml--arg-error fmt type illegal child-types)))) ;;; BASE BUILDER FUNCTIONS ;;; build helpers (eval-and-compile (defun org-ml--build-bare-node (type post-blank props children) "Return new node of TYPE with POST-BLANK, PROPS and CHILDREN. TYPE is a symbol and POST-BLANK is a positive integer." ;; don't set children in the function itself a) so I can check for valid ;; types and b) because `org-element-create' will add :parent (let ((node (org-element-create type `(:post-blank ,(or post-blank 0) ,@props)))) ;; Use this function here so we get child type checks (if children (org-ml-set-children children node) node)))) (defmacro org-ml--build-blank-node (type post-blank) "Return new node of TYPE with POST-BLANK and all properties set to nil." (let ((ips (->> (alist-get type org-ml--property-alist) (-map #'car) (--mapcat (list it nil)) (cons 'list)))) `(org-ml--build-bare-node ',type ,post-blank ,ips nil))) ;;; base builders ;; define all base builders using this automated monstrosity (defmacro org-ml--with-cache (table switch valid type key body) "Run BODY with a memoization cache. TABLE is a symbol with an alist indexed by TYPE. SWITCH is a symbol which will be dynamically read at runtime to determine if the cache should be used. VALID is a symbol bound to a list of valid types (at runtime) which should use the cache. KEY is the lookup key to be used in the cache (which is actually a hash table) and is assumed to correspond to the inputs to BODY. If KEY is not in the cache, run BODY and put the result in the cache under KEY. If KEY is in the cache, return whatever that is." (let* ((k (make-symbol "--key")) (n (make-symbol "--node")) (c (make-symbol "--cached")) (h (alist-get type (eval table)))) (unless h (error "Failed to get cache table for %s" type)) `(let* ((,k ,key) (,c (and ,switch (memq ',type ,valid) (gethash ,k ,h)))) (if ,c (org-ml-copy ,c t) ;; turn off memoizer internally since some shorthand builders ;; call other shorthand builders and caching each layer is probably ;; overkill since none of these functions have that many arguments ;; to vary (let ((,switch nil)) (let ((,n ,body)) (puthash ,k (org-ml-copy ,n t) ,h) ,n)))))) (eval-and-compile (defvar org-ml--builder-cache (--map (cons it (make-hash-table :test #'equal)) org-ml-builder-types) "Alist of hash tables to store builder results.")) (defun org-ml-clear-builder-cache () "Clear the memoization cache for node builders." (interactive) (--each org-ml--builder-cache (clrhash (cdr it)))) (defmacro org-ml--with-builder-cache (type key body) "Run BODY with builder cache. See org-ml--with-cache' for meaning of TYPE and KEY." (declare (indent 1)) `(org-ml--with-cache org-ml--builder-cache org-ml-memoize-builders org-ml-memoize-builder-types ,type ,key ,body)) (eval-when-compile (defun org-ml--autodef-kwd-to-sym (keyword) "Return KEYWORD as a string with no leading colon." (->> (symbol-name keyword) (s-chop-prefix ":") (intern))) (defun org-ml--autodef-prepend-article (string) "Return STRING starting with \"a\" or \"an\" depending on first word." (let ((a (--> (symbol-name string) (s-left 1 it) (if (member it '("a" "e" "i" "o" "u")) "an" "a")))) (format "%s %s" a string))) (defun org-ml--autodef-categorize-prop (prop) "Return category for PROP." (-let (((&plist :require :pred :const) (cdr prop))) (cond (const 'const) ((not pred) 'null) ((eq require t) 'req) (t 'key)))) (defun org-ml--autodef-prop-form (len fun-0 fun-n props) "Return form to set properties to PROPS. If list PROPS is length LEN, use FUN-0, otherwise FUN-N." (declare (indent 1)) (if (= len (length props)) `(,fun-0 ,@props) `(,fun-n (list ,@props)))) (defun org-ml--indent-doc (s) (with-temp-buffer (insert s) (fill-paragraph) (buffer-string))) (defun org-ml--autodef-make-docstring (type rest-arg props) "Return docstring for PROPS. TYPE is the type of the node in question and REST-ARG is the symbol for the rest argument." (let ((class (if (memq type org-element-all-elements) "element" "object")) (end (if (not rest-arg) "." (->> (symbol-name rest-arg) (s-upcase) (format " with %s as children.")))) ;; (post-blank (if element? "newlines" "spaces")) (prop (-some->> (append (alist-get 'req props) (alist-get 'key props)) (--map (let ((p (->> (car it) (symbol-name) (s-chop-prefix ":") (s-upcase))) (r (--> (plist-get (cdr it) :require) (pcase it ((pred stringp) (format "(default %S)" it)) (`(quote ,s) (format "(default `%s')" s)) ((guard (eq it t)) "(required)") (_ "")))) (d (plist-get (cdr it) :type-desc))) (unless d (error "No type-desc: %s %s" type p)) (->> (if (listp d) (s-join " " d) d) (format "- %s: %s %s" p r) (org-ml--indent-doc)))) (s-join "\n")))) (concat (format "Build %s %s node" (org-ml--autodef-prepend-article type) class) end "\n\nThe following properties are settable:\n" prop "\n- POST-BLANK: a non-negative integer"))) (defun org-ml--autodef-build-node-form (entry) "Return defun form for ENTRY." (let* ((type (car entry)) (name (intern (format "org-ml-build-%s" type))) (props (->> (cdr entry) (--remove (eq :post-blank (car it))) (-non-nil) (-group-by #'org-ml--autodef-categorize-prop))) (pos-args (->> (alist-get 'req props) (--map (org-ml--autodef-kwd-to-sym (car it))))) (kw-args (->> (alist-get 'key props) (--map (let ((prop (org-ml--autodef-kwd-to-sym (car it))) (default (plist-get (cdr it) :require))) (if default `(,prop ,default) prop))))) (rest-arg (cond ((memq type org-element-greater-elements) 'element-nodes) ((memq type org-element-object-containers) 'object-nodes))) (args (let ((a `(,@pos-args &key ,@kw-args post-blank))) (if rest-arg `(,@a &rest ,rest-arg) a))) (const-props (->> (alist-get 'const props) (--mapcat (list (car it) (plist-get (cdr it) :const))))) (nil-props (->> (alist-get 'null props) (-map #'car) (--mapcat (list it nil)))) (strict-props (->> (append (alist-get 'key props) (alist-get 'req props)) (-map #'car) (--mapcat (list it `(org-ml--property-encode ,it ,(org-ml--autodef-kwd-to-sym it) ',type))))) (all-props (-some->> (append strict-props nil-props const-props) (cons 'list))) (updaters (->> (alist-get type org-ml--property-updater-functions) (-map #'cdr) (-uniq))) (doc (org-ml--autodef-make-docstring type rest-arg props)) (inner-body `(org-ml--build-bare-node ',type post-blank ,all-props ,rest-arg)) (prop-syms (->> (alist-get 'key props) (append (alist-get 'req props)) (-map #'car) (-map #'org-ml--autodef-kwd-to-sym) (cons 'post-blank))) (memoizer-key (cond ((and rest-arg (not prop-syms)) rest-arg) ((and rest-arg (= (length prop-syms) 1)) `(cons ,@prop-syms ,rest-arg)) (rest-arg `(append (list ,@prop-syms) ,rest-arg)) ((not prop-syms) nil) ((= (length prop-syms) 1) (car prop-syms)) (t `(list ,@prop-syms)))) (body (if updaters (let ((us (--map `(funcall #',it node) updaters))) `(let ((node ,inner-body)) ,@us)) inner-body)) (memoized-body (if memoizer-key `(org-ml--with-builder-cache ,type ,memoizer-key ,body) body))) (macroexpand `(org-ml--defun-kw ,name ,args ,doc ,memoized-body)))) (defmacro org-ml--autodef-build-node-functions () "Define all build node functions." (let ((forms (--> (--remove (eq 'plain-text (car it)) org-ml--property-alist) (--map (org-ml--autodef-build-node-form it) it)))) `(progn ,@forms)))) (org-ml--autodef-build-node-functions) ;; INTERNAL TYPE-SPECIFIC PROPERTY FUNCTIONS ;;; object nodes ;; ;; statistics-cookie (defun org-ml--statistics-cookie-get-format (statistics-cookie) "Return format of STATISTICS-COOKIE as a symbol. If fractional cookie, return `fraction'; if percentage cookie return `percent', else throw error (which should never happen)." (let ((value (org-element-property-raw :value statistics-cookie))) (cond ((s-contains? "/" value) 'fraction) ((s-contains? "%" value) 'percent) (t (org-ml--arg-error "Unparsable statistics cookie: %s" value))))) ;; timestamp (auxiliary functions) ;; terminology (in haskell types) ;; type Date = (Y, M, D) ;; type Time = (H, M) ;; type DateTime = (Y, M, D, H, M) ;; type TimeList = (Y, M, D, (Maybe H), (Maybe M)) (defun org-ml-is-time-p (time) "Return t if TIME is a list like (hour min)." (pcase time (`(,(pred integerp) ,(pred integerp)) t))) (defun org-ml-timelist-has-time (timelist) "Return t if TIMELIST has a time." (pcase timelist (`(,(pred integerp) ,(pred integerp) ,(pred integerp) ,(pred integerp) ,(pred integerp)) t))) ;; make these public, not sure where else to put them (defun org-ml-timelist-to-unixtime (timelist) "Return the unix time (integer seconds) of TIMELIST. The returned value is dependent on the time zone of the operating system." (->> (-let (((y m d H M) timelist)) (list 0 (or M 0) (or H 0) d m y nil -1 (current-time-zone))) (encode-time) (float-time) (round))) (defun org-ml-unixtime-to-timelist (has-time unixtime) "Return the long time list of UNIXTIME. The list will be formatted like (YEAR MONTH DAY HOUR MIN) unless HAS-TIME is nil, in which case HOUR and MIN will be set to nil." (-let (((M H d m y) (-slice (decode-time unixtime (current-time-zone)) 1 6))) (if has-time (list y m d H M) (list y m d nil nil)))) (defun org-ml-unixtime-to-datetime (unixtime) "Return the long time list of UNIXTIME. The list will be formatted like (YEAR MONTH DAY HOUR MIN)." (reverse (-slice (decode-time unixtime (current-time-zone)) 1 6))) (defun org-ml-unixtime-to-date (unixtime) "Return the short time list of UNIXTIME. The list will be formatted like (YEAR MONTH DAY nil nil)." (append (-take 3 (org-ml-unixtime-to-datetime unixtime)) '(nil nil))) (defun org-ml--timelist-truncate (timelist) "Return the date of TIMELIST with hour amd minute fields nil-ed." `(,@(-take 3 timelist) nil nil)) (defun org-ml-timelist-split (timelist) "Return TIMELIST split into ((Y M D) (H M)). The second member will be nil if either hours or minutes is nil." (-let (((ymd (h m)) (-split-at 3 timelist))) (list ymd (if (and h m) (list h m) nil)))) (defun org-ml-times-equal-date-p (time1 time2) "Return t if the dates of TIME1 and TIME2 are the same." (equal (org-ml--timelist-truncate time1) (org-ml--timelist-truncate time2))) (defun org-ml--timelists-get-range-type (timelist1 timelist2 original) "Return range type of TIMELIST1 and TIMELIST2. Valid return values are nil (unranged), `daterange' (ranged with different dates), or `timerange' (ranged with same date). ORIGINAL can be any of the return values above. If TIME1 and TIME2 are a timerange as defined above, return ORIGINAL if it is non-nil." (-let (((d1 t1) (org-ml-timelist-split timelist1)) ((d2 t2) (org-ml-timelist-split timelist2))) (if (equal d1 d2) (if (equal t1 t2) nil (or original 'timerange)) 'daterange))) ;; ASSUME any "impossible datetimes" will be corrected when the timelist is ;; parsed back into a timestamp (or however it will be used). Ie if I add 10000 ;; days to any timestamp assume this will be reflected sensibly in the month ;; and year of the final result downstream. (defun org-ml-timelist-shift (n unit timelist) "Return modified TIMELIST shifted N UNIT's. UNIT is one of `day', `week', `month', `year', `minute', or `hour'. N is an integer." (-let (((i s) (cond ((eq unit 'year) `(0 ,n)) ((eq unit 'month) `(1 ,n)) ((eq unit 'week) `(2 ,(* 7 n))) ((eq unit 'day) `(2 ,n)) ((and (eq unit 'hour) (org-ml-timelist-has-time timelist)) `(3 ,n)) ((and (eq unit 'minute) (org-ml-timelist-has-time timelist)) `(4 ,n)) (t (org-ml--arg-error "Invalid time unit: %S" unit))))) (org-ml--map-at* i (+ s it) timelist))) (defun org-ml--time-shift (n unit time) "Return modified TIME shifted N UNITs (modulo). UNIT is `minute', or `hour'. N is an integer." (-let* ((f (pcase unit (`hour 60) (`minute 1) (_ (org-ml--arg-error "Invalid time unit: %S" unit)))) ((H M) time) (s (+ (* n f) (* H 60) M))) (list (mod (/ s 60) 24) (mod s 60)))) ;; timestamp (regular) ;; ASSUME the source of truth for if a timestamp is ranged or not is in the ;; :ranged-type property. This is much faster than querying each piece of the ;; timestamp and inferring if it is ranged or not. It also is less ambiguous for ;; in cases where the timestamp may be collapsed. (defun org-ml--check-time (H M) "Check time, decomposed into H and M." (unless (and (integerp H) (integerp M)) (org-ml--arg-error "Invalid time %s" (list H M)))) (defun org-ml--check-time-from-list (time) "Check TIME." (if (consp time) (-let (((H M) time)) (org-ml--check-time H M)) (org-ml--arg-error "Time must not be nil"))) (defun org-ml--check-timelist (y m d H M) "Check timelist, decomposed into Y M D H and M." (unless (and (integerp y) (integerp m) (integerp d) (or (not H) (integerp H)) (or (not M) (integerp M))) (org-ml--arg-error "Invalid timelist %s" (list y m d H M)))) (defun org-ml--check-timelist-from-list (timelist) "Check TIMELIST." (if (consp timelist) (-let (((y m d H M) timelist)) (org-ml--check-timelist y m d H M)) (org-ml--arg-error "Timelist must not be nil"))) (defun org-ml--check-warning (type value unit) "Check that warning (TYPE VALUE UNIT) is valid." (unless (and (org-ml--is-valid-timestamp-warning-type type) (integerp value) (org-ml--is-valid-timestamp-unit unit)) (org-ml--arg-error "Invalid warning %s" (list type value unit)))) (defun org-ml--check-repeater (type value unit) "Check that repeater (TYPE VALUE UNIT) is valid." (unless (and (org-ml--is-valid-timestamp-repeater-type type) (integerp value) (org-ml--is-valid-timestamp-unit unit)) (org-ml--arg-error "Invalid repeater %s" (list type value unit)))) (defun org-ml--check-deadline (value unit) "Check that deadline (VALUE UNIT) is valid." (unless (and (integerp value) (org-ml--is-valid-timestamp-unit unit)) (org-ml--arg-error "Invalid deadline %s" (list value unit)))) (defun org-ml--check-warning-from-list (warning) "Check that WARNING is valid." (if (consp warning) (-let (((y v u) warning)) (org-ml--check-warning y v u)) (org-ml--arg-error "Warning must not be nil"))) (defun org-ml--check-repeater-from-list (repeater) "Check that REPEATER is valid." (if (consp repeater) (-let (((y v u) repeater)) (org-ml--check-repeater y v u)) (org-ml--arg-error "Repeater must not be nil"))) (defun org-ml--check-deadline-from-list (deadline) "Check that DEADLINE is valid." (if (consp deadline) (-let (((v u) deadline)) (org-ml--check-deadline v u)) (org-ml--arg-error "Repeater must not be nil"))) (defun org-ml--timestamp-get-start-timelist (timestamp) "Return the timelist of the start time in TIMESTAMP." (-let (((&plist :minute-start n :hour-start h :day-start d :month-start m :year-start y) (org-ml--get-nonstandard-properties timestamp))) `(,y ,m ,d ,h ,n))) (defun org-ml--timestamp-get-start-date (timestamp) "Return the start date of TIMESTAMP." (-let (((&plist :year-start y :month-start m :day-start d) (org-ml--get-nonstandard-properties timestamp))) `(,y ,m ,d))) (defun org-ml--timestamp-get-start-time (timestamp) "Return the start time of TIMESTAMP or nil if not set." (-let (((&plist :minute-start m :hour-start h) (org-ml--get-nonstandard-properties timestamp))) (if (and h m) `(,h ,m) nil))) (defun org-ml--timestamp-get-end-timelist (timestamp) "Return the timelist of the end time in TIMESTAMP." (-let (((&plist :minute-end n :hour-end h :day-end d :month-end m :year-end y) (org-ml--get-nonstandard-properties timestamp))) `(,y ,m ,d ,h ,n))) (defun org-ml--timestamp-get-end-date (timestamp) "Return the end date of TIMESTAMP." (-let (((&plist :year-end y :month-end m :day-end d) (org-ml--get-nonstandard-properties timestamp))) `(,y ,m ,d))) (defun org-ml--timestamp-get-end-time (timestamp) "Return the end time of TIMESTAMP or nil if not set." (-let (((&plist :minute-end m :hour-end h) (org-ml--get-nonstandard-properties timestamp))) (if (and h m) `(,h ,m) nil))) (defun org-ml--timestamp-get-start-unixtime (timestamp) "Return the unixtime of the start time in TIMESTAMP." (->> (org-ml--timestamp-get-start-timelist timestamp) (org-ml-timelist-to-unixtime))) (defun org-ml--timestamp-get-end-unixtime (timestamp) "Return the unixtime of the end time in TIMESTAMP." (->> (org-ml--timestamp-get-end-timelist timestamp) (org-ml-timelist-to-unixtime))) (defun org-ml--timestamp-has-equal-dates-p (timestamp) "Return t if start and end dates of TIMESTAMP are the same." (equal (org-ml--timestamp-get-start-date timestamp) (org-ml--timestamp-get-end-date timestamp))) (defun org-ml--timestamp-get-length (timestamp) "Return the range of TIMESTAMP in seconds." (- (org-ml--timestamp-get-end-unixtime timestamp) (org-ml--timestamp-get-start-unixtime timestamp))) (defun org-ml--timestamp-is-active (timestamp) "Return t if TIMESTAMP is an active type." (memq (org-element-property-raw :type timestamp) '(active active-range))) (defun org-ml--timestamp-is-range-type (timestamp) "Return t if TIMESTAMP has a range type." (memq (org-element-property-raw :type timestamp) '(active-range inactive-range))) (defun org-ml--timestamp-is-ranged (timestamp) "Return t if TIMESTAMP has a range greater than 0 seconds." (/= 0 (org-ml--timestamp-get-length timestamp))) (defun org-ml--timestamp-set-start-timelist-nocheck (timelist timestamp) "Set the start of TIMESTAMP using TIMELIST. Does not set type." (-let (((y m d H M) timelist)) (org-ml--set-properties-raw timestamp :year-start y :month-start m :day-start d :hour-start H :minute-start M))) (defun org-ml--timestamp-set-start-timelist (timelist timestamp) "Return TIMESTAMP with start time set according to TIMELIST." (->> (org-ml--timestamp-set-start-timelist-nocheck timelist timestamp) (org-ml--timestamp-update-type-ranged))) (defun org-ml--timestamp-set-end-timelist-nocheck (timelist timestamp) "Set the end of TIMESTAMP using TIMELIST. Does not set type. Set end to start if TIMELIST is nil." (-let (((y m d H M) (or timelist (org-ml--timestamp-get-start-timelist timestamp)))) (org-ml--set-properties-raw timestamp :year-end y :month-end m :day-end d :hour-end H :minute-end M))) (defun org-ml--timestamp-set-end-timelist (timelist timestamp) "Return TIMESTAMP with end set according to TIMELIST." (->> (org-ml--timestamp-set-end-timelist-nocheck timelist timestamp) (org-ml--timestamp-update-type-ranged))) (defun org-ml--timestamp-set-single-timelist (timelist timestamp) "Return TIMESTAMP with start/end set to TIMELIST." (->> (org-ml--timestamp-set-start-timelist-nocheck timelist timestamp) (org-ml--timestamp-set-end-timelist-nocheck timelist) (org-ml--timestamp-set-range-type nil))) (defun org-ml--timestamp-set-double-timelist (timelist1 timelist2 timestamp) "Return TIMESTAMP with start/end set to TIMELIST1/TIMELIST2." (->> (org-ml--timestamp-set-start-timelist-nocheck timelist1 timestamp) (org-ml--timestamp-set-end-timelist-nocheck timelist2) (org-ml--timestamp-update-type-ranged))) (defun org-ml--timestamp-set-type-ranged (is-ranged timestamp) "Return TIMESTAMP with `:type' set according to IS-RANGED." (org-ml--map-property-raw* :type (pcase it ((or `active `active-range) (if is-ranged 'active-range 'active)) ((or `inactive `inactive-range) (if is-ranged 'inactive-range 'inactive)) (e (org-ml--arg-error "Invalid timestamp type: %s" e))) timestamp)) (defun org-ml--timestamp-set-range-type (range-type timestamp) "Return TIMESTAMP updated to reflect RANGE-TYPE. Specifically update `:range-type' and `:type'." (->> (org-ml--timestamp-set-type-ranged range-type timestamp) (org-element-put-property-2 :range-type range-type))) (defun org-ml--timestamp-set-length (n unit timestamp) "Return TIMESTAMP with end time shifted to N UNITs from start time." (let* ((t1 (org-ml--timestamp-get-start-timelist timestamp)) (has-time (org-ml-timelist-has-time t1)) ;; convert to unixtime and back to fix any overflow values (t2 (->> (org-ml-timelist-shift n unit t1) (org-ml-timelist-to-unixtime) (org-ml-unixtime-to-timelist has-time))) (rt (->> (org-element-property-raw :range-type timestamp) (org-ml--timelists-get-range-type t1 t2)))) (->> (org-ml--timestamp-set-end-timelist-nocheck t2 timestamp) (org-ml--timestamp-update-type-ranged) (org-ml--timestamp-set-range-type rt)))) (defun org-ml--timestamp-update-type-ranged (timestamp) "Return TIMESTAMP with updated `:type' and `:range-type'. Specifically, this assumes that the start and/or end of TIMESTAMP have just been updated, and that the `:type' and `:range-type' are now out of sync with the range between start/end. If deciding between `timerange' or `daterange', prefer the original value of TIMESTAMP if possible." (let* ((t1 (org-ml--timestamp-get-start-timelist timestamp)) (t2 (org-ml--timestamp-get-end-timelist timestamp)) (rt (->> (org-element-property-raw :range-type timestamp) (org-ml--timelists-get-range-type t1 t2)))) (org-ml--timestamp-set-range-type rt timestamp))) (defun org-ml--timestamp-set-active (flag timestamp) "Return TIMESTAMP with active type if FLAG is t." (let ((type (if (org-element-property-raw :range-type timestamp) (if flag 'active-range 'inactive-range) (if flag 'active 'inactive)))) (org-element-put-property-2 :type type timestamp))) (defun org-ml--timestamp-get-warning (timestamp) "Return the warning component of TIMESTAMP. Return a list like (TYPE VALUE UNIT) or nil." (-let (((&plist :warning-type y :warning-value v :warning-unit u) (org-ml--get-nonstandard-properties timestamp))) (when (and y v u) `(,y ,v, u)))) (defun org-ml--timestamp-set-warning (warning timestamp) "Return TIMESTAMP with warning properties set to WARNING list." (-let (((type value unit) warning)) (org-ml--set-properties-raw timestamp :warning-type type :warning-value value :warning-unit unit))) (defun org-ml--timestamp-get-repeater (timestamp) "Return the repeater component of TIMESTAMP. Return a list like (TYPE VALUE UNIT) or nil." (-let (((&plist :repeater-type y :repeater-value v :repeater-unit u) (org-ml--get-nonstandard-properties timestamp))) (when (and y v u) `(,y ,v, u)))) (defun org-ml--timestamp-set-repeater (repeater timestamp) "Return TIMESTAMP with repeater properties set to REPEATER." (unless repeater (org-ml--set-properties-raw timestamp :repeater-deadline-value nil :repeater-deadline-unit nil)) (-let (((type value unit) repeater)) (org-ml--set-properties-raw timestamp :repeater-type type :repeater-value value :repeater-unit unit))) (defun org-ml--timestamp-set-deadline (deadline timestamp) "Return TIMESTAMP with repeater properties set to DEADLINE." (if (not (org-ml--timestamp-get-repeater timestamp)) timestamp (-let (((value unit) deadline)) (org-ml--set-properties-raw timestamp :repeater-deadline-value value :repeater-deadline-unit unit)))) (defun org-ml--timestamp-set-collapsed (flag timestamp) "Return TIMESTAMP with collapsed set to FLAG." (pcase (org-element-property-raw :range-type timestamp) ;; collapsed (`timerange (if flag timestamp (->> (org-ml-copy timestamp) (org-element-put-property-2 :range-type 'daterange)))) ;; uncollapsed (`daterange (if (and (org-ml--timestamp-get-start-time timestamp) (org-ml--timestamp-get-end-time timestamp)) (cond ((and (eq flag t) (org-ml--timestamp-has-equal-dates-p timestamp)) (org-element-put-property-2 :range-type 'timerange timestamp)) ((and (eq flag 'force)) (let ((s (org-ml--timestamp-get-start-timelist timestamp))) (->> (org-ml-copy timestamp) (org-ml--timestamp-set-end-timelist-nocheck s) (org-element-put-property-2 :range-type 'timerange)))) (t timestamp)) timestamp)) ;; neither (`nil timestamp) (e (error "Invalid range-type %s" e)))) (defun org-ml--timestamp-set-start-time (time timestamp-diary) "Set the start of TIMESTAMP-DIARY to TIME. Does not set type." (-let (((H M) time)) (org-ml--set-properties-raw timestamp-diary :hour-start H :minute-start M))) (defun org-ml--timestamp-set-end-time (time timestamp-diary) "Set the end of TIMESTAMP-DIARY to TIME. Does not set type." (-let (((H M) time)) (org-ml--set-properties-raw timestamp-diary :hour-end H :minute-end M))) (defun org-ml--timestamp-update-type-ranged-timeonly (timestamp-diary) "Return TIMESTAMP-DIARY with updated `:range-type'." (let* ((t1 (org-ml--timestamp-get-start-time timestamp-diary)) (t2 (org-ml--timestamp-get-end-time timestamp-diary)) (rt (if (equal t1 t2) nil 'timerange))) (org-element-put-property-2 :range-type rt timestamp-diary))) ;; timestamp (diary sexp) ;;; element nodes ;; ;; item (defun org-ml--item-get-subcomponents (item) "Return the children of ITEM broken down into subcomponents. The returned list will be of the form (HEAD SUBITEMS POST-BLANK REST) where HEAD consists of all nodes before the first nested plain-list, SUBITEMS will be all items in the nested plain-list, POST-BLANK will be the post-blank of the nested plain-list, and REST will be everything after the plain-list (which should be nil for all sensible items). Example item showing how this breaks down: - HEAD - SUBITEM1 - SUBITEM2 (with POST-BLANK 1 below) REST REST may itself contain more plain lists, but (for now at least) let's consider these cases extremely rare. This function will still do the right thing, but any plain list in REST will be off-limits for the indent/outdent functions that use this function." (-let* (((h (s . r)) (->> (org-element-contents item) (--split-with (not (org-ml--is-type 'plain-list it))))) (pb (if s (org-element-post-blank s) 0)) (i (org-element-contents s))) (list h i pb r))) (defun org-ml--item-set-subcomponents (subcomponents item) "Return the child subcomponents of ITEM. SUBCOMPONENTS is a list like that returned by `org-ml--item-get-subcomponents'." (-let* (((head subitems sub-pb rest) subcomponents)) (-when-let (pb (cond (rest (org-element-post-blank (-last-item rest))) (subitems sub-pb) (head (org-element-post-blank (-last-item head))))) ;; TODO why did I do this? (let ((rest* (org-ml--set-last-post-blank 0 rest)) (sublist (apply #'org-ml-build-plain-list :post-blank (if rest sub-pb 0) subitems))) (->> (org-ml--set-children-nocheck `(,@head ,sublist ,@rest*) item) (org-ml--shift-post-blank-textsafe pb)))))) (defmacro org-ml--item-map-subcomponents* (form item) "Return ITEM with subcomponents modified. FORM is a form where the subcomponents of item are bound to the symbol `it' and returns modified subcomponents. The subcomponents will conform to those given in `org-ml--item-get-subcomponents'." (declare (debug (form form))) (let ((i (make-symbol "item"))) `(let ((,i ,item)) (let ((it (org-ml--item-get-subcomponents ,i))) (org-ml--item-set-subcomponents ,form ,i))))) (defmacro org-ml--item-map-subcomponents-cond* (head-form subitem-form rest-form item) "Return ITEM with subcomponents modified. First, split ITEM using `org-ml--item-get-subcomponents' and assign each of the four outputs to `it-head', `it-subitems', `it-rest-blank', and `it-rest' respectively. REST-FORM will run with all `it' variables are non-nil. This should return a modified `it-rest' analogue. SUBITEM-FORM will run if `it-rest' is nil and the rest are non-nil. This should return a list (SUBITEMS REST-BLANK REST). HEAD-FORM will run if `it-rest' and `it-subitems' are nil and the others are non-nil. This should return a list to be fed into `org-ml--item-set-subcomponents'." (declare (indent 3)) (let ((h (make-symbol "--head")) (s (make-symbol "--subitems")) (b (make-symbol "--blank")) (r (make-symbol "--rest"))) `(org-ml--item-map-subcomponents* (-let (((,h ,s ,b ,r) it)) (cond (,r (let ((it-rest ,r)) (list ,h ,s ,b ,rest-form))) (,s (let ((it-subitems ,s)) (cons ,h ,subitem-form))) (t (let ((it-head ,h)) ,head-form)))) ,item))) (defun org-ml--item-get-subitems (item) "Return the subitems of ITEM." (-let (((_ s _ _) (org-ml--item-get-subcomponents item))) s)) (defun org-ml--item-set-subitems (subitems item) "Return ITEM with subitems set to SUBITEMS." (org-ml--item-map-subcomponents* (-let (((h _ p r) it)) (list h subitems p r)) item)) (defmacro org-ml--item-map-subitems* (form item) "Return a ITEM with FORM applied to its sublist if present. FORM is a Lisp form in which the symbol `it' is bound to the items in the sub plain-list, and returns a modified list of items." (declare (debug (form form))) (let ((h (make-symbol "h")) (p (make-symbol "p")) (r (make-symbol "r"))) `(org-ml--item-map-subcomponents* (-let (((,h it ,p ,r) it)) (list ,h ,form ,p ,r)) ,item))) ;; headline (defun org-ml--headline-shift-level (n headline) "Return HEADLINE node with the level property shifted by N. If the level is less then one after shifting, set level to one." (->> (org-element-properties-resolve headline) (org-ml--map-property-raw* :level (org-ml--shift-pos-integer n it)))) (defun org-ml--headline-set-statistics-cookie (value headline) "Return HEADLINE node with statistics cookie set by VALUE. VALUE is a list conforming to `org-ml--is-valid-statistics-cookie-value' or nil to erase the statistics cookie if present." (org-ml--map-property-raw* :title (let ((last? (org-ml--is-type 'statistics-cookie (-last-item it)))) (cond ((and last? value) ;; NOTE use full property setter here since this will call the encoder (org-ml--map-last* (org-ml-set-property :value value it) (org-ml-copy it))) ((and last? (not value)) (-drop-last 1 it)) (value (-snoc it (org-ml-build-statistics-cookie value))) (t it))) (org-element-properties-resolve headline))) (defun org-ml--headline-set-statistics-cookie-fraction (done total headline) "Return HEADLINE node with statistics cookie set by DONE and TOTAL. DONE and TOTAL are integers representing the numerator and denominator respectively of the statistics-cookie's fractional value. Both must be greater than zero, and DONE must be less than or equal to TOTAL." (-if-let (cookie (org-ml-headline-get-statistics-cookie headline)) (let* ((format (org-ml--statistics-cookie-get-format cookie)) (value (if (eq 'fraction format) `(,done ,total) (-> (float done) (/ total) (* 100) (round) (list))))) (org-ml--headline-set-statistics-cookie value headline)) headline)) ;; planning (defun org-ml--build-planning-timestamp (active timelist) "Build a planning timestamp. ACTIVE is a boolean. TIMELIST is a list like (year month date [hour] [minute]). Note this is a more optimized version of `org-ml-build-timestamp!'" (-let (((y m d H M) timelist)) (org-ml--check-timelist y m d H M) (org-ml--set-properties-raw (org-ml--build-blank-node timestamp 0) :year-start y :month-start m :day-start d :hour-start H :minute-start M :year-end y :month-end m :day-end d :hour-end H :minute-end M :type (if active 'active 'inactive)))) (defun org-ml--planning-list-to-timestamp (planning-list) "Return timestamp node from PLANNING-LIST. See `org-ml-build-planning!' for syntax of PLANNING-LIST." (-let* ((p (-partition-before-pred (lambda (it) (memq it '(&warning &repeater))) planning-list)) (ts (org-ml--build-planning-timestamp t (car p)))) (-when-let (w (alist-get '&warning p)) (org-ml--check-warning-from-list w) (org-ml--timestamp-set-warning w ts)) (-when-let (r (alist-get '&repeater p)) (org-ml--check-repeater-from-list r) (org-ml--timestamp-set-repeater r ts)) ts)) (defun org-ml--timestamp-to-planning-list (timestamp) "Return TIMESTAMP as planning list. See `org-ml-build-planning!' for syntax of PLANNING-LIST. This is only meant for deadline or scheduled timestamps, since the list for closed is trival." (let ((timelist (org-ml--timestamp-get-start-timelist timestamp)) (warning (org-ml--timestamp-get-warning timestamp)) (repeater (org-ml--timestamp-get-repeater timestamp))) (append timelist (and warning (cons '&warning warning)) (and repeater (cons '&repeater repeater))))) ;; clock (defun org-ml--build-clock-timestamp (start end) "Build clock timestamp from START and END. Both arguments are lists like (year month date hour minute). This is a more optimized version of `org-ml-build-timestamp!'." (-let (((y0 m0 d0 H0 M0) start) ((y1 m1 d1 H1 M1) (or end start))) (org-ml--check-timelist y0 m0 d0 H0 M0) (when end (org-ml--check-timelist y1 m1 d1 H1 M1)) (org-ml--set-properties-raw (org-ml--build-blank-node timestamp 0) :year-start y0 :month-start m0 :day-start d0 :hour-start H0 :minute-start M0 :year-end y1 :month-end m1 :day-end d1 :hour-end H1 :minute-end M1 :range-type (and end 'daterange) :type (if end 'inactive-range 'inactive)))) ;;; INTERNAL TYPE-SPECIFIC BRANCH/CHILD FUNCTIONS ;;; headline (defun org-ml-headline-get-section (headline) "Return children of section node in HEADLINE node or nil if none." (--> (car (org-element-contents headline)) (when (org-ml--is-type 'section it) (org-element-contents it)))) (defun org-ml-headline-set-section (children headline) "Return HEADLINE with section node containing CHILDREN. If CHILDREN is nil, return HEADLINE with no section node." (org-ml--map-children-nocheck* (if (org-ml--is-type 'section (car it)) (cons (org-ml-set-children children (car it)) (cdr it)) (cons (apply #'org-ml-build-section children) it)) headline)) (org-ml--defun-anaphoric* org-ml-headline-map-section (fun headline) "Return HEADLINE node with child section node modified by FUN. FUN is a unary function that takes a section node's children as a list returns a modified child list." (--> (org-ml-headline-get-section headline) (org-ml-headline-set-section (funcall fun it) headline))) (defun org-ml-headline-get-subheadlines (headline) "Return list of child headline nodes in HEADLINE node or nil if none." (let ((children (org-element-contents headline))) (if (org-ml--is-type 'section (car children)) (cdr children) children))) (defun org-ml-headline-set-subheadlines (subheadlines headline) "Return HEADLINE node with SUBHEADLINES set to child subheadlines." (org-ml--map-children-nocheck* (-if-let (section (assq 'section it)) (cons section subheadlines) subheadlines) headline)) (org-ml--defun-anaphoric* org-ml-headline-map-subheadlines (fun headline) "Return HEADLINE node with child headline nodes modified by FUN. FUN is a unary function that takes a list of headlines and returns a modified list of headlines." (--> (org-ml-headline-get-subheadlines headline) (org-ml-headline-set-subheadlines (funcall fun it) headline))) (defun org-ml--headline-subtree-shift-level (n headline) "Return HEADLINE node with its level shifted by N. Also shift all HEADLINE node's child headline nodes by N. If the final shifted level is less one, set level to one (for parent and child nodes)." (->> (org-ml-copy headline) (org-ml--headline-shift-level n) (org-ml-headline-map-subheadlines* (--map (org-ml--headline-subtree-shift-level n it) it)))) (defun org-ml--headline-set-level (level headline) "Return HEADLINE node with its level set to LEVEL. Additionally set all child headline nodes to be (+ 1 level) for first layer, (+ 2 level) for second, and so on." ;; NOTE full setter needed since this is called from the headline builder (->> (org-element-put-property-2 :level level headline) (org-ml-headline-map-subheadlines* (--map (org-ml--headline-set-level (1+ level) it) it)))) ;;; table (defun org-ml--table-get-width (table) "Return the width of TABLE as an integer. This effectively is the maximum of all table-row lengths." (->> (org-element-contents table) (--map (length (org-element-contents it))) (-max))) (defun org-ml--table-pad-or-truncate (length list) "Pad or truncate LIST of table-cell nodes by LENGTH. Behavior is the same as `org-ml--pad-or-truncate' where the padded value is a blank table-cell node." (let ((pad (org-ml-build-table-cell ""))) (org-ml--pad-or-truncate length pad list))) (defun org-ml--column-map-down-rows (fun column-index table) "Return TABLE node with FUN applied down the rows at COLUMN-INDEX. FUN is a unary function that takes a table-cell node and returns a modified table-cell node." (cl-flet ((zip-into-rows (row new-cell) (if (org-ml--property-is-eq :type 'rule row) row (org-ml--map-children-nocheck* (funcall fun new-cell it) row)))) (org-ml--map-children-nocheck* (->> (--find-indices (org-ml--property-is-eq :type 'rule it) it) (--reduce-from (-insert-at it nil acc) column-index) (org-ml--table-pad-or-truncate (length it)) (-zip-with #'zip-into-rows it)) table))) (defun org-ml--table-get-row (row-index table) "Return the table-row node at ROW-INDEX within TABLE. Rule-type table-row nodes do not factor when counting the index." (->> (org-element-contents table) (--filter (org-ml--property-is-eq :type 'standard it)) (org-ml--nth row-index))) (defun org-ml--table-replace-column (column-index column-cells table) "Return TABLE with COLUMN-CELLS in place of original cells at COLUMN-INDEX." (org-ml--column-map-down-rows (lambda (new-cell cells) (org-ml--replace-at column-index new-cell cells)) column-cells table)) (defun org-ml--table-row-pad-maybe (table table-row) "Return TABLE-ROW with row truncated or padded. See `org-ml--table-pad-or-truncate' for how padding and truncation is performed. TABLE is used to get the table width." (if (org-ml--property-is-eq :type 'rule table-row) table-row (let ((width (org-ml--table-get-width table))) (org-ml--map-children-nocheck* (org-ml--table-pad-or-truncate width it) table-row)))) (defun org-ml--table-replace-row (row-index table-row table) "Return TABLE node with row at ROW-INDEX replaced by TABLE-ROW." (let ((table-row (org-ml--table-row-pad-maybe table table-row))) (org-ml--map-children-nocheck* (org-ml--replace-at row-index table-row it) table))) (defun org-ml--table-clear-row (row-index table) "Return TABLE with table-cells in row at ROW-INDEX filled with blanks." (org-ml--table-replace-row row-index (org-ml-build-table-row! '(" ")) table)) (defun org-ml--table-clear-column (column-index table) "Return TABLE with table-cells in column at COLUMN-INDEX filled with blanks." (org-ml--table-replace-column column-index `(,(org-ml-build-table-cell " ")) table)) ;;; COMPOSITE BUILDERS ;;; misc builders (org-ml--defun-kw org-ml-build-timestamp-diary (form &key start end post-blank) "Return a new diary-sexp timestamp node from FORM. TIME1 and TIME1 are lists like (hour min) which specify the time(s) of the diary timestamp. If TIME2 is provided, TIME1 must also be provided and the timestamp will be ranged. Optionally set POST-BLANK (a positive integer)." ;; TODO this isn't very efficient (->> (org-ml--build-blank-node timestamp post-blank) (org-element-put-property-2 :type 'diary) (org-ml-timestamp-diary-set-value form) (org-ml-timestamp-diary-set-double-time start end))) (org-ml--defun-kw org-ml-build-table-row-hline (&key post-blank) "Return a new rule-typed table-row node. Optionally set POST-BLANK (a positive integer)." (->> (org-ml--build-blank-node table-row post-blank) (org-element-put-property-2 :type 'rule))) ;;; shorthand builders ;; These function offer a shorter and more convenient way of building ;; nodes. They all end in '!' (and all associated functions later (eval-and-compile (defvar org-ml--shorthand-builder-cache (--map (cons it (make-hash-table :test #'equal)) org-ml-shorthand-builder-types) "Alist of hash tables to store shorthand builder results.")) (defun org-ml-clear-shorthand-builder-cache () "Clear the memoization cache for shorthand node builders." (interactive) (--each org-ml--shorthand-builder-cache (clrhash (cdr it)))) (defmacro org-ml--with-shorthand-builder-cache (type key body) "Run BODY with shorthand builder cache. See org-ml--with-cache' for meaning of TYPE and KEY." (declare (indent 1)) `(org-ml--with-cache org-ml--shorthand-builder-cache org-ml-memoize-shorthand-builders org-ml-memoize-shorthand-builder-types ,type ,key ,body)) (defun org-ml-build-secondary-string! (string) "Return a secondary string (list of object nodes) from STRING. STRING is any string that contains a textual representation of object nodes. If the string does not represent a list of object nodes, throw an error." (org-ml--with-shorthand-builder-cache secondary-string string ;; add space to prevent leading stars from parsing as headlines (-if-let (d (->> (org-ml--from-string (concat " " string)) (org-ml--get-descendent '(0)))) ;; special case, anything starting with what looks like a bullet will ;; be parsed as a list with one item (if (org-ml--is-type 'plain-list d) (-let* ((i (org-ml--get-descendent '(0) d)) ((first . rest) (->> (org-ml--get-descendent '(0) i) (org-element-contents))) (bullet (org-element-property-raw :bullet i))) (if (org-ml--is-type 'plain-text first) `(,(concat bullet first) ,@rest) `(,bullet ,first ,@rest))) (if-let (ss (org-element-contents d)) (cond ((not (org-ml--is-secondary-string ss)) (org-ml--arg-error "Secondary string must only contain objects")) ((equal (car ss) " ") (-drop 1 ss)) (t (org-ml--map-first* (substring it 1) ss))) (org-ml--arg-error "Could not make secondary string from %S" string))) (org-ml--arg-error "Could not make secondary string from %S" string)))) (org-ml--defun-kw org-ml-build-timestamp! (start &key end active repeater deadline warning collapsed post-blank) "Return a new timestamp node. START specifies the start time and is a list of integers in one of the following forms: - (YEAR MONTH DAY): short form - (YEAR MONTH DAY nil nil): short form - (YEAR MONTH DAY HOUR MINUTE): long form END (if supplied) will add the ending time, and follows the same formatting rules as START. ACTIVE is a boolean where t signifies the type is `active', else `inactive' (the range suffix will be added if an end time is supplied). REPEATER, DEADLINE, and WARNING are lists corresponding to those required for `org-ml-timestamp-set-repeater', `org-ml-timestamp-set-deadline', and `org-ml-timestamp-set-warning' respectively. Building a diary sexp timestamp is not possible with this function." (org-ml--check-timelist-from-list start) (when end (org-ml--check-timelist-from-list end)) (when repeater (org-ml--check-repeater-from-list repeater)) (when warning (org-ml--check-warning-from-list warning)) (when deadline (org-ml--check-deadline-from-list deadline)) (org-ml--with-shorthand-builder-cache timestamp (list start end active repeater deadline warning collapsed post-blank) (org-ml->> (org-ml--build-blank-node timestamp post-blank) (org-ml--timestamp-set-start-timelist-nocheck start) (org-ml--timestamp-set-end-timelist-nocheck end) (org-ml--timestamp-set-active active) (org-ml--timestamp-update-type-ranged) (org-ml--timestamp-set-warning warning) (org-ml--timestamp-set-repeater repeater) (org-ml--timestamp-set-deadline deadline) (org-ml--timestamp-set-collapsed (or collapsed t))))) (org-ml--defun-kw org-ml-build-clock! (start &key end post-blank) "Return a new clock node. START and END follow the same rules as their respective arguments in `org-ml-build-timestamp!'." (org-ml--with-shorthand-builder-cache clock (list start end post-blank) (let ((ts (org-ml--build-clock-timestamp start end))) (org-ml-build-clock ts :post-blank post-blank)))) (org-ml--defun-kw org-ml-build-planning! (&key closed deadline scheduled post-blank) "Return a new planning node. DEADLINE and SCHEDULED are lists with the following structure \(brackets denote optional members): \(YEAR MINUTE DAY [HOUR] [MIN] [&warning TYPE VALUE UNIT] [&repeater TYPE VALUE UNIT]) In terms of arguments supplied to `org-ml-build-timestamp!', the first five members correspond to the list supplied as TIME, and the TYPE, VALUE, and UNIT fields correspond to the lists supplied to WARNING and REPEATER arguments. The order of warning and repeater does not matter. CLOSED is a similar list to above but does not have &warning or &repeater." (org-ml--with-shorthand-builder-cache planning (list closed deadline scheduled post-blank) (let ((node (org-ml--build-blank-node planning (or post-blank 0)))) (when closed (->> (org-ml--build-planning-timestamp nil closed) (org-element-put-property node :closed))) (when deadline (->> (org-ml--planning-list-to-timestamp deadline) (org-element-put-property node :deadline))) (when scheduled (->> (org-ml--planning-list-to-timestamp scheduled) (org-element-put-property node :scheduled))) node))) (org-ml--defun-kw org-ml-build-property-drawer! (&key post-blank &rest keyvals) "Return a new property-drawer node. Each member in KEYVALS is a list like (KEY VAL) where KEY and VAL are both strings, where each list will generate a node-property node in the property-drawer node like \":key: val\"." (org-ml--with-shorthand-builder-cache property-drawer (cons post-blank keyvals) (->> keyvals (--map (let ((key (car it)) (val (cadr it))) (org-ml-build-node-property key val))) (apply #'org-ml-build-property-drawer :post-blank post-blank)))) (org-ml--defun-kw org-ml-build-headline! (&key (level 1) title-text todo-keyword tags pre-blank priority commentedp archivedp post-blank planning statistics-cookie section-children &rest subheadlines) "Return a new headline node. TITLE-TEXT is a oneline string for the title of the headline. PLANNING is a list like (PLANNING-TYPE ARGS ...) where PLANNING-TYPE is one of `:closed', `:deadline', or `:scheduled', and ARGS are the args supplied to any of the planning types in `org-ml-build-planning!'. Up to all three planning types can be used in the same list like (:closed ARGS :deadline ARGS :scheduled ARGS). STATISTICS-COOKIE is a list following the same format as `org-ml-build-statistics-cookie'. SECTION-CHILDREN is a list of elements that will go in the headline section. SUBHEADLINES contains zero or more headlines that will go under the created headline. The level of all members in SUBHEADLINES will automatically be adjusted to LEVEL + 1. All arguments not mentioned here follow the same rules as `org-ml-build-headline'" (org-ml--with-shorthand-builder-cache headline (append (list level title-text todo-keyword tags pre-blank priority commentedp archivedp post-blank planning statistics-cookie section-children) subheadlines) (let* ((planning (-some->> planning (apply #'org-ml-build-planning!))) (section (-some->> (if planning (cons planning section-children) section-children) (apply #'org-ml-build-section))) (shls (--map (org-ml--headline-set-level (1+ level) it) subheadlines)) (nodes (--> shls (if section (cons section it) it)))) (->> (apply #'org-ml-build-headline :todo-keyword todo-keyword :level level :tags tags :post-blank post-blank :pre-blank pre-blank :priority priority :commentedp commentedp :archivedp archivedp nodes) (org-ml-headline-set-title! title-text statistics-cookie))))) (org-ml--defun-kw org-ml-build-paragraph! (string &key post-blank) "Return a new paragraph node from STRING. STRING is the text to be parsed into a paragraph and must contain valid textual representations of object nodes." ;; ASSUME all children coming from `org-ml-build-secondary-string!' will be ;; valid so bypass type checking overhead. (org-ml--with-shorthand-builder-cache paragraph (list string post-blank) (->> (org-ml--build-blank-node paragraph post-blank) (org-ml-set-children (org-ml-build-secondary-string! string))))) (org-ml--defun-kw org-ml-build-item! (&key post-blank bullet checkbox tag paragraph counter &rest children) "Return a new item node. TAG is a string representing the tag (make with `org-ml-build-secondary-string!') . PARAGRAPH is a string that will be the initial text in the item \(made with `org-ml-build-paragraph!'). CHILDREN contains the nodes that will go under this item after PARAGRAPH. All other arguments follow the same rules as `org-ml-build-item'." (org-ml--with-shorthand-builder-cache item (append (list post-blank bullet checkbox tag paragraph counter) children) (let ((children* (or (-some-> paragraph (org-ml-build-paragraph!) (cons children)) children)) (tag (-some->> tag (org-ml-build-secondary-string!)))) (apply #'org-ml-build-item :post-blank post-blank :bullet bullet :checkbox checkbox :counter counter :tag tag children*)))) (defun org-ml-build-table-cell! (string) "Return a new table-cell node. STRING is the text to be contained in the table-cell node. It must contain valid textual representations of objects that are allowed in table-cell nodes." (org-ml--with-shorthand-builder-cache table-cell string (apply #'org-ml-build-table-cell (org-ml-build-secondary-string! string)))) (defun org-ml-build-table-row! (row-list) "Return a new table-row node. ROW-LIST is a list of strings to be built into table-cell nodes via `org-ml-build-table-cell!' (see that function for restrictions). Alternatively, ROW-LIST may the symbol `hline' instead of a string to create a rule-typed table-row." (org-ml--with-shorthand-builder-cache table-row row-list (if (eq row-list 'hline) (org-ml-build-table-row-hline) (->> (-map #'org-ml-build-table-cell! row-list) (apply #'org-ml-build-table-row))))) (org-ml--defun-kw org-ml-build-table! (&key tblfm post-blank &rest row-lists) "Return a new table node. Each member of ROW-LISTS will be converted to a table-row node via `org-ml-build-table-row!' (see that function for restrictions). All other arguments follow the same rules as `org-ml-build-table'." (org-ml--with-shorthand-builder-cache table (append (list tblfm post-blank) row-lists) (->> (-map #'org-ml-build-table-row! row-lists) (apply #'org-ml-build-table :tblfm tblfm :post-blank post-blank)))) (defun org-ml-build-org-data (&rest nodes) "Return a new org-data node using NODES. NODES should be either headline or section nodes." (->> (org-ml--build-blank-node org-data nil) (org-ml-set-children nodes))) ;;; logbook items ;; internal (defun org-ml--log-replace (placeholder string heading) "Return HEADING with PLACEHOLDER replaced by STRING." (->> (cons placeholder string) (list) (org-replace-escapes heading))) (defun org-ml--log-replace-new (string heading) "Return HEADING with placeholder \"%s\" replaced by STRING." (--> (format "\"%s\"" string) (org-ml--log-replace "%s" it heading))) (defun org-ml--log-replace-old (string heading) "Return HEADING with placeholder \"%S\" replaced by STRING." (--> (format "\"%s\"" string) (org-ml--log-replace "%S" it heading))) (defun org-ml--log-replace-new-state (state heading) "Return HEADING with placeholder \"%s\" replaced by string STATE." (org-ml--log-replace-new state heading)) (defun org-ml--log-replace-old-state (state heading) "Return HEADING with placeholder \"%S\" replaced by string STATE." (org-ml--log-replace-old state heading)) (defun org-ml--log-replace-new-timestamp (timestamp heading) "Return HEADING with placeholder \"%s\" replaced by TIMESTAMP. TIMESTAMP is a timestamp node and will be converted to an inactive timestamp if active." (-> (org-ml-timestamp-set-active nil timestamp) (org-ml-to-string) (org-ml--log-replace-new heading))) (defun org-ml--log-replace-old-timestamp (timestamp heading) "Return HEADING with placeholder \"%S\" replaced by TIMESTAMP. TIMESTAMP is a timestamp node and will be converted to an inactive timestamp if active." (-> (org-ml-timestamp-set-active nil timestamp) (org-ml-to-string) (org-ml--log-replace-old heading))) (defun org-ml--log-replace-timestamp (unixtime active-p long-p heading) "Return HEADING with timestamp placeholders replaced by a timestamp. UNIXTIME is an integer to be converted to a timestamp. The type of timestamp and the placeholders that are replaced depend on the boolean values of ACTIVE-P and LONG-P: - ACTIVE-P and LONG-P are t: long active timestamp replacing \"T\" - ACTIVE-P is t: short active timestamp replacing \"D\" - LONG-P is t: long inactive timestamp replacing \"t\" - both nil: short inactive timestamp replacing \"d\"" (let ((key (cond ((and active-p long-p) "%T") (active-p "%D") (long-p "%t") (t "%d"))) (time (if long-p (org-ml-unixtime-to-datetime unixtime) (org-ml-unixtime-to-date unixtime)))) ;; TODO this can likely be optimized (--> (org-ml-build-timestamp! time :active active-p) (org-ml-to-string it) (org-ml--log-replace key it heading)))) (defun org-ml--log-replace-username (username heading) "Return HEADING with \"%u\" replaced by symbol USERNAME." (org-ml--log-replace "%u" username heading)) (defun org-ml--log-replace-full-username (full-username heading) "Return HEADING with \"%U\" replaced by symbol FULL-USERNAME." (org-ml--log-replace "%U" full-username heading)) (defun org-ml--log-get (type) "Return the log heading associated with symbol TYPE. This function will only use the default value of `org-log-note-headings' and is thus a pure function." (alist-get type (default-value 'org-log-note-headings))) (defun org-ml--build-log-item (note heading) "Return an item with string HEADING as its first line. If string NOTE is supplied, append this after a newline object node in the first paragraph of the returned item." (->> (if note (format "%s \\\\\n %s" heading note) heading) (org-ml-build-paragraph!) (org-ml-build-item))) (defun org-ml--build-log-item-trans (type unixtime old-timestamp note) "Return an item for any of the transition log entry types. These are re/del-schedule/deadline (specified with TYPE) transitioning from OLD-TIMESTAMP at UNIXTIME with optionally supplied NOTE." (->> (org-ml--log-get type) (org-ml--log-replace-old-timestamp old-timestamp) (org-ml--log-replace-timestamp unixtime nil t) (org-ml--build-log-item note))) ;; public (defun org-ml-build-log-done (unixtime &optional note) "Return an item node for a done log entry. This will format the log entry from the default value for the `done' cell in `org-log-note-headings'. UNIXTIME is an integer representing the time to be used for all timestamp nodes. If string NOTE is supplied, append a note to the log entry." (->> (org-ml--log-get 'done) (org-ml--log-replace-timestamp unixtime nil t) (org-ml--build-log-item note))) (defun org-ml-build-log-state (unixtime new-state old-state &optional note) "Return an item node for a state change log entry. This will format the log entry from the default value for the `state' cell in `org-log-note-headings'. UNIXTIME is an integer representing the time to be used for all timestamp nodes. NEW-STATE and OLD-STATE are strings for the new and old todo keywords respectively. If string NOTE is supplied, append a note to the log entry." (->> (org-ml--log-get 'state) (org-ml--log-replace-new-state new-state) (org-ml--log-replace-old-state old-state) (org-ml--log-replace-timestamp unixtime nil t) (org-ml--build-log-item note))) (defun org-ml-build-log-note (unixtime note) "Return an item node for a new note log entry. This will format the log entry from the default value for the `note' cell in `org-log-note-headings'. UNIXTIME is an integer representing the time to be used for all timestamp nodes. NOTE is a string for the note text." (->> (org-ml--log-get 'note) (org-ml--log-replace-timestamp unixtime nil t) (org-ml--build-log-item note))) (defun org-ml-build-log-reschedule (unixtime old-timestamp &optional note) "Return an item node for a new schedule log entry. This will format the log entry from the default value for the `reschedule' cell in `org-log-note-headings'. UNIXTIME is an integer representing the time to be used for all timestamp nodes. OLD-TIMESTAMP is a timestamp node of the schedule that is being deleted. It will always be converted to an inactive timestamp. If string NOTE is supplied, append a note to the log entry." (org-ml--build-log-item-trans 'reschedule unixtime old-timestamp note)) (defun org-ml-build-log-delschedule (unixtime old-timestamp &optional note) "Return an item node for a delete schedule log entry. This will format the log entry from the default value for the `delschedule' cell in `org-log-note-headings'. UNIXTIME is an integer representing the time to be used for all timestamp nodes. OLD-TIMESTAMP is a timestamp node of the schedule that is being deleted. It will always be converted to an inactive timestamp. If string NOTE is supplied, append a note to the log entry." (org-ml--build-log-item-trans 'delschedule unixtime old-timestamp note)) (defun org-ml-build-log-redeadline (unixtime old-timestamp &optional note) "Return an item node for a new deadline log entry. This will format the log entry from the default value for the `redeadline' cell in `org-log-note-headings'. UNIXTIME is an integer representing the time to be used for all timestamp nodes. OLD-TIMESTAMP is a timestamp node of the deadline that is being deleted. It will always be converted to an inactive timestamp. If string NOTE is supplied, append a note to the log entry." (org-ml--build-log-item-trans 'redeadline unixtime old-timestamp note)) (defun org-ml-build-log-deldeadline (unixtime old-timestamp &optional note) "Return an item node for a delete deadline log entry. This will format the log entry from the default value for the `deldeadline' cell in `org-log-note-headings'. UNIXTIME is an integer representing the time to be used for all timestamp nodes. OLD-TIMESTAMP is a timestamp node of the deadline that is being deleted. It will always be converted to an inactive timestamp. If string NOTE is supplied, append a note to the log entry." (org-ml--build-log-item-trans 'deldeadline unixtime old-timestamp note)) (defun org-ml-build-log-refile (unixtime &optional note) "Return an item node for a refile log entry. This will format the log entry from the default value for the `deldeadline' cell in `org-log-note-headings'. UNIXTIME is an integer representing the time to be used for all timestamp nodes. If string NOTE is supplied, append a note to the log entry." (->> (org-ml--log-get 'refile) (org-ml--log-replace-timestamp unixtime nil t) (org-ml--build-log-item note))) (org-ml--defun-kw org-ml-build-log-type (type &key old new unixtime username full-username note) "Return an item for an arbitrary log entry. TYPE is a symbol corresponding to the car of one of the cells in `org-log-note-headings'. Unlike the other log entry build functions in this package, this function will not use the default value of `org-log-note-headings' which means it can be used for customly formatted log entries. The arguments correspond to the following formatting placeholders (see `org-log-note-headings' for more information on these placeholders): - NEW: either a string or timestamp node that will replace the new state/timestamp placeholder (%s) - OLD: like NEW but for the old state/timestamp placeholder (%S) - UNIXTIME: an integer corresponding to the time to be used for the timestamp placeholders (%t/%T/%d/%D) - USERNAME: a string for the username (%u) - FULL-USERNAME: a string for the full username (%U) If any of these arguments are not supplied but their placeholders are present in the heading determined by TYPE, the placeholders will not be substituted. If string NOTE is supplied, append a note to the log entry." ;; TODO this can likely be made faster (if desired) by not relying on the ;; individual replacement functions; doing it this way will call ;; `org-replace-escapes' multiple times, which is likely not as fast (cl-flet ((replace-note (old-p rep note) (if (not rep) note (let ((fun (cond ((org-ml--is-type 'timestamp rep) (if old-p #'org-ml--log-replace-old-timestamp #'org-ml--log-replace-new-timestamp)) ((stringp rep) (if old-p #'org-ml--log-replace-old-state #'org-ml--log-replace-new-state)) (t (org-ml--arg-error "Must be string or timestamp: Got %S" rep))))) (funcall fun rep note)))) (replace-timestamps (heading) (if (not unixtime) heading (->> heading (org-ml--log-replace-timestamp unixtime nil nil) (org-ml--log-replace-timestamp unixtime t nil) (org-ml--log-replace-timestamp unixtime nil t) (org-ml--log-replace-timestamp unixtime t t))))) (--> (alist-get type org-log-note-headings) (replace-timestamps it) (replace-note t old it) (replace-note nil new it) (if username (org-ml--log-replace-username username it) it) (if full-username (org-ml--log-replace-full-username full-username it) it) (org-ml--build-log-item note it)))) ;;; PUBLIC TYPE FUNCTIONS (defalias 'org-ml-get-type #'org-element-type "Return the type of NODE.") (defun org-ml-is-type (type node) "Return t if the type of NODE is TYPE (a symbol)." (declare (pure t)) (unless (memq type org-ml-nodes) (org-ml--arg-error "Argument 'type' must be in `org-ml-nodes': Got %s" type)) (org-ml--is-type type node)) (defun org-ml-is-any-type (types node) "Return t if the type of NODE is in TYPES (a list of symbols)." (declare (pure t)) (-some->> (-difference types org-ml-nodes) (org-ml--arg-error "All in 'types' must be in `org-ml-nodes'; these were not: %s")) (org-ml--is-any-type types node)) (defun org-ml-is-element (node) "Return t if NODE is an element class." (org-ml--is-any-type org-ml-elements node)) (defun org-ml-is-branch-node (node) "Return t if NODE is a branch node." (org-ml--is-any-type org-ml-branch-nodes node)) (defun org-ml-node-may-have-child-objects (node) "Return t if NODE is a branch node that may have child objects." (org-ml--is-any-type org-ml-branch-nodes-permitting-child-objects node)) (defun org-ml-node-may-have-child-elements (node) "Return t if NODE is a branch node that may have child elements. Note this implies that NODE is also of class element since only elements may have other elements as children." (org-ml--is-any-type org-ml-branch-elements-permitting-child-elements node)) ;;; PUBLIC PROPERTY FUNCTIONS ;;; polymorphic (defun org-ml-contains-point-p (point node) "Return t if POINT is within the boundaries of NODE." (-let ((b (org-element-begin node)) (e (org-element-end node))) (if (and (integerp b) (integerp e)) (<= b point e) (error "Node boundaries are not defined")))) (defun org-ml--property-is-attribute (prop) "Return t if PROP is of the form :attr_X where X is anything." (and (keywordp prop) (s-prefix-p ":attr_" (symbol-name prop) t))) (defun org-ml-set-property (prop value node) "Return NODE with PROP set to VALUE. See builder functions for a list of properties and their rules for each type." (let ((type (org-ml-get-type node))) ;; Specialized code to handle :attr_X properties which can't be put in ;; `org-ml--property-alist'. Values for these can only be lists of strings ;; and have no encoder or decoder. (cond ((and (memq type org-ml--element-nodes-with-affiliated) (org-ml--property-is-attribute prop)) (if (org-ml--is-string-list value) (org-element-put-property-2 prop value node) (org-ml--arg-error "All attributes like '%s' must be a list of strings. Got '%S'" prop value))) ((eq type 'plain-text) (if (eq prop :post-blank) (concat (s-trim-right node) (make-string value ?\ )) (org-add-props node nil prop value))) (t (let* ((value* (org-ml--property-encode prop value type)) (node* (->> (if (eq type 'headline) (org-element-properties-resolve node) node) (org-ml-copy) (org-element-put-property-2 prop value*)))) (-if-let (update-fun (org-ml--get-property-updater type prop)) (funcall update-fun node*) node*)))))) (defun org-ml-set-properties (plist node) "Return NODE with all properties set to the values according to PLIST. PLIST is a list of property-value pairs that corresponds to the property list in NODE. See builder functions for a list of properties and their rules for each type." (cl-flet ((split-keyvals-maybe (type keyvals) (if (not (memq type org-ml--element-nodes-with-affiliated)) (list keyvals nil) (--> keyvals (--group-by (org-ml--property-is-attribute (car it)) it) (list (alist-get nil it) (alist-get t it)))))) (if (not (org-ml--is-plist plist)) (org-ml--arg-error "Not a plist: %S" plist) (-let* ((type (org-ml-get-type node)) ;; this will divide the keywords to those that are of the form ;; :attr_X which must be set differently ((kv kv-attrs) (split-keyvals-maybe type (-partition 2 plist))) (update-funs (->> (--map (org-ml--get-property-updater type (car it)) kv) (-uniq) (-non-nil))) (node* (org-ml-copy node))) (--each kv (->> (org-ml--property-encode (car it) (cadr it) type) (org-element-put-property node* (car it)))) (--each kv-attrs (org-element-put-property node* (car it) (cadr it))) (--each update-funs (funcall it node*)) node*)))) (defun org-ml-get-property (prop node) "Return the value of PROP of NODE." (let ((type (org-ml-get-type node))) (if (and (eq type 'plain-text) (eq prop :post-blank)) (org-ml--get-post-blank-text node) (let ((decoder-fun (unless (or (and (memq type org-ml--element-nodes-with-affiliated) (org-ml--property-is-attribute prop)) (memq prop org-element--standard-properties)) (org-ml--get-property-decoder type prop))) (value (org-element-property prop node))) (if decoder-fun (funcall decoder-fun value) value))))) (defun org-ml-get-properties (props node) "Return all the values of PROPS from NODE. PROPS is a list of all the properties desired, and the returned list will be the values of these properties in the order requested. To get all properties of NODE, use `org-ml--get-all-properties'." (--map (org-ml-get-property it node) props)) (org-ml--defun-anaphoric* org-ml-map-property (prop fun node) "Return NODE with FUN applied to the value of PROP. FUN is a unary function which takes the current value of PROP and returns a new value to which PROP will be set. See builder functions for a list of properties and their rules for each type." (--> (org-ml-get-property prop node) (org-ml-set-property prop (funcall fun it) node))) (defun org-ml-map-properties (plist node) "Return NODE with functions applied to the values of properties. PLIST is a property list where the keys are properties of NODE and its values are unary functions to be mapped to these properties. See builder functions for a list of properties and their rules for each type." ;; TODO this is slow since it will copy the node for each property iteration (cond ((not plist) node) ((org-ml--is-plist plist) (->> (org-ml-map-property (nth 0 plist) (nth 1 plist) node) (org-ml-map-properties (-drop 2 plist)))) (t (org-ml--arg-error "Not a plist: %s" plist)))) (defmacro org-ml-map-properties* (plist node) "Anaphoric form of `org-ml-map-properties'. PLIST is a property list where the keys are properties of NODE and its values are forms to be mapped to these properties." (declare (debug (form form))) (let ((p (make-symbol "plist*"))) `(let ((,p (org-ml--plist-map-values (lambda (form) `(lambda (it) ,form)) ',plist))) (org-ml-map-properties ,p ,node)))) (defun org-ml-toggle-property (prop node) "Return NODE with the value of PROP flipped. This function only applies to properties that are booleans." (let ((type (org-ml-get-type node))) (if (org-ml--property-memq org-ml--properties-with-toggle type prop) (org-ml-map-property prop #'not node) (org-ml--arg-error "Not a toggle-able property")))) (defun org-ml-shift-property (prop n node) "Return NODE with PROP shifted by N (an integer). This only applies the properties that are represented as integers." (let* ((type (org-ml-get-type node)) (fun (org-ml--get-property-shifter type prop))) (if fun (org-ml-map-property* prop (funcall fun n it) node) (org-ml--arg-error "'%s' not a shiftable for '%s'" prop type)))) (defun org-ml-insert-into-property (prop index string node) "Return NODE with STRING inserted at INDEX into PROP. This only applies to properties that are represented as lists of strings." (let ((type (org-ml-get-type node))) (if (org-ml--property-memq org-ml--properties-with-string-list type prop) (org-ml-map-property* prop (if (member string it) it (org-ml--insert-at index string it)) node) (org-ml--arg-error "Property '%s' in node of type '%s' is not a string-list" prop type)))) (defun org-ml-remove-from-property (prop string node) "Return NODE with STRING removed from PROP if present. This only applies to properties that are represented as lists of strings. See `org-ml-insert-into-property' for a list of supported elements and properties that may be used with this function." (let ((type (org-ml-get-type node))) (if (org-ml--property-memq org-ml--properties-with-string-list type prop) (org-ml-map-property* prop (-remove-item string it) node) (org-ml--arg-error "Property '%s' in node of type '%s' is not a string-list" prop type)))) (defun org-ml-plist-put-property (prop key value node) "Return NODE with VALUE corresponding to KEY inserted into PROP. KEY is a keyword and VALUE is a symbol. This only applies to properties that are represented as plists." (if (org-ml--property-memq org-ml--properties-with-plist (org-ml-get-type node) prop) (org-ml-map-property* prop (plist-put it key value) node) (org-ml--arg-error "Not a plist property"))) (defun org-ml-plist-remove-property (prop key node) "Return NODE with KEY and its corresponding value removed from PROP. KEY is a keyword. This only applies to properties that are represented as plists. See `org-ml-plist-put-property' for a list of supported elements and properties that may be used with this function." (if (org-ml--property-memq org-ml--properties-with-plist (org-ml-get-type node) prop) (org-ml-map-property* prop (org-ml--plist-remove key it) node) (org-ml--arg-error "Not a plist property"))) ;; update polymorphic property function documentation: ;; ;; For the functions immediately above, modify the docstrings to inform the user ;; which node types and property combinations may be used. This information is ;; stored in `org-ml--property-alist'. (defun org-ml--get-types-with-property-attribute (attr) "Return alist of all nodes types that contain ATTR. Return a list like ((TYPE (PROP1 ...)) ...) where TYPE is the node type and PROPX are the properties that contain ATTR." (->> org-ml--property-alist (--map (cons (car it) (--filter (plist-get (cdr it) attr) (cdr it)))) (-filter #'cdr))) (defun org-ml--format-alist-operations (type-alist) "Return a formatted string of TYPE-ALIST. TYPE-ALIST is a list like that given by `org-ml--format-alist-operations'." (->> type-alist (--map (cons (car it) (-map #'car (cdr it)))) (--map (format "\n%s\n%s" (car it) (s-join "\n" (--map (format "- %S" it) (cdr it))))) (s-join "\n"))) (defun org-ml--append-documentation (fun string) "Append STRING to the docstring of FUN." (let ((msg "\n\nThe following types and properties are supported:\n") (doc (documentation fun))) ;; ensure we only update once, otherwise reloads will keep adding to the ;; docstrings (unless (s-contains? msg doc) (->> (concat doc msg string) (function-put fun 'function-documentation))))) (->> (org-ml--get-types-with-property-attribute :toggle) (org-ml--format-alist-operations) (org-ml--append-documentation 'org-ml-toggle-property)) (->> (org-ml--get-types-with-property-attribute :shift) (--map (cons (car it) (--remove (eq :post-blank (car it)) (cdr it)))) (-filter #'cdr) (org-ml--format-alist-operations) (concat "\nall elements\n- :post-blank\n") (org-ml--append-documentation 'org-ml-shift-property)) (->> (org-ml--get-types-with-property-attribute :string-list) (org-ml--format-alist-operations) (org-ml--append-documentation 'org-ml-insert-into-property)) (->> (org-ml--get-types-with-property-attribute :plist) (org-ml--format-alist-operations) (org-ml--append-documentation 'org-ml-plist-put-property)) (defun org-ml-get-parents (node) "Return parents of NODE as a list. The toplevel parent will be the left-most member, and NODE itself will be the rightmost member." (cl-labels ((get-parents (acc node) (if (or (null node) (eq 'org-data (car node))) acc (get-parents (cons node acc) (org-element-parent node))))) (get-parents nil node))) (defun org-ml-remove-parent (node) "Return NODE with the :parent property set to nil. Short synopsis: Use this function to declutter a node if you are trying to print its literal list representation or you are running into infinite loops caused by self-referential lists (there are probably other valid reasons but these are the main ones). Gory details: The :parent property refers to the node one level higher in the tree that contains NODE as a child. It will be present in a node that is generated from a parse operation with `org-ml-parse-this-buffer' or related. This property offers a nice shortcut to traverse up the node tree from a child. Besides this, it is not necessary as the tree structure itself already encodes all parent-child relationships. Further, it is not used by org-element internally to convert nodes into strings (such as with `org-ml-to-string') and thus can be thought of as a \"read-only\" property. This is why :parent will be set to nil when building a new node with the \"org-ml-build-\" family of functions and why `org-ml-set-property' forbids setting this property. In many cases, one can safely ignore :parent unless, of course, one actually needs to read it with `org-ml-get-parents' or `org-ml-get-property'. However, it heavily clutters the list representation of nodes, and therefore it is nice to remove this property whenever literal node lists are printed/visualized (eg for debugging). Note that for deep trees, each parent will itself have a :parent property pointing to its own parent, with this pattern repeating until the top of the tree. Furthermore, each parent will itself contain its own child node, which implies a circular/self-referential list. For the most part, this won't matter. However, some functions don't like dealing with circular lists and will complain about infinite recursion. If this is happening, the :parent property is likely to blame, and setting it to nil has a high probability of fixing the issue." (if (stringp node) (progn (remove-text-properties 0 (length node) '(:parent) node) node) (org-element-put-property-2 :parent nil node))) (defun org-ml--caption-remove-parents (node) "Remove parents from CAPTION property in NODE if present." (cl-flet* ((remove-ss (ss) (-map #'org-ml-remove-parents ss)) (remove-from-caption (caption) (pcase caption (`(,(pred org-ml--is-secondary-string)) (list (remove-ss (car caption)))) (`(,(pred org-ml--is-secondary-string) . ,(pred org-ml--is-secondary-string)) (-let (((long . short) caption)) (cons (remove-ss long) (remove-ss short)))) ;; TODO error here? (_ caption)))) (if (and (org-ml--is-any-type org-ml--element-nodes-with-affiliated node) (org-element-property-raw :caption node)) (org-ml--map-property-raw* :caption (-map #'remove-from-caption it) node) node))) (defun org-ml-remove-parents (node) "Like `org-ml-remove-parent' but for children of NODE as well. See `org-ml-remove-parent' for why you might want this." (cl-flet* ((remove-recursive (nodes) (--map (org-ml-remove-parents it) nodes)) (remove-within-prop (prop node) (org-ml--map-property-raw* prop (remove-recursive it) node))) (->> ;; remove parents from secondary strings (if necessary) (pcase (org-ml-get-type node) (`headline (->> (org-element-properties-resolve node) (remove-within-prop :title))) (`item (remove-within-prop :tag node)) (_ node)) (org-ml--caption-remove-parents) (org-ml-remove-parent) (org-ml--map-children-nocheck* (remove-recursive it))))) ;;; object nodes ;; ;; entity (defun org-ml-entity-get-replacement (key entity) "Return replacement string or symbol for ENTITY node. KEY is one of: - `:latex' (the entity's latex representation) - `:latex-math-p' (t if the latex representation requires math mode, nil otherwise) - `:html' (the entity's html representation) - `:ascii' (the entity's ascii representation) - `:latin1' (the entity's Latin1 representation) - `:utf-8' (the entity's utf8 representation) Any other keys will trigger an error." (org-ml--check-type 'entity entity) (-if-let (index (-elem-index key (list :latex :latex-math-p :html :ascii :latin1 :utf-8))) (->> (org-element-property-raw :name entity) (org-entity-get) (cdr) (nth index)) (org-ml--arg-error "Invalid encoding requested: %s" index))) ;; statistics-cookie (defun org-ml-statistics-cookie-is-complete (statistics-cookie) "Return t is STATISTICS-COOKIE node is complete." (org-ml--check-type 'statistics-cookie statistics-cookie) (let ((val (org-element-property-raw :value statistics-cookie))) (or (-some->> (s-match "\\([[:digit:]]+\\)%" val) (nth 1) (string-to-number) (= 100)) (-some->> (s-match "\\([[:digit:]]+\\)/\\([[:digit:]]+\\)" val) (cdr) (-map #'string-to-number) (apply #'=))))) ;; timestamp (standard) (defun org-ml-timestamp-get-start-time (timestamp) "Return the time list for start time of TIMESTAMP node. The return value will be a list as specified by the TIME argument in `org-ml-build-timestamp!'." (org-ml--check-type 'timestamp timestamp) (org-ml--timestamp-get-start-timelist timestamp)) (defun org-ml-timestamp-get-end-time (timestamp) "Return the end time list for end time of TIMESTAMP or nil if not a range. The return value will be a list as specified by the TIME argument in `org-ml-build-timestamp!'." (org-ml--check-type 'timestamp timestamp) (and (org-ml--timestamp-is-range-type timestamp) (org-ml--timestamp-get-end-timelist timestamp))) (defun org-ml-timestamp-get-length (timestamp) "Return the length of TIMESTAMP node in seconds as an integer. If non-ranged, this function will return 0. If ranged but the start time is in the future relative to end the time, return a negative integer." (org-ml--check-type 'timestamp timestamp) (org-ml--timestamp-get-length timestamp)) (defun org-ml-timestamp-is-active (timestamp) "Return t if TIMESTAMP node is active." (org-ml--check-type 'timestamp timestamp) (let ((y (org-element-property-raw :type timestamp))) (if (memq y '(active active-range)) t))) (defun org-ml-timestamp-is-ranged (timestamp) "Return t if TIMESTAMP node is ranged." (org-ml--check-type 'timestamp timestamp) (let ((y (org-element-property-raw :type timestamp))) (if (memq y '(active-ranged inactive-range)) t))) (defun org-ml-timestamp-range-contains-p (unixtime timestamp) "Return t if UNIXTIME is between start and end time of TIMESTAMP node. The boundaries are inclusive. If TIMESTAMP has a range of zero, then only return t if UNIXTIME is the same as TIMESTAMP. TIMESTAMP will be interpreted according to the localtime of the operating system." (org-ml--check-type 'timestamp timestamp) (let ((ut1 (org-ml--timestamp-get-start-unixtime timestamp)) (ut2 (org-ml--timestamp-get-end-unixtime timestamp))) (<= ut1 unixtime ut2))) (defun org-ml-timestamp-set-start-time (time timestamp) "Return TIMESTAMP node with start time set to TIME. TIME is a list analogous to the same argument specified in `org-ml-build-timestamp!'." (org-ml--check-type 'timestamp timestamp) (org-ml--check-timelist-from-list time) (org-ml--timestamp-set-start-timelist time (org-ml-copy timestamp))) (defun org-ml-timestamp-set-end-time (time timestamp) "Return TIMESTAMP node with end time set to TIME. TIME is a list analogous to the same argument specified in `org-ml-build-timestamp!'." (org-ml--check-type 'timestamp timestamp) (when time (org-ml--check-timelist-from-list time)) (org-ml--timestamp-set-end-timelist time (org-ml-copy timestamp))) (defun org-ml-timestamp-set-single-time (time timestamp) "Return TIMESTAMP node with start and end times set to TIME. TIME is a list analogous to the same argument specified in `org-ml-build-timestamp!'." (org-ml--check-type 'timestamp timestamp) (org-ml--check-timelist-from-list time) (org-ml--timestamp-set-single-timelist time (org-ml-copy timestamp))) (defun org-ml-timestamp-set-double-time (time1 time2 timestamp) "Return TIMESTAMP node with start/end times set to TIME1/TIME2 respectively. TIME1 and TIME2 are lists analogous to the TIME argument specified in `org-ml-build-timestamp!'." (org-ml--check-type 'timestamp timestamp) (org-ml--check-timelist-from-list time1) (org-ml--check-timelist-from-list time2) (org-ml--timestamp-set-double-timelist time1 time2 (org-ml-copy timestamp))) (defun org-ml-timestamp-set-length (n unit timestamp) "Return TIMESTAMP node with length set to N UNITs. If TIMESTAMP is ranged, keep start time the same and adjust the end time. If not, make a new end time. The units for RANGE are in minutes if TIMESTAMP is in long format and days if TIMESTAMP is in short format." (org-ml--check-type 'timestamp timestamp) ;; ASSUME unit will be checked internally (org-ml--timestamp-set-length n unit (org-ml-copy timestamp))) (defun org-ml-timestamp-set-active (flag timestamp) "Return TIMESTAMP node with active type if FLAG is t." (org-ml--check-type 'timestamp timestamp) (org-ml--timestamp-set-active flag (org-ml-copy timestamp))) (defun org-ml-timestamp-shift (n unit timestamp) "Return TIMESTAMP node with time shifted by N UNIT's. This function will move the start and end times together; therefore ranged inputs will always output ranged timestamps and same for non-ranged. To move the start and end time independently, use `org-ml-timestamp-shift-start' or `org-ml-timestamp-shift-end'. N is a positive or negative integer and UNIT is one of `minute', `hour', `day', `month', or `year'. Overflows will wrap around transparently; for instance, supplying `minute' for UNIT and 90 for N will increase the hour property by 1 and the minute property by 30." ;; ASSUME unit will be checked internally ;; ;; if not ranged, simply need to shift start and end (which are the same); ;; otherwise need to shift both, set both, and update the timerange depending ;; on if we straddle a day boundary after the shift (org-ml--check-type 'timestamp timestamp) (let ((rt (org-element-property-raw :range-type timestamp)) (timestamp* (org-ml-copy timestamp))) (if (not rt) (let ((t1 (->> (org-ml--timestamp-get-start-timelist timestamp) (org-ml-timelist-shift n unit)))) (->> (org-ml--timestamp-set-start-timelist t1 timestamp*) (org-ml--timestamp-set-end-timelist t1))) (-let* ((s1 (->> (org-ml--timestamp-get-start-timelist timestamp) (org-ml-timelist-shift n unit))) (s2 (->> (org-ml--timestamp-get-end-timelist timestamp) (org-ml-timelist-shift n unit))) ;; total micro-optimization... ((d1 t1) (org-ml-timelist-split s1)) ((d2 t2) (org-ml-timelist-split s2)) (rt* (if (and (not (equal t1 t2)) (equal d1 d2)) (or rt 'timerange) 'daterange))) (->> (org-ml--timestamp-set-start-timelist s1 timestamp*) (org-ml--timestamp-set-end-timelist s2) (org-ml--timestamp-set-range-type rt*)))))) (defun org-ml-timestamp-shift-start (n unit timestamp) "Return TIMESTAMP node with start time shifted by N UNIT's. N and UNIT behave the same as those in `org-ml-timestamp-shift'. If TIMESTAMP is not range, the output will be a ranged timestamp with the shifted start time and the end time as that of TIMESTAMP. If this behavior is not desired, use `org-ml-timestamp-shift'." ;; ASSUME unit will be checked internally (org-ml--check-type 'timestamp timestamp) (let* ((t1 (->> (org-ml--timestamp-get-start-timelist timestamp) (org-ml-timelist-shift n unit))) (t2 (org-ml--timestamp-get-end-timelist timestamp)) (rt (->> (org-element-property-raw :range-type timestamp) (org-ml--timelists-get-range-type t1 t2)))) (->> (org-ml-copy timestamp) (org-ml--timestamp-set-start-timelist t1) (org-ml--timestamp-set-range-type rt)))) (defun org-ml-timestamp-shift-end (n unit timestamp) "Return TIMESTAMP node with end time shifted by N UNIT's. N and UNIT behave the same as those in `org-ml-timestamp-shift'. If TIMESTAMP is not range, the output will be a ranged timestamp with the shifted end time and the start time as that of TIMESTAMP. If this behavior is not desired, use `org-ml-timestamp-shift'." ;; ASSUME unit will be checked internally (org-ml--check-type 'timestamp timestamp) (let* ((t1 (org-ml--timestamp-get-start-timelist timestamp)) (t2 (->> (org-ml--timestamp-get-end-timelist timestamp) (org-ml-timelist-shift n unit))) (rt (->> (org-element-property-raw :range-type timestamp) (org-ml--timelists-get-range-type t1 t2)))) (->> (org-ml-copy timestamp) (org-ml--timestamp-set-end-timelist t2) (org-ml--timestamp-set-range-type rt)))) (defun org-ml-timestamp-toggle-active (timestamp) "Return TIMESTAMP node with its active/inactive type flipped." (org-ml--check-type 'timestamp timestamp) (-> (org-ml--timestamp-is-active timestamp) (not) (org-ml--timestamp-set-active (org-ml-copy timestamp)))) (defun org-ml-timestamp-truncate (timestamp) "Return TIMESTAMP node with start/end times forced to short format." (org-ml--check-type 'timestamp timestamp) (let* ((t1 (->> (org-ml--timestamp-get-start-timelist timestamp) (org-ml--timelist-truncate))) (t2 (->> (org-ml--timestamp-get-end-timelist timestamp) (org-ml--timelist-truncate))) ;; NOTE it is impossible for range-type to be 'timerange since hours ;; and minutes will be missing (rt (if (equal t1 t2) nil 'daterange))) (->> (org-ml-copy timestamp) (org-ml--timestamp-set-start-timelist t1) (org-ml--timestamp-set-end-timelist t2) (org-ml--timestamp-set-range-type rt)))) (defun org-ml-timestamp-truncate-start (timestamp) "Return TIMESTAMP node with start time forced to short format. Collapsed timestamps will become uncollapsed." (org-ml--check-type 'timestamp timestamp) (let* ((t1 (->> (org-ml--timestamp-get-start-timelist timestamp) (org-ml--timelist-truncate))) (t2 (->> (org-ml--timestamp-get-end-timelist timestamp) (org-ml--timelist-truncate))) (rt (if (equal t1 t2) nil 'daterange))) (->> (org-ml-copy timestamp) (org-ml--timestamp-set-start-timelist t1) (org-ml--timestamp-set-range-type rt)))) (defun org-ml-timestamp-truncate-end (timestamp) "Return TIMESTAMP node with end time forced to short format. Collapsed timestamps will become uncollapsed." (org-ml--check-type 'timestamp timestamp) (let* ((t1 (->> (org-ml--timestamp-get-start-timelist timestamp) (org-ml--timelist-truncate))) (t2 (->> (org-ml--timestamp-get-end-timelist timestamp) (org-ml--timelist-truncate))) (rt (if (equal t1 t2) nil 'daterange))) (->> (org-ml-copy timestamp) (org-ml--timestamp-set-end-timelist t2) (org-ml--timestamp-set-range-type rt)))) (defun org-ml-timestamp-set-collapsed (flag timestamp) "Return TIMESTAMP with collapsed set to FLAG. Collapsed timestamps are like [yyyy-mm-dd xxx hh:mm-hh:mm]. Uncollapsed timestamp are like [yyyy-mm-dd xxx hh:mm]--[yyyy-mm-dd xxx hh:mm]. FLAG may be one of nil, t, or `force'. If nil, uncollapse the timestamp if it is collapsed. The dates in the uncollapsed timestamp will be the same. Has no effect if the timestamp is not collapsed. If t, collapse the timestamp from uncollapsed format if the following conditions are met: 1. the dates are the same 2. start and end hours/minutes are non-nil Has no effect if timestamp id not uncollapsed and these conditions are not met. If `force', ignore condition 1 above. The date in the collapsed timestamp will be taken from the start date and the end date will be ignored." (org-ml--check-type 'timestamp timestamp) (org-ml--timestamp-set-collapsed flag timestamp)) (defun org-ml-timestamp-get-warning (timestamp) "Return the warning component of TIMESTAMP. Return a list like (TYPE VALUE UNIT)." (org-ml--check-type 'timestamp timestamp) (-let (((&plist :warning-type y :warning-value v :warning-unit u) (org-ml--get-nonstandard-properties timestamp))) (when (and y v u) `(,y ,v ,u)))) (defun org-ml-timestamp-set-warning (warning timestamp) "Set the warning of TIMESTAMP to WARNING. WARNING is a list like (TYPE VALUE UNIT). TYPE is `all' or `first' VALUE and is an integer. UNIT is one of `year', `month', `week', or `day'." (org-ml--check-type 'timestamp timestamp) (when warning (org-ml--check-warning-from-list warning)) (->> (org-ml-copy timestamp) (org-ml--timestamp-set-warning warning))) (org-ml--defun-anaphoric* org-ml-timestamp-map-warning (fun timestamp) "Apply FUN to the warning of TIMESTAMP. FUN is a function that takes a warning list like and returns a new warning list. The same rules that apply to `org-ml-timestamp-set-warning' and `org-ml-timestamp-get-warning' apply here." ;; TODO this will check node type twice (let ((w (org-ml-timestamp-get-warning timestamp))) (org-ml-timestamp-set-warning (funcall fun w) timestamp))) (defun org-ml-timestamp-get-repeater (timestamp) "Return the repeater component of TIMESTAMP. Return a list like (TYPE VALUE UNIT) or nil." (org-ml--check-type 'timestamp timestamp) (org-ml--timestamp-get-repeater timestamp)) (defun org-ml-timestamp-set-repeater (repeater timestamp) "Set the repeater of TIMESTAMP to REPEATER. REPEATER is a list like (TYPE VALUE UNIT); TYPE is one of `cumulate', `restart', or `catch-up'. VALUE is an integer. UNIT is one of `year', `month', `week', or `day'. Setting REPEATER to nil will remove the repeater and its deadline if present." (org-ml--check-type 'timestamp timestamp) (when repeater (org-ml--check-repeater-from-list repeater)) (->> (org-ml-copy timestamp) (org-ml--timestamp-set-repeater repeater))) (org-ml--defun-anaphoric* org-ml-timestamp-map-repeater (fun timestamp) "Apply FUN to the warning of TIMESTAMP. FUN is a function that takes a repeater list like and returns a new repeater list. The same rules that apply to `org-ml-timestamp-set-repeater' and `org-ml-timestamp-get-repeater' apply here." (let ((r (org-ml-timestamp-get-repeater timestamp))) (org-ml-timestamp-set-repeater (funcall fun r) timestamp))) (defun org-ml-timestamp-get-deadline (timestamp) "Return the repeater component of TIMESTAMP. Return a list like (VALUE UNIT) or nil." (org-ml--check-type 'timestamp timestamp) (-let (((&plist :repeater-deadline-value dv :repeater-deadline-unit du) (org-ml--get-nonstandard-properties timestamp))) (when (and dv du) (list dv du)))) (defun org-ml-timestamp-set-deadline (deadline timestamp) "Set the repeater of TIMESTAMP to DEADLINE. DEADLINE is a list like (VALUE UNIT); VALUE is an integer. UNIT is one of `year', `month', `week', or `day'. Setting DEADLINE to nil will remove the deadline. Will have no effect if repeater is not present." (org-ml--check-type 'timestamp timestamp) (when deadline (org-ml--check-deadline-from-list deadline)) (->> (org-ml-copy timestamp) (org-ml--timestamp-set-deadline deadline))) (org-ml--defun-anaphoric* org-ml-timestamp-map-deadline (fun timestamp) "Apply FUN to the deadline of TIMESTAMP. FUN is a function that takes a repeater list like and returns a new repeater list. The same rules that apply to `org-ml-timestamp-set-deadline' and `org-ml-timestamp-get-deadline' apply here." (let ((d (org-ml-timestamp-get-deadline timestamp))) (org-ml-timestamp-set-deadline (funcall fun d) timestamp))) ;; timestamp (diary) (defun org-ml-timestamp-diary-set-value (form timestamp-diary) "Return TIMESTAMP-DIARY node with value set to FORM. The node must have a type `eq' to `diary'. FORM is a quoted list." (org-ml--check-type 'timestamp timestamp-diary) (if (listp form) (->> (org-ml-copy timestamp-diary) (org-element-put-property-2 :raw-value (format "<%%%%%S>" form)) (org-element-put-property-2 :diary-sexp (format "%S" form))) (org-ml--arg-error "Timestamp-diary node value must be a form: Got %S" form))) (defun org-ml-timestamp-diary-get-start-time (timestamp-diary) "Return start time for TIMESTAMP-DIARY or nil." (org-ml--check-type 'timestamp timestamp-diary) (org-ml--timestamp-get-start-time timestamp-diary)) (defun org-ml-timestamp-diary-get-end-time (timestamp-diary) "Return end time for TIMESTAMP-DIARY or nil." (org-ml--check-type 'timestamp timestamp-diary) (org-ml--timestamp-get-end-time timestamp-diary)) (defun org-ml-timestamp-diary-set-single-time (time timestamp-diary) "Return TIMESTAMP-DIARY node with start/end time set to TIME. The node must have a type `eq' to `diary'. TIME is a list like (hour min). If TIME is nil remove the time." (org-ml--check-type 'timestamp timestamp-diary) (when time (org-ml--check-time-from-list time)) (->> (org-ml-copy timestamp-diary) (org-ml--timestamp-set-start-time time) (org-ml--timestamp-set-end-time time) (org-ml--timestamp-update-type-ranged-timeonly))) (defun org-ml-timestamp-diary-set-start-time (time timestamp-diary) "Return TIMESTAMP-DIARY node with start time set to TIME. The node must have a type `eq' to `diary'. TIME is a list like (hour min). TIME may not be nil" (org-ml--check-type 'timestamp timestamp-diary) (org-ml--check-time-from-list time) (let* ((start (org-ml--timestamp-get-start-time timestamp-diary)) (end (or (org-ml--timestamp-get-end-time timestamp-diary) start time))) (->> (org-ml-copy timestamp-diary) (org-ml--timestamp-set-start-time time) (org-ml--timestamp-set-end-time end) (org-ml--timestamp-update-type-ranged-timeonly)))) (defun org-ml-timestamp-diary-set-end-time (time timestamp-diary) "Return TIMESTAMP-DIARY node with end time set to TIME. The node must have a type `eq' to `diary'. TIME is a list like (hour min). If TIME is nil then remove the end time. If start time is not set, return node unchanged." (org-ml--check-type 'timestamp timestamp-diary) (when time (org-ml--check-time-from-list time)) (let ((start (org-ml--timestamp-get-start-time timestamp-diary))) (if (not start) timestamp-diary (->> (org-ml-copy timestamp-diary) (org-ml--timestamp-set-end-time (or time start)) (org-ml--timestamp-update-type-ranged-timeonly))))) (defun org-ml-timestamp-diary-set-double-time (time1 time2 timestamp-diary) "Return TIMESTAMP-DIARY node with time set to TIME1 and TIME2. The node must have a type `eq' to `diary'. TIME1 and TIME2 are lists like (hour min). Either time may be nil, but if TIME1 is nil then TIME2 must also be nil." (org-ml--check-type 'timestamp timestamp-diary) (when (and (not time1) time2) (org-ml--arg-error "Time1 cannot be nil if Time2 is non-nil")) (when time1 (org-ml--check-time-from-list time1)) (when time2 (org-ml--check-time-from-list time2)) (->> (org-ml-copy timestamp-diary) (org-ml--timestamp-set-start-time time1) (org-ml--timestamp-set-end-time (or time2 time1)) (org-ml--timestamp-update-type-ranged-timeonly))) (defun org-ml-timestamp-diary-set-length (n unit timestamp-diary) "Return TIMESTAMP-DIARY node with range set to N UNITs. If TIMESTAMP-DIARY is ranged, keep start time the same and adjust the end time. If not, make a new end time." (org-ml--check-type 'timestamp timestamp-diary) (-if-let (start (org-ml--timestamp-get-start-time timestamp-diary)) (let ((s (org-ml--time-shift n unit start))) (->> (org-ml-copy timestamp-diary) (org-ml--timestamp-set-end-time s) (org-ml--timestamp-update-type-ranged-timeonly))) timestamp-diary)) (defun org-ml-timestamp-diary-shift (n unit timestamp-diary) "Return TIMESTAMP-DIARY node with time shifted by N UNITs. This function will move the start and end times together; therefore ranged inputs will always output ranged timestamps and same for non-ranged. To move the start and end time independently, use `org-ml-timestamp-diary-shift-start' or `org-ml-timestamp-shift-end'. N is a positive or negative integer and UNIT is one of `minute', `hour', `day', `month', or `year'. Overflows will wrap around transparently; for instance, supplying `minute' for UNIT and 90 for N will increase the hour property by 1 and the minute property by 30." (org-ml--check-type 'timestamp timestamp-diary) (-if-let (start (org-ml--timestamp-get-start-time timestamp-diary)) ;; 'or' to guard against nil end time when start is set, which is not ;; supposed to happen (but might) (let* ((end (or (org-ml--timestamp-get-end-time timestamp-diary) start)) (start* (org-ml--time-shift n unit start)) (end* (org-ml--time-shift n unit end))) (->> (org-ml-copy timestamp-diary) (org-ml--timestamp-set-start-time start*) (org-ml--timestamp-set-end-time end*) ;; update this in case range is in undefined state (org-ml--timestamp-update-type-ranged-timeonly))) timestamp-diary)) (defun org-ml-timestamp-diary-shift-start (n unit timestamp-diary) "Return TIMESTAMP-DIARY node with start time shifted by N UNITs. N and UNIT behave the same as those in `org-ml-timestamp-diary-shift'. If TIMESTAMP-DIARY is not range, the output will be a ranged timestamp with the shifted start time and the end time as that of TIMESTAMP-DIARY. If this behavior is not desired, use `org-ml-timestamp-diary-shift'." (org-ml--check-type 'timestamp timestamp-diary) (-if-let (start (org-ml--timestamp-get-start-time timestamp-diary)) (let ((end (or (org-ml--timestamp-get-end-time timestamp-diary) start)) (start* (org-ml--time-shift n unit start))) (->> (org-ml-copy timestamp-diary) (org-ml--timestamp-set-start-time start*) (org-ml--timestamp-set-end-time end) (org-ml--timestamp-update-type-ranged-timeonly))) timestamp-diary)) (defun org-ml-timestamp-diary-shift-end (n unit timestamp-diary) "Return TIMESTAMP-DIARY node with end time shifted by N UNITs. N and UNIT behave the same as those in `org-ml-timestamp-diary-shift'. If TIMESTAMP-DIARY is not range, the output will be a ranged timestamp with the shifted end time and the start time as that of TIMESTAMP-DIARY. If this behavior is not desired, use `org-ml-timestamp-diary-shift'." (org-ml--check-type 'timestamp timestamp-diary) (-if-let (start (org-ml--timestamp-get-start-time timestamp-diary)) (let* ((end (or (org-ml--timestamp-get-end-time timestamp-diary) start))) (-> (org-ml--time-shift n unit end) (org-ml--timestamp-set-end-time (org-ml-copy timestamp-diary)) (org-ml--timestamp-update-type-ranged-timeonly))) timestamp-diary)) ;;; element nodes ;; ;; clock (defun org-ml-clock-is-running (clock) "Return t if CLOCK element is running (eg is open)." (org-ml--check-type 'clock clock) (org-ml--property-is-eq :status 'running clock)) ;; headline (defun org-ml-headline-get-statistics-cookie (headline) "Return the statistics cookie node from HEADLINE if it exists." (org-ml--check-type 'headline headline) (->> (org-element-property :title headline) (-last-item) (org-ml--filter-type 'statistics-cookie))) (defun org-ml-headline-is-done (headline) "Return t if HEADLINE node has a done todo-keyword." (org-ml--check-type 'headline headline) (-> (org-element-property :todo-keyword headline) (member org-done-keywords) (and t))) (defun org-ml-headline-has-tag (tag headline) "Return t if HEADLINE node is tagged with TAG." (org-ml--check-type 'headline headline) (if (member tag (org-element-property :tags headline)) t)) (defun org-ml-headline-set-title! (title-text stats-cookie-value headline) "Return HEADLINE node with new title. TITLE-TEXT is a string to be parsed into object nodes for the title via `org-ml-build-secondary-string!' (see that function for restrictions) and STATS-COOKIE-VALUE is a list described in `org-ml-build-statistics-cookie'." (org-ml--check-type 'headline headline) (let ((ss (org-ml-build-secondary-string! title-text))) (if (not stats-cookie-value) (org-ml-set-property :title ss headline) (let ((ss* (org-ml--set-last-post-blank 1 ss)) (sc (org-ml-build-statistics-cookie stats-cookie-value))) (org-ml-set-property :title (-snoc ss* sc) headline))))) ;; item (defun org-ml-item-toggle-checkbox (item) "Return ITEM node with its checkbox state flipped. This only affects item nodes with checkboxes in the `on' or `off' states; return ITEM node unchanged if the checkbox property is `trans' or nil." (org-ml--check-type 'item item) (pcase (org-element-property-raw :checkbox item) ('on (org-element-put-property-2 :checkbox 'off (org-ml-copy item))) ('off (org-element-put-property-2 :checkbox 'on (org-ml-copy item))) ((or `trans `nil) item) (_ (error "This should not happen")))) ;;; PUBLIC BRANCH/CHILD FUNCTIONS ;;; polymorphic (defun org-ml-children-contain-point (point branch-node) "Return t if POINT is within the boundaries of BRANCH-NODE's children." (org-ml--check-types org-ml-branch-nodes branch-node) (-let ((b (org-element-contents-begin branch-node)) (e (org-element-contents-end branch-node))) (<= b point e))) (defun org-ml-get-children (branch-node) "Return the children of BRANCH-NODE as a list." (org-ml--check-types org-ml-branch-nodes branch-node) (org-element-contents branch-node)) (defun org-ml-set-children (children branch-node) "Return BRANCH-NODE with its children set to CHILDREN. CHILDREN is a list of nodes; the types permitted in this list depend on the type of NODE." (let ((type (org-ml-get-type branch-node))) (-if-let (child-types (alist-get type org-ml--node-restrictions)) (-if-let (illegal (-difference (-map #'org-ml-get-type children) child-types)) (org-ml--set-children-throw-error type child-types illegal) (org-ml--set-children-nocheck children branch-node)) ;; this should not happen (error "Child type restrictions not found for %s" type)))) (org-ml--defun-anaphoric* org-ml-map-children (fun branch-node) "Return BRANCH-NODE with FUN applied to its children. FUN is a unary function that takes the current list of children and returns a modified list of children." (--> (org-ml-get-children branch-node) (org-ml-set-children (funcall fun it) branch-node))) (defun org-ml-is-childless (branch-node) "Return t if BRANCH-NODE has no children." (not (org-ml-get-children branch-node))) ;;; objects (defun org-ml--normalize-secondary-string (secondary-string) "Return SECONDARY-STRING with all adjacent strings concatenated." (cl-flet ((concat-maybe (acc node) (let ((last (car acc))) (if (and (org-ml--is-type 'plain-text last) (org-ml--is-type 'plain-text node)) (cons (concat last node) (cdr acc)) (cons node acc))))) (reverse (-reduce-from #'concat-maybe nil secondary-string)))) (eval-when-compile (defmacro org-ml--mapcat-normalize (form secondary-string) "Return mapped, concatenated, and normalized SECONDARY-STRING. FORM is a form supplied to `--mapcat'." (declare (debug (def-form form))) `(->> (--map ,form ,secondary-string) (apply #'append) (org-ml--normalize-secondary-string)))) (defun org-ml-unwrap (object-node) "Return the children of OBJECT-NODE as a secondary string. If OBJECT-NODE is a plain-text node, wrap it in a list and return. Else add the post-blank property of OBJECT-NODE to the last member of its children and return children as a secondary string." (org-ml--check-types org-ml-objects object-node) (if (org-ml--is-type 'plain-text object-node) (list object-node) (let ((post-blank (org-ml--get-post-blank-textsafe object-node))) (->> (org-ml-copy object-node t) (org-element-contents) (org-ml--map-last* (org-ml--shift-post-blank-textsafe post-blank it)))))) (defun org-ml-unwrap-types-deep (types object-node) "Return the children of OBJECT-NODE as a secondary string. If OBJECT-NODE is a plain-text node, wrap it in a list and return. Else recursively descend into the children of OBJECT-NODE and splice the children of nodes with type in TYPES in place of said node and return the result as a secondary string." ;; TODO this will check for object nodes in nested levels which is redundant (org-ml--check-types org-ml-objects object-node) (cond ((org-ml--is-type 'plain-text object-node) (list object-node)) ((org-ml-is-any-type types object-node) (let ((post-blank (org-ml--get-post-blank-textsafe object-node))) (->> (org-element-contents object-node) (org-ml--mapcat-normalize (->> (org-ml-copy it) (org-ml-unwrap-types-deep types))) (org-ml--map-last* (org-ml--shift-post-blank-textsafe post-blank it))))) (t (->> object-node (org-ml-map-children* (org-ml--mapcat-normalize (org-ml-unwrap-types-deep types it) it)) (list))))) (defun org-ml-unwrap-deep (object-node) "Return the children of OBJECT-NODE as plain-text wrapped in a list." (org-ml-unwrap-types-deep org-ml-nodes object-node)) ;;; secondary strings (defun org-ml-flatten (secondary-string) "Return SECONDARY-STRING with its first level unwrapped. The unwrap operation will be done with `org-ml-unwrap'." (org-ml--mapcat-normalize (org-ml-unwrap it) secondary-string)) (defun org-ml-flatten-types-deep (types secondary-string) "Return SECONDARY-STRING with object nodes in TYPES unwrapped. The unwrap operation will be done with `org-ml-unwrap-types-deep'." (org-ml--mapcat-normalize (org-ml-unwrap-types-deep types it) secondary-string)) (defun org-ml-flatten-deep (secondary-string) "Return SECONDARY-STRING with all object nodes unwrapped to plain-text. The unwrap operation will be done with `org-ml-unwrap-deep'." (org-ml--mapcat-normalize (org-ml-unwrap-deep it) secondary-string)) ;;; item (defun org-ml--append-join-plain-lists (nodes1 nodes2) "Append NODES1 and NODES2 into one list. If the last node in NODES1 and the first node in NODES2 are plain-lists, join the two lists together." (let ((last (-last-item nodes1)) (first (car nodes2))) (if (and (org-ml--is-type 'plain-list last) (org-ml--is-type 'plain-list first)) (let ((pb (org-element-post-blank last))) (--> (org-element-contents last) (org-ml--set-last-post-blank pb it) (append it (org-element-contents first)) (org-ml--set-children-nocheck it last) (cons it (cdr nodes2)) (append (-drop-last 1 nodes1) it))) (append nodes1 nodes2)))) (defun org-ml-item-get-paragraph (item) "Return the first paragraph's children of ITEM or nil if none." (org-ml--check-type 'item item) (-when-let (first-child (car (org-element-contents item))) (when (org-ml--is-type 'paragraph first-child) (org-element-contents first-child)))) (defun org-ml-item-set-paragraph (secondary-string item) "Set the first paragraph's children of ITEM to SECONDARY-STRING." (org-ml--check-type 'item item) (org-ml-map-children* (if (org-ml--is-type 'paragraph (car it)) (if (not secondary-string) (cdr it) (cons (org-ml-set-children secondary-string (car it)) (cdr it))) (cons (apply #'org-ml-build-paragraph secondary-string) it)) item)) (org-ml--defun-anaphoric* org-ml-item-map-paragraph (fun item) "Apply FUN to the first paragraph's children in ITEM. FUN is a UNARY function that takes the secondary-string of the first paragraph and returns modified secondary-string." (--> (org-ml-item-get-paragraph item) (org-ml-item-set-paragraph (funcall fun it) item))) ;;; headline (supercontents) ;; Everything under a headline in the "section" should follow a predictable ;; structure. The planning and property-drawer nodes is always first and second ;; respectively (if present) followed by a "logbook" and the "contents" The ;; "logbook" contains two types of nodes, here called "log items" (or sometimes ;; simply "items" if the context is obvious) and "clocks." The former include ;; any plain-list/item node as given by `org-log-note-headings' (except for ;; 'clock-out' which applies only to clocks), and clocks includes clock nodes ;; and optionally plain-list/item nodes that represent the clock-out notes. ;; Anything that comes after the logbook is deemed "contents." To make this even ;; more complicated, the spacing after these nodes potentially interacts the ;; encapsulating headline itself through the :pre-blank property. For instance, ;; if a planning node has a non-zero :post-blank property, this value should be ;; set to the :pre-blank property of the headline if the planning node is ;; deleted (indicating that the space "moves up"). ;; To simplify this entire process, here we introduce an abstraction layer ;; called the "supercontents" which will encompass the entire headline section ;; and the :pre-blank property of the headline itself. This will represent all ;; these components in a standardized way. A similar data structure for ;; "logbook" also exists within the supercontents for similar reasons, as the ;; logbook has many different complex representations. ;; In haskell types, the supercontents and logbook are like this: ;; type Blank = Natural ;; ;; type Property = (Text, Text) ;; ;; data LogBook = LogBook ;; { clocks :: [ClockNode] ;; , items :: [ItemNode] ;; , unknown :: [Node] ;; } ;; ;; data SuperContents = SuperContents ;; { planning :: (Maybe Planning) ;; , node-properties :: [Property] ;; , logbook :: LogBook ;; , blank :: Blank ;; , contents :: [Nodes] ;; } ;; There is one *very important* assumption built into this data structure. If ;; the planning, property-drawer, or logbook are present, there must not be any ;; spaces between them the nor can there be a space between the headline and the ;; first node. By extension this means :pre-blank (in the encapsulating ;; headline) must be 0 if planning, property-drawer, or logbook are present. In ;; this case, "blank" represents the first blank after any of these three ;; components and the first node after (the start of the "contents"). If ;; planning, property-drawer, or logbook are not present, "blank" is the same as ;; :pre-blank. The advantage of this setup is that this annoying whitespace ;; doesn't need to be transferred to different nodes as the headline section is ;; edited. ;; The "logbook" requires its own special attention, since it could be several ;; different things depending on configuration. This is controlled by ;; `org-log-into-drawer', `org-clock-into-drawer', and `org-log-note-clock-out'. ;; These roughly control when the log items and/or clocks are in a named drawer ;; or "loose" by themselves. ;; ;; Aside from these variables, the logbook will be defined as follows: ;; - a continuous string of multi-line text after the headline metadata (in ;; other words, the logbook cannot contain consecutive newlines) ;; - any items that are parsed as log items must conform to ;; `org-log-note-headines', which (for now) means they must end with a ;; timestamp on the first line (in the future, this will be extended since it ;; is possible to modify `org-log-note-headings', even if it is not the best ;; idea). Note this also implies that any log item must have a timestamp ;; regardless of `org-log-note-headings', which makes sense for a log note to ;; have... ;; - any clock notes are defined as any item that is not a log item but after a ;; clock ;; ;; The first node that breaks any of the above conditions will be the dividing ;; line between the logbook and contents. Note that the one loophole this ;; creates is that it is theoretically possible (but unlikely) that an item ;; immediately after a clock could be interpreted as a clock note even if it was ;; not intended as one. ;; Any operation involving the logbook or contents will either require ;; separating the supercontents of the headline into the supercontents object, ;; merging (the reverse), or both. All cases will require the user-specified ;; config to determine how to perform the separation/merge. ;; ;; Steps for separating a headlines section nodes to a supercontents list are: ;; 1. determine the logbook configuration ;; 2. initialize a list of functions called the "state" which will be used to ;; identify and collect logbook nodes ;; 3. use the state to "walk" down the nodes of the headline's section, sorting ;; them as items, clocks, or unknown; as the state iterates, the functions ;; in the state list will be modified to reflect valid logbook nodes that ;; can be subsequently parsed (hence the name) ;; 4. Stop "walking" when the state node either runs out of functions or a node ;; is encountered that satisfies none of the state functions; all the ;; remaining nodes are deemed "contents" ;; 5. return a supercontents list using the sorted items/clocks/unknown nodes ;; from the walk and the contents ;; ;; Steps for merging a supercontents list to nodes are: ;; 1. determine the logbook configuration ;; 2. sort the items and clocks by their timestamp (most recent at the top) ;; 3. merge the items and clocks if required by the config ;; 4. encapsulate items and clocks in drawers if required ;; 5. append items and clocks (or drawers if applicable) ;; 6. append the logbook nodes from above with the contents from the contents ;; logbook struct (define-inline org-ml--logbook-init (items clocks unknown) "Create a new logbook alist. ITEMS, CLOCKS, and UNKNOWN correspond to a list of item nodes, clock notes (which may contain item nodes for notes) and other nodes." (declare (pure t) (side-effect-free t)) (inline-quote (list :items ,items :clocks ,clocks :unknown ,unknown))) (define-inline org-ml-logbook-get-items (logbook) "Return the :items slot from LOGBOOK." (declare (pure t) (side-effect-free t)) (inline-quote (plist-get ,logbook :items))) (define-inline org-ml-logbook-get-clocks (logbook) "Return the :clocks slot from LOGBOOK." (declare (pure t) (side-effect-free t)) (inline-quote (plist-get ,logbook :clocks))) (define-inline org-ml-logbook-get-post-blank (logbook) "Return the :clocks slot from LOGBOOK." (declare (pure t) (side-effect-free t)) (inline-quote (plist-get ,logbook :post-blank))) (define-inline org-ml-logbook-set-items (items logbook) "Set the :items slot in LOGBOOK to ITEMS." (declare (pure t) (side-effect-free t)) (inline-quote (-let (((&plist :clocks :unknown) ,logbook)) (org-ml--logbook-init ,items clocks unknown)))) (define-inline org-ml-logbook-set-clocks (clocks logbook) "Set the :clocks slot in LOGBOOK to CLOCKS." (declare (pure t) (side-effect-free t)) (inline-quote (-let (((&plist :items :unknown) ,logbook)) (org-ml--logbook-init items ,clocks unknown)))) (org-ml--defun-anaphoric* org-ml-logbook-map-items (fun logbook) "Apply function to :item slot in LOGBOOK. FUN is a unary function that takes a list of items and returns a new list of items." (--> (org-ml-logbook-get-items logbook) (org-ml-logbook-set-items (funcall fun it) logbook))) (org-ml--defun-anaphoric* org-ml-logbook-map-clocks (fun logbook) "Apply function to :clocks slot in LOGBOOK. FUN is a unary function that takes a list of clocks and returns a new list of clocks." (--> (org-ml-logbook-get-clocks logbook) (org-ml-logbook-set-clocks (funcall fun it) logbook))) ;; supercontents struct ;; This is a structure that the user may interact with, so some of these ;; functions are public (define-inline org-ml--supercontents-init-from-lb (planning node-props logbook blank contents) "Create a supercontents plist. PLANNING is a planning node or nil. NODE-PROPS is a list of like (KEY VAL) for each node property. LOGBOOK is a logbook as given by `org-ml--logbook-init'. BLANK is the blank space above the contents. CONTENTS is a list of nodes corresponding to the headline contents (the stuff after the logbook)." (declare (pure t) (side-effect-free t)) (inline-quote (list :planning ,planning :node-props ,node-props :logbook ,logbook :blank ,blank :contents ,contents))) (define-inline org-ml--supercontents-init (planning node-props items clocks unknown blank contents) "Create a supercontents alist. ITEMS, CLOCKS, UNKNOWN, and POST-BLANK are lists corresponding to the arguments in `org-ml--logbook-init' and CONTENTS has the same meaning as `org-ml--supercontents-init-from-lb'." (declare (pure t) (side-effect-free t)) (inline-quote (let ((lb (org-ml--logbook-init ,items ,clocks ,unknown))) (org-ml--supercontents-init-from-lb ,planning ,node-props lb ,blank ,contents)))) (define-inline org-ml-supercontents-get-planning (supercontents) "Return the :planning slot of SUPERCONTENTS." (declare (pure t) (side-effect-free t)) (inline-quote (plist-get ,supercontents :planning))) (define-inline org-ml-supercontents-set-planning (planning supercontents) "Set the :planning slot of SUPERCONTENTS to CONTENTS." (declare (pure t) (side-effect-free t)) (inline-quote (-let (((&plist :node-props n :logbook l :blank b :contents c) ,supercontents)) (org-ml--supercontents-init-from-lb ,planning n l b c)))) (define-inline org-ml-supercontents-get-node-properties (supercontents) "Return the :node-props slot of SUPERCONTENTS." (declare (pure t) (side-effect-free t)) (inline-quote (plist-get ,supercontents :node-props))) (define-inline org-ml-supercontents-set-node-properties (node-props supercontents) "Set the :node-props slot of SUPERCONTENTS to CONTENTS." (declare (pure t) (side-effect-free t)) (inline-quote (-let (((&plist :planning p :logbook l :blank b :contents c) ,supercontents)) (org-ml--supercontents-init-from-lb p ,node-props l b c)))) (define-inline org-ml-supercontents-get-contents (supercontents) "Return the :contents slot of SUPERCONTENTS." (declare (pure t) (side-effect-free t)) (inline-quote (plist-get ,supercontents :contents))) (define-inline org-ml-supercontents-set-contents (contents supercontents) "Set the :contents slot of SUPERCONTENTS to CONTENTS." (declare (pure t) (side-effect-free t)) (inline-quote (-let (((&plist :planning p :node-props n :logbook l :blank b) ,supercontents)) (org-ml--supercontents-init-from-lb p n l b ,contents)))) (org-ml--defun-anaphoric* org-ml-supercontents-map-contents (fun supercontents) "Apply function to :contents slot in SUPERCONTENTS. FUN is a unary function that takes a list of nodes and returns a new list of nodes." (--> (org-ml-supercontents-get-contents supercontents) (org-ml-supercontents-set-contents (funcall fun it) supercontents))) (define-inline org-ml-supercontents-get-logbook (supercontents) "Return the :logbook slot of SUPERCONTENTS." (declare (pure t) (side-effect-free t)) (inline-quote (plist-get ,supercontents :logbook))) (define-inline org-ml-supercontents-set-logbook (logbook supercontents) "Set the :logbook slot of SUPERCONTENTS to LOGBOOK." (declare (pure t) (side-effect-free t)) (inline-quote (-let (((&plist :planning p :node-props n :blank b :contents c) ,supercontents)) (org-ml--supercontents-init-from-lb p n ,logbook b c)))) (org-ml--defun-anaphoric* org-ml-supercontents-map-logbook (fun supercontents) "Apply function to :logbook slot in SUPERCONTENTS. FUN is a unary function that takes a logbook and returns a new logbook." (--> (org-ml-supercontents-get-logbook supercontents) (org-ml-supercontents-set-logbook (funcall fun it) supercontents))) ;; supercontents config (scc) data structure ;; Internal alist representing the user-specified config. The user form of the ;; config is a plist with the keys :log-into-drawer, :clock-into-drawer, and ;; :clock-notes which correspond to `org-log-into-drawer', ;; `org-clock-into-drawer', and `org-log-note-clock-out' respectively. ;; The options :log/clock-into-drawer control the "drawer configuration". Eight ;; configurations are possible: ;; ;; | log | clock | result | ;; |----------+----------+----------------------------------------------------------------------| ;; | nil | nil | items and clocks loose | ;; | t | nil | items in a drawer called LOGBOOK, clocks loose | ;; | nil | t | clocks in a drawer called LOGBOOK, items loose | ;; | STR1 | STR2 | items and clocks in different drawers called STR1 and STR2 | ;; | STR/t | STR/t | items and clocks in the same drawer called STRING (or LOGBOOK if t) | ;; | nil | INTEGER | items loose, clocks in a drawer called LOGBOOK if > INTEGER | ;; | t | INTEGER | items in drawer called LOGBOOK, and same for clocks if > INTEGER | ;; | STR | INTEGER | items in drawer called STR clocks in drawer called LOGBOOK if > INTEGER | ;; ;; :clock-out-notes applies to all the above cases and is thus an independent ;; consideration (defun org-ml-logbook-item-get-timestamp (item) "Return the log timestamp of ITEM if it exists." (cl-flet ((is-long-inactive-timestamp (node) (when (and (org-ml--is-type 'timestamp node) (org-ml--property-is-eq :type 'inactive node) (-some->> (org-ml--timestamp-get-start-timelist node) (org-ml-timelist-has-time))) (org-ml--timestamp-get-start-unixtime node))) (is-line-break (node) (or (org-ml--is-type 'line-break node) (and (org-ml--is-type 'plain-text node) (equal "\n" node)))) (get-paragraph-children (item) (-when-let (first-child (car (org-element-contents item))) (when (org-ml--is-type 'paragraph first-child) (org-element-contents first-child))))) (when (org-ml--is-type 'item item) (let ((pchildren (get-paragraph-children item))) (-if-let (i (-find-index #'is-line-break pchildren)) (is-long-inactive-timestamp (nth (1- i) pchildren)) (is-long-inactive-timestamp (-last-item pchildren))))))) (defun org-ml--scc-encode (config) "Return a supercontents-config object from CONFIG." (cl-flet* ((select-name (option) (pcase option (`t "LOGBOOK") (`nil nil) ((and (pred stringp) s) s) (e (error "Invalid option: %s" e))))) (-let* (((&plist :log-into-drawer lid :clock-into-drawer cid :clock-out-notes notes) config) (clock-limit (and (integerp cid) cid)) (id-name (select-name lid)) (cd-name (if clock-limit "LOGBOOK" (select-name cid))) (single-drawer? (equal id-name cd-name))) `((:drawers :items ,(and (not single-drawer?) id-name) :clocks ,(and (not single-drawer?) cd-name) :mixed ,(and single-drawer? id-name) :clock-limit ,clock-limit) (:clock-notes . ,notes) (:is-log-item-fun . ,#'org-ml-logbook-item-get-timestamp))))) (defun org-ml--scc-get-drawer-key (key scc) "Return the drawer from SCC in slot denoted by KEY." (-let (((&alist :drawers) scc)) (plist-get drawers key))) (define-inline org-ml--scc-get-clock-notes (scc) "Return the :clock-notes slot from SCC." (inline-quote (alist-get :clock-notes ,scc))) (define-inline org-ml--scc-get-log-item-fun (scc) "Return the :is-log-item-fun slot from SCC." (inline-quote (alist-get :is-log-item-fun ,scc))) ;; logbook separation (nodes -> logbook + contents) (defun org-ml--node-has-trailing-space (node) "Return t if NODE has at least one newline after it." (and (< 0 (org-ml--get-post-blank-textsafe node)) t)) (defun org-ml--node-is-drawer-with-name (drawer-name node) "Return t if NODE is a drawer with DRAWER-NAME." (and (org-ml--is-type 'drawer node) (equal drawer-name (org-element-property-raw :drawer-name node)))) (defun org-ml--flatten-plain-lists (nodes) "Return NODES with unwrapped plain-list nodes. \"Unwrapping\" means replacing the plain-list with its top-level items." (cl-flet ((flatten (plain-list) (let ((pb (org-element-post-blank plain-list))) (->> (org-element-contents plain-list) (org-ml--set-last-post-blank pb))))) (--splice (org-ml--is-type 'plain-list it) (flatten it) nodes))) (defun org-ml--wrap-plain-lists (nodes) "Return NODES with all subsequent items wrapped as plain-lists. This is the dual of `org-ml--flatten-plain-lists'." (cl-flet ((wrap (acc node) (cond ((and (org-ml--is-type 'item node) (org-ml--is-type 'plain-list (car acc))) (cons (org-ml-map-children* (cons node it) (car acc)) (cdr acc))) ((org-ml--is-type 'item node) (let* ((pb (org-element-post-blank node)) (pl (->> (org-ml--set-post-blank 0 node) (org-ml-build-plain-list :post-blank pb)))) (cons pl acc))) (t (cons node acc))))) (-reduce-from #'wrap nil (reverse nodes)))) (defun org-ml--separate-logbook (scc mode nodes) "Separate NODES into logbook components. SCC is the supercontents-config as given by `org-ml--scc-encode'. MODE is the mode by which to separate the nodes and is one of `mixed' (items and clocks are mixed together), `clocks', or `items'. The returned list will be like (ITEMS CLOCKS UNKNOWN)." (let ((n (org-ml--scc-get-clock-notes scc)) (f (org-ml--scc-get-log-item-fun scc))) (cl-flet ((split (acc node) (if (not node) acc (cond ((and (org-ml--is-type 'clock node) (memq mode '(:mixed :clocks))) (cons (cons 'clocks node) acc)) ((and (org-ml--is-type 'item node) (memq mode '(:items :mixed)) (funcall f node)) (cons (cons 'items node) acc)) ((and (org-ml--is-type 'item node) (memq mode '(:clocks :mixed)) n (not (funcall f node)) (org-ml--is-type 'clock (cdr (car acc)))) (cons (cons 'clocks node) acc)) (t (cons (cons 'unknown node) acc)))))) (->> (org-ml--flatten-plain-lists nodes) (-reduce-from #'split nil))))) (defmacro org-ml--state-slot (key limit eliminators next-fun) "Return a new slot for logbook separator state. KEY is the slot's key and LIMIT, ELIMINATORS, and NEXT-FUN are the respectibe values for the plist part of the slot." (declare (indent 3)) `(list ,key :limit ,limit :eliminators ,eliminators :next ,next-fun)) (defun org-ml--state-add-slot (slot state) "Add SLOT to STATE if SLOT's key is not already present." (if (--any? (eq (car slot) (car it)) (cdr state)) state (cons 'state (cons slot (cdr state))))) (defun org-ml--state-remove-slot (key state) "Remove slot from STATE given by KEY." (cons 'state (--remove-first (eq key (car it)) (cdr state)))) (defun org-ml--state-tick (key state) "Update STATE based on KEY. The following will happen: 1) the slot named KEY will have its limit decremented by 1 2) all slots with limits of 0 will be removed 3) all slots with eliminators containing KEY will be removed" (cl-flet ((decrement (slot) (-let* (((key . (&plist :limit :eliminators :next)) slot) (limit* (when limit (1- limit)))) (org-ml--state-slot key limit* eliminators next))) (is-at-limit (slot) (let ((limit (plist-get (cdr slot) :limit))) (when limit (= 0 limit)))) (can-eliminate (key slot) (let ((el (plist-get (cdr slot) :eliminators))) (or (eq t el) (memq key el))))) (->> (cdr state) (--map-first (eq key (car it)) (decrement it)) (-remove #'is-at-limit) (--remove (can-eliminate key it)) (cons 'state)))) (defun org-ml--item-get-next-state (scc state node) "Return updated state for NODE if it is a valid log item. SCC is given by `org-ml--scc-encode' and STATE is given by `org-ml--state-init'. STATE will be updated by called `org-ml--state-tick'." (let ((f (org-ml--scc-get-log-item-fun scc))) (when (and (org-ml--is-type 'item node) (funcall f node)) (list (org-ml--state-tick :item state) (list (cons 'items node)))))) (defun org-ml--clock-note-get-next-state (scc state node) "Return updated state for NODE if it is a valid clock note. SCC is given by `org-ml--scc-encode' and STATE is given by `org-ml--state-init'. STATE will be updated by called `org-ml--state-tick'." (-let ((f (org-ml--scc-get-log-item-fun scc))) (when (and (org-ml--is-type 'item node) (not (funcall f node))) (list (org-ml--state-tick :clock-note state) (list (cons 'clocks node)))))) (defun org-ml--clock-get-next-state (scc state node) "Return updated state for NODE if it is a valid clock. This will distinguish between clocks and clock notes as appropriate, and if a clock as found and clock notes are allowed, STATE will be updated with a new slot to detect clock notes that will exist for one pass. SCC is given by `org-ml--scc-encode' and STATE is given by `org-ml--state-init'. STATE will be updated by called `org-ml--state-tick'." (when (org-ml--is-type 'clock node) (let* ((slot (org-ml--state-slot :clock-notes 1 t #'org-ml--clock-note-get-next-state)) (next-state (--> (org-ml--state-tick :clock state) (if (org-ml--scc-get-clock-notes scc) (org-ml--state-add-slot slot it) it)))) (list next-state (list (cons 'clocks node)))))) (defun org-ml--drawer-get-next-state (mode name scc state node) "Return updated state for NODE if it is a valid drawer. The drawer will be separated using `org-ml--separate-logbook' according to MODE but only if NAME matches. SCC is given by `org-ml--scc-encode' and STATE is given by `org-ml--state-init'. STATE will be updated by called `org-ml--state-tick'." (when (org-ml--node-is-drawer-with-name name node) (let ((drawer-nodes (->> (org-element-contents node) (org-ml--separate-logbook scc mode))) ;; (reverse))) (key (cl-case mode (items :item-drawer) (clocks :clock-drawer) (mixed :mixed-drawer)))) (list (org-ml--state-tick key state) drawer-nodes)))) (defun org-ml--clock-get-next-state* (scc state node) "Return updated state for NODE if it is a valid clock. Unlike `org-ml--clock-get-next-state' this will add a new slot to STATE that detects item drawers (using the :item-drawer name from SCC) and removes the slot that detects mixed drawers. This is only intended to be used for the configuration option where clocks may or may not be in a drawer with items. SCC is given by `org-ml--scc-encode' and STATE is given by `org-ml--state-init'. STATE will be updated by called `org-ml--state-tick'." (-let (((next-state log-nodes) (org-ml--clock-get-next-state scc state node))) (when next-state (let* ((name (org-ml--scc-get-drawer-key :mixed scc)) (slot (org-ml--state-slot :item-drawer 1 nil (-partial #'org-ml--drawer-get-next-state :items name))) (next-state (->> (org-ml--state-add-slot slot state) (org-ml--state-remove-slot :mixed-drawer) (org-ml--state-tick :clock)))) (list next-state log-nodes))))) (defun org-ml--mixed-drawer-get-next-state** (mode name scc state node) "Return updated state for NODE if it is a valid mixed drawer. Unlike `org-ml--drawer-get-next-state' this will remove the slot that detects clocks This is only intended to be used for the configuration option where clocks may or may not be in a drawer with items. MODE and NAME carry the same meaning. SCC is given by `org-ml--scc-encode' and STATE is given by `org-ml--state-init'. STATE will be updated by called `org-ml--state-tick'." (-let (((next-state log-nodes) (org-ml--drawer-get-next-state mode name scc state node))) (if (--any? (eq 'clocks (car it)) log-nodes) (let ((next-state (->> (org-ml--state-remove-slot :clock next-state) (org-ml--state-tick :mixed-drawer)))) (list next-state log-nodes))))) (defun org-ml--init-state (scc) "Create a new state from SCC. The state will be a list like (state SLOT1 SLOT2 ...) where SLOTX is given by `org-ml--state-slot'. The purpose of this data structure is to represent valid logbook nodes for a particular configuration as well as their order and number. The reason it is called a state is because it will be used in an iterator as the logbook is separated from the contents, and a `stateful' iterator is needed because most logbook configurations have sequential dependencies for valid nodes." (-let ((funs (pcase (alist-get :drawers scc) ;; items not in drawer, clocks not in drawer (`(:items nil :clocks nil :mixed nil :clock-limit nil) (list (org-ml--state-slot :item nil nil #'org-ml--item-get-next-state) (org-ml--state-slot :clock nil nil #'org-ml--clock-get-next-state))) ;; items and clocks in the same drawer (`(:items nil :clocks nil :mixed ,m :clock-limit nil) (list (org-ml--state-slot :mixed-drawer 1 nil (-partial #'org-ml--drawer-get-next-state :mixed m)))) ;; items not in drawer, clocks in drawer (`(:items nil :clocks ,c :mixed nil :clock-limit nil) (list (org-ml--state-slot :item nil nil #'org-ml--item-get-next-state) (org-ml--state-slot :clock-drawer 1 nil (-partial #'org-ml--drawer-get-next-state :clocks c)))) ;; items not in drawer, clocks might be in a drawer (`(:items nil :clocks ,c :mixed nil :clock-limit ,L) (list (org-ml--state-slot :item nil nil #'org-ml--item-get-next-state) (org-ml--state-slot :clock L '(:clock-drawer) #'org-ml--clock-get-next-state) (org-ml--state-slot :clock-drawer 1 '(:clock) (-partial #'org-ml--drawer-get-next-state :clocks c)))) ;; items in drawer, clocks not in drawer (`(:items ,i :clocks nil :mixed nil :clock-limit nil) (list (org-ml--state-slot :clock nil nil #'org-ml--clock-get-next-state) (org-ml--state-slot :item-drawer 1 nil (-partial #'org-ml--drawer-get-next-state :items i)))) ;; items in drawer, clocks in a different drawer (`(:items ,i :clocks ,c :mixed nil :clock-limit nil) (list (org-ml--state-slot :item-drawer 1 nil (-partial #'org-ml--drawer-get-next-state :items i)) (org-ml--state-slot :clock-drawer 1 nil (-partial #'org-ml--drawer-get-next-state :clocks c)))) ;; items in drawer, clocks either loose or in a different drawer (`(:items ,i :clocks ,c :mixed nil :clock-limit ,L) (list (org-ml--state-slot :item-drawer 1 nil (-partial #'org-ml--drawer-get-next-state :items i)) (org-ml--state-slot :clock L '(:clock-drawer) #'org-ml--clock-get-next-state) (org-ml--state-slot :clock-drawer 1 '(:clock) (-partial #'org-ml--drawer-get-next-state :clocks c)))) ;; items in drawer, clocks might be in the same drawer (`(:items nil :clocks nil :mixed ,m :clock-limit ,L) (list (org-ml--state-slot :clock L nil #'org-ml--clock-get-next-state*) (org-ml--state-slot :mixed-drawer 1 nil (-partial #'org-ml--mixed-drawer-get-next-state** :mixed m)))) (e (error "This shouldn't happen: %s" e))))) (cons 'state funs))) (defmacro org-ml--reduce-state (initial-state form list) "Sort of like `--reduce' but with state. It is only \"sort of\" like a standard reduce function for two reasons a) it keeps track of state and b) returns the remainder of LIST when the state is nil (which signifies termination of the loop). FORM is a form where `it' is bound to the current node, `acc' is bound to the accumulated nodes, and `it-state' is bound to the current state. FORM must return a list like \(NEW-STATE NEW-ACC), where NEW-STATE and NEW-ACC become the state and accumulator on the next iteration. INITIAL-STATE is bound to `it-state' on the first iteration." (declare (indent 1)) (let ((r (make-symbol "--rest"))) `(let ((it-state ,initial-state) (,r ,list) acc it) (while (and it-state ,r) (setq it (car ,r)) (-setq (it-state acc) ,form) (when it-state (setq ,r (cdr ,r)))) (list acc ,r)))) (defun org-ml--split-logbook (config nodes) "Return NODES split to logbook components. CONFIG is a plist parsable by `org-ml--scc-encode'." (if (not nodes) (list (org-ml--logbook-init nil nil nil) 0 nil) (cl-flet ((map-cdr (list) (-map #'cdr list)) (try-test-funs (scc state node) (-let ((test-funs (--map (plist-get (cdr it) :next) (cdr state)))) (--reduce-from (if acc acc (funcall it scc state node)) nil test-funs)))) (-let* ((scc (org-ml--scc-encode config)) (init-state (org-ml--init-state scc)) (flat (org-ml--flatten-plain-lists nodes)) (i (-some->> flat (-find-index #'org-ml--node-has-trailing-space) (1+))) ((nodes-before-space nodes-after-space) (if i (-split-at i flat) (list flat nil))) (first-space-post-blank (->> (-last-item nodes-before-space) (org-element-post-blank))) ((logbook-nodes contents-nodes-before-space) (org-ml--reduce-state init-state (-let (((next-state logbook-nodes) (try-test-funs scc it-state it))) (if logbook-nodes (list next-state (append logbook-nodes acc)) (list nil acc))) nodes-before-space)) ((&alist 'items 'clocks 'unknown) (->> (reverse logbook-nodes) (-group-by #'car))) (post-blank (if logbook-nodes (if contents-nodes-before-space 0 first-space-post-blank) 0)) (contents (->> nodes-after-space (append contents-nodes-before-space) (org-ml--wrap-plain-lists)))) (list (org-ml--logbook-init (map-cdr items) (map-cdr clocks) (map-cdr unknown)) post-blank contents))))) ;; logbook merging (supercontents -> nodes) (defun org-ml--sort-logbook (mode scc nodes) "Sort NODES and return. NODES will be sorted according to their timestamps and are assumed to be valid log items or clocks/clock-notes (anything else will trigger an error). SCC is a supercontents-config as returned by `org-ml--scc-init'. MODE is one of :mixed, :items, or :clocks depending on what is intended to be sorted." (-let (((&alist :clock-notes n :is-log-item-fun f) scc)) (cl-labels ((get-ts (node) (cl-case (org-ml-get-type node) (clock (-some->> (org-element-property-raw :value node) (org-ml--timestamp-get-start-unixtime))) (item (funcall f node)))) (prepare-node (acc node) ;; Return a list like (NODE . NOTE) where NODE is a clock or item and ;; NOTE is a clock note, which is only added to NODE if the type of ;; NODE is a clock and NOTE appears immediately after. (cond ((and n (memq mode '(:clocks :mixed)) (org-ml--is-type 'item node) (org-ml--is-type 'clock (car (car acc))) (not (funcall f node))) (cons (list (car (car acc)) node) (cdr acc))) ((or (and (memq mode '(:items :mixed)) (org-ml--is-type 'item node) (funcall f node)) (and (memq mode '(:clocks :mixed)) (org-ml--is-type 'clock node))) (cons (list node) acc)) (t (let ((msg (cond ((and n (eq mode :clocks)) "Not a valid clock or note: %s") ((and n (eq mode :mixed)) "Not a valid item, clock, or note: %s") ((eq mode :clocks) "Not a valid clock: %s") ((eq mode :items) "Not a valid item: %s") (t "Not a valid clock or item: %s")))) (error msg node))))) ;; this should be imperative because the recursive version has O(n) ;; calls to itself...byebye stack :( (merge-nodes (nodes-a nodes-b) (let (merged) (while (or nodes-a nodes-b) (pcase (cons nodes-a nodes-b) (`(,as . nil) (setq merged (append (nreverse as) merged) nodes-a nil)) (`(nil . ,bs) (setq merged (append (nreverse bs) merged) nodes-b nil)) (`((,a . ,as) . (,b . ,bs)) (let ((ts-a (get-ts (car a))) (ts-b (get-ts (car b)))) (cond ((not ts-a) (error "Could not get timestamp for logbook node: %s" a)) ((not ts-b) (error "Could not get timestamp for logbook node: %s" b)) ((<= ts-b ts-a) (setq merged (cons a merged) nodes-a as)) ((< ts-a ts-b) (setq merged (cons b merged) nodes-b bs)) (t (error "Unknown merge error"))))))) (nreverse merged))) (merge-and-sort (nodes) (let ((L (length nodes))) (if (<= L 1) nodes (-let (((left right) (-split-at (/ L 2) nodes))) (merge-nodes (merge-and-sort left) (merge-and-sort right))))))) (->> (-reduce-from #'prepare-node nil nodes) (merge-and-sort) (-flatten-n 1) (org-ml--wrap-plain-lists))))) (defun org-ml--merge-logbook (scc items clocks) "Merge ITEMS and CLOCKS. Return these two inputs as a single sorted list (highest timestamp first) according to `org-ml--sort-logbook'. SCC is a supercontents-config as returned by `org-ml--scc-encode'." (org-ml--sort-logbook :mixed scc (append items clocks))) (defun org-ml--logbook-items-to-nodes (scc logbook) "Return items in LOGBOOK as a sorted list of NODES. SCC is a supercontents-config as returned by `org-ml--scc-encode'." (->> (org-ml-logbook-get-items logbook) (org-ml--sort-logbook :items scc))) (defun org-ml--logbook-clocks-to-nodes (scc logbook) "Return clocks in LOGBOOK as a sorted list of NODES. SCC is a supercontents-config as returned by `org-ml--scc-encode'." (->> (org-ml-logbook-get-clocks logbook) (org-ml--sort-logbook :clocks scc))) (defun org-ml--logbook-to-nodes (config logbook) "Return LOGBOOK as a list of NODES. Anything in the UNKNOWN slot will be ignored. The exact nodes (drawers, loose items, etc) will be determined by the SCC. CONFIG is a config plist to be given to `org-ml--scc-encode'." ;; TODO clean this up (-let (((&plist :items :clocks) logbook)) (when (or items clocks) (cl-flet* ((build-drawer (name children) (apply #'org-ml-build-drawer name children)) (build-drawer-maybe (name children) (-some->> children (build-drawer name))) (cons-drawer-maybe (name drawer-nodes loose-nodes) (let ((drawer (-some->> drawer-nodes (build-drawer name)))) (if drawer (cons drawer loose-nodes) loose-nodes))) (below-limit (limit lb) (->> (org-ml-logbook-get-clocks lb) (--count (org-ml--is-type 'clock it)) (>= limit))) (merge-nodes (enconf lb) (-let (((&plist :items :clocks) lb)) (org-ml--merge-logbook enconf items clocks))) (build-mixed-drawer-maybe (enconf m lb) (-some->> (merge-nodes enconf lb) (build-drawer m) (list))) (to-item-clock-nodes (enconf lb) (list (org-ml--logbook-items-to-nodes enconf lb) (org-ml--logbook-clocks-to-nodes enconf lb)))) (-let (((enconf &as &alist :drawers d) (org-ml--scc-encode config))) (pcase d ;; items not in drawer, clocks not in drawer (`(:items nil :clocks nil :mixed nil :clock-limit nil) (merge-nodes enconf logbook)) ;; items and clocks in the same drawer (`(:items nil :clocks nil :mixed ,m :clock-limit nil) (build-mixed-drawer-maybe enconf m logbook)) ;; items in drawer, clocks not in drawer (`(:items ,i :clocks nil :mixed nil :clock-limit nil) (-let* (((items clocks) (to-item-clock-nodes enconf logbook))) (cons-drawer-maybe i items clocks))) ;; items not in drawer, clocks in drawer (`(:items nil :clocks ,c :mixed nil :clock-limit nil) (-let* (((items clocks) (to-item-clock-nodes enconf logbook))) (cons-drawer-maybe c clocks items))) ;; items in drawer, clocks might be in the same drawer (`(:items nil :clocks nil :mixed ,m :clock-limit ,l) (if (below-limit l logbook) (-let* (((items clocks) (to-item-clock-nodes enconf logbook))) (cons-drawer-maybe m items clocks)) (build-mixed-drawer-maybe enconf m logbook))) ;; items not in drawer, clocks might be in a drawer (`(:items nil :clocks ,c :mixed nil :clock-limit ,l) (if (below-limit l logbook) (merge-nodes enconf logbook) (-let* (((items clocks) (to-item-clock-nodes enconf logbook))) (cons-drawer-maybe c clocks items)))) ;; items in drawer, clocks in a different drawer (`(:items ,i :clocks ,c :mixed nil :clock-limit nil) (-let* (((items clocks) (to-item-clock-nodes enconf logbook)) (items-drawer (build-drawer-maybe i items)) (clocks-drawer (build-drawer-maybe c clocks))) (-non-nil (list items-drawer clocks-drawer)))) ;; items in drawer, clocks either loose or in a different drawer (`(:items ,i :clocks ,c :mixed nil :clock-limit ,l) (-let* (((items clocks) (to-item-clock-nodes enconf logbook)) (items-drawer (build-drawer-maybe i items))) (if (below-limit l logbook) (if items-drawer (cons items-drawer clocks) clocks) (->> (build-drawer-maybe c clocks) (list items-drawer) (-non-nil))))) (e (error "This shouldn't happen: %s" e)))))))) ;; section -> supercontents ;; Introduce another data abstraction here called the "supersection". This is ;; much simpler than the supercontents, and consists only of the :pre-blank and ;; section children of the encapsulating headline. The main purpose of this is ;; to provide a means to update "the stuff under the headline" easily without ;; triggering the headline itself to undefer most of its properties. The ;; :pre-blank is part of the headline node even though it visually affects the ;; stuff underneath it. This especially matters for functions like ;; `org-ml-update-supersections' and `org-ml-update-supercontents' which can be ;; massively sped up if they don't need to update the headline in the buffer. (define-inline org-ml--supersection-init (pre-blank section) "Create a supersection plist from PRE-BLANK and SECTION. SECTION is a list of nodes under the section node in a headline." (inline-quote (list :pre-blank ,pre-blank :section ,section))) (defun org-ml--planning-split (planning) "Decompose PLANNING into lists." (list :closed (-some->> (org-element-property-raw :closed planning) (org-ml--timestamp-get-start-timelist)) :scheduled (-some->> (org-element-property-raw :scheduled planning) (org-ml--timestamp-to-planning-list)) :deadline (-some->> (org-element-property-raw :deadline planning) (org-ml--timestamp-to-planning-list)))) (defun org-ml--property-drawer-split (property-drawer) "Decompose PROPERTY-DRAWER into a list of node-property nodes." (->> (org-element-contents property-drawer) (--map (list (org-element-property-raw :key it) (org-element-property-raw :value it))))) (defun org-ml--from-first-second-rest (config planning prop-drawer blank-node children) "Create a new supercontents node in various ways. CONFIG is a list corresponding to `org-ml--scc-encode'. PLANNING is a planning node. PROP-DRAWER is a property-drawer node. BLANK-NODE is a node that has a post-blank behind it. CHILDREN is everything after the planning and/or property-drawer." (-let* ((pb (org-element-post-blank blank-node)) ((logbook blank contents) (if (< 0 pb) `(nil ,pb ,children) (org-ml--split-logbook config children)))) (org-ml--supercontents-init-from-lb (and planning (org-ml--planning-split planning)) (and prop-drawer (org-ml--property-drawer-split prop-drawer)) logbook blank contents))) (defun org-ml--supersection-to-supercontents (config supersection) "Convert SUPERSECTION to supercontents. CONFIG is a list corresponding to `org-ml--scc-encode'." (-let (((&plist :pre-blank pb :section children) supersection)) ;; If pre-blank is >0, by definition there is no planning, ;; property-drawer, or logbook (if (< 0 pb) (org-ml--supercontents-init nil nil nil nil nil pb children) (-let* (((first . rest1) children) ((second . rest2) rest1) (t1 (org-ml-get-type first)) (t2 (org-ml-get-type second))) (cond ((and (eq t1 'planning) (eq t2 'property-drawer)) (org-ml--from-first-second-rest config first second second rest2)) ((eq t1 'planning) (org-ml--from-first-second-rest config first nil first rest1)) ((eq t1 'property-drawer) (org-ml--from-first-second-rest config nil first first rest1)) (t (->> (org-ml--split-logbook config children) (apply #'org-ml--supercontents-init-from-lb nil nil)))))))) (defun org-ml--supercontents-to-supersection (config supercontents) "Convert SUPERCONTENTS to supersection. CONFIG is a list corresponding to `org-ml--scc-encode'." (-let* (((&plist :planning p :node-props n :logbook lb :blank b :contents c) supercontents) (anyp (or (plist-get p :closed) (plist-get p :scheduled) (plist-get p :deadline))) (lb-nodes (org-ml--logbook-to-nodes config lb))) (cond (lb-nodes (org-ml--supersection-init 0 `(,@(when anyp (list (apply #'org-ml-build-planning! p))) ,@(when n (list (apply #'org-ml-build-property-drawer! n))) ,@(org-ml--set-last-post-blank b lb-nodes) ,@c))) (n (org-ml--supersection-init 0 `(,@(when anyp (list (apply #'org-ml-build-planning! p))) ,(apply #'org-ml-build-property-drawer! :post-blank b n) ,@c))) (anyp (org-ml--supersection-init 0 (cons (apply #'org-ml-build-planning! :post-blank b p) c))) (t (org-ml--supersection-init b c))))) ;; public supercontents functions (defun org-ml-headline-get-supercontents (config headline) "Return the supercontents of HEADLINE node. Supercontents will be a plist like: \( :planning PLANNING :node-props PROPS :logbook LB :blank BLANK :contents CONTENTS ) PLANNING is a plist like the analogous argument of `org-ml-build-planning!' or nil if non-existent. PROPS is a list of node-property nodes. LB is the logbook, which is another plist (see below). BLANK is the value of any whitespace after the planning, property-drawer, or logbook (assuming any exist) or the :pre-blank value of the encapsulating headline (if they don't exist). CONTENTS is a list of nodes after all the other stuff above. The logbook will be have keys :items, :clocks, and :unknown, where the first two will include the item and clock nodes of the logbook respectively, and the third will contain anything that could not be identified as a valid logbook entry. Note that items are actually stored under a plain-list node but will be returned here as a flat list of items for convenience. Also note that the :clocks slot can also include item nodes if clock notes are returned. CONFIG is a plist representing the logbook configuration to target and will contain the following keys; - :log-into-drawer - corresponds to the value of symbol `org-log-into-drawer' and carriers the same meaning - :clock-into-drawer - corresponds to the value of symbol `org-clock-into-drawer' and carriers the same meaning - :clock-out-notes - corresponds to the value of `org-log-note-clock-out' Any values not given will default to nil. Note that there is no way to infer what the logbook configuration should be, and thus this controls how the logbook will be parsed; this means it also determines which nodes will be returned in the :items/:clocks slots and which will be deemed :unknown (see above) so be sure this plist is set according to your desired target configuration." (->> (org-ml-headline-get-supersection headline) (org-ml--supersection-to-supercontents config))) (defun org-ml-headline-set-supercontents (config supercontents headline) "Set logbook and contents of HEADLINE according to SUPERCONTENTS. See `org-ml-headline-get-supercontents' for the meaning of CONFIG and the structure of the SUPERCONTENTS list." (-> (org-ml--supercontents-to-supersection config supercontents) (org-ml-headline-set-supersection headline))) (org-ml--defun-anaphoric* org-ml-headline-map-supercontents (config fun headline) "Map a function over the supercontents of HEADLINE. FUN is a unary function that takes a supercontents list and returns a modified supercontents list. See `org-ml-headline-get-supercontents' for the meaning of CONFIG and the structure of the supercontents list." (--> (org-ml-headline-get-supercontents config headline) (org-ml-headline-set-supercontents config (funcall fun it) headline))) (defun org-ml-headline-get-supersection (headline) "Return supersection list for the section in HEADLINE." (org-ml--check-type 'headline headline) (org-ml--supersection-init (org-element-property-raw :pre-blank headline) (org-ml-headline-get-section headline))) (defun org-ml-headline-set-supersection (supersection headline) "Return SUPERSECTION for the section in HEADLINE." (org-ml--check-type 'headline headline) (-let* (((&plist :pre-blank p :section m) supersection) (pb (org-element-property-raw :pre-blank headline)) (headline* (if (/= p pb) (->> (org-ml-copy headline) (org-element-put-property-2 :pre-blank p)) headline))) (org-ml-headline-set-section m headline*))) (org-ml--defun-anaphoric* org-ml-headline-map-supersection (fun headline) "Apply FUN to HEADLINE supersection." (let ((it (org-ml-headline-get-supersection headline))) (org-ml-headline-set-supersection (funcall fun it) headline))) ;; planning (defun org-ml-headline-get-planning (headline) "Return the planning node in HEADLINE or nil if none." (org-ml--check-type 'headline headline) ;; TODO it seems silly that we need to "convert" the logbook when I'm not ;; modifying it. Lazy eval? (->> (org-ml-headline-get-supercontents nil headline) (org-ml-supercontents-get-planning))) (defun org-ml-headline-set-planning (planning headline) "Return HEADLINE node with planning components set to PLANNING node." (org-ml--check-type 'headline headline) (org-ml-headline-map-supercontents* nil (org-ml-supercontents-set-planning planning it) headline)) (org-ml--defun-anaphoric* org-ml-headline-map-planning (fun headline) "Return HEADLINE node with planning node modified by FUN. FUN is a unary function that takes a planning node and returns a modified planning node." (--> (org-ml-headline-get-planning headline) (org-ml-headline-set-planning (funcall fun it) headline))) ;; node-properties (eg the entire property drawer) (defun org-ml-headline-get-node-properties (headline) "Return a list of node-properties nodes in HEADLINE or nil if none." (org-ml--check-type 'headline headline) ;; TODO it seems silly that we need to "convert" the logbook when I'm not ;; modifying it. Lazy eval? (->> (org-ml-headline-get-supercontents nil headline) (org-ml-supercontents-get-node-properties))) (defun org-ml-headline-set-node-properties (node-properties headline) "Return HEADLINE node with property drawer containing NODE-PROPERTIES. NODE-PROPERTIES is a list of (key . value) pairs (both strings)." (org-ml--check-type 'headline headline) (org-ml-headline-map-supercontents* nil (org-ml-supercontents-set-node-properties node-properties it) headline)) (org-ml--defun-anaphoric* org-ml-headline-map-node-properties (fun headline) "Return HEADLINE node with property-drawer node modified by FUN. FUN is a unary function that takes a property-drawer node and returns a modified property-drawer node." (--> (org-ml-headline-get-node-properties headline) (org-ml-headline-set-node-properties (funcall fun it) headline))) ;; node-property (defun org-ml-headline-get-node-property (key headline) "Return value of property with KEY in HEADLINE or nil if not found. If multiple properties with KEY are present, only return the first." (->> (org-ml-headline-get-node-properties headline) (--first (equal key (car it))) (cadr))) (defun org-ml-headline-set-node-property (key value headline) "Return HEADLINE with node property matching KEY set to VALUE. If a property matching KEY is present, set it to VALUE. If multiple properties matching KEY are present, only set the first." (org-ml-headline-map-node-properties* (-if-let (np (-some->> value (list key))) (-if-let (i (--find-index (equal key (car it)) it)) (-replace-at i np it) (cons np it)) (--remove-first (equal key (car it)) it)) headline)) (org-ml--defun-anaphoric* org-ml-headline-map-node-property (key fun headline) "Return HEADLINE node with property value matching KEY modified by FUN. FUN is a unary function that takes a node-property value and returns a modified node-property value." (--> (org-ml-headline-get-node-property key headline) (org-ml-headline-set-node-property key (funcall fun it) headline))) ;; public logbook/contents getters/setters/mappers (defun org-ml-headline-get-logbook-items (config headline) "Return the logbook items of HEADLINE. See `org-ml-headline-get-supercontents' for the meaning of CONFIG. The returned items will be a flat list of item nodes, not a plain-list node." (->> (org-ml-headline-get-supercontents config headline) (org-ml-supercontents-get-logbook) (org-ml-logbook-get-items))) (defun org-ml-headline-set-logbook-items (config items headline) "Set the logbook items of HEADLINE to ITEMS. See `org-ml-headline-get-supercontents' for the meaning of CONFIG. ITEMS must be supplied as a flat list of valid logbook item nodes, not as a plain-list node." (org-ml-headline-map-supercontents* config (org-ml-supercontents-map-logbook* (org-ml-logbook-set-items items it) it) headline)) (org-ml--defun-anaphoric* org-ml-headline-map-logbook-items (config fun headline) "Map a function over the logbook items of HEADLINE. FUN is a unary function that takes a list of item nodes and returns a modified list of item nodes. See `org-ml-headline-get-supercontents' for the meaning of CONFIG." (--> (org-ml-headline-get-logbook-items config headline) (org-ml-headline-set-logbook-items config (funcall fun it) headline))) (defun org-ml-headline-get-logbook-clocks (config headline) "Return the logbook clocks of HEADLINE. See `org-ml-headline-get-supercontents' for the meaning of CONFIG. The returned list will include clock nodes and maybe item nodes if :clock-out-notes is t in CONFIG." (->> (org-ml-headline-get-supercontents config headline) (org-ml-supercontents-get-logbook) (org-ml-logbook-get-clocks))) (defun org-ml-headline-set-logbook-clocks (config clocks headline) "Set the logbook clocks of HEADLINE to CLOCKS. See `org-ml-headline-get-supercontents' for the meaning of CONFIG. CLOCKS must be supplied as a flat list of valid clock nodes and optionally item nodes if :clock-out-notes is t in CONFIG." (org-ml-headline-map-supercontents* config (org-ml-supercontents-map-logbook* (org-ml-logbook-set-clocks clocks it) it) headline)) (org-ml--defun-anaphoric* org-ml-headline-map-logbook-clocks (config fun headline) "Map a function over the logbook clocks of HEADLINE. FUN is a unary function that takes a list of clock nodes and optionally item nodes to represent the clock notes and returns a modified list of said nodes. `org-ml-headline-get-supercontents' for the meaning of CONFIG." (--> (org-ml-headline-get-logbook-clocks config headline) (org-ml-headline-set-logbook-clocks config (funcall fun it) headline))) (defun org-ml-headline-get-contents (config headline) "Return the contents of HEADLINE. Contents is everything in the headline after the logbook and will be returned as a flat list of nodes. See `org-ml-headline-get-supercontents' for the meaning of CONFIG." (->> (org-ml-headline-get-supercontents config headline) (org-ml-supercontents-get-contents))) (defun org-ml-headline-set-contents (config contents headline) "Set the contents of HEADLINE to CONTENTS. Contents is everything in the headline after the logbook, and CONTENTS must be a flat list of nodes. See `org-ml-headline-get-supercontents' for the meaning of CONFIG." (org-ml-headline-map-supercontents* config (org-ml-supercontents-set-contents contents it) headline)) (org-ml--defun-anaphoric* org-ml-headline-map-contents (config fun headline) "Map a function over the contents of HEADLINE. Contents is everything in the headline after the logbook. FUN is a unary function that takes a list of nodes representing the contents and returns a modified list of nodes. See `org-ml-headline-get-supercontents' for the meaning of CONFIG." (--> (org-ml-headline-get-contents config headline) (org-ml-headline-set-contents config (funcall fun it) headline))) ;; public high-level logbook operations (defun org-ml-headline-logbook-append-item (config item headline) "Append ITEM to the logbook of HEADLINE. See `org-ml-headline-get-supercontents' for the meaning of CONFIG. ITEM must be a valid logbook item. The logbook will be started if it does not already exist, else ITEM will be added in chronological order." (org-ml-headline-map-logbook-items* config (cons item it) headline)) (defun org-ml-headline-logbook-append-open-clock (config unixtime headline) "Append an open clock to the logbook of HEADLINE. See `org-ml-headline-get-supercontents' for the meaning of CONFIG. UNIXTIME will set the start time of the clock. The logbook will be started if it does not already exist, else the new clock will be added in chronological order." (let ((clock (-> (org-ml-unixtime-to-datetime unixtime) (org-ml-build-clock!)))) (org-ml-headline-map-logbook-clocks* config (cons clock it) headline))) (defun org-ml-headline-logbook-close-open-clock (config unixtime note headline) "Close an open clock to the logbook of HEADLINE. See `org-ml-headline-get-supercontents' for the meaning of CONFIG. UNIXTIME will set the end time of the clock. This will only close an open clock if it is the most recent clock; else it will do nothing. NOTE is a string representing the clock-out note (or nil if not desired). Note that supplying a non-nil clock-note when it is not allowed by CONFIG will trigger an error." (org-ml-headline-map-logbook-clocks* config (-let (((first . rest) it)) (if (not (and first (org-ml-clock-is-running first))) it (let* ((time (org-ml-unixtime-to-datetime unixtime)) (closed (->> first ;; NOTE making copies here is necessary (org-ml-map-property* :value (org-ml-timestamp-set-end-time time it)))) (note* (-some->> note (org-ml-build-paragraph) (org-ml-build-item)))) (if note* `(,closed ,note* ,@rest) (cons closed rest))))) headline)) (defun org-ml-headline-logbook-convert-config (config1 config2 headline) "Convert the logbook of HEADLINE to a new configuration. CONFIG1 is the current config and CONFIG2 is the target config. Note that any logbook nodes that are invalid under CONFIG1 will be silently dropped, and nodes which do not conform to CONFIG2 will trigger an error. See `org-ml-headline-get-supercontents' for the structure of both config lists." (--> (org-ml-headline-get-supercontents config1 headline) (org-ml-headline-set-supercontents config2 it headline))) ;; misc (defun org-ml-headline-get-path (headline) "Return tree path of HEADLINE node. The return value is a list of headline titles (including that from HEADLINE) leading to the root node." (org-ml--check-type 'headline headline) (->> (org-ml-get-parents headline) (--map (org-element-property :raw-value it)))) (defun org-ml-headline-update-item-statistics (headline) "Return HEADLINE node with updated statistics cookie via items. The percent/fraction will be computed as the number of checked items over the number of items with checkboxes (non-checkbox items will not be considered)." (let* ((items (->> (org-ml-headline-get-section headline) (org-element-contents) (--filter (org-ml--is-type 'plain-list it)) (-mapcat #'org-element-contents) (--filter (org-element-property-raw :checkbox it)))) (done (length (--filter (org-ml--property-is-eq :checkbox 'on it) items))) (total (length items))) (->> (org-ml-copy headline) (org-ml--headline-set-statistics-cookie-fraction done total)))) (defun org-ml-headline-update-todo-statistics (headline) "Return HEADLINE node with updated statistics cookie via subheadlines. The percent/fraction will be computed as the number of done subheadlines over the number of todo subheadlines (eg non-todo subheadlines will not be counted)." (let* ((subtodo (->> (org-ml-headline-get-subheadlines headline) (--filter (org-element-property :todo-keyword it)))) (done (length (-filter #'org-ml-headline-is-done subtodo))) (total (length subtodo))) (->> (org-ml-copy headline) (org-ml--headline-set-statistics-cookie-fraction done total)))) ;;; plain-list ;; TODO there seems to be a bug in the interpreter that prevents "+" bullets from ;; being recognized (as of org-9.1.9 they are simply read as "-") (defun org-ml-plain-list-set-type (type plain-list) "Return PLAIN-LIST node with type property set to TYPE. TYPE is one of the symbols `unordered' or `ordered'." (org-ml--check-type 'plain-list plain-list) (cond ((eq type 'unordered) (org-ml--map-children-nocheck* (--map (org-ml-set-property :bullet '- it) it) plain-list)) ((eq type 'ordered) ;; NOTE the org-interpreter seems to use the correct, ordered numbers if any ;; number is set here. This behavior may not be reliable. (org-ml--map-children-nocheck* (--map (org-ml-set-property :bullet 1 it) it) plain-list)) (t (org-ml--arg-error "Invalid type: %s" type)))) ;;; table (defun org-ml-table-get-cell (row-index column-index table) "Return table-cell node at ROW-INDEX and COLUMN-INDEX in TABLE node. Rule-type rows do not count toward row indices." (org-ml--check-type 'table table) (->> (org-ml--table-get-row row-index table) (org-element-contents) (org-ml--nth column-index))) (defun org-ml-table-delete-row (row-index table) "Return TABLE node with row at ROW-INDEX deleted." (org-ml--check-type 'table table) (org-ml--map-children-nocheck* (org-ml--remove-at row-index it) table)) (defun org-ml-table-delete-column (column-index table) "Return TABLE node with column at COLUMN-INDEX deleted." (org-ml--check-type 'table table) (org-ml--map-children-nocheck* (--map (if (org-ml--property-is-eq :type 'rule it) it (org-ml--map-children-nocheck* (org-ml--remove-at column-index it) it)) it) table)) (defun org-ml-table-insert-column! (column-index column-text table) "Return TABLE node with COLUMN-TEXT inserted at COLUMN-INDEX. COLUMN-INDEX is the index of the column and COLUMN-TEXT is a list of strings to be made into table-cells to be inserted following the same syntax as `org-ml-build-table-cell!'." (org-ml--check-type 'table table) (let ((column (-map #'org-ml-build-table-cell! column-text))) (org-ml--column-map-down-rows (lambda (new-cell cells) (org-ml--insert-at column-index new-cell cells)) column table))) (defun org-ml-table-insert-row! (row-index row-text table) "Return TABLE node with ROW-TEXT inserted at ROW-INDEX. ROW-INDEX is the index of the column and ROW-TEXT is a list of strings to be made into table-cells to be inserted following the same syntax as `org-ml-build-table-row!'." (org-ml--check-type 'table table) (if (not row-text) (org-ml--table-clear-row row-index table) (let ((row (->> (org-ml-build-table-row! row-text) (org-ml--table-row-pad-maybe table)))) (org-ml--map-children-nocheck* (org-ml--insert-at row-index row it) table)))) (defun org-ml-table-replace-cell! (row-index column-index cell-text table) "Return TABLE node with a table-cell node replaced by CELL-TEXT. If CELL-TEXT is a string, it will replace the children of the table-cell at ROW-INDEX and COLUMN-INDEX in TABLE. CELL-TEXT will be processed the same as the argument given to `org-ml-build-table-cell!'. If CELL-TEXT is nil, it will set the cell to an empty string." (org-ml--check-type 'table table) (let* ((cell (if cell-text (org-ml-build-table-cell! cell-text) (org-ml-build-table-cell ""))) (row (->> (org-ml--table-get-row row-index table) (org-ml--map-children-nocheck* (org-ml--replace-at column-index cell it))))) (org-ml--table-replace-row row-index row table))) (defun org-ml-table-replace-column! (column-index column-text table) "Return TABLE node with the column at COLUMN-INDEX replaced by COLUMN-TEXT. If COLUMN-TEXT is a list of strings, it will replace the table-cells at COLUMN-INDEX. Each member of COLUMN-TEXT will be processed the same as the argument given to `org-ml-build-table-cell!'. If COLUMN-TEXT is nil, it will clear all cells at COLUMN-INDEX." (org-ml--check-type 'table table) (if (not column-text) (org-ml--table-clear-column column-index table) (let ((column-cells (-map #'org-ml-build-table-cell! column-text))) (org-ml--table-replace-column column-index column-cells table)))) (defun org-ml-table-replace-row! (row-index row-text table) "Return TABLE node with the row at ROW-INDEX replaced by ROW-TEXT. If ROW-TEXT is a list of strings, it will replace the cells at ROW-INDEX. Each member of ROW-TEXT will be processed the same as the argument given to `org-ml-build-table-row!'. If ROW-TEXT is nil, it will clear all cells at ROW-INDEX." (org-ml--check-type 'table table) (let ((row-cells (org-ml-build-table-row! row-text))) (org-ml--table-replace-row row-index row-cells table))) ;;; INDENTATION FUNCTIONS ;; NOTE: for headlines, promote = outdent, and demote = indent ;;; indentation (single and tree) ;; high level steps to indent ;; ;; Assume an abstract tree thing like this: ;; - 0. ;; - 1. ;; - 1.0 ;; - 2. ;; ;; We wish to indent 1. There are two cases: ;; 1. indent only 1. ;; 2. indent 1. and 1.0 along with it ;; ;; In both cases, make 1.0 a child of 0. Remove 1.0 from the ;; top-level list and leave 1.0 and 2. untouched ;; ;; In case 2, this is all that is needed since 1.0 is already a child of 1. and ;; will "autoindent" as 1. itself is moved. ;; ;; To make it "stay in place," as in case 1, remove 1.0 as a child of ;; 1., append it to the end of the list containing 2., and set this list (with ;; both 1. and 1.0.) as the child of 0. ;; ;; parameters for indenting: ;; - index of target to indent (1 in above example) ;; TODO these mostly work except for whitespace edgecases, and those are really ;; ugly to work around (defmacro org-ml--tree-set-child* (index form tree) "Return TREE with node at INDEX set as child of the node before it. FORM is a Lisp form that takes the last member of TREE immediately before INDEX (called \"parent\", bound to `it') and the item at INDEX to be set as its child (bound to `it-target') and returns a new \"parent\" node." (declare (indent 1) (debug (form form form))) (let ((i (make-symbol "index")) (h (make-symbol "head")) (T (make-symbol "tail"))) `(let ((,i ,index)) (unless (and (integerp ,i) (< 0 ,index)) (error "Cannot indent topmost item at this level")) (-let (((,h ,T) (-split-at ,i ,tree))) (if (not ,T) (error "Index over range: %s" ,i) (let ((it-target (car ,T))) (append (org-ml--map-last* ,form ,h) (cdr ,T)))))))) (defun org-ml--headline-move-post-blank (headline) "Move :post-blank to :pre-blank if HEADLINE is totally empty." (if (org-element-contents headline) headline (let ((pre (org-element-property :pre-blank headline)) (post (org-element-post-blank headline))) (org-ml--set-properties-raw (org-ml-copy headline) :pre-blank (+ pre post) :post-blank 0)))) ;; headline (defun org-ml-headline-demote-subtree (index headline) "Return HEADLINE node with child headline at INDEX demoted. Unlike `org-ml-headline-demote-subheadline' this will also demote the demoted headline node's children." (org-ml-headline-map-subheadlines* (org-ml--tree-set-child* index (org-ml--map-children-nocheck* (-snoc it (org-ml--headline-subtree-shift-level 1 it-target)) (org-ml--headline-move-post-blank it)) it) headline)) (defun org-ml-headline-demote-subheadline (index headline) "Return HEADLINE node with child headline at INDEX demoted. Unlike `org-ml-headline-demote-subtree' this will not demote the demoted headline node's children." (org-ml-headline-map-subheadlines* (org-ml--tree-set-child* index (let* ((headlines-in-target (org-ml-headline-get-subheadlines it-target)) (tgt-children (org-element-contents it-target)) (tgt-pb (if (org-ml--is-type 'section (car tgt-children)) (org-ml--get-post-blank-textsafe (car tgt-children)) (org-element-property-raw :pre-blank it-target))) (tgt-headline* (->> (org-ml-copy it-target) (org-ml-headline-set-subheadlines nil) (org-ml--headline-shift-level 1) (org-ml--set-post-blank tgt-pb)))) (org-ml--map-children-nocheck* (append it (list tgt-headline*) headlines-in-target) (org-ml--headline-move-post-blank it))) it) headline)) ;; plain-list (defun org-ml-plain-list-indent-item-tree (index plain-list) "Return PLAIN-LIST node with child item at INDEX indented. Unlike `org-ml-item-indent-item' this will also indent the indented item node's children." (org-ml--check-type 'plain-list plain-list) (org-ml--map-children-nocheck* (org-ml--tree-set-child* index (let ((parent-pb (org-element-post-blank it)) (indented-target (org-ml--set-post-blank 0 it-target))) (org-ml--item-map-subcomponents-cond* ;; If neither subitems nor rest present, add indented tree as new ;; subitem under parent. Put the parent post-blank at the end of ;; the header material. (list (org-ml--shift-last-post-blank parent-pb it-head) `(,indented-target) 0 nil) ;; If rest not present but subitems present, append indented tree ;; to the end of these subitems. Put the parent post-blank at the ;; end of the list of subitems. (list (-snoc (org-ml--shift-last-post-blank parent-pb it-subitems) indented-target) 0 nil) ;; If rest present, append indented item tree to the end of rest. ;; Add the post-blank from parent to the end the last node in rest (cons (org-ml--shift-last-post-blank parent-pb it-rest) (org-ml-build-plain-list indented-target)) it)) it) plain-list)) (defun org-ml-plain-list-indent-item (index plain-list) "Return PLAIN-LIST node with child item at INDEX indented. Unlike `org-ml-item-indent-item-tree' this will not indent the indented item node's children." (org-ml--check-type 'plain-list plain-list) (org-ml--map-children-nocheck* (org-ml--tree-set-child* index ;; Get the target item (the one to be indented) and set its children ;; to nil. Assume that its subitems and anything after it (including the ;; post-blank) will not change. (-let* (((tgt-head tgt-subitems tgt-rest-pb tgt-rest) (org-ml--item-get-subcomponents it-target)) (indented-target (org-ml--item-set-subcomponents `(,tgt-head nil nil nil) it-target)) ;; NOTE: this is the post-blank of the *topmost* item in front of ;; the one to be indented. Any space after the the last subitem (if ;; any) are reflected in this (more to come below). (parent-pb (org-element-post-blank it))) (org-ml--item-map-subcomponents-cond* (list (org-ml--shift-last-post-blank parent-pb it-head) (cons indented-target tgt-subitems) 0 nil) ;; Otherwise, add the indented target and its children to the ;; subitems under the parent, and set the rest to be that of the ;; target (if anything). The only tricky part here is to most the ;; post-blank of the toplevel parent into the last subitem of the ;; parent (otherwise the post blank would move to the end of the ;; entire new list after indentation) (let ((psub (org-ml--shift-last-post-blank parent-pb it-subitems))) `((,@psub ,indented-target ,@tgt-subitems) 0 nil)) ;; If the parent has "extra stuff" underneath its subitems (ie ;; "rest") then we need to append the indented item after this "extra ;; stuff." Make a new list with the indented item and its children ;; (which will be at the same level after the target is indented) (let ((rest* (->> (cons indented-target tgt-subitems) (apply #'org-ml-build-plain-list :post-blank tgt-rest-pb) (cons it-rest)))) `(,@rest* ,@tgt-rest)) it)) it) plain-list)) ;;; unindentation (tree) ;; high level steps to unindent a tree ;; ;; Assume an abstract tree thing like this: ;; - 0. ;; - 1. ;; - 1.0. ;; - 1.1. ;; - 1.1.0. ;; - 1.2. ;; - 2. ;; ;; We want to unindent everything under 1. So just take all children of 1. and ;; splice them into the top-level list between 1. and 2. In this case 1.1.0 will ;; remain a child of 1.1 but it will be unindented as well because its parent is ;; being unindented ;; ;; parameters for unindenting a tree: ;; - the index whose children are to be unindented (defmacro org-ml--split-children-at-index* (index form tree) "Return TREE with node at INDEX split according to FORM. The node at INDEX will be bound to the symbol `it' which is to be referenced in FORM, and FORM is to return a list like (PARENT CHILDREN) where PARENT is the modified node at INDEX and CHILDREN is a list of nodes that were children under PARENT but are to be spliced after parent. The new TREE will effectively splice the CHILDREN nodes after PARENT at the same level as PARENT." (declare (indent 1) (debug (form form form))) (let ((head (make-symbol "head")) (tail (make-symbol "tail"))) `(-let* (((,head ,tail) (-split-at ,index ,tree)) (it (car ,tail)) ((parent children) ,form)) `(,@,head ,parent ,@children ,@(cdr ,tail))))) ;; headline (defun org-ml-headline-promote-all-subheadlines (index headline) "Return HEADLINE node with all child headlines under INDEX promoted." (org-ml-headline-map-subheadlines* (org-ml--split-children-at-index* index (let* ((children (->> (org-element-contents it) (--map (org-ml--headline-subtree-shift-level -1 it)))) (parent (org-ml--set-children-nocheck nil it)) (parent* (org-ml--headline-move-post-blank parent))) (list parent* children)) it) headline)) ;; plain-list (defun org-ml-plain-list-outdent-all-items (index plain-list) "Return PLAIN-LIST node with all child items under INDEX outdented." (org-ml--check-type 'plain-list plain-list) (org-ml--map-children-nocheck* (org-ml--split-children-at-index* index (-let* (((tgt-head tgt-subitems tgt-rest-pb tgt-rest) (org-ml--item-get-subcomponents it)) (parent-pb (or (org-element-post-blank (-last-item tgt-head)) 0)) (parent (->> (org-ml--item-set-subcomponents `(,tgt-head nil nil nil) it) (org-ml--set-post-blank parent-pb))) (outdent-pb (org-element-post-blank it)) (outdented (cond (tgt-rest (append (org-ml--shift-last-post-blank tgt-rest-pb tgt-subitems) (org-ml--shift-last-post-blank outdent-pb tgt-rest))) (tgt-subitems (org-ml--shift-last-post-blank outdent-pb tgt-subitems)) (t nil)))) `(,parent ,outdented)) it) plain-list)) ;;; unindentation (single target) ;; high level steps to unindent a single item ;; ;; Assume an abstract tree thing like this: ;; - 0. ;; - 1. ;; - 1.0. ;; - 1.1. ;; - 1.1.0. ;; - 1.2. ;; - 2. ;; ;; We want to unindent 1.1. First, indent everything after 1.1 (in this case ;; only 1.2, which will be appended to the list starting with 1.1.0). Then move ;; 1.1 (with 1.1.0 and 1.2 as children) between 1 and 2 in the toplevel list. ;; ;; parameters for unindenting: ;; - parent index (in this case 1 for 1.) ;; - child index (in this case 1 for 1.1) ;; headline ;; TODO trigger error when child-index is out of range (defun org-ml-headline-promote-subheadline (index child-index headline) "Return HEADLINE node with a child headline under INDEX promoted. The specific child headline to promote is selected by CHILD-INDEX." (org-ml-headline-map-subheadlines* (org-ml--split-children-at-index* index (-let* (((head tail) (-split-at child-index (org-element-contents it))) (target (->> (car tail) (org-ml-copy) (org-ml--headline-subtree-shift-level -1) (org-ml-headline-map-subheadlines* (append it (cdr tail))))) (parent (org-ml--set-children-nocheck head it))) (list parent (list target))) it) headline)) ;; plain-list (defun org-ml-plain-list-outdent-item (index child-index plain-list) "Return PLAIN-LIST node with a child item under INDEX outdented. The specific child item to outdent is selected by CHILD-INDEX." (org-ml--check-type 'plain-list plain-list) (org-ml--map-children-nocheck* (org-ml--split-children-at-index* index (-let* (((parent-head parent-subitems parent-rest-pb parent-rest) (org-ml--item-get-subcomponents it)) ((above-outdent (to-outdent . outdent-subitems)) (-split-at child-index parent-subitems)) (parent-pb (or (org-element-post-blank (-last-item above-outdent)) 0)) ;; Make new parent with the subitems that are above the item to ;; be outdented (if any) and remove its rest component since this ;; will become part of the outdented item's children (parent (->> (org-ml--set-post-blank parent-pb it) (org-ml--item-set-subcomponents `(,parent-head ,above-outdent 0 nil)))) (tgt-pb (org-element-post-blank to-outdent))) (if (not to-outdent) `(,parent nil) (let ((outdented (org-ml--item-map-subcomponents-cond* (list (org-ml--set-last-post-blank tgt-pb it-head) outdent-subitems 0 nil) (-> (org-ml--shift-last-post-blank tgt-pb it-subitems) (append outdent-subitems) (list 0 nil)) (let ((psub (apply #'org-ml-build-plain-list :post-blank parent-rest-pb outdent-subitems))) `(,@it-rest ,psub ,@parent-rest)) to-outdent))) `(,parent (,outdented))))) it) plain-list)) ;;; PRINTING FUNCTIONS ;; For the most part, printing a node only involves ;; `org-element-interpret-data', except this function has several limitations to ;; work around ;; - printing the string 'nil' where there should be a blank string ;; - printing the node when it should not be printed at all ;; - throwing an error when blank ;;; printing workaround functions (defun org-ml--set-blank-children (node) "Set the children of NODE to a blank string (\"\")." (org-ml--set-children-nocheck '("") node)) ;; Some objects and greater elements should be removed if blank. Table and plain ;; list will error, and the others make no sense if they are empty. (defconst org-ml--rm-if-empty '(table plain-list bold italic radio-target strike-through superscript subscript table-cell underline) "Nodes that will be blank if printed and empty. This is a workaround for a bug") ;; Some greater elements will print "nil" in their children if they are empty. ;; The workaround for this is to set the children to a single blank string if ;; empty (defconst org-ml--blank-if-empty '(center-block drawer dynamic-block property-drawer quote-block special-block table-cell verse-block) "Branch element nodes that require \"\" to correctly print empty. This is a workaround for a bug.") ;; TODO do I still need this in 9.7? (defun org-ml--blank (node) "Return NODE with empty child nodes `org-ml--blank-if-empty' set to contain \"\"." (if (not (org-element-contents node)) (cond ((org-ml--is-any-type org-ml--blank-if-empty node) (org-ml--set-blank-children node)) (t (unless (or (org-ml--is-any-type org-ml--rm-if-empty node) (org-ml--is-table-row node)) node))) (org-ml--map-children-nocheck* (remove nil (-map #'org-ml--blank it)) node))) ;;; print functions (defun org-ml-to-string (node) "Return NODE as an interpreted string without text properties." (cond ((null node) "") ((org-ml--is-node node) (let ((s (->> (org-ml--blank node) (org-element-interpret-data) (substring-no-properties)))) (if (not (org-ml--is-type 'section node)) s ;; TODO this is a bug in 9.7; sections now don't carry a post-blank ;; property, and instead assume that the post-blank is encoded in the ;; underlying contents. Unfortunately, `org-element-interpret-data' will ;; normalize the underlying contents (as a string) to only have one ;; newline regardless of post-blank. This workaround will manually add ;; the newlines back in the case of section nodes (let ((pb (->> (org-element-contents node) (-last-item) (org-element-post-blank)))) (concat s (make-string pb ?\n)))))) (t (org-ml--arg-error "Can only stringify node or nil, got %s" node)))) (defun org-ml-to-trimmed-string (node) "Like `org-ml-to-string' but strip whitespace when returning NODE." (-some->> (org-ml-to-string node) (s-trim))) ;;; inverse printing functions (defun org-ml-from-string (type string) "Convert STRING to a node. TYPE is the node type intended by STRING; if STRING cannot be parsed into TYPE this function will return nil." (cl-flet* ((string-to-post-blank (s) (-let (((b . e) (car (s-matched-positions-all "\n+$" s)))) (if (not (and b e)) 0 (let ((d (- e b))) (if (= 1 d) 0 d))))) (shift-property (prop n node) (org-ml--map-property-raw* prop (+ n it) node)) (shift-property-maybe (prop n node) (org-ml--map-property-raw* prop (when it (+ n it)) node)) (shift-object-node (n node) (->> (shift-property :begin n node) (shift-property :end n))) (shift-branch-object-node (n node) (->> (shift-object-node n node) (shift-property-maybe :contents-begin n) (shift-property-maybe :contents-end n))) (shift-element-node (n node) (->> (shift-object-node n node) (shift-property :post-affiliated n))) (shift-branch-element-node (n node) (->> (shift-element-node n node) (shift-property-maybe :contents-begin n) (shift-property-maybe :contents-end n))) (shift-property-node (prop n node) (org-ml--map-property-raw* prop (-some->> it (shift-object-node n)) node)) (decrement-object-node (node) (if (org-ml-is-branch-node node) (shift-branch-object-node -1 node) (shift-object-node -1 node))) (decrement-node (node) (if (org-ml-is-element node) (if (org-ml-is-branch-node node) (shift-branch-element-node -1 node) (shift-element-node -1 node)) (decrement-object-node node))) (remove-leading-space-maybe (node) (org-ml--map-children-nocheck* (org-ml--map-first* (if (org-ml--is-type 'paragraph it) (org-ml--map-children-nocheck* (if (equal (car it) " ") (cdr it) (org-ml--map-first* (substring it 1) it)) it)) it) node)) (from-prefixed-string (prefix level string) (-if-let (x (->> (concat prefix string) (org-ml--from-string) (org-ml--get-descendent level))) (->> (shift-branch-object-node -1 x) (org-ml-match-map '((:not plain-text) *) #'decrement-object-node))))) (-some->> (cond ((eq type 'paragraph) (let* ((pb (string-to-post-blank string)) (e (1+ (length string))) (ce (- e pb))) (-> (org-ml-build-paragraph! string :post-blank pb) (org-ml--set-properties-raw :begin 1 :contents-begin 1 :end e :contents-end ce)))) ((and (eq type 'section) (s-matches-p "^\\*" string)) (->> (concat " " string) (org-ml--from-string) (remove-leading-space-maybe) (shift-property :end -1) (shift-property-maybe :contents-end -1) (org-ml-match-map '((:and 0 (:not plain-text)) *) (lambda (node) (->> (if (not (org-ml-is-branch-node node)) node (shift-property :contents-end -1 node)) (shift-property :end -1)))) (org-ml-match-map '((:and (> 0) (:not plain-text)) *) #'decrement-node))) ((eq type 'node-property) (let* ((pb (string-to-post-blank string)) (e (1+ (- (length string) pb)))) (-if-let (x (->> (format "* dummy\n:PROPERTIES:\n%s\n:END:" string) (org-ml--from-string) (org-ml--get-descendent '(0 0 0)))) (org-ml--set-properties-raw x :post-affiliated 1 :begin 1 :post-blank pb :end e)))) ((eq type 'property-drawer) (-if-let (x (->> (concat "* dummy\n" string) (org-ml--from-string) (org-ml--get-descendent '(0 0)))) (->> (shift-branch-element-node -8 x) (org-ml--map-children-nocheck* (--map (shift-element-node -8 it) it))))) ((eq type 'planning) (-if-let (x (->> (concat "* dummy\n" string) (org-ml--from-string) (org-ml--get-descendent '(0 0)))) (->> (shift-element-node -8 x) (shift-property-node :scheduled -8) (shift-property-node :deadline -8) (shift-property-node :closed -8)))) ((eq type 'bold) (from-prefixed-string " " '(0 1) string)) ((memq type '(superscript subscript)) (from-prefixed-string "s" '(0 1) string)) ((eq type 'table-cell) (from-prefixed-string "|" '(0 0 0) string)) (t (let ((level (cond ((eq type 'headline) nil) ((eq type 'section) nil) ((eq type 'item) '(0 0)) ((eq type 'table-row) '(0 0)) ((memq type org-ml-objects) '(0 0)) (t '(0))))) (->> (org-ml--from-string string) (org-ml--get-descendent level))))) (org-element-put-property-2 :parent nil)))) ;;; PATTERN MATCHING ;; This is a framework for applying "pattern matching" on node trees. All these ;; functions search through the node tree and return (and sometimes operate on) ;; a list of matches much like the UNIX find function for searching filesystems. ;; Patterns are composed of the following parts: ;; conditions - match a node based on its type, properties, and index ;; wildcards - keywords that match one of more nodes regardless of type, ;; properties, and index ;; slicers - keywords with arguments that limit the returned match list to a ;; subset all matches (such as first match or 2nd - 5th matches) ;; ;; Of the above, only conditions are required in the pattern ;; When a pattern is fed into any of the match functions, it will first be ;; 'compiled' into a lambda function that will walk through the node tree and ;; accumulate/return the results the pattern requests. All possible functions ;; operate on the same data structure which is a list of children in the tree at ;; each level with the indices cons'ed to them like ((L . R) . CHILD) where L is ;; the left index and R is the right index (starting from -1 and counting down ;; to the left given a list of children in a node). The right index is necessary ;; for negative index matching. ;; This data structure ensures that any child has the information necessary for ;; a condition form to determine if a match is successful (if this data ;; structure wasn't used, index matching would fail as it would require ;; knowledge of the entire list when the match is made) ;; For slicers, two tricks are used to ensure that work is minimized. The first ;; is that searches are limited to the maximum number of matches needed. If only ;; the first match is needed, the search will stop after one match. If the 2nd ;; to 5th matches are needed, the search will stop after 5 matches and return ;; this with the first match dropped. The second trick is that the search is ;; reversed if the slicer requests negatively indexed results. If the last match ;; is needed, reverse the tree and return the first result. These tricks are ;; possible/easier with the indexed-children data structure described above as ;; it ensures that indexing information is preserved even when the children are ;; reversed, and ensures that matching can be made on one child node at a time, ;; which guarantees the limit will never be overshot. (defmacro org-ml--map-indexed (reverse? form list) "Like `--map-indexed' but can be told to reverse the result. If REVERSE? is t, the final results are reversed (which actually means not reversed since the results are made in reverse order). FORM and LIST carry the same meaning." (declare (indent 1)) (let* ((r (make-symbol "result")) (return (if reverse? r `(nreverse ,r)))) `(let (,r) (--each ,list (!cons ,form ,r)) ,return))) (defmacro org-ml--get-children-indexed (reverse? node) "Return list of children from NODE (if any) with index annotations. If REVERSE is t, reverse the final result." `(let* ((children (org-element-contents ,node)) (len (- (length children)))) (org-ml--map-indexed ,reverse? (cons `(,it-index . ,(+ len it-index)) it) children))) (defmacro org-ml--reduce-from-while (pred form initial-value list) "Like `--reduce-from' but only reduce LIST while PRED is t. FORM and INITIAL-VALUE work the same way, and the exposed symbols `it' and `acc' carry the same meaning." (declare (debug (form form form form))) `(let ((acc ,initial-value)) (--each-while ,list ,pred (setq acc ,form)) acc)) (defun org-ml--match-make-condition-form (condition) "Return a Lisp form equivalent to CONDITION. Assume that `it' is a symbol bound to a list of the form \((INDEX RINDEX) . NODE) where NODE is the node being matched to CONDITION, INDEX is the INDEX of NODE, and RINDEX is the right-index of NODE (starting at -1 on the rightmost side of the children list)." ;; initialize some 'accessor' forms (let ((it-node '(cdr it)) (it-lindex '(caar it)) (it-rindex '(cdar it))) (pcase condition ;; ;; condition should not be nil (`nil (org-ml--arg-error "Condition cannot be nil")) ;; ;; quote is invalid (may be accidentally in condition) (`(quote . ,_) (org-ml--arg-error "'quote' not allowed in condition")) ;; ;; function is invalid (may be accidentally in condition) (`(function . ,_) (org-ml--arg-error "'function' not allowed in condition")) ;; ;; literal node ((and (pred org-ml--is-node) pattern-node) `(equal ,it-node ',pattern-node)) ;; ;; type ((and (pred (lambda (y) (memq y org-ml-nodes))) type) `(org-ml-is-type ',type ,it-node)) ;; ;; index ((and (pred integerp) index) `(= ,index ,(if (< index 0) it-rindex it-lindex))) ;; ;; relative index (`(,(and (or '< '<= '> '>=) op) ,(and (pred integerp) index)) `(funcall #',op ,(if (< index 0) it-rindex it-lindex) ,index)) ;; ;; predicate (`(:pred . (,pred . nil)) `(funcall #',pred ,it-node)) ;; ;; not (`(:not . (,p . nil)) `(not ,(org-ml--match-make-condition-form p))) ;; ;; and (`(:and . ,(and (pred and) p)) `(and ,@(-map #'org-ml--match-make-condition-form p))) ;; ;; or (`(:or . ,(and (pred and) p)) `(or ,@(-map #'org-ml--match-make-condition-form p))) ;; ;; property ;; NOTE: this must go last if we don't want :pred/:and/:or/:not ;; to be interpreted as a property (`(,(and (pred keywordp) prop) . (,val . nil)) `(equal (org-ml-get-property ,prop ,it-node) ,val)) ;; ;; :any (:any t) ;; (p (org-ml--arg-error "Invalid condition: %s" p))))) (defun org-ml--match-pattern-make-inner-form (end? limit pattern) "Return matching form for PATTERN. END? is a boolean describing if the search should be made in reverse. If t, reverse all children when obtaining from any given node. LIMIT is an integer or nil describing the number of matches at which the search should terminate. If nil, don't perform any checks and terminate only when the entire tree is searched within PATTERN." (let* ((accum '(cons (cdr it) acc)) (get-children `(org-ml--get-children-indexed ,end? (cdr it))) (reduce (if (not limit) '(--reduce-from) `(org-ml--reduce-from-while (< (length acc) ,limit))))) (pcase pattern ;; slicers should not be here (`(,(or :first :last :nth :slice) . ,_) (org-ml--arg-error "Slicers can only appear at the front of pattern")) ;; empty pattern - add current node to accumulator as-is ('nil accum) ;; * - if condition0 and condition1 match, add node to accumulator and ;; descend into child to repeat, if only condition0 matches just descend ;; into child and continue (`(,condition . (* . nil)) (let* ((pred (org-ml--match-make-condition-form condition)) ;; need to explicitly check limit here because not in reduce form ;; where limit is build in, this doesn't conform to the pattern of ;; the rest of this function (add-maybe (if limit `(if (< (length acc) ,limit) ,accum acc) accum)) (add-descend (if (not end?) `(get-many ,add-maybe ,get-children) `(let ((acc (get-many acc ,get-children))) ,add-maybe)))) `(cl-labels ((get-many (acc children) (,@reduce (if ,pred ,add-descend acc) acc children))) (let ((acc ,accum)) (get-many acc ,get-children))))) (`(,condition0 . (* . ,ps)) (let* ((condition1 (car ps)) (ps (cdr ps)) (pred0 (org-ml--match-make-condition-form condition0)) (pred1 (org-ml--match-make-condition-form condition1)) (inner (if (not ps) accum (org-ml--match-pattern-make-inner-form end? limit ps))) ;; need to explicitly check limit here because not in reduce form ;; where limit is build in, this doesn't conform to the pattern of ;; the rest of this function (add-maybe (if (not limit) `(if ,pred1 ,inner acc) `(if (and (< (length acc) ,limit) ,pred1) ,inner acc))) (add-descend (if end? `(let ((acc (get-many acc ,get-children))) ,add-maybe) `(get-many ,add-maybe ,get-children)))) `(cl-labels ((get-many (acc children) (,@reduce (cond (,pred0 ,add-descend) (,pred1 ,inner) (t acc)) acc children))) (get-many acc ,get-children)))) ;; condition - descend into the children of matching nodes and either ;; continue searching or add to accumulator if no more conditions to ;; match (`(,condition . ,ps) (let ((pred (org-ml--match-make-condition-form condition)) (inner (if (not ps) accum (org-ml--match-pattern-make-inner-form end? limit ps)))) `(,@reduce (if ,pred ,inner acc) acc ,get-children))) ;; (ps (org-ml--arg-error "Invalid pattern: %s" ps))))) (defun org-ml--match-is-alternate-form (form) "Return t if FORM is an alternative pattern form (eg has `|`s)." (and (listp form) (memq '| form))) (defun org-ml--match-pattern-expand-alternations (pattern) "Convert PATTERN with alternations to a list of patterns. Eg given (a (b | c)), return ((a b) (a c)). This will act recursively on nested alternations. The returned list will be deduplicated." (cl-flet ((add-subpattern (acc p) (if (org-ml--match-is-alternate-form p) (let ((p* (->> (-split-on '| p) (-replace '(nil) nil) (-mapcat #'org-ml--match-pattern-expand-alternations)))) (-mapcat (lambda (a) (--map (append a it) p*)) acc)) (--map (append it (list p)) acc)))) (-uniq (-reduce-from #'add-subpattern '(()) pattern)))) (defun org-ml--match-pattern-process-alternations (end? limit alt-patterns) "Convert ALT-PATTERNS to a matching form. ALT-PATTERNS is a list of patterns created from expanded alternations in the original pattern. See `org-ml--match-pattern-make-inner-form' for the meaning of END? and LIMIT." (->> (if end? alt-patterns (reverse alt-patterns)) (--map (org-ml--match-pattern-make-inner-form end? limit it)) ;; use nested let statements to keep track of accumulator ;; note the comma usage to make this extra confusing :) (--reduce `(let ((acc ,it)) ,acc)))) (defun org-ml--match-pattern-simplify-wildcards (pattern) "Return PATTERN with wildcards replaced by simpler syntax. Specifically, this means brackets, `\\?`, `+` wildcards will be put in terms of explicit conditions, alternative branches, and `*` wildcards." (cl-flet* ((append-n (acc n) (append (-repeat (1- n) (car acc)) acc)) (append-m-n (acc m n) (--> (-repeat n (car acc)) (-reductions-from (lambda (a b) (cons b a)) nil it) (-drop m it) (-interpose '(|) it) (if (= m 0) (cons '(nil) it) it) (-flatten-n 1 it) (cons it (cdr acc)))) (expand (acc sym) (pcase sym ;; match X at least once ;; (X +) -> (X X *) ('+ (append (list '* (car acc)) acc)) ;; match X 0 or 1 times ;; (X \?) -> ((nil | X)) ('\? (cons (list nil '| (car acc)) (cdr acc))) ;; match X N times ;; (X [N]) -> (X1 X2 ... XN) (`[,(and (pred integerp) n)] (if (< 0 n) (append-n acc n) (org-ml--arg-error "In [N], N must be > 0: got %s" n))) ;; match X at least M times ;; (X [M nil]) -> (X1 X2 ... XN X *) ;; (X [M !]) -> (X1 X2 ... XN X *!) (`[,(and (pred integerp) m) ,(and (pred (lambda (x) (or (null x) (eq '! x)))) n)] (let ((wc (if (eq n '!) '*! '*))) (if (< 0 m) (append (cons wc (-repeat m (car acc))) acc) (org-ml--arg-error "In [M nil] M must be positive; got %s" m)))) ;; match X M to N times (inclusive) ;; (X [M N]) -> (XM XM+1 ... XN-1 XN) (`[,(and (pred integerp) m) ,(and (pred integerp) n)] (cond ;; if they are equal and greater than 0, same as [N] ((= 0 m n) (org-ml--arg-error "Both in [M N] cannot be zero")) ((and (< 0 m) (< 0 n) (= m n)) (append-n acc n)) ((or (< m 0) (< n 0)) (org-ml--arg-error "Both in [M N] must be positive: got %s and %s" m n)) ((< n m) (org-ml--arg-error "In [M N], M must be <= N: got %s and %s" m n)) (t (append-m-n acc m n)))) ;; all else (s (cons s acc))))) (reverse (-reduce-from #'expand nil pattern)))) (defun org-ml--match-make-pattern-form (end? limit pattern) "Return non-slicer matching form for PATTERN. See `org-ml--match-pattern-make-inner-form' for meaning of END? and LIMIT which are passed directly through this function. NODE is the target node to be matched" (let ((body (->> (org-ml--match-pattern-simplify-wildcards pattern) (org-ml--match-pattern-expand-alternations) (org-ml--match-pattern-process-alternations end? limit)))) ;; NOTE: the accumulator is assembled in reverse due to the nature of linked ;; lists. Consing to the front is a linear operation, while appending to the ;; back is a quadratic operation since the list needs to be fully traversed ;; with each append and the list is growing. This means that the list is ;; reversed here if `END?' is nil (which means we want the list in ;; forward-order) and left in reverse order if `END?' is t (meaning backward ;; order) (if end? body `(nreverse ,body)))) (defun org-ml--match-make-slicer-form (pattern) "Return matching form with slicer operations for PATTERN. NODE is the node to be matched." (pcase pattern ;; :first - search until one match found and return that (`(:first . ,ps) (org-ml--match-make-pattern-form nil 1 ps)) ;; ;; :last - search backwards until one match found and return that (`(:last . ,ps) (org-ml--match-make-pattern-form t 1 ps)) ;; ;; :nth - search until N matches found and return Nth; note that nil will be ;; returned if N refers to anything outside the results list (`(:nth . (,n . ,ps)) (unless (integerp n) (org-ml--arg-error ":nth argument must be an integer")) (if (<= 0 n) `(-drop ,n ,(org-ml--match-make-pattern-form nil (1+ n) ps)) `(-drop-last ,(1- (- n)) ,(org-ml--match-make-pattern-form t (- n) ps)))) ;; ;; :sub - search until B matches found, drop A+1, and return; note that if B ;; is longer than the results then all results will be dropped and nil ;; will be ultimately returned (`(:sub . (,a . (,b . ,ps))) (cond ((not (and (integerp a) (integerp b))) (org-ml--arg-error ":sub arguments must be an integers")) ((> a b) (org-ml--arg-error ":sub left index must be less than right index")) ((and (<= 0 a) (<= 0 b)) `(-drop ,a ,(org-ml--match-make-pattern-form nil (1+ b) ps))) ((and (< a 0) (< b 0)) `(-drop-last ,(1- (- b)) ,(org-ml--match-make-pattern-form t (- a) ps))) (t (org-ml--arg-error "Both indices must be on the same side of zero")))) ;; ;; no slicer - search without limit and return all (ps (org-ml--match-make-pattern-form nil nil ps)))) (defvar org-ml--match-form-cache (make-hash-table :test #'equal) "Cache of previously generated lambda forms.") (defun org-ml-clear-match-cache () "Clear the pattern cache for `org-ml-match' and friends. See `org-ml-memoize-match-patterns' for details." (interactive) (clrhash org-ml--match-form-cache)) (defun org-ml--match-make-lambda-form-nocache (pattern) "Return callable lambda form for PATTERN. NODE is the node to be matched." (let ((body (org-ml--match-make-slicer-form pattern))) `(lambda (it) (let ((it (cons nil it)) (acc)) ,body)))) (defun org-ml--match-make-lambda-form (pattern) "Run memoized version of `org-ml--match-make-lambda-form-nocache'. PATTERN has the same meaning." (if org-ml-memoize-match-patterns (or (gethash pattern org-ml--match-form-cache) (let ((form (--> (org-ml--match-make-lambda-form-nocache pattern) (if (eq 'compiled org-ml-memoize-match-patterns) (byte-compile it) it)))) (puthash pattern form org-ml--match-form-cache) form)) (org-ml--match-make-lambda-form-nocache pattern))) ;;; match (defun org-ml-match (pattern node) "Return a list of child nodes matching PATTERN in NODE. PATTERN is a list like ([SLICER [X] [Y]] [SUB1 ...]). SLICER is an optional prefix to the pattern describing how many and which matches to return. If not given, all matches are returned. Possible values are: - `:first' - return the first match - `:last' - return the last match - `:nth' X - return the nth match where X is an integer denoting the index to return (starting at 0). X may be a negative number to start counting at the end of the match list, in which case -1 is the last index. Using 0 and -1 for X is equivalent to using `:first' and `:last' respectively - `:sub' X Y - return a sublist between indices X and Y. X may not be greater than Y, and both must either be non-negative integers or negative integers. In the case of negative integers, the indices refer to the same counterparts as described in `:nth'. If X and Y are equal, this slicer has the same behavior as `:nth'. SUBX denotes subpatterns that that match nodes in the parse tree. Subpatterns may either be wildcards or conditions. Conditions match exactly one level of the node tree being searched based on the node's type (the symbol returned by `org-ml-get-type'), properties (the value returned by `org-ml-get-property' for a valid property keyword), and index (the position of the node in the list returned by `org-ml-get-children'). For index, both left indices (where zero refers to the left end of the list) and right indices (where -1 refers to the right end of the list) are understood. Conditions may either be atomic or compound, where compound conditions are themselves composed of atomic or compound conditions. The types of atomic conditions are: - TYPE - match when the node's type is `eq' to TYPE (a symbol) - INDEX - match when the node's index is `=' to INDEX (an integer) - (OP INDEX) - match when (OP NODE-INDEX INDEX) returns t. OP is one of `<', `>', `<=', or `>=' and NODE-INDEX is the index of the node being evaluated - (PROP VAL) - match nodes whose property PROP (a keyword) is `equal' to VAL; VAL is obtained by evaluating `org-ml-get-property' with PROP and the current node; if PROP is invalid, an error will be thrown - (:pred PRED) - match when PRED evaluates to t; PRED is a symbol for a unary function that takes the current node as its argument Compound conditions start with an operator followed by their component conditions. The types of compound conditions are: - (:and C1 C2 [C3 ...]) - match when all `C' are true - (:or C1 C2 [C3 ...]) - match when at least one `C' is true - (:not C) - match when `C' is not true In addition, SUBX may be a wildcard keyword or symbol. These are analogous to the special characters found in POSIX extended regular expression syntax. Specifically, `[' and `]' correspond to `{' and `}' respectively and `:any' corresponds to the `.' operator. All other characters have the same meaning between this function and POSIX extended regular expressions.: - `:any' - always match exactly one node - SUB `?' - match SUB zero or once - SUB `*' - match SUB zero or more times - SUB `+' - match SUB one or more times - SUB [N] - match SUB N times - SUB [M N] - match SUB M to N times (inclusive); if M or N is nil, this will match \"at most N times\" or \"at least M times\" respectively - (ALT-A1 [ALT-A2 ...] | ALT-B1 [ALT-B2 ...] [| ...]) - match any of the ALT expressions separated by `|' where ALT is a list of subpatterns as described above or nil to match nothing; these expressions may be nested If PATTERN is nil, return NODE. Likewise, if any wildcard patterns match the nil pattern, also return NODE along with anything else the wildcard matches. Examples of this would be (SUB *), (SUB ?), and ((nil | SUB)). For increased performance, this function (and all others that consume a PATTERN parameter) can be memoized using `org-ml-memoize-match-patterns'. If nil, PATTERN is processed into a lambda form for every function call. If t, the resulting lambda forms are cached for each unique PATTERN, running generation step only once if multiple instances of the same PATTERN are used. Note that `org-ml-memoize-match-patterns' is shared between all functions that consume a PATTERN parameter." (let ((match-fun (org-ml--match-make-lambda-form pattern))) (funcall match-fun node))) ;;; generalized tree modification ;; this macro provides the means of using a list of matches returned from ;; `org-ml--match' for other operations that use the match list as targets for ;; modifying the original tree (eval-when-compile (defmacro org-ml--modify-children (node form) "Recursively modify the children of NODE using FORM. FORM returns a list of element or object nodes as the new children, and the variable `it' is bound to the original children." (declare (debug (form def-form)) (indent 1)) ;; TODO this makes a closure `(cl-labels ((rec (node) (if (not (org-ml-is-branch-node node)) node (org-ml-map-children* (let ((it (--map (rec it) it))) ,form) node)))) (rec ,node)))) ;;; delete (defun org-ml--delete-targets (node targets) "Return NODE without children in TARGETS (a list of nodes)." (org-ml--modify-children node (--remove (member it targets) it))) (defun org-ml-match-delete (pattern node) "Return NODE without children matching PATTERN. PATTERN follows the same rules as `org-ml-match'." (-if-let (targets (org-ml-match pattern node)) (org-ml--delete-targets node targets) node)) ;;; extract (defun org-ml-match-extract (pattern node) "Remove nodes matching PATTERN from NODE. Return cons cell where the car is a list of all removed nodes and the cdr is the modified NODE. PATTERN follows the same rules as `org-ml-match'." (-if-let (targets (org-ml-match pattern node)) (cons targets (org-ml--delete-targets node targets)) node)) ;;; map (org-ml--defun-anaphoric* org-ml-match-map (pattern fun node) "Return NODE with FUN applied to children matching PATTERN. FUN is a unary function that takes a node and returns a new node which will replace the original. PATTERN follows the same rules as `org-ml-match'." (-if-let (targets (org-ml-match pattern node)) (org-ml--modify-children node (--map-when (member it targets) (funcall fun it) it)) node)) ;;; mapcat (org-ml--defun-anaphoric* org-ml-match-mapcat (pattern fun node) "Return NODE with FUN applied to children matching PATTERN. FUN is a unary function that takes a node and returns a list of new nodes which will be spliced in place of the original node. PATTERN follows the same rules as `org-ml-match'." (-if-let (targets (org-ml-match pattern node)) (org-ml--modify-children node (--mapcat (if (member it targets) (funcall fun it) (list it)) it)) node)) ;;; replace (defun org-ml-match-replace (pattern node* node) "Return NODE with NODE* in place of children matching PATTERN. PATTERN follows the same rules as `org-ml-match'." (declare (indent 1)) (-if-let (targets (org-ml-match pattern node)) (org-ml--modify-children node (--map-when (member it targets) node* it)) node)) ;;; insert-before (defun org-ml-match-insert-before (pattern node* node) "Return NODE with NODE* inserted before children matching PATTERN. PATTERN follows the same rules as `org-ml-match'." (declare (indent 1)) (-if-let (targets (org-ml-match pattern node)) (org-ml--modify-children node (--mapcat (if (member it targets) (list node* it) (list it)) it)) node)) ;;; insert-after (defun org-ml-match-insert-after (pattern node* node) "Return NODE with NODE* inserted after children matching PATTERN. PATTERN follows the same rules as `org-ml-match'." (declare (indent 1)) (-if-let (targets (org-ml-match pattern node)) (org-ml--modify-children node (--mapcat (if (member it targets) (list it node*) (list it)) it)) node)) ;;; insert-within (defun org-ml-match-insert-within (pattern index node* node) "Return NODE with NODE* inserted at INDEX in children matching PATTERN. PATTERN follows the same rules as `org-ml-match' with the exception that PATTERN may be nil. In this case NODE* will be inserted at INDEX in the immediate, top level children of NODE." (declare (indent 2)) (if pattern (-if-let (targets (org-ml-match pattern node)) (org-ml--modify-children node (--map-when (member it targets) (org-ml-map-children* (org-ml--insert-at index node* it t) it) it)) node) (org-ml-map-children* (org-ml--insert-at index node* it t) node))) ;;; splice (defun org-ml-match-splice (pattern nodes* node) "Return NODE with NODES* spliced in place of children matching PATTERN. NODES* is a list of nodes. PATTERN follows the same rules as `org-ml-match'." (declare (indent 1)) (-if-let (targets (org-ml-match pattern node)) (org-ml--modify-children node (--mapcat (if (member it targets) nodes* (list it)) it)) node)) ;;; splice-before (defun org-ml-match-splice-before (pattern nodes* node) "Return NODE with NODES* spliced before children matching PATTERN. NODES* is a list of nodes. PATTERN follows the same rules as `org-ml-match'." (declare (indent 1)) (-if-let (targets (org-ml-match pattern node)) (org-ml--modify-children node (--mapcat (if (member it targets) (append nodes* (list it)) (list it)) it)) node)) ;;; splice-after (defun org-ml-match-splice-after (pattern nodes* node) "Return NODE with NODES* spliced after children matching PATTERN. NODES* is a list of nodes. PATTERN follows the same rules as `org-ml-match'." (declare (indent 1)) (-if-let (targets (org-ml-match pattern node)) (org-ml--modify-children node (--mapcat (if (member it targets) (cons it nodes*) (list it)) it)) node)) ;;; splice-within (defun org-ml-match-splice-within (pattern index nodes* node) "Return NODE with NODES* spliced at INDEX in children matching PATTERN. NODES* is a list of nodes. PATTERN follows the same rules as `org-ml-match' with the exception that PATTERN may be nil. In this case NODES* will be inserted at INDEX in the immediate, top level children of NODE." (declare (indent 2)) (if pattern (-if-let (targets (org-ml-match pattern node)) (org-ml--modify-children node (--map-when (member it targets) (org-ml-map-children* (org-ml--splice-at index nodes* it t) it) it)) node) (org-ml-map-children* (org-ml--splice-at index nodes* it t) node))) ;;; side-effects (defun org-ml-match-do (pattern fun node) "Like `org-ml-match-map' but for side effects only. FUN is a unary function that has side effects and is applied to the matches from NODE using PATTERN. This function itself returns nil. PATTERN follows the same rules as `org-ml-match'." (-when-let (targets (org-ml-match pattern node)) (--each targets (funcall fun it)))) ;; anaphoric form doesn't work here for some reason (defmacro org-ml-match-do* (pattern form node) "Anaphoric form of `org-ml-match-do'. Like `org-ml-match-map' but for side effects only. FORM is a unary form that has side effects and is applied to the matches from NODE using PATTERN. This form itself returns nil. PATTERN follows the same rules as `org-ml-match'." (let ((n (make-symbol "--n"))) `(let ((,n ,node)) (-when-let (targets (org-ml-match ,pattern ,n)) (--each targets ,form))))) ;;; BUFFER PARSING ;;; org-element--parse-elements wrapper (defun org-ml--parse-elements (beg end mode) "Call `org-element--parse-elements' and unpack the result. BEG, END and MODE are passed to `org-element--parse-elements'." ;; NOTE: A subject to review if something breaks eventually with another Org ;; update. ;; ;; HACK: In future versions of Org as of commit fc80d052d, the last ;; argument to `org-element--parse-elemnts' may not be nil. We create a ;; dummy list, pass it to the function and unpack the result. (cddr (org-element--parse-elements beg end mode nil nil nil (list 'org-data nil)))) ;;; parse at specific point (defun org-ml--parse-objects (type begin end) "Return a parsed object defined in the buffer by BEGIN and END. TYPE is the type of the node to be parsed." (if (eq type 'link) ;; NOTE these two variables will change the parsed link representation in ;; an irreversible and non-obvious way, thus set them to nil (which means ;; that parsing and then printing will compose to the identity) (let ((org-link-abbrev-alist nil) (org-link-translation-function nil)) (org-ml--parse-elements begin end 'first-section)) (org-ml--parse-elements begin end 'first-section))) ;; TODO add test for plain-text parsing (defun org-ml-parse-object-at (point) "Return object node under POINT or nil if not on an object." (save-excursion (goto-char point) (-let* ((context (org-element-context)) (type (org-ml-get-type context)) ((offset nesting) (pcase type ((or `superscript `subscript) '(-1 (0 1))) (`table-cell '(-1 (0 0 0))) (_ '(0 (0 0))))) (begin (org-element-begin context)) (end (org-element-end context)) (tree (org-ml--parse-objects type (+ begin offset) end))) (->> (car tree) (org-ml--get-descendent nesting) (org-ml--filter-types org-ml-objects))))) ;; TODO this seems really inefficient; essentially we are parsing twice and ;; there is probably a better way to do this with the new API (defun org-ml--parse-element-at (point type) "Return element node immediately under POINT. For a list of all possible return types refer to `org-ml-elements'; this will return everything in this list except `section' which is ambiguous when referring to a single point. \(see `org-ml-parse-section-at'). If TYPE is non-nil, only return nil if the object under point is not of that type. TYPE is a symbol from `org-ml-elements'. Furthermore, setting TYPE to `table-row' will prefer table-row elements over table elements and likewise when setting TYPE to `item' for plain-list elements vs item elements." (save-excursion (goto-char point) (let* ((node (org-element-at-point)) (node-type (org-ml-get-type node))) ;; NOTE this will not filter by type if it is a leaf node (if (not (memq node-type org-ml-branch-nodes)) node ;; need to parse again if branch-node since ;; `org-element-at-point' does not parse children (-let* ((begin (org-element-begin node)) (end (org-element-end node)) (contents-end (org-element-contents-end node)) (tree (car (org-ml--parse-elements begin end 'first-section))) (nesting (pcase node-type (`headline nil) ;; `org-element-at-point' will return a table if on ;; the first row of a table, and a table-row ;; otherwise (`table-row '(0 0)) (`table (if (eq type 'table-row) '(0 0) '(0))) (`plain-list (if (eq type 'item) '(0 0) '(0))) (`item '(0 0)) (_ '(0)))) (node* (->> (org-ml--get-descendent nesting tree) ;; set ending boundaries according to what we get ;; from `org-element-at-point' (org-element-put-property-2 :end end) (org-element-put-property-2 :contents-end contents-end)))) ;; some elements will always have post-blank set to 0, so no need to ;; update it (--> (if (memq node-type '(section table-row)) node* (let ((pb (org-element-post-blank node))) (org-ml--set-post-blank pb node*))) (if type (org-ml--filter-type type it) it))))))) (defun org-ml-parse-element-at (point) "Return element node under POINT or nil if not on an element. This function will return every element available in `org-ml-elements' with the exception of `section', `item', and `table-row'. To specifically parse these, use the functions `org-ml-parse-section-at', `org-ml-parse-item-at', and `org-ml-parse-table-row-at'." (org-ml--parse-element-at point nil)) (defun org-ml-parse-table-row-at (point) "Return table-row node under POINT or nil if not on a table-row." (save-excursion (goto-char point) (beginning-of-line) (org-ml--parse-element-at (point) 'table-row))) (defun org-ml-parse-item-at (point) "Return item node under POINT or nil if not on an item. This will return the item node even if POINT is not at the beginning of the line." ;; TODO this doesn't work if not on the first item (save-excursion (goto-char point) (beginning-of-line) (org-ml--parse-element-at (point) 'item))) (defun org-ml--parse-headline-subtree-at (point subtree) "Return headline node under POINT in the current buffer. POINT may be anywhere between the points given by `org-back-to-heading' and `org-end-of-subtree'; it does not matter if the node immediately under POINT is not a headline. If SUBTREE is t, parse the entire subtree, else just parse the top headline." (save-excursion (goto-char point) (when (ignore-errors (org-back-to-heading t)) (let* ((b (point)) (e (if subtree (progn (org-end-of-subtree) ;; skip ahead to the next headline because ;; `org-end-of-subtree' does not by default, which misses ;; any spacing after headlines (or (outline-next-heading) (point-max))) (or (outline-next-heading) (point-max)))) (tree (car (org-ml--parse-elements b e 'first-section)))) ;; TODO this is a hack; since org 9.6 setting the boundaries at the next ;; headline will not stop the parser from parsing the entire subtree, ;; even if we don't want it. Workaround is to parse the entire subtree ;; and possibly throw away most of it (if subtree tree (let ((cs (org-element-contents tree))) (if (< 1 (length cs)) (org-ml-set-children (list (car cs)) tree) tree))))))) (defun org-ml-parse-headline-at (point) "Return headline node under POINT or nil if not on a headline. POINT does not need to be on the headline itself. Only the headline and its section will be returned. To include subheadlines, use `org-ml-parse-subtree-at'." (org-ml--parse-headline-subtree-at point nil)) (defun org-ml-parse-subtree-at (point) "Return headline node under POINT or nil if not on a headline. POINT does not need to be on the headline itself. Unlike `org-ml-parse-headline-at', the returned node will include child headlines." (org-ml--parse-headline-subtree-at point t)) (defun org-ml-parse-section-at (point) "Return section node under POINT or nil if not on a section. If POINT is on or within a headline, return the section under that headline. If POINT is before the first headline (if any), return the section at the top of the org buffer." (save-excursion (goto-char point) (->> (condition-case nil (progn (org-back-to-heading) ;; TODO this suffers from the same problem as the headline parser ;; (parses entire subtree and probably wastes most of it) (org-ml--parse-headline-subtree-at point nil)) (error (org-ml--parse-elements (point-min) (or (outline-next-heading) (point-max)) 'first-section))) (org-ml--get-descendent '(0)) (org-ml--filter-type 'section)))) ;;; parse at current point (eval-when-compile (defun org-ml--autodef-parse-node-form (name) "Return defun form for NAME." (let* ((fun-name (intern (format "org-ml-parse-this-%s" name))) (call (intern (format "org-ml-parse-%s-at" name))) (doc (format "Call `%s' with the current point." call)) (body `(,call (point)))) `(defun ,fun-name () ,doc ,body))) (defmacro org-ml--autodef-parse-node-functions () "Define all parse functions." (let ((forms (->> '(object element table-row item headline subtree section) (-map #'org-ml--autodef-parse-node-form)))) `(progn ,@forms)))) (org-ml--autodef-parse-node-functions) (defun org-ml-parse-this-toplevel-section () "Return section node corresponding to the top of the current buffer. If there is no such section, return nil." (save-excursion (goto-char (point-min)) (unless (= ?* (char-after)) (org-ml-parse-this-section)))) (defun org-ml-parse-this-buffer () "Return org-data document tree for the current buffer. Contrary to the org-element specification, the org-data element returned from this function will have :begin and :end properties." (org-element-parse-buffer)) (defun org-ml-this-buffer-has-headlines () "Return t if the current buffer has headlines, else return nil." (save-excursion (goto-char (point-min)) (and (re-search-forward "^\\*" nil t) t))) ;;; BUFFER SIDE EFFECTS ;;; insert (defun org-ml--nodes-to-string-maybe (nodes) "Return NODES as a string. NODES may either be a single node or a list of nodes." (cond ((org-ml--is-node nodes) (org-ml-to-string nodes)) ((listp nodes) (mapconcat #'org-ml-to-string nodes "")) (t (error "Must a node or a list of nodes")))) (defun org-ml--insert (point node) "Convert NODE to a string and insert at POINT in the current buffer. NODE may be a node or a list of nodes. Return NODE. Does not save point." (goto-char point) (insert (org-ml--nodes-to-string-maybe node))) (defun org-ml-insert (point node) "Convert NODE to a string and insert at POINT in the current buffer. NODE may be a node or a list of nodes. Return NODE." (save-excursion (org-ml--insert point node)) node) (defun org-ml-insert-tail (point node) "Like `org-ml-insert' but insert NODE at POINT and move to end of insertion." (let ((s (org-ml--nodes-to-string-maybe node))) (save-excursion (goto-char point) (insert s)) (goto-char (+ point (length s)))) node) ;;; update (defun org-ml--apply-overlays (os) "Apply overlays OS to the current buffer." (cl-flet ((apply-overlays (o) (let* ((beg (plist-get o :start)) (end (plist-get o :end)) (props (plist-get o :props)) (o* (make-overlay beg end))) (--each (-partition 2 props) (apply #'overlay-put o* it))))) (-each os #'apply-overlays))) ;; Myers diff algorithm ;; Myers, E.W. AnO(ND) difference algorithm and its variations. Algorithmica 1, ;; 251–266 (1986). https://doi.org/10.1007/BF01840446 ;; TODO There is a 99.99999% chance I can do way better than this. If the goal ;; is to figure out what stringy bits to put into the buffer based on what has ;; been modified, it makes more sense to make a crazy tree-based diff algorithm ;; that is specialized for org-element nodes (which almost assuredly does not ;; exist so I can't just steal a paper like I did with Myers) and only convert ;; the things that have changes to strings and put those in the buffer. At least ;; that seems to make sense, I haven't done complexity analysis yet. ;; this is a souped-up version of the linear-space diff algorithm as presented ;; from Myers; adapted from the python implementation listed here: ;; https://blog.robertelder.org/diff-algorithm/ (defun org-ml--diff-find-middle (str-eq M N) "Return the coordinates for the middle snake. STR-EQ is a ternary function that takes a direction (0 = forward, 1 = backward) and X/Y coordinates; it will return t if the two strings at the given coordinates in the indicated direction match. M and N are the length of the current substrings." (cl-flet* ((init-V (len) (make-vector len 0)) (init-k (D len) (- D (* 2 (max 0 (- D len))))) (get-x (len V k) (elt V (mod k len)))) (let* ((D-max (+ M N)) (D-mid (ceiling D-max 2)) (delta (- M N)) (V-len (+ 2 (* 2 (min M N)))) (V+ (init-V V-len)) (V- (init-V V-len)) ;; if D-max is odd, only check for overlaps in the forward direction ;; (and vice versa); note that the directions are coded 0 for forward ;; and 1 for backward (see below) (check-dir-p (mod (1+ D-max) 2)) (D 0) ret dir fwd-p kstart kend z-lim x-vert x-horz x0 y0 x y z Va Vb offset k) ;; iterate through D-paths for all D (while (and (not ret) (<= D D-mid)) (setq kstart (- (init-k D N)) kend (init-k D M) dir 0) ;; this loop runs 2x for each direction (0 = forward and 1 = backward) (while (and (not ret) (<= dir 1)) (setq fwd-p (= dir 0) Va (if fwd-p V+ V-) Vb (if fwd-p V- V+) offset (if fwd-p 1 0) z-lim (- D offset) k kstart) ;; iterate across all diagonals (k) to find furthest reaching paths (while (and (not ret) (<= k kend)) (setq x-vert (get-x V-len Va (1+ k)) x-horz (get-x V-len Va (1- k)) x0 (if (or (= k (- D)) (and (/= k D) (< x-horz x-vert))) x-vert (1+ x-horz)) y0 (- x0 k) x x0 y y0 z (- delta k)) (while (and (< x M) (< y N) (funcall str-eq fwd-p x y)) (setq x (1+ x) y (1+ y))) (aset Va (mod k V-len) x) (when (and (= dir check-dir-p) (<= (- z-lim) z z-lim) (<= M (+ (get-x V-len Va k) (get-x V-len Vb z)))) (setq ret (->> (if fwd-p `(,x0 ,y0 ,x ,y) `(,(- M x) ,(- N y) ,(- M x0) ,(- N y0))) (cons (- (* 2 D) offset))))) (setq k (+ 2 k))) (setq dir (1+ dir))) (setq D (1+ D))) ret))) (defun org-ml--diff (str-a str-b) "Return the edit commands to make STR-A `equal' STR-B. This is the linear-space version of the Myers diff algorithm with several other enhancements, including tighter diagonal bounds to prevent running off the edit grid (useless CPU cycles) and only allocating memory for each V-array according to the minimum string length and using them as circular buffers. After these edits, the time complexity should be O(min(A, B)*D) and the space complexity should be O(min(A, B). Return value will be a list of either `(ins I M N)' or `(del I J)'. For `ins' commands M and N are the indices from STR-B to insert at I in STR-A, and for `del' commands I and J are the indices between which will be deleted in STR-A. Note that consecutive edits will be consolidated so the length of the return list will not necessarily be the length of the LCS computed by the Myers diff algorithm." (cl-labels ((diff (a0 a1 b0 b1 i j) (let* ((M (- a1 a0)) (N (- b1 b0)) (str= (lambda (fwd-p x y) (if fwd-p (= (elt str-a (+ a0 x)) (elt str-b (+ b0 y))) (= (elt str-a (+ a0 (- M 1 x))) (elt str-b (+ b0 (- N 1 y)))))))) (cond ((and (< 0 M) (< 0 N)) (-let (((D-tot x y u v) (org-ml--diff-find-middle str= M N))) (cond ((and (or (< 1 D-tot) (and (/= x u) (/= y v)))) (append (diff a0 (+ a0 x) b0 (+ b0 y) i j) (diff (+ a0 u) (+ a0 M) (+ b0 v) (+ b0 N) (+ i u) (+ j v)))) ((< M N) (diff 0 0 (+ b0 M) (+ b0 N) (+ i M) (+ j M))) ((< N M) (diff (+ a0 N) (+ a0 M) 0 0 (+ i N) (+ j N))) (t nil)))) ((< 0 M) `((del ,i ,(+ i M)))) ((< 0 N) `((ins ,i ,j ,(+ j N))))))) (consolidate (acc next) (-let (((last . rest) acc)) (pcase `(,last ,next) (`((ins ,i0 ,m0 ,n0) (ins ,i1 ,m1 ,n1)) (if (and (= i0 i1) (= n0 m1)) (cons `(ins ,i0 ,m0 ,n1) rest) (cons next acc))) (`((del ,i0 ,j0) (del ,i1 ,j1)) (if (= j0 i1) (cons `(del ,i0 ,j1) rest) (cons next acc))) (_ (cons next acc)))))) (let ((a1 (length str-a)) (b1 (length str-b))) (->> (diff 0 a1 0 b1 0 0) (-reduce-from #'consolidate nil))))) (defun org-ml--diff-region (start end new-str) "Use Myers Diff algorithm to update the current buffer. The region to be updated will be between START and END and will be made to look like NEW-STR. Only differences as given by the Myers diff algorithm (eg insertions and deletions) will actually be applied to the buffer." (-let* ((old-str (buffer-substring-no-properties start end)) (edits (org-ml--diff old-str new-str))) (save-excursion (while edits (pcase (car edits) (`(ins ,i ,m ,n) (goto-char (+ start i)) (insert (substring new-str m n))) (`(del ,i ,j) (delete-region (+ start i) (+ start j)))) (!cdr edits))))) ;; (defun org-ml--properties-equal (type prop value1 value2) ;; "Return t if VALUE1 and VALUE2 are 'the same'. ;; If TYPE and PROP are 'headline/:title or 'item/:tag respectively, ;; compare using `org-ml--equal' on all their members (as these are ;; secondary strings). Otherwise use `equal'. This function is meant ;; to avoid infinite loops which may be caused by comparing the ;; parent nodes in secondary strings." ;; (if (or (and (eq type 'headline) (eq prop :title)) ;; (and (eq type 'item) (eq prop :tag))) ;; (let ((matches t)) ;; (while (and value1 matches) ;; (setq matches (org-ml--equal (car value1) (car value2)) ;; value1 (cdr value1) ;; value2 (cdr value2))) ;; (and (not value1) matches)) ;; (equal value1 value2))) ;; (defun org-ml--equal (node1 node2) ;; "Test of NODE1 is 'the same' as NODE2. ;; 'The same' means that both nodes have the same type, children, ;; and properties, where children are assessed recursively. ;; For properties, order and presence matters, and all properties ;; except for parent will be tested for equality using `equal' when ;; comparing their values (if :parent is present in one, it will ;; still be expected in the other but their values are ignored). ;; This may be contradictory to the more general definition of 'the ;; same' because a plist is unordered, but this function is only ;; intended to test for equality in cases where NODE2 is a modified ;; version of NODE1 and thus their plists should have the same ;; order." ;; (let* ((is-str-1 (stringp node1)) ;; (is-str-2 (stringp node2))) ;; (cond ;; ((and is-str-1 is-str-2) ;; (equal node1 node2)) ;; ((not (and is-str-1 is-str-2)) ;; (-let (((t1 . (p1 . c1)) node1) ;; ((t2 . (p2 . c2)) node2)) ;; ;; first test if types match ;; (and (eq t1 t2) ;; ;; then test children (which will test their types first) ;; (let ((children-match t)) ;; (while (and c1 children-match) ;; (setq children-match (org-ml--equal (car c1) (car c2)) ;; c1 (cdr c1) ;; c2 (cdr c2))) ;; (and (not c2) children-match)) ;; ;; then test the plist, which will likely be slower than testing ;; ;; types so do it last so the average run time is shorter ;; (let ((plist-matches t)) ;; (while (and p1 plist-matches) ;; ;; skip over parents since these could make circular lists ;; (setq plist-matches (and (eq (car p1) (car p2)) ;; (or (eq p1 :parent) ;; (org-ml--properties-equal ;; t1 (car p1) (cadr p1) (cadr p2)))) ;; p1 (cdr (cdr p1)) ;; p2 (cdr (cdr p2)))) ;; (and (not p2) plist-matches)))))))) (defun org-ml--replace-region (begin end text) "Replace text between BEGIN and END with TEXT." (delete-region begin end) (goto-char begin) (insert text)) (defun org-ml--replace-bounds (diff-mode begin end node) "Replace text between BEGIN and END with NODE1 in current buffer. See `org-ml~update' for meaning of DIFF-MODE." (let ((ov-cmd (-if-let (x (->> (overlays-in begin end) (--filter (eq 'outline (overlay-get it 'invisible))) (--map (list :start (overlay-start it) :end (overlay-end it) :props (overlay-properties it))))) (list 'apply 'org-ml--apply-overlays x)))) ;; hacky way to add overlays to undo tree (when ov-cmd (setq-local buffer-undo-list (cons ov-cmd buffer-undo-list))) (if diff-mode (org-ml--diff-region begin end (org-ml-to-string node)) ;; convert node to string before deleting so deferred properties can get ;; what they need from the buffer (org-ml--replace-region begin end (org-ml-to-string node))) nil)) (org-ml--defun-anaphoric* org-ml--update (diff-mode fun node) "Internal version of `org-ml~update'. DIFF-MODE, FUN, and NODE have the same meaning. The only difference is this function does not save the point's position" ;; do all computation before modifying buffer ;; ;; NOTE force resolution so that we can convert back to string after ;; deleting the node from the buffer (let* ((begin (org-element-begin node)) (end (org-element-end node))) (->> (funcall fun node) (org-ml--replace-bounds diff-mode begin end)))) (org-ml--defun* org-ml~update (diff-mode fun node) "Replace NODE in the current buffer with a new one. FUN is a unary function that takes NODE and returns a modified node or list of nodes. DIFF-MODE describes how the buffer will be updated and can be one of the following: - t: use the Myers diff algorithm to compare the old buffer string with the new string from the modified NODE, and only edit the the regions that are different - nil: use no diff algorithm; just replace the old buffer string entirely with the new one." (save-excursion (org-ml--update diff-mode fun node))) (org-ml--defun* org-ml-update (fun node) "Replace NODE in the current buffer with a new one. FUN is a unary function that takes NODE and returns a modified node or list of nodes. The modified NODE will be converted to a string and then compared to the old buffer string using the Myers diff algorithm. This has an average time complexity of O(M+N+D^2) where M and N are the lengths of the old and new strings respectively and D is the number of inserts or deletes required to change one into the other. At the cost of performance, only the parts of the buffer that need to be modified will actually be changed, which is less likely to disturb overlays and move the cursor (and is also more like how org-mode's build-in imperative functions behave). If one does not need this level of precision, use the function `org-ml~update' and supply nil for the DIFF-MODE argument. This will simply replace the old node's string representation with the modified node's string in its entirety. This will likely be faster but could destroy overlays (eg folding) and will reposition the cursor to the beginning of NODE if it is in the middle of NODE." (org-ml~update t fun node)) ;; generate all update functions for corresponding parse functions ;; since all take function args, also generate anaphoric forms (eval-when-compile (defun org-ml--autodef-update-node-forms (name) "Return defun and defmacro forms for NAME." (cl-flet ((format-doc (name doclist) (--> (s-join "\n" doclist) (format it name)))) (let* ((update-at (intern (format "org-ml-update-%s-at" name))) (update-this (intern (format "org-ml-update-this-%s" name))) (update-at~ (intern (format "org-ml~update-%s-at" name))) (update-this~ (intern (format "org-ml~update-this-%s" name))) (myers-doc (list "This function uses the Myers diff algorithm." "See `org-ml-update' for what this means.")) (diff-doc (list "See `org-ml~update' for the meaning of DIFF-MODE")) (update-at-doc-header (list "Update %1$s under POINT using FUN." "FUN takes an %1$s and returns a modified %1$s")) (update-this-doc-header (list "Update %1$s under current point using FUN." "FUN takes an %1$s and returns a modified %1$s")) (update-at-doc~ (->> (append update-at-doc-header '("") diff-doc) (format-doc name))) (update-this-doc~ (->> (append update-this-doc-header '("") diff-doc) (format-doc name))) (update-at-doc (->> (append update-at-doc-header '("") myers-doc) (format-doc name))) (update-this-doc (->> (append update-this-doc-header '("") myers-doc) (format-doc name))) (call (intern (format "org-ml-parse-%s-at" name))) (update-at-body~ `(org-ml~update diff-mode fun (,call point))) (update-this-body~ `(,update-at~ diff-mode (point) fun)) (update-at-body `(,update-at~ t point fun)) (update-this-body `(,update-this~ t fun))) (list `(org-ml--defun* ,update-at~ (diff-mode point fun) ,update-at-doc~ ,update-at-body~) `(org-ml--defun* ,update-this~ (diff-mode fun) ,update-this-doc~ ,update-this-body~) `(org-ml--defun* ,update-at (point fun) ,update-at-doc ,update-at-body) `(org-ml--defun* ,update-this (fun) ,update-this-doc ,update-this-body))))) (defmacro org-ml--autodef-update-node-functions () "Define all update-node functions and macros." (let ((forms (->> '(object element table-row item headline subtree section) (-mapcat #'org-ml--autodef-update-node-forms)))) `(progn ,@forms)))) (org-ml--autodef-update-node-functions) (org-ml--defun* org-ml-update-this-buffer (fun) "Apply FUN to the contents of the current buffer. FUN is a unary function that takes a node of type `org-data' and returns a modified node." (org-ml-update fun (org-ml-parse-this-buffer))) ;;; fold (defun org-ml--fold-get-contents-begin-maybe (node) "Return :contents-begin minus one or nil if not found for NODE." (-some-> (org-element-contents-begin node) (1-))) (eval-when-compile (defmacro org-ml--fold-get-contents-begin-offset (node offset) "Return the fold beginning boundary of NODE. Try `org-ml--fold-get-contents-begin-maybe' first, and if this returns nil, use OFFSET to calculated the beginning fold boundary beginning. OFFSET can either be an integer or a form that evaluates to an integer." (declare (indent 1) (debug (form form))) (let ((n (make-symbol "--node"))) `(let ((,n ,node)) (or (org-ml--fold-get-contents-begin-maybe ,n) (+ ,offset (org-element-begin ,n))))))) (defun org-ml--fold-get-begin-boundary (node) "Return integer for point at the beginning of fold region for NODE." (cl-case (org-ml-get-type node) ;; Blocks must be folded regardless of if they have children (center-block (org-ml--fold-get-contents-begin-offset node 14)) (dynamic-block (org-ml--fold-get-contents-begin-offset node (+ 9 (length (org-element-property-raw :block-name node))))) (drawer (org-ml--fold-get-contents-begin-offset node (+ 2 (length (org-element-property-raw :drawer-name node))))) (property-drawer (org-ml--fold-get-contents-begin-offset node 12)) ((quote-block verse-block) (org-ml--fold-get-contents-begin-offset node 13)) (special-block (org-ml--fold-get-contents-begin-offset node (+ 9 (length (org-element-property-raw :type node))))) ;; Headlines should only be folded if they have children (headline (org-ml--fold-get-contents-begin-maybe node)) ;; Items are tricky since everything after the "first line" is folded. If ;; the first child is a paragraph, need to figure out how long its first ;; line is and add that to :contents-begin. Do nothing if there are no ;; children (item (-when-let (first (-first-item (org-element-contents node))) (let ((offset (if (not (org-ml--is-type 'paragraph first)) -1 (->> (org-ml-to-string first) (s-split "\n") (-first-item) (length))))) (+ offset (org-element-contents-begin node))))) ;; These elements are not branch types and thus don't have child boundaries, ;; so will need to manually calculated where the boundaries should be ((comment-block example-block) (+ 15 (org-element-begin node))) (export-block (+ (org-element-begin node) (-if-let (type (org-element-property-raw :type node)) (1+ (length type)) 0) 14)) (src-block (+ (org-element-begin node) (-if-let (meta (-> (list (org-element-property-raw :language node) (org-element-property-raw :switches node) (org-element-property-raw :parameters node)) (-non-nil))) (1+ (length (s-join " " meta))) 0) 11)))) (defun org-ml--fold-flag-region-block (begin end flag) "Set invisibility for region denoted by BEGIN and END. FLAG is a boolean (t for invisible). The overlays applied should only be used for block elements." ;; Code ripped off from `org-flag-region' with overlay properties set to ;; match those created in `org-hide-block-toggle' (remove-overlays begin end 'invisible) (when flag (let ((o (make-overlay begin end nil 'front-advance))) (overlay-put o 'evaporate t) (overlay-put o 'invisible 'org-hide-block) (overlay-put o 'isearch-open-invisible #'delete-overlay)))) (defun org-ml--fold-flag-node (flag node) "Set folding of buffer contents in NODE to FLAG." (-when-let (begin (org-ml--fold-get-begin-boundary node)) (let ((end (- (org-element-end node) (org-element-post-blank node) 1))) (cl-case (org-ml-get-type node) ((drawer headline item property-drawer) (outline-flag-region begin end flag)) ((center-block comment-block dynamic-block example-block export-block quote-block special-block src-block verse-block) (org-ml--fold-flag-region-block begin end flag)))))) (defun org-ml-fold (node) "Fold the children of NODE if they exist." (org-ml--fold-flag-node t node)) (defun org-ml-unfold (node) "Unfold the children of NODE if they exist." (org-ml--fold-flag-node nil node)) (defun org-ml-subtree-set-fold (fold-state headline) "Set the fold state of HEADLINE node. This function will do nothing unless HEADLINE has children. FOLD-STATE may be one of: - `none`: hide everything - `children`: show section and 1st-level subheadlines only - `subtree`: show section and subheadline contents (but not drawers) - `all`: show everything" (cl-flet ((fold-drawers (headline) (-when-let (section (org-ml-headline-get-section headline)) (-some->> (--first (org-ml--is-type 'property-drawer it) section) (org-ml-fold)) (let ((drawers (->> (org-element-contents section) (--filter (org-ml--is-type 'drawer it))))) (--each drawers (org-ml-fold it)))))) (cl-case fold-state (none (org-ml-fold headline)) (children (org-ml-unfold headline) (fold-drawers headline) (--each (org-ml-headline-get-subheadlines headline) (org-ml-fold it))) (subtree (org-ml-unfold headline) (fold-drawers headline) (--each (org-ml-headline-get-subheadlines headline) (org-ml-subtree-set-fold fold-state it))) (all (org-ml-unfold headline))))) ;;; headline batch processing (defun org-ml--get-forward-bounds (m n re) "Return the boundaries of headlines to parse. M is the minimum number of headlines and N is the maximum number of headlines. RE is a regular expression that will be used to search for a headline. The return value will be a list like (BEGIN END) where BEGIN is the start of the Mth headline and END is the end of the Nth headline." (save-excursion (save-match-data (goto-char (point-min)) (let (begin end) (when (re-search-forward re nil t) (let ((i 0) (next t)) (while (and next (<= i n)) (when (= m i) (setq begin (match-beginning 0))) (setq i (1+ i) next (re-search-forward re nil t))) (setq end (if next (match-beginning 0) (point-max))))) (list begin end))))) (defun org-ml--get-backward-bounds (m n re) "Return the boundaries of headlines to parse. This is like `org-ml--get-forward-bounds' except it searches backwards. M is the minimum number of headlines and N is the maximum number of headlines. RE is a regular expression that will be used to search for a headline. The return value will be a list like (BEGIN END) where BEGIN is the start of the Nth headline and END is the end of the Mth headline." (save-excursion (save-match-data (goto-char (point-max)) (let ((i 0) (prev-point (point-max)) begin end) (while (and (<= i n) (re-search-backward re nil t)) (when (= m i) (setq end prev-point)) (setq i (1+ i) prev-point (point))) (when end (setq begin (point))) (list begin end))))) (defun org-ml--get-region-bounds (begin end re) "Return the boundaries of headlines to parse. RE is a regular expression that will be used to search for a headline. The return value will be a list like (PBEGIN PEND) where PBEGIN is the start of the headline immediately after BEGIN and PEND is the end of the headline immediately before END." (save-match-data (save-excursion (let ((b (progn (goto-char begin) (if (looking-at re) begin (when (re-search-forward re nil t) (match-beginning 0))))) (e (or (progn (goto-char end) (if (looking-at re) end (when (re-search-forward re nil t) (match-beginning 0)))) (point-max)))) (list b e))))) (defun org-ml--parse-patterns-where (which re) "Return the parse boundaries of a headline based on WHICH. See `org-ml-get-some-headlines' for the meaning of WHICH. RE is a regular expression used to search for the next headline." (declare (indent 1)) (cl-flet ((int-or-nil-p (x) (or (null x) (integerp x)))) (-let (((b e) (pcase which ;; parse N (`all (org-ml--get-region-bounds (point-min) (point-max) re)) ((and (pred integerp) n) (if (<= 0 n) (org-ml--get-forward-bounds 0 n re) (org-ml--get-backward-bounds 0 n re))) ;; parse M-N (`(,(and (pred integerp) m) ,(and (pred integerp) n)) (cond ((<= 0 m n) (org-ml--get-forward-bounds m n re)) ((<= m n -1) (org-ml--get-backward-bounds (1- (- n)) (1- (- m)) re)) ((< n m) (org-ml--arg-error "M must be less than or equal to N")) (t (org-ml--arg-error "M and N must be the same sign")))) ;; parse region between A and B (`[,(and (pred int-or-nil-p) a) ,(and (pred int-or-nil-p) b)] (let ((a (or a (point-min))) (b (or b (point-max)))) (org-ml--get-region-bounds a b re))) (e (org-ml--arg-error "Invalid 'which' specification: Got %S" e))))) (when (and b e) (org-ml--parse-elements b e 'first-section))))) (defun org-ml-parse-headlines (which) "Return list of headline nodes from current buffer. WHICH describes the location of headlines to be parsed and is one of the following: - N: parse up to index N headlines (which 0 is the first); if negative start counting from the last headline (which -1 refers to the last) - (M N): like N but parse after index M headlines; M and N may both be similarly negative - [A B]: parse all headlines whose first point falls between points A and B in the buffer; if A and B are nil, use `point-min' and `point-max' respectively. - `all': parse all headlines (equivalent to [nil nil]) Each headline is obtained with `org-ml-parse-headline-at'." (cl-labels ((get-subheadlines (headline) (->> (org-ml-headline-get-subheadlines headline) (-mapcat #'get-subheadlines) (cons headline)))) (->> (org-ml--parse-patterns-where which "^\\*+ ") (-mapcat #'get-subheadlines)))) (defun org-ml-parse-subtrees (which) "Return list of subtree nodes from current buffer. WHICH has analogous meaning to that in `org-ml-parse-headlines' except applied to subtrees not individual headlines." (org-ml--parse-patterns-where which "^\\* ")) (org-ml--defun* org-ml-update-headlines (which fun) "Update some headlines in the current using FUN. See `org-ml-parse-headlines' for the meaning of WHICH. Headlines are updated using `org-ml~update' with DIFF-ARG set to nil (see this for use and meaning of FUN)." ;; don't use the myers diff algorithm here, since these functions are meant ;; for batch processing. (save-excursion (cl-labels ((map-to-subheadlines (headline) (org-ml-headline-map-subheadlines* (-map #'map-to-subheadlines it) (funcall fun headline)))) ;; NOTE there two main ways to do this. We can either flatten the output ;; of `org-ml--parse-patterns-where' into individual headlines (eg no ;; headline would have a subheadline and all subheadlines would be in the ;; top level of the list) and update each of them in the buffer ;; individually using `FUN'. Or we can do we we do here, which is to apply ;; `FUN' recursively to each subtree and then update the entire subtree in ;; place in the buffer. This has the advantage of not requiring the ;; subtrees to be broken apart which could introduce whitespace errors ;; between headlines, section, etc. It has the disadvantage of requiring ;; more text to be modified in the buffer at once, which could be ;; disruptive. (--> (org-ml--parse-patterns-where which "^\\*+ ") (nreverse it) (--each it (org-ml~update nil #'map-to-subheadlines it)))))) (org-ml--defun* org-ml-update-subtrees (which fun) "Update some toplevel subtrees in the current buffer using FUN. See `org-ml-parse-subtrees' for the meaning of WHICH. Subtrees are updated using `org-ml~update' with DIFF-ARG set to nil (see this for use and meaning of FUN)." (save-excursion (--> (org-ml--parse-patterns-where which "^\\* ") (nreverse it) (--each it (org-ml~update nil fun it))))) (org-ml--defun* org-ml-update-supersections (which fun) "Update some headline supersections in the current using FUN. See `org-ml-parse-headlines' for the meaning of WHICH. Headlines are updated using `org-ml~update' with DIFF-ARG set to nil (see this for use and meaning of FUN)." ;; don't use the myers diff algorithm here, since these functions are meant ;; for batch processing. (save-excursion (cl-labels ((map-to-subheadlines (headline) (-each (nreverse (org-ml-headline-get-subheadlines headline)) #'map-to-subheadlines) (-let* (((ss0 &as &plist :pre-blank pb0 :section nodes0) (org-ml-headline-get-supersection headline)) ((ss1 &as &plist :pre-blank pb1 :section nodes1) (funcall fun ss0))) (if (or (not pb1) (= pb0 pb1)) (let ((s (->> (-map #'org-ml-to-string nodes1) (apply #'concat (make-string pb0 ?\n))))) (if nodes0 (let ((begin (org-element-begin (-first-item nodes0))) (end (org-element-end (-last-item nodes0)))) (org-ml--replace-region begin end s)) (let* ((begin (or (org-element-contents-begin headline) ;; If there are no contents, go to ;; headline start, try to go to next ;; line, and insert new line if we can't ;; (which means we are at the end) (progn (goto-char (org-element-begin headline)) (forward-line) (if (bolp) (point) ;; use this since this plays nice ;; with evil mode (when (re-search-forward "$" nil t) (replace-match "\n" nil nil)) (forward-line) (point)))))) (goto-char begin) (insert s)))) (let ((headline* (->> (org-ml-copy headline) (org-ml-headline-set-subheadlines nil) (org-ml-headline-set-supersection ss1))) (begin (org-element-begin headline)) (end (or (outline-next-heading) (point-max)))) (org-ml--replace-bounds nil begin end headline*)))))) (-each (nreverse (org-ml--parse-patterns-where which "^\\* ")) #'map-to-subheadlines)))) (org-ml--defun* org-ml-update-supercontents (config which fun) "Update some headline supercontents in the current using FUN. See `org-ml-parse-headlines' for the meaning of WHICH. Headlines are updated using `org-ml~update' with DIFF-ARG set to nil (see this for use and meaning of FUN)." (org-ml-update-supersections* which (->> (org-ml--supersection-to-supercontents config it) (funcall fun) (org-ml--supercontents-to-supersection config)))) ;;; deprecated functions (define-obsolete-function-alias 'org-ml-timestamp-get-range 'org-ml-timestamp-get-length "6.0.0") (defun org-ml-timestamp-set-range (n timestamp) "Return TIMESTAMP node with range set to N seconds. If TIMESTAMP is ranged, keep start time the same and adjust the end time. If not, make a new end time. The units for RANGE are in minutes if TIMESTAMP is in long format and days if TIMESTAMP is in short format. This function is deprecated. Use `org-ml-timestamp-set-length' instead." (if (->> (org-ml-timestamp-get-start-time timestamp) (org-ml-timelist-has-time)) (org-ml-timestamp-set-length (* 60 n) 'minute timestamp) (org-ml-timestamp-set-length (* 86400 n) 'day timestamp))) (define-obsolete-function-alias `org-ml-time-is-long 'org-ml-timelist-has-time "6.0.0") (define-obsolete-function-alias `org-ml-time-to-unixtime 'org-ml-timelist-to-unixtime "6.0.0") (defun org-ml-unixtime-to-time-short (unixtime) "Convert UNIXTIME to list like (YEAR MONTH DAY). This function is deprecated." (-take 3 (org-ml-unixtime-to-timelist nil unixtime))) (defun org-ml-unixtime-to-time-long (unixtime) "Convert UNIXTIME to list like (YEAR MONTH DAY HOUR MINUTE). This function is deprecated." (org-ml-unixtime-to-timelist t unixtime)) (provide 'org-ml) ;;; org-ml.el ends here