update packages
This commit is contained in:
674
lisp/org-contrib/COPYING
Normal file
674
lisp/org-contrib/COPYING
Normal file
@@ -0,0 +1,674 @@
|
||||
GNU GENERAL PUBLIC LICENSE
|
||||
Version 3, 29 June 2007
|
||||
|
||||
Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
|
||||
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.
|
||||
|
||||
<one line to give the program's name and a brief idea of what it does.>
|
||||
Copyright (C) <year> <name of author>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
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:
|
||||
|
||||
<program> Copyright (C) <year> <name of author>
|
||||
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
|
||||
<https://www.gnu.org/licenses/>.
|
||||
|
||||
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
|
||||
<https://www.gnu.org/philosophy/why-not-lgpl.html>.
|
||||
143
lisp/org-contrib/README.org
Normal file
143
lisp/org-contrib/README.org
Normal file
@@ -0,0 +1,143 @@
|
||||
This repository contains add-ons to Org.
|
||||
|
||||
You can use them by installing the =org-contrib= NonGNU ELPA package
|
||||
from https://elpa.nongnu.org/nongnu/.
|
||||
|
||||
** Please help maintaining these add-ons
|
||||
|
||||
Files in this repository used to live in the Org repository but have
|
||||
been filtered out of the Org 9.5 release. The =contrib/= directory used
|
||||
to contain a =scripts/= directory that now lives on [[https://code.orgmode.org/bzg/worg/src/master/code][the Worg repository]].
|
||||
|
||||
*Files in this repository receive little if no maintainance and there
|
||||
is no guaranty that they are compatible with the Org stable version.*
|
||||
|
||||
For files a =Maintainer= header and a =Homepage= pointing outside of this
|
||||
repository are in transition: they are maintained and will be removed
|
||||
from the next release of this repository. As a user, please carefully
|
||||
track the new URL where the add-on is now maintained.
|
||||
|
||||
If you want to maintain some of these add-ons, please send me an email
|
||||
at =bzg@gnu.org= once you set up a separate repository for them.
|
||||
|
||||
** License
|
||||
|
||||
All files in this repository are licensed under the GNU General Public
|
||||
License, either version 3 of the License, or (at your option) any
|
||||
later version. See [[file:COPYING][COPYING]].
|
||||
|
||||
** Files to remove from the next release
|
||||
|
||||
These files are maintained in a separate repository, which you can
|
||||
find after the "Homepage:" keyword in the files themselves:
|
||||
|
||||
- ob-arduino.el :: Org-mode Babel support for Arduino
|
||||
- ob-clojure-literate.el :: Clojure's Org-mode Literate Programming
|
||||
- ob-mathematica.el :: org-babel functions for Mathematica evaluation
|
||||
- ob-php.el :: Execute PHP within org-mode blocks
|
||||
- ob-redis.el :: Execute Redis queries within org-mode blocks
|
||||
- ob-sclang.el :: SCLang support for Org-mode Babel
|
||||
- ob-smiles.el :: Org-mode Babel support for SMILES
|
||||
- ob-spice.el :: org-babel functions for spice evaluation
|
||||
- ol-notmuch.el :: Links to notmuch messages
|
||||
- org-attach-embedded-images.el :: Transmute images to attachments
|
||||
- org-link-edit.el :: Slurp and barf with Org links
|
||||
- org-mac-link.el :: Insert org-mode links to items selected in various Mac apps
|
||||
- org-notify.el :: Notifications for Org-mode
|
||||
- org-passwords.el :: org derived mode for managing passwords
|
||||
- org-velocity.el :: something like Notational Velocity for Org
|
||||
- ox-rss.el :: RSS 2.0 Back-End for Org Export Engine
|
||||
|
||||
** Other files
|
||||
*** Org utils
|
||||
|
||||
- org-annotate-file.el :: Annotate a file with org syntax
|
||||
- org-attach-embedded-images.el :: Transmute images to attachments
|
||||
- org-bibtex-extras.el :: Extras for working with org-bibtex entries
|
||||
- org-checklist.el :: org functions for checklist handling
|
||||
- org-choose.el :: Use TODO keywords to mark decision states
|
||||
- org-collector.el :: Collect properties into tables
|
||||
- org-contacts.el :: Contacts management
|
||||
- org-contribdir.el :: Dummy file to mark the org contrib Lisp directory
|
||||
- org-depend.el :: TODO dependencies for Org-mode
|
||||
- org-effectiveness.el :: Measuring your personal effectiveness
|
||||
- org-eldoc.el :: Eldoc documentation for SRC blocks
|
||||
- org-eval.el :: The <lisp> tag, adapted from Muse
|
||||
- org-eval-light.el :: Evaluate in-buffer code on demand
|
||||
- org-expiry.el :: Expiry mechanism for Org entries
|
||||
- org-git-link.el :: Provide org links to specific file version
|
||||
- org-interactive-query.el :: Interactive modification of tags query
|
||||
- org-invoice.el :: Help manage client invoices in OrgMode
|
||||
- org-learn.el :: SuperMemo's incremental learning algorithm
|
||||
- org-license.el :: Insert free licenses to your org documents
|
||||
- org-link-edit.el :: Slurp and barf with Org links
|
||||
- org-mac-iCal.el :: Imports events from iCal.app to the Emacs diary
|
||||
- org-mac-link.el :: Grab links and URLs from various Mac applications
|
||||
- org-mairix.el :: Hook mairix search into Org for different MUAs
|
||||
- org-notify.el :: Notifications for Org-mode
|
||||
- org-panel.el :: Simple routines for us with bad memory
|
||||
- org-passwords.el :: Org derived mode for managing passwords
|
||||
- org-registry.el :: A registry for Org links
|
||||
- org-screen.el :: Visit screen sessions through Org-mode links
|
||||
- org-screenshot.el :: Take and manage screenshots in Org-mode files
|
||||
- org-secretary.el :: Team management with org-mode
|
||||
- org-static-mathjax.el :: Muse-like tags in Org-mode
|
||||
- org-sudoku.el :: Create and solve SUDOKU puzzles in Org tables
|
||||
- org-toc.el :: Table of contents for Org-mode buffer
|
||||
- org-track.el :: Keep up with Org development
|
||||
- org-velocity.el :: something like Notational Velocity for Org
|
||||
- org-wikinodes.el :: CamelCase wiki-like links for Org
|
||||
|
||||
*** Org exporters
|
||||
|
||||
- ox-bibtex.el :: Export bibtex fragments
|
||||
- ox-confluence.el :: Confluence Wiki exporter
|
||||
- ox-deck.el :: deck.js presentations exporter
|
||||
- ox-extra.el :: Convenience functions for org export
|
||||
- ox-freemind.el :: Freemind exporter
|
||||
- ox-groff.el :: Groff exporter
|
||||
- ox-rss.el :: RSS 2.0 exporter
|
||||
- ox-s5.el :: S5 presentations exporter
|
||||
- ox-taskjuggler.el :: TaskJuggler exporter
|
||||
|
||||
*** Org link
|
||||
|
||||
- ol-bookmark.el :: Links to bookmarks
|
||||
- ol-elisp-symbol.el :: Links to Emacs-lisp symbols
|
||||
- ol-git-link.el :: Links to specific file version
|
||||
- ol-mew.el :: Links to Mew messages
|
||||
- ol-notmuch.el :: Links to notmuch messages
|
||||
- ol-vm.el :: Support for links to VM messages
|
||||
- ol-wl.el :: Support for links to Wanderlust messages
|
||||
|
||||
*** Org Babel languages
|
||||
|
||||
- ob-abc.el :: Org-mode Babel Functions for ABC
|
||||
- ob-arduino.el :: Org-mode Babel Functions for Arduino
|
||||
- ob-asymptote.el :: Org-mode Babel Functions for Asymptote
|
||||
- ob-clojure-literate.el :: Clojure's Org-mode Literate Programming
|
||||
- ob-coq.el :: Org-mode Babel Functions for Coq
|
||||
- ob-csharp.el :: Org-mode Babel Functions for csharp evaluation
|
||||
- ob-ebnf.el :: Org-mode Babel Functions for EBNF
|
||||
- ob-eukleides.el :: Org-mode Babel Functions for eukleides evaluation
|
||||
- ob-fomus.el :: Org-mode Babel Functions for fomus evaluation
|
||||
- ob-hledger.el :: Org-mode Babel Functions for hledger
|
||||
- ob-io.el :: Org-mode Babel Functions for Io
|
||||
- ob-J.el :: Org-mode Babel Functions for J
|
||||
- ob-ledger.el :: Org-mode Babel Functions for Ledger
|
||||
- ob-mathematica.el :: Org-mode Babel Functions for Mathematica evaluation
|
||||
- ob-mathomatic.el :: Org-mode Babel Functions for mathomatic evaluation
|
||||
- ob-mscgen.el :: Org-mode Babel Functions for Mscgen
|
||||
- ob-oz.el :: Org-mode Babel Functions for Oz evaluation
|
||||
- ob-php.el :: Execute PHP within org-mode blocks
|
||||
- ob-picolisp.el :: Org-mode Babel Functions for Picolisp
|
||||
- ob-redis.el :: Execute Redis queries within org-mode blocks
|
||||
- ob-sclang.el :: SCLang support for Org-mode Babel
|
||||
- ob-shen.el :: Org-mode Babel Functions for Shen
|
||||
- ob-smiles.el :: Org-mode Babel support for SMILES
|
||||
- ob-spice.el :: Org-mode Babel Functions for spice evaluation
|
||||
- ob-stan.el :: Babel Functions for Stan
|
||||
- ob-stata.el :: Org-mode Babel Functions for Stata evaluation
|
||||
- ob-tcl.el :: Org-mode Babel Functions for tcl evaluation
|
||||
- ob-vala.el :: Org-mode Babel Functions for Vala
|
||||
- ob-vbnet.el :: Org-mode Babel Functions for VB.Net evaluation
|
||||
189
lisp/org-contrib/ob-J.el
Normal file
189
lisp/org-contrib/ob-J.el
Normal file
@@ -0,0 +1,189 @@
|
||||
;;; ob-J.el --- Babel Functions for J -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Oleh Krehel
|
||||
;; Maintainer: Joseph Novakovich <josephnovakovich@gmail.com>
|
||||
;; Keywords: literate programming, reproducible research
|
||||
;; Homepage: https://orgmode.org
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Org-Babel support for evaluating J code.
|
||||
;;
|
||||
;; Session interaction depends on `j-console' from package `j-mode'
|
||||
;; (available in MELPA).
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ob)
|
||||
(require 'org-macs)
|
||||
|
||||
(declare-function j-console-ensure-session "ext:j-console" ())
|
||||
|
||||
(defcustom org-babel-J-command "jconsole"
|
||||
"Command to call J."
|
||||
:group 'org-babel
|
||||
:version "26.1"
|
||||
:package-version '(Org . "9.0")
|
||||
:type 'string)
|
||||
|
||||
(defun org-babel-expand-body:J (body _params &optional _processed-params)
|
||||
"Expand BODY according to PARAMS, return the expanded body.
|
||||
PROCESSED-PARAMS isn't used yet."
|
||||
(org-babel-J-interleave-echos-except-functions body))
|
||||
|
||||
(defun org-babel-J-interleave-echos (body)
|
||||
"Interleave echo',' between each source line of BODY."
|
||||
(mapconcat #'identity (split-string body "\n") "\necho','\n"))
|
||||
|
||||
(defun org-babel-J-interleave-echos-except-functions (body)
|
||||
"Interleave echo',' between source lines of BODY that aren't functions."
|
||||
(if (obj-string-match-m "\\(?:^\\|\n\\)[^\n]*\\(?:0\\|1\\|2\\|3\\|4\\|dyad\\) : 0\n.*\n)\\(?:\n\\|$\\)" body)
|
||||
(let ((s1 (substring body 0 (match-beginning 0)))
|
||||
(s2 (match-string 0 body))
|
||||
(s3 (substring body (match-end 0))))
|
||||
(concat
|
||||
(if (string= s1 "")
|
||||
""
|
||||
(concat (org-babel-J-interleave-echos s1)
|
||||
"\necho','\n"))
|
||||
s2
|
||||
"\necho','\n"
|
||||
(org-babel-J-interleave-echos-except-functions s3)))
|
||||
(org-babel-J-interleave-echos body)))
|
||||
|
||||
(defalias 'org-babel-execute:j 'org-babel-execute:J)
|
||||
|
||||
(defun org-babel-execute:J (body params)
|
||||
"Execute a block of J code BODY.
|
||||
PARAMS are given by org-babel.
|
||||
This function is called by `org-babel-execute-src-block'."
|
||||
(message "executing J source code block")
|
||||
(let* ((processed-params (org-babel-process-params params))
|
||||
(sessionp (cdr (assq :session params)))
|
||||
(sit-time (let ((sit (assq :sit params)))
|
||||
(if sit (cdr sit) .1)))
|
||||
(full-body (org-babel-expand-body:J
|
||||
body params processed-params))
|
||||
(tmp-script-file (org-babel-temp-file "J-src")))
|
||||
(org-babel-j-initiate-session sessionp)
|
||||
(org-babel-J-strip-whitespace
|
||||
(if (string= sessionp "none")
|
||||
(progn
|
||||
(with-temp-file tmp-script-file
|
||||
(insert full-body))
|
||||
(org-babel-eval (format "%s < %s" org-babel-J-command tmp-script-file) ""))
|
||||
(org-babel-J-eval-string full-body sit-time)))))
|
||||
|
||||
(defun org-babel-J-eval-string (str sit-time)
|
||||
"Sends STR to the `j-console-cmd' session and execute it."
|
||||
(let ((session (j-console-ensure-session)))
|
||||
(with-current-buffer (process-buffer session)
|
||||
(goto-char (point-max))
|
||||
(insert (format "\n%s\n" str))
|
||||
(let ((beg (point)))
|
||||
(comint-send-input)
|
||||
(sit-for sit-time)
|
||||
(buffer-substring-no-properties
|
||||
beg (point-max))))))
|
||||
|
||||
(defun org-babel-J-strip-whitespace (str)
|
||||
"Remove whitespace from jconsole output STR."
|
||||
(mapconcat
|
||||
#'identity
|
||||
(delete "" (mapcar
|
||||
#'org-babel-J-print-block
|
||||
(split-string str "^ *,\n" t)))
|
||||
"\n\n"))
|
||||
|
||||
(defun obj-get-string-alignment (str)
|
||||
"Return a number to describe STR alignment.
|
||||
STR represents a table.
|
||||
Positive/negative/zero result means right/left/undetermined.
|
||||
Don't trust first line."
|
||||
(let* ((str (org-trim str))
|
||||
(lines (split-string str "\n" t))
|
||||
n1 n2)
|
||||
(cond ((<= (length lines) 1)
|
||||
0)
|
||||
((= (length lines) 2)
|
||||
;; numbers are right-aligned
|
||||
(if (and
|
||||
(numberp (read (car lines)))
|
||||
(numberp (read (cadr lines)))
|
||||
(setq n1 (obj-match-second-space-right (nth 0 lines)))
|
||||
(setq n2 (obj-match-second-space-right (nth 1 lines))))
|
||||
n2
|
||||
0))
|
||||
((not (obj-match-second-space-left (nth 0 lines)))
|
||||
0)
|
||||
((and
|
||||
(setq n1 (obj-match-second-space-left (nth 1 lines)))
|
||||
(setq n2 (obj-match-second-space-left (nth 2 lines)))
|
||||
(= n1 n2))
|
||||
n1)
|
||||
((and
|
||||
(setq n1 (obj-match-second-space-right (nth 1 lines)))
|
||||
(setq n2 (obj-match-second-space-right (nth 2 lines)))
|
||||
(= n1 n2))
|
||||
(- n1))
|
||||
(t 0))))
|
||||
|
||||
(defun org-babel-J-print-block (x)
|
||||
"Prettify jconsole output X."
|
||||
(let* ((x (org-trim x))
|
||||
(a (obj-get-string-alignment x))
|
||||
(lines (split-string x "\n" t))
|
||||
b)
|
||||
(cond ((< a 0)
|
||||
(setq b (obj-match-second-space-right (nth 0 lines)))
|
||||
(concat (make-string (+ a b) ? ) x))
|
||||
((> a 0)
|
||||
(setq b (obj-match-second-space-left (nth 0 lines)))
|
||||
(concat (make-string (- a b) ? ) x))
|
||||
(t x))))
|
||||
|
||||
(defun obj-match-second-space-left (s)
|
||||
"Return position of leftmost space in second space block of S or nil."
|
||||
(and (string-match "^ *[^ ]+\\( \\)" s)
|
||||
(match-beginning 1)))
|
||||
|
||||
(defun obj-match-second-space-right (s)
|
||||
"Return position of rightmost space in second space block of S or nil."
|
||||
(and (string-match "^ *[^ ]+ *\\( \\)[^ ]" s)
|
||||
(match-beginning 1)))
|
||||
|
||||
(defun obj-string-match-m (regexp string &optional start)
|
||||
"Call (string-match REGEXP STRING START).
|
||||
REGEXP is modified so that .* matches newlines as well."
|
||||
(string-match
|
||||
(replace-regexp-in-string "\\.\\*" "[\0-\377[:nonascii:]]*" regexp)
|
||||
string
|
||||
start))
|
||||
|
||||
(defun org-babel-j-initiate-session (&optional session)
|
||||
"Initiate a J session.
|
||||
SESSION is a parameter given by org-babel."
|
||||
(unless (string= session "none")
|
||||
(require 'j-console)
|
||||
(j-console-ensure-session)))
|
||||
|
||||
(provide 'ob-J)
|
||||
|
||||
;;; ob-J.el ends here
|
||||
94
lisp/org-contrib/ob-abc.el
Normal file
94
lisp/org-contrib/ob-abc.el
Normal file
@@ -0,0 +1,94 @@
|
||||
;;; ob-abc.el --- Org Babel Functions for ABC -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: William Waites
|
||||
;; Maintainer: William Waites
|
||||
;; Keywords: literate programming, music
|
||||
;; Homepage: https://www.tardis.ed.ac.uk/~wwaites
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;; This file adds support to Org Babel for music in ABC notation.
|
||||
;;; It requires that the abcm2ps program is installed.
|
||||
;;; See http://moinejf.free.fr/
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ob)
|
||||
|
||||
;; optionally define a file extension for this language
|
||||
|
||||
(add-to-list 'org-babel-tangle-lang-exts '("abc" . "abc"))
|
||||
|
||||
;; optionally declare default header arguments for this language
|
||||
(defvar org-babel-default-header-args:abc
|
||||
'((:results . "file") (:exports . "results"))
|
||||
"Default arguments to use when evaluating an ABC source block.")
|
||||
|
||||
(defun org-babel-expand-body:abc (body params)
|
||||
"Expand BODY according to PARAMS, return the expanded body."
|
||||
(let ((vars (org-babel--get-vars params)))
|
||||
(mapc
|
||||
(lambda (pair)
|
||||
(let ((name (symbol-name (car pair)))
|
||||
(value (cdr pair)))
|
||||
(setq body
|
||||
(replace-regexp-in-string
|
||||
(concat "\\$" (regexp-quote name))
|
||||
(if (stringp value) value (format "%S" value))
|
||||
body))))
|
||||
vars)
|
||||
body))
|
||||
|
||||
(defun org-babel-execute:abc (body params)
|
||||
"Execute a block of ABC code with org-babel.
|
||||
This function is called by `org-babel-execute-src-block'."
|
||||
(message "executing Abc source code block")
|
||||
(let* ((cmdline (cdr (assq :cmdline params)))
|
||||
(out-file (let ((file (cdr (assq :file params))))
|
||||
(if file (replace-regexp-in-string "\\.pdf$" ".ps" file)
|
||||
(error "abc code block requires :file header argument"))))
|
||||
(in-file (org-babel-temp-file "abc-"))
|
||||
(render (concat "abcm2ps" " " cmdline
|
||||
" -O " (org-babel-process-file-name out-file)
|
||||
" " (org-babel-process-file-name in-file))))
|
||||
(with-temp-file in-file (insert (org-babel-expand-body:abc body params)))
|
||||
(org-babel-eval render "")
|
||||
;;; handle where abcm2ps changes the file name (to support multiple files
|
||||
(when (or (string= (file-name-extension out-file) "eps")
|
||||
(string= (file-name-extension out-file) "svg"))
|
||||
(rename-file (concat
|
||||
(file-name-sans-extension out-file) "001."
|
||||
(file-name-extension out-file))
|
||||
out-file t))
|
||||
;;; if we were asked for a pdf...
|
||||
(when (string= (file-name-extension (cdr (assq :file params))) "pdf")
|
||||
(org-babel-eval (concat "ps2pdf" " " out-file " " (cdr (assq :file params))) ""))
|
||||
;;; indicate that the file has been written
|
||||
nil))
|
||||
|
||||
;; This function should be used to assign any variables in params in
|
||||
;; the context of the session environment.
|
||||
(defun org-babel-prep-session:abc (_session _params)
|
||||
"Return an error because abc does not support sessions."
|
||||
(error "ABC does not support sessions"))
|
||||
|
||||
(provide 'ob-abc)
|
||||
|
||||
;;; ob-abc.el ends here
|
||||
117
lisp/org-contrib/ob-arduino.el
Normal file
117
lisp/org-contrib/ob-arduino.el
Normal file
@@ -0,0 +1,117 @@
|
||||
;;; ob-arduino.el --- Org-mode Babel support for Arduino
|
||||
;;
|
||||
;; Authors: stardiviner <numbchild@gmail.com>
|
||||
;; Package-Requires: ((emacs "24.4") (org "24.1"))
|
||||
;; Package-Version: 1.0
|
||||
;; Keywords: arduino org babel
|
||||
;; homepage: https://github.com/stardiviner/arduino-mode/blob/master/ob-arduino.el
|
||||
;;
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
;;
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
;;
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; Like the following src block, press =[C-c C-c]= to upload to Arduino board.
|
||||
;;
|
||||
;; #+begin_src arduino
|
||||
;; // the setup function runs once when you press reset or power the board
|
||||
;; void setup() {
|
||||
;; // initialize digital pin LED_BUILTIN as an output.
|
||||
;; pinMode(LED_BUILTIN, OUTPUT);
|
||||
;; }
|
||||
;;
|
||||
;; // the loop function runs over and over again forever
|
||||
;; void loop() {
|
||||
;; digitalWrite(LED_BUILTIN, HIGH); // turn the LED on (HIGH is the voltage level)
|
||||
;; delay(100); // wait for 0.1 second
|
||||
;; digitalWrite(LED_BUILTIN, LOW); // turn the LED off by making the voltage LOW
|
||||
;; delay(100); // wait for 0.1 second
|
||||
;; }
|
||||
;; #+end_src
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(require 'org)
|
||||
(require 'ob)
|
||||
(require 'arduino-mode nil t)
|
||||
|
||||
(defgroup ob-arduino nil
|
||||
"org-mode blocks for Arduino."
|
||||
:group 'org)
|
||||
|
||||
(defcustom ob-arduino:program "arduino"
|
||||
"Default Arduino program name."
|
||||
:group 'ob-arduino
|
||||
:type 'string)
|
||||
|
||||
(defcustom ob-arduino:port "/dev/ttyACM0"
|
||||
"Default Arduino port."
|
||||
:group 'ob-arduino
|
||||
:type 'string)
|
||||
|
||||
(defcustom ob-arduino:board "arduino:avr:uno"
|
||||
"Default Arduino board."
|
||||
:group 'ob-arduino
|
||||
:type 'string)
|
||||
|
||||
|
||||
(defvar org-babel-default-header-args:sclang nil)
|
||||
|
||||
;;;###autoload
|
||||
(defun org-babel-execute:arduino (body params)
|
||||
"org-babel arduino hook."
|
||||
(let* ((port (cdr (assoc :port params)))
|
||||
(board (cdr (assoc :board params)))
|
||||
(cmd (mapconcat 'identity (list
|
||||
ob-arduino:program "--upload"
|
||||
(if port (concat "--port " port))
|
||||
(if board (concat "--board " board))
|
||||
) " "))
|
||||
(code (org-babel-expand-body:generic body params))
|
||||
(src-file (org-babel-temp-file "ob-arduino-" ".ino")))
|
||||
;; delete all `ob-arduino' temp files, otherwise arduino will compile all
|
||||
;; ob-arduino temp files, and report error.
|
||||
(mapc
|
||||
(lambda (f)
|
||||
(unless (file-directory-p f)
|
||||
(delete-file (expand-file-name f org-babel-temporary-directory))))
|
||||
(directory-files
|
||||
(file-name-directory (org-babel-temp-file "ob-arduino-" ".ino"))
|
||||
nil ".ino"))
|
||||
;; specify file for arduino command.
|
||||
(with-temp-file src-file
|
||||
(insert code))
|
||||
(org-babel-eval
|
||||
(concat ob-arduino:program
|
||||
" " "--upload"
|
||||
" " (if port (concat "--port " port))
|
||||
" " (if board (concat "--board " board))
|
||||
" " src-file)
|
||||
"" ; pass empty string "" as `BODY' to `org-babel--shell-command-on-region'
|
||||
;; to fix command `arduino' don't accept string issue.
|
||||
)
|
||||
))
|
||||
|
||||
|
||||
;;;###autoload
|
||||
(eval-after-load 'org
|
||||
'(add-to-list 'org-src-lang-modes '("arduino" . arduino)))
|
||||
|
||||
|
||||
|
||||
|
||||
(provide 'ob-arduino)
|
||||
|
||||
;;; ob-arduino.el ends here
|
||||
138
lisp/org-contrib/ob-asymptote.el
Normal file
138
lisp/org-contrib/ob-asymptote.el
Normal file
@@ -0,0 +1,138 @@
|
||||
;;; ob-asymptote.el --- Babel Functions for Asymptote -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Eric Schulte
|
||||
;; Maintainer: Luc Pellissier <luc.pellissier@crans.org>
|
||||
;; Keywords: literate programming, reproducible research
|
||||
;; Homepage: https://orgmode.org
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Org-Babel support for evaluating asymptote source code.
|
||||
;;
|
||||
;; This differs from most standard languages in that
|
||||
;;
|
||||
;; 1) there is no such thing as a "session" in asymptote
|
||||
;;
|
||||
;; 2) we are generally only going to return results of type "file"
|
||||
;;
|
||||
;; 3) we are adding the "file" and "cmdline" header arguments, if file
|
||||
;; is omitted then the -V option is passed to the asy command for
|
||||
;; interactive viewing
|
||||
|
||||
;;; Requirements:
|
||||
|
||||
;; - The asymptote program :: http://asymptote.sourceforge.net/
|
||||
;;
|
||||
;; - asy-mode :: Major mode for editing asymptote files
|
||||
|
||||
;;; Code:
|
||||
(require 'ob)
|
||||
|
||||
(defvar org-babel-tangle-lang-exts)
|
||||
(add-to-list 'org-babel-tangle-lang-exts '("asymptote" . "asy"))
|
||||
|
||||
(defvar org-babel-default-header-args:asymptote
|
||||
'((:results . "file") (:exports . "results"))
|
||||
"Default arguments when evaluating an Asymptote source block.")
|
||||
|
||||
(defun org-babel-execute:asymptote (body params)
|
||||
"Execute a block of Asymptote code.
|
||||
This function is called by `org-babel-execute-src-block'."
|
||||
(let* ((out-file (cdr (assq :file params)))
|
||||
(format (or (file-name-extension out-file)
|
||||
"pdf"))
|
||||
(cmdline (cdr (assq :cmdline params)))
|
||||
(in-file (org-babel-temp-file "asymptote-"))
|
||||
(cmd
|
||||
(concat "asy "
|
||||
(if out-file
|
||||
(concat
|
||||
"-globalwrite -f " format
|
||||
" -o " (org-babel-process-file-name out-file))
|
||||
"-V")
|
||||
" " cmdline
|
||||
" " (org-babel-process-file-name in-file))))
|
||||
(with-temp-file in-file
|
||||
(insert (org-babel-expand-body:generic
|
||||
body params
|
||||
(org-babel-variable-assignments:asymptote params))))
|
||||
(message cmd) (shell-command cmd)
|
||||
nil)) ;; signal that output has already been written to file
|
||||
|
||||
(defun org-babel-prep-session:asymptote (_session _params)
|
||||
"Return an error if the :session header argument is set.
|
||||
Asymptote does not support sessions."
|
||||
(error "Asymptote does not support sessions"))
|
||||
|
||||
(defun org-babel-variable-assignments:asymptote (params)
|
||||
"Return list of asymptote statements assigning the block's variables."
|
||||
(mapcar #'org-babel-asymptote-var-to-asymptote
|
||||
(org-babel--get-vars params)))
|
||||
|
||||
(defun org-babel-asymptote-var-to-asymptote (pair)
|
||||
"Convert an elisp value into an Asymptote variable.
|
||||
The elisp value PAIR is converted into Asymptote code specifying
|
||||
a variable of the same value."
|
||||
(let ((var (car pair))
|
||||
(val (let ((v (cdr pair)))
|
||||
(if (symbolp v) (symbol-name v) v))))
|
||||
(cond
|
||||
((integerp val)
|
||||
(format "int %S=%S;" var val))
|
||||
((floatp val)
|
||||
(format "real %S=%S;" var val))
|
||||
((stringp val)
|
||||
(format "string %S=\"%s\";" var val))
|
||||
((and (listp val) (not (listp (car val))))
|
||||
(let* ((type (org-babel-asymptote-define-type val))
|
||||
(fmt (if (eq 'string type) "\"%s\"" "%s"))
|
||||
(vect (mapconcat (lambda (e) (format fmt e)) val ", ")))
|
||||
(format "%s[] %S={%s};" type var vect)))
|
||||
((listp val)
|
||||
(let* ((type (org-babel-asymptote-define-type val))
|
||||
(fmt (if (eq 'string type) "\"%s\"" "%s"))
|
||||
(array (mapconcat (lambda (row)
|
||||
(concat "{"
|
||||
(mapconcat (lambda (e) (format fmt e))
|
||||
row ", ")
|
||||
"}"))
|
||||
val ",")))
|
||||
(format "%S[][] %S={%s};" type var array))))))
|
||||
|
||||
(defun org-babel-asymptote-define-type (data)
|
||||
"Determine type of DATA.
|
||||
|
||||
DATA is a list. Return type as a symbol.
|
||||
|
||||
The type is `string' if any element in DATA is a string.
|
||||
Otherwise, it is either `real', if some elements are floats, or
|
||||
`int'."
|
||||
(letrec ((type 'int)
|
||||
(find-type
|
||||
(lambda (row)
|
||||
(dolist (e row type)
|
||||
(cond ((listp e) (setq type (funcall find-type e)))
|
||||
((stringp e) (throw 'exit 'string))
|
||||
((floatp e) (setq type 'real)))))))
|
||||
(catch 'exit (funcall find-type data)) type))
|
||||
|
||||
(provide 'ob-asymptote)
|
||||
|
||||
;;; ob-asymptote.el ends here
|
||||
306
lisp/org-contrib/ob-clojure-literate.el
Normal file
306
lisp/org-contrib/ob-clojure-literate.el
Normal file
@@ -0,0 +1,306 @@
|
||||
;;; ob-clojure-literate.el --- Clojure's Org-mode Literate Programming
|
||||
|
||||
;; Authors: stardiviner <numbchild@gmail.com>
|
||||
;; Package-Requires: ((emacs "24.4") (org "9") (cider "0.16.0") (dash "2.12.0"))
|
||||
;; Package-Version: 1.1
|
||||
;; Keywords: tools
|
||||
;; homepage: https://github.com/stardiviner/ob-clojure-literate
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
;;
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; Auto setup ob-clojure-literate scaffold and jack-in Clojure project.
|
||||
;;
|
||||
;; Usage:
|
||||
;;
|
||||
;; [M-x ob-clojure-literate-mode] to toggle this minor mode.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ob-clojure)
|
||||
(require 'cider nil t)
|
||||
|
||||
(defgroup ob-clojure-literate nil
|
||||
"Clojure's Org-mode Literate Programming."
|
||||
:prefix "ob-clojure-literate-"
|
||||
:group 'ob-babel)
|
||||
|
||||
;;;###autoload
|
||||
(defcustom ob-clojure-literate-auto-jackin-p nil
|
||||
"Auto jack in ob-clojure project.
|
||||
Don't auto jack in by default for not rude."
|
||||
:type 'boolean
|
||||
:group 'ob-clojure-literate)
|
||||
|
||||
(defcustom ob-clojure-literate-project-location nil
|
||||
"The location for `ob-clojure-literate' scaffold project.
|
||||
If it is nil, then `cider-jack-in' will jack-in outside of Clojure project.
|
||||
If it is a directory, `ob-clojure-literate' will try to create Clojure project automatically."
|
||||
:type 'string
|
||||
:group 'ob-clojure-literate)
|
||||
|
||||
(defvar ob-clojure-literate-session nil)
|
||||
(defvar ob-clojure-literate-original-ns nil)
|
||||
(defvar ob-clojure-literate-session-ns nil)
|
||||
(defvar ob-clojure-literate-cider-connections nil)
|
||||
|
||||
(defcustom ob-clojure-literate-default-session "*cider-repl localhost*"
|
||||
"The default session name for `ob-clojure-literate'."
|
||||
:type 'string
|
||||
:group 'ob-clojure-literate)
|
||||
|
||||
(defun ob-clojure-literate-any-connection-p ()
|
||||
"Return t if have any CIDER connection."
|
||||
(and
|
||||
;; handle the case `cider-jack-in' is not finished creating connection, but `ob-clojure-literate-mode' is enabled.
|
||||
(not (null (cider-connections)))
|
||||
(not (null ob-clojure-literate-session)) ; before mode enabled, it is nil.
|
||||
(not (string-empty-p ob-clojure-literate-session)) ; after disable, it is "".
|
||||
))
|
||||
|
||||
(defun ob-clojure-literate-get-session-list ()
|
||||
"Return a list of available started CIDER REPL sessions list."
|
||||
(mapcar #'buffer-name
|
||||
;; for multiple connections case.
|
||||
;; get global value instead of buffer local.
|
||||
(default-value 'cider-connections)))
|
||||
|
||||
;;; Do not allow "ob-clojure" project session name.
|
||||
(defun ob-clojure-literate-set-session ()
|
||||
"Set session name for buffer local."
|
||||
;; if default session is the only one in connections list.
|
||||
(if (and (= (length (ob-clojure-literate-get-session-list)) 1)
|
||||
(member ob-clojure-literate-default-session (ob-clojure-literate-get-session-list)))
|
||||
(setq-local ob-clojure-literate-session ob-clojure-literate-default-session)
|
||||
;; if have any connections, choose one from them.
|
||||
(if (ob-clojure-literate-any-connection-p)
|
||||
(setq-local ob-clojure-literate-session
|
||||
(completing-read "Choose ob-clojure-literate :session : "
|
||||
(ob-clojure-literate-get-session-list)))
|
||||
;; if none, set to default session name to fix `ob-clojure-literate-mode'
|
||||
;; is enabled before `cider-jack-in' generated connections.
|
||||
(setq-local ob-clojure-literate-session
|
||||
ob-clojure-literate-default-session))))
|
||||
|
||||
;;;###autoload
|
||||
(defun ob-clojure-literate-specify-session ()
|
||||
"Specify ob-clojure header argument :session with value selected from a list of available sessions."
|
||||
(interactive)
|
||||
(let ((lang (nth 0 (org-babel-get-src-block-info))))
|
||||
(if (and (string= lang "clojure") ; only in clojure src block.
|
||||
(car (seq-filter ; only when :session is not specified yet.
|
||||
(lambda (header-argument)
|
||||
(if (eq (car header-argument) :session)
|
||||
(not (null (cdr header-argument)))))
|
||||
(nth 2 (org-babel-get-src-block-info)))))
|
||||
(org-babel-insert-header-arg
|
||||
"session"
|
||||
(format "\"%s\""
|
||||
(completing-read
|
||||
"Choose :session for ob-clojure-literate: "
|
||||
(ob-clojure-literate-get-session-list))))
|
||||
(message "This function only used in `clojure' src block.")))
|
||||
)
|
||||
|
||||
;;; Auto start CIDER REPL session in a complete Leiningen project environment for Org-mode Babel to jack-in.
|
||||
;;;###autoload
|
||||
(defun ob-clojure-literate-auto-jackin ()
|
||||
"Auto setup ob-clojure-literate scaffold and jack-in Clojure project."
|
||||
(interactive)
|
||||
(cond
|
||||
;; jack-in outside of Clojure project.
|
||||
((null ob-clojure-literate-project-location)
|
||||
(if (member (get-buffer "*cider-repl localhost*") cider-connections)
|
||||
(message "CIDER default session already launched.")
|
||||
(cider-jack-in nil)))
|
||||
((not (null ob-clojure-literate-project-location))
|
||||
(unless (file-directory-p (expand-file-name ob-clojure-literate-project-location))
|
||||
(make-directory ob-clojure-literate-project-location t)
|
||||
(let ((default-directory ob-clojure-literate-project-location))
|
||||
(shell-command "lein new ob-clojure")))
|
||||
(unless (or
|
||||
(and (cider-connected-p)
|
||||
(if (not (null ob-clojure-literate-session))
|
||||
(seq-contains cider-connections (get-buffer ob-clojure-literate-session))))
|
||||
cider-connections
|
||||
(ob-clojure-literate-any-connection-p))
|
||||
;; return back to original file.
|
||||
(if (not (and (= (length (ob-clojure-literate-get-session-list)) 1)
|
||||
(member ob-clojure-literate-default-session (ob-clojure-literate-get-session-list))))
|
||||
(save-window-excursion
|
||||
(find-file (expand-file-name (concat ob-clojure-literate-project-location "ob-clojure/src/ob_clojure/core.clj")))
|
||||
(with-current-buffer "core.clj"
|
||||
(cider-jack-in))))))))
|
||||
|
||||
(defun ob-clojure-literate-set-local-cider-connections (toggle?)
|
||||
"Set buffer local `cider-connections' for `ob-clojure-literate-mode' `TOGGLE?'."
|
||||
(if toggle?
|
||||
(progn
|
||||
(setq ob-clojure-literate-cider-connections cider-connections)
|
||||
(unless (local-variable-if-set-p 'cider-connections)
|
||||
(make-local-variable 'cider-connections))
|
||||
(setq-local cider-connections ob-clojure-literate-cider-connections))
|
||||
;; store/restore emptied CIDER connections by `ob-clojure-literate-enable'.
|
||||
(kill-local-variable 'cider-connections) ; kill local variable so that I can get the original global variable value.
|
||||
;; Empty all CIDER connections to avoid `cider-current-connection' return any connection.
|
||||
;; FIXME: when try to enable, `cider-connections' is local and nil.
|
||||
;; (if (and (= (length (ob-clojure-literate-get-session-list)) 1)
|
||||
;; (member ob-clojure-literate-default-session (ob-clojure-literate-get-session-list))))
|
||||
;; (unless (local-variable-if-set-p 'cider-connections)
|
||||
;; (make-local-variable 'cider-connections))
|
||||
;; (setq-local cider-connections '())
|
||||
))
|
||||
|
||||
(defun ob-clojure-literate-set-ns (body params)
|
||||
"Fix the issue that `cider-current-ns' try to invoke `clojure-find-ns' to extract ns from buffer."
|
||||
;; TODO: Is it possible to find ns in `body'?
|
||||
(when (ob-clojure-literate-any-connection-p)
|
||||
(setq ob-clojure-literate-original-ns (cider-current-ns))
|
||||
(with-current-buffer ob-clojure-literate-session
|
||||
(setq ob-clojure-literate-session-ns cider-buffer-ns))
|
||||
(setq-local cider-buffer-ns (or (cdr (assq :ns params))
|
||||
ob-clojure-literate-session-ns)))
|
||||
(message (format "ob-clojure-literate: current CIDER ns is [%s]." cider-buffer-ns)))
|
||||
|
||||
(defun ob-clojure-literate-set-local-session (toggle?)
|
||||
"Set buffer local `org-babel-default-header-args:clojure' for `ob-clojure-literate-mode' `TOGGLE?'."
|
||||
(if toggle?
|
||||
(progn
|
||||
;; set local default session for ob-clojure.
|
||||
(setq ob-clojure-literate-session (ob-clojure-literate-set-session))
|
||||
(unless (local-variable-if-set-p 'org-babel-default-header-args:clojure)
|
||||
(make-local-variable 'org-babel-default-header-args:clojure))
|
||||
(add-to-list 'org-babel-default-header-args:clojure
|
||||
`(:session . ,ob-clojure-literate-session))
|
||||
)
|
||||
;; remove :session from buffer local default header arguments list.
|
||||
(unless (local-variable-if-set-p 'org-babel-default-header-args:clojure)
|
||||
(make-local-variable 'org-babel-default-header-args:clojure))
|
||||
(setq org-babel-default-header-args:clojure
|
||||
(delq t
|
||||
(mapcar
|
||||
(lambda (cons) (if (eq (car cons) :session) t cons))
|
||||
org-babel-default-header-args:clojure)))))
|
||||
|
||||
|
||||
;;; Support header arguments :results graphics :file "image.png" by inject Clojure code.
|
||||
(defun ob-clojure-literate-inject-code (args)
|
||||
"Inject Clojure code into `BODY' in `ARGS'.
|
||||
It is used to change Clojure currently working directory in a FAKE way.
|
||||
And generate inline graphics image file link result.
|
||||
Use header argument like this:
|
||||
|
||||
:results graphics :file \"incanter-plot.png\"
|
||||
|
||||
Then you need to assign image variable to this :file value like:
|
||||
(def incanter-plot (histogram (sample-normal 1000)))
|
||||
|
||||
*NOTE*: Currently only support Incanter's `save' function.
|
||||
"
|
||||
(let* ((body (nth 0 args))
|
||||
(params (nth 1 args))
|
||||
(dir (cdr (assq :dir params)))
|
||||
(default-directory (and (buffer-file-name) (file-name-directory (buffer-file-name))))
|
||||
(directory (and dir (file-name-as-directory (expand-file-name dir))))
|
||||
(result-type (cdr (assq :results params)))
|
||||
(file (cdr (assq :file params)))
|
||||
(file-name (and file (file-name-base file)))
|
||||
;; TODO: future support `:graphics-file' to avoid collision.
|
||||
(graphics-result (member "graphics" (cdr (assq :result-params params))))
|
||||
;; (graphics-file (cdr (assq :graphics-file params)))
|
||||
;; (graphics-name (file-name-base graphics-file))
|
||||
(prepend-to-body (lambda (code)
|
||||
(setq body (concat code "\n" body))))
|
||||
(append-to-body (lambda (code)
|
||||
(setq body (concat body "\n" code "\n"))))
|
||||
)
|
||||
(when directory
|
||||
(unless (file-directory-p (expand-file-name directory))
|
||||
(warn (format "Target directory %s does not exist, please create it." dir))))
|
||||
(when file
|
||||
(funcall append-to-body
|
||||
(format "(save %s \"%s\")" file-name (concat directory file)))
|
||||
)
|
||||
(list body params) ; return modified argument list
|
||||
))
|
||||
|
||||
;;; support :results graphics :dir "data/image" :file "incanter-plot.png"
|
||||
(defun ob-clojure-literate-support-graphics-result (result)
|
||||
"Support :results graphics :dir \"data/images\" :file \"incanter-plot.png\"
|
||||
reset `RESULT' to `nil'."
|
||||
(let* ((params (nth 2 info))
|
||||
(graphics-result (member "graphics" (cdr (assq :result-params params)))))
|
||||
(if graphics-result
|
||||
(setq result nil))
|
||||
result))
|
||||
|
||||
|
||||
(defvar ob-clojure-literate-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
map)
|
||||
"Keymap for `ob-clojure-literate-mode'.")
|
||||
|
||||
(define-key org-babel-map (kbd "M-s") 'ob-clojure-literate-specify-session)
|
||||
(define-key org-babel-map (kbd "M-j") 'ob-clojure-literate-auto-jackin)
|
||||
;; (define-key org-babel-map (kbd "M-e") 'cider-eval-last-sexp)
|
||||
;; (define-key org-babel-map (kbd "M-d") 'cider-doc)
|
||||
|
||||
;;;###autoload
|
||||
(defun ob-clojure-literate-enable ()
|
||||
"Enable Org-mode buffer locally for `ob-clojure-literate'."
|
||||
(when (and (not (null cider-connections)) ; only enable `ob-clojure-literate-mode' when has CIDER connections.
|
||||
(equal major-mode 'org-mode)) ; `ob-clojure-literate-mode' only works in `org-mode'.
|
||||
(ob-clojure-literate-set-local-cider-connections ob-clojure-literate-mode)
|
||||
(ob-clojure-literate-set-local-session ob-clojure-literate-mode)
|
||||
(advice-add 'org-babel-execute:clojure :before #'ob-clojure-literate-set-ns)
|
||||
(advice-add 'org-babel-expand-body:clojure :filter-args #'ob-clojure-literate-inject-code)
|
||||
(advice-add 'org-babel-execute:clojure :filter-return #'ob-clojure-literate-support-graphics-result)
|
||||
(message "ob-clojure-literate minor mode enabled.")))
|
||||
|
||||
;;;###autoload
|
||||
(defun ob-clojure-literate-disable ()
|
||||
"Disable Org-mode buffer locally for `ob-clojure-literate'."
|
||||
(advice-remove 'org-babel-execute:clojure #'ob-clojure-literate-set-ns)
|
||||
(advice-remove 'org-babel-expand-body:clojure #'ob-clojure-literate-inject-code)
|
||||
(advice-remove 'org-babel-execute:clojure #'ob-clojure-literate-support-graphics-result)
|
||||
(setq-local cider-buffer-ns ob-clojure-literate-original-ns)
|
||||
(ob-clojure-literate-set-local-cider-connections ob-clojure-literate-mode)
|
||||
(ob-clojure-literate-set-local-session ob-clojure-literate-mode)
|
||||
(message "ob-clojure-literate minor mode disabled."))
|
||||
|
||||
;;;###autoload
|
||||
(if ob-clojure-literate-auto-jackin-p (ob-clojure-literate-auto-jackin))
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode ob-clojure-literate-mode
|
||||
"A minor mode to toggle `ob-clojure-literate'."
|
||||
:require 'ob-clojure-literate
|
||||
:init-value nil
|
||||
:lighter " clj-lp"
|
||||
:group 'ob-clojure-literate
|
||||
:keymap ob-clojure-literate-mode-map
|
||||
:global nil
|
||||
(if ob-clojure-literate-mode
|
||||
(ob-clojure-literate-enable)
|
||||
(ob-clojure-literate-disable))
|
||||
)
|
||||
|
||||
|
||||
|
||||
(provide 'ob-clojure-literate)
|
||||
|
||||
;;; ob-clojure-literate.el ends here
|
||||
81
lisp/org-contrib/ob-coq.el
Normal file
81
lisp/org-contrib/ob-coq.el
Normal file
@@ -0,0 +1,81 @@
|
||||
;;; ob-coq.el --- Babel Functions for Coq -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Eric Schulte
|
||||
;; Maintainer: Luc Pellissier <luc.pellissier@crans.org>
|
||||
;; Keywords: literate programming, reproducible research
|
||||
;; Homepage: https://orgmode.org
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Rudimentary support for evaluating Coq code blocks. Currently only
|
||||
;; session evaluation is supported. Requires both coq.el and
|
||||
;; coq-inferior.el, both of which are distributed with Coq.
|
||||
;;
|
||||
;; https://coq.inria.fr/
|
||||
|
||||
;;; Code:
|
||||
(require 'ob)
|
||||
|
||||
(declare-function run-coq "ext:coq-inferior.el" (cmd))
|
||||
(declare-function coq-proc "ext:coq-inferior.el" ())
|
||||
|
||||
(defvar coq-program-name "coqtop"
|
||||
"Name of the coq toplevel to run.")
|
||||
|
||||
(defvar org-babel-coq-buffer "*coq*"
|
||||
"Buffer in which to evaluate coq code blocks.")
|
||||
|
||||
(defun org-babel-coq-clean-prompt (string)
|
||||
(if (string-match "^[^[:space:]]+ < " string)
|
||||
(substring string 0 (match-beginning 0))
|
||||
string))
|
||||
|
||||
(defun org-babel-execute:coq (body params)
|
||||
(let ((full-body (org-babel-expand-body:generic body params))
|
||||
(session (org-babel-coq-initiate-session))
|
||||
(pt (lambda ()
|
||||
(marker-position
|
||||
(process-mark (get-buffer-process (current-buffer)))))))
|
||||
(org-babel-coq-clean-prompt
|
||||
(org-babel-comint-in-buffer session
|
||||
(let ((start (funcall pt)))
|
||||
(with-temp-buffer
|
||||
(insert full-body)
|
||||
(comint-send-region (coq-proc) (point-min) (point-max))
|
||||
(comint-send-string (coq-proc)
|
||||
(if (string= (buffer-substring (- (point-max) 1) (point-max)) ".")
|
||||
"\n"
|
||||
".\n")))
|
||||
(while (equal start (funcall pt)) (sleep-for 0.1))
|
||||
(buffer-substring start (funcall pt)))))))
|
||||
|
||||
(defun org-babel-coq-initiate-session ()
|
||||
"Initiate a coq session.
|
||||
If there is not a current inferior-process-buffer in SESSION then
|
||||
create one. Return the initialized session."
|
||||
(unless (fboundp 'run-coq)
|
||||
(error "`run-coq' not defined, load coq-inferior.el"))
|
||||
(save-window-excursion (run-coq coq-program-name))
|
||||
(sit-for 0.1)
|
||||
(get-buffer org-babel-coq-buffer))
|
||||
|
||||
(provide 'ob-coq)
|
||||
|
||||
;;; ob-coq.el ends here
|
||||
83
lisp/org-contrib/ob-csharp.el
Normal file
83
lisp/org-contrib/ob-csharp.el
Normal file
@@ -0,0 +1,83 @@
|
||||
;;; ob-csharp.el --- org-babel functions for csharp evaluation
|
||||
|
||||
;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: thomas "at" friendlyvillagers.com based on ob-java.el by Eric Schulte
|
||||
;; Keywords: literate programming, reproducible research
|
||||
;; Homepage: https://orgmode.org
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Currently this only supports the external compilation and execution
|
||||
;; of csharp code blocks (i.e., no session support).
|
||||
|
||||
;;; Code:
|
||||
(require 'ob)
|
||||
|
||||
(defvar org-babel-tangle-lang-exts)
|
||||
(add-to-list 'org-babel-tangle-lang-exts '("csharp" . "cs"))
|
||||
|
||||
(defcustom org-babel-csharp-command "mono"
|
||||
"Name of the csharp command.
|
||||
May be either a command in the path, like mono
|
||||
or an absolute path name, like /usr/local/bin/mono
|
||||
parameters may be used, like mono -verbose"
|
||||
:group 'org-babel
|
||||
:version "24.3"
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-babel-csharp-compiler "mcs"
|
||||
"Name of the csharp compiler.
|
||||
May be either a command in the path, like mcs
|
||||
or an absolute path name, like /usr/local/bin/mcs
|
||||
parameters may be used, like mcs -warnaserror+"
|
||||
:group 'org-babel
|
||||
:version "24.3"
|
||||
:type 'string)
|
||||
|
||||
(defun org-babel-execute:csharp (body params)
|
||||
(let* ((full-body (org-babel-expand-body:generic body params))
|
||||
(cmpflag (or (cdr (assq :cmpflag params)) ""))
|
||||
(cmdline (or (cdr (assq :cmdline params)) ""))
|
||||
(src-file (org-babel-temp-file "csharp-src-" ".cs"))
|
||||
(exe-file (concat (file-name-sans-extension src-file) ".exe"))
|
||||
(compile
|
||||
(progn (with-temp-file src-file (insert full-body))
|
||||
(org-babel-eval
|
||||
(concat org-babel-csharp-compiler " " cmpflag " " src-file) ""))))
|
||||
(let ((results (org-babel-eval (concat org-babel-csharp-command " " cmdline " " exe-file) "")))
|
||||
(org-babel-reassemble-table
|
||||
(org-babel-result-cond (cdr (assq :result-params params))
|
||||
(org-babel-read results)
|
||||
(let ((tmp-file (org-babel-temp-file "c-")))
|
||||
(with-temp-file tmp-file (insert results))
|
||||
(org-babel-import-elisp-from-file tmp-file)))
|
||||
(org-babel-pick-name
|
||||
(cdr (assq :colname-names params)) (cdr (assq :colnames params)))
|
||||
(org-babel-pick-name
|
||||
(cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))))
|
||||
|
||||
(defun org-babel-prep-session:csharp (session params)
|
||||
"Return an error because csharp does not support sessions."
|
||||
(error "Sessions are not supported for CSharp"))
|
||||
|
||||
(provide 'ob-csharp)
|
||||
|
||||
|
||||
|
||||
;;; ob-csharp.el ends here
|
||||
81
lisp/org-contrib/ob-ebnf.el
Normal file
81
lisp/org-contrib/ob-ebnf.el
Normal file
@@ -0,0 +1,81 @@
|
||||
;;; ob-ebnf.el --- Babel Functions for EBNF -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Michael Gauland
|
||||
;; Keywords: literate programming, reproducible research
|
||||
;; Homepage: https://orgmode.org
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Org-Babel support for using ebnf2ps to generate encapsulated postscript
|
||||
;; railroad diagrams. It recognizes these arguments:
|
||||
;;
|
||||
;; :file is required; it must include the extension '.eps.' All the rules
|
||||
;; in the block will be drawn in the same file. This is done by
|
||||
;; inserting a '[<file>' comment at the start of the block (see the
|
||||
;; documentation for ebnf-eps-buffer for more information).
|
||||
;;
|
||||
;; :style specifies a value in ebnf-style-database. This provides the
|
||||
;; ability to customize the output. The style can also specify the
|
||||
;; grammar syntax (by setting ebnf-syntax); note that only ebnf,
|
||||
;; iso-ebnf, and yacc are supported by this file.
|
||||
|
||||
;;; Requirements:
|
||||
|
||||
;;; Code:
|
||||
(require 'ob)
|
||||
(require 'ebnf2ps)
|
||||
|
||||
;; optionally declare default header arguments for this language
|
||||
(defvar org-babel-default-header-args:ebnf '((:style . nil)))
|
||||
|
||||
;; Use ebnf-eps-buffer to produce an encapsulated postscript file.
|
||||
;;
|
||||
(defun org-babel-execute:ebnf (body params)
|
||||
"Execute a block of Ebnf code with org-babel.
|
||||
This function is called by `org-babel-execute-src-block'."
|
||||
(save-excursion
|
||||
(let* ((dest-file (cdr (assq :file params)))
|
||||
(dest-dir (file-name-directory dest-file))
|
||||
(dest-root (file-name-sans-extension
|
||||
(file-name-nondirectory dest-file)))
|
||||
(style (cdr (assq :style params)))
|
||||
(result nil))
|
||||
(with-temp-buffer
|
||||
(when style (ebnf-push-style style))
|
||||
(let ((comment-format
|
||||
(cond ((string= ebnf-syntax 'yacc) "/*%s*/")
|
||||
((string= ebnf-syntax 'ebnf) ";%s")
|
||||
((string= ebnf-syntax 'iso-ebnf) "(*%s*)")
|
||||
(t (setq result
|
||||
(format "EBNF error: format %s not supported."
|
||||
ebnf-syntax))))))
|
||||
(setq ebnf-eps-prefix dest-dir)
|
||||
(insert (format comment-format (format "[%s" dest-root)))
|
||||
(newline)
|
||||
(insert body)
|
||||
(newline)
|
||||
(insert (format comment-format (format "]%s" dest-root)))
|
||||
(ebnf-eps-buffer)
|
||||
(when style (ebnf-pop-style))))
|
||||
result)))
|
||||
|
||||
(provide 'ob-ebnf)
|
||||
|
||||
;;; ob-ebnf.el ends here
|
||||
98
lisp/org-contrib/ob-eukleides.el
Normal file
98
lisp/org-contrib/ob-eukleides.el
Normal file
@@ -0,0 +1,98 @@
|
||||
;;; ob-eukleides.el --- Org-babel functions for eukleides evaluation
|
||||
|
||||
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Luis Anaya
|
||||
;; Keywords: literate programming, reproducible research
|
||||
;; Homepage: https://orgmode.org
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; This program is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Org-Babel support for evaluating eukleides script.
|
||||
;;
|
||||
;; Inspired by Ian Yang's org-export-blocks-format-eukleides
|
||||
;; https://www.emacswiki.org/emacs/org-export-blocks-format-eukleides.el
|
||||
|
||||
;;; Requirements:
|
||||
|
||||
;; eukleides | http://eukleides.org
|
||||
;; eukleides | `org-eukleides-path' should point to the eukleides executablexs
|
||||
|
||||
;;; Code:
|
||||
(require 'ob)
|
||||
(require 'ob-eval)
|
||||
|
||||
(defvar org-babel-default-header-args:eukleides
|
||||
'((:results . "file") (:exports . "results"))
|
||||
"Default arguments for evaluating a eukleides source block.")
|
||||
|
||||
(defcustom org-eukleides-path nil
|
||||
"Path to the eukleides executable file."
|
||||
:group 'org-babel
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-eukleides-eps-to-raster nil
|
||||
"Command used to convert EPS to raster. Nil for no conversion."
|
||||
:group 'org-babel
|
||||
:type '(choice
|
||||
(repeat :tag "Shell Command Sequence" (string :tag "Shell Command"))
|
||||
(const :tag "sam2p" "a=%s;b=%s;sam2p ${a} ${b}" )
|
||||
(const :tag "NetPNM" "a=%s;b=%s;pstopnm -stdout ${a} | pnmtopng > ${b}" )
|
||||
(const :tag "None" nil)))
|
||||
|
||||
(defun org-babel-execute:eukleides (body params)
|
||||
"Execute a block of eukleides code with org-babel.
|
||||
This function is called by `org-babel-execute-src-block'."
|
||||
(let* ((result-params (split-string (or (cdr (assq :results params)) "")))
|
||||
(out-file (or (cdr (assq :file params))
|
||||
(error "Eukleides requires a \":file\" header argument")))
|
||||
(cmdline (cdr (assq :cmdline params)))
|
||||
(in-file (org-babel-temp-file "eukleides-"))
|
||||
(java (or (cdr (assq :java params)) ""))
|
||||
(cmd (if (not org-eukleides-path)
|
||||
(error "`org-eukleides-path' is not set")
|
||||
(concat (expand-file-name org-eukleides-path)
|
||||
" -b --output="
|
||||
(org-babel-process-file-name
|
||||
(concat
|
||||
(file-name-sans-extension out-file) ".eps"))
|
||||
" "
|
||||
(org-babel-process-file-name in-file)))))
|
||||
(unless (file-exists-p org-eukleides-path)
|
||||
(error "Could not find eukleides at %s" org-eukleides-path))
|
||||
|
||||
(if (string= (file-name-extension out-file) "png")
|
||||
(if org-eukleides-eps-to-raster
|
||||
(shell-command (format org-eukleides-eps-to-raster
|
||||
(concat (file-name-sans-extension out-file) ".eps")
|
||||
(concat (file-name-sans-extension out-file) ".png")))
|
||||
(error "Conversion to PNG not supported. Use a file with an EPS name")))
|
||||
|
||||
(with-temp-file in-file (insert body))
|
||||
(message "%s" cmd) (org-babel-eval cmd "")
|
||||
nil)) ;; signal that output has already been written to file
|
||||
|
||||
(defun org-babel-prep-session:eukleides (session params)
|
||||
"Return an error because eukleides does not support sessions."
|
||||
(error "Eukleides does not support sessions"))
|
||||
|
||||
(provide 'ob-eukleides)
|
||||
|
||||
|
||||
|
||||
;;; ob-eukleides.el ends here
|
||||
92
lisp/org-contrib/ob-fomus.el
Normal file
92
lisp/org-contrib/ob-fomus.el
Normal file
@@ -0,0 +1,92 @@
|
||||
;;; ob-fomus.el --- Org-babel functions for fomus evaluation
|
||||
|
||||
;; Copyright (C) 2011-2014, 2021 Torsten Anders
|
||||
|
||||
;; Author: Torsten Anders
|
||||
;; Keywords: literate programming, reproducible research
|
||||
;; Homepage: https://orgmode.org
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 3, 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 GNU Emacs; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||||
;; Boston, MA 02110-1301, USA.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Org-Babel support for evaluating Fomus source code.
|
||||
;; For information on Fomus see http://fomus.sourceforge.net/
|
||||
;;
|
||||
;; This differs from most standard languages in that
|
||||
;;
|
||||
;; 1) there is no such thing as a "session" in fomus
|
||||
;;
|
||||
;; 2) we are generally only going to return results of type "file"
|
||||
;;
|
||||
;; 3) we are adding the "file" and "cmdline" header arguments
|
||||
;;
|
||||
;; 4) there are no variables (at least for now)
|
||||
|
||||
;;; Code:
|
||||
(require 'ob)
|
||||
(require 'ob-eval)
|
||||
|
||||
(defvar org-babel-default-header-args:fomus
|
||||
'((:results . "file") (:exports . "results"))
|
||||
"Default arguments to use when evaluating a fomus source block.")
|
||||
|
||||
(defun org-babel-expand-body:fomus (body params)
|
||||
"Expand BODY according to PARAMS, return the expanded body."
|
||||
(let ((vars (org-babel--get-vars params)))
|
||||
(mapc
|
||||
(lambda (pair)
|
||||
(let ((name (symbol-name (car pair)))
|
||||
(value (cdr pair)))
|
||||
(setq body
|
||||
(replace-regexp-in-string
|
||||
(concat "\$" (regexp-quote name))
|
||||
(if (stringp value) value (format "%S" value))
|
||||
body))))
|
||||
vars)
|
||||
body))
|
||||
|
||||
(defun org-babel-execute:fomus (body params)
|
||||
"Execute a block of Fomus code with org-babel.
|
||||
This function is called by `org-babel-execute-src-block'."
|
||||
(let* ((result-params (cdr (assq :result-params params)))
|
||||
(out-file (cdr (assq :file params)))
|
||||
(cmdline (cdr (assq :cmdline params)))
|
||||
(cmd (or (cdr (assq :cmd params)) "fomus"))
|
||||
(in-file (org-babel-temp-file "fomus-" ".fms")))
|
||||
(with-temp-file in-file
|
||||
(insert (org-babel-expand-body:fomus body params)))
|
||||
;; TMP: testing
|
||||
;; (message (concat cmd
|
||||
;; " " (org-babel-process-file-name in-file)
|
||||
;; " " cmdline
|
||||
;; " -o " (org-babel-process-file-name out-file)))
|
||||
(org-babel-eval
|
||||
(concat cmd
|
||||
" " (org-babel-process-file-name in-file)
|
||||
" " cmdline
|
||||
" -o " (org-babel-process-file-name out-file)) "")
|
||||
nil)) ;; signal that output has already been written to file
|
||||
|
||||
(defun org-babel-prep-session:fomus (session params)
|
||||
"Return an error because Fomus does not support sessions."
|
||||
(error "Fomus does not support sessions"))
|
||||
|
||||
(provide 'ob-fomus)
|
||||
|
||||
;;; ob-fomus.el ends here
|
||||
69
lisp/org-contrib/ob-hledger.el
Normal file
69
lisp/org-contrib/ob-hledger.el
Normal file
@@ -0,0 +1,69 @@
|
||||
;;; ob-hledger.el --- Babel Functions for hledger -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Simon Michael
|
||||
;; Keywords: literate programming, reproducible research, plain text accounting
|
||||
;; Homepage: https://orgmode.org
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Babel support for evaluating hledger entries.
|
||||
;;
|
||||
;; Based on ob-ledger.el.
|
||||
;; If the source block is empty, hledger will use a default journal file,
|
||||
;; probably ~/.hledger.journal (it may not notice your $LEDGER_FILE env var).
|
||||
;; So make ~/.hledger.journal a symbolic link to the real file if necessary.
|
||||
|
||||
;; TODO Unit tests are more than welcome, too.
|
||||
|
||||
;;; Code:
|
||||
(require 'ob)
|
||||
|
||||
(defvar org-babel-default-header-args:hledger
|
||||
'((:results . "output") (:exports . "results") (:cmdline . "bal"))
|
||||
"Default arguments to use when evaluating a hledger source block.")
|
||||
|
||||
(defun org-babel-execute:hledger (body params)
|
||||
"Execute a block of hledger entries with org-babel.
|
||||
This function is called by `org-babel-execute-src-block'."
|
||||
(message "executing hledger source code block")
|
||||
(letrec ( ;(result-params (split-string (or (cdr (assq :results params)) "")))
|
||||
(cmdline (cdr (assq :cmdline params)))
|
||||
(in-file (org-babel-temp-file "hledger-"))
|
||||
(out-file (org-babel-temp-file "hledger-output-"))
|
||||
(hledgercmd (concat "hledger"
|
||||
(if (> (length body) 0)
|
||||
(concat " -f " (org-babel-process-file-name in-file))
|
||||
"")
|
||||
" " cmdline)))
|
||||
(with-temp-file in-file (insert body))
|
||||
;; TODO This is calling for some refactoring:
|
||||
;; (concat "hledger" (if ...) " " cmdline)
|
||||
;; could be built only once and bound to a symbol.
|
||||
(message "%s" hledgercmd)
|
||||
(with-output-to-string
|
||||
(shell-command (concat hledgercmd " > " (org-babel-process-file-name out-file))))
|
||||
(with-temp-buffer (insert-file-contents out-file) (buffer-string))))
|
||||
|
||||
(defun org-babel-prep-session:hledger (_session _params)
|
||||
(error "hledger does not support sessions"))
|
||||
|
||||
(provide 'ob-hledger)
|
||||
|
||||
;;; ob-hledger.el ends here
|
||||
105
lisp/org-contrib/ob-io.el
Normal file
105
lisp/org-contrib/ob-io.el
Normal file
@@ -0,0 +1,105 @@
|
||||
;;; ob-io.el --- Babel Functions for Io -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Andrzej Lichnerowicz
|
||||
;; Keywords: literate programming, reproducible research
|
||||
;; Homepage: https://orgmode.org
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
;; Currently only supports the external execution. No session support yet.
|
||||
;; :results output -- runs in scripting mode
|
||||
;; :results output repl -- runs in repl mode
|
||||
|
||||
;;; Requirements:
|
||||
;; - Io language :: https://iolanguage.org/
|
||||
;; - Io major mode :: Can be installed from Io sources
|
||||
;; https://github.com/stevedekorte/io/blob/master/extras/SyntaxHighlighters/Emacs/io-mode.el
|
||||
|
||||
;;; Code:
|
||||
(require 'ob)
|
||||
|
||||
(defvar org-babel-tangle-lang-exts) ;; Autoloaded
|
||||
(add-to-list 'org-babel-tangle-lang-exts '("io" . "io"))
|
||||
(defvar org-babel-default-header-args:io '())
|
||||
(defvar org-babel-io-command "io"
|
||||
"Name of the command to use for executing Io code.")
|
||||
|
||||
(defun org-babel-execute:io (body params)
|
||||
"Execute a block of Io code with org-babel.
|
||||
This function is called by `org-babel-execute-src-block'."
|
||||
(message "executing Io source code block")
|
||||
(let* ((processed-params (org-babel-process-params params))
|
||||
(session (org-babel-io-initiate-session (nth 0 processed-params)))
|
||||
(result-params (nth 2 processed-params))
|
||||
(result-type (cdr (assq :result-type params)))
|
||||
(full-body (org-babel-expand-body:generic
|
||||
body params))
|
||||
(result (org-babel-io-evaluate
|
||||
session full-body result-type result-params)))
|
||||
|
||||
(org-babel-reassemble-table
|
||||
result
|
||||
(org-babel-pick-name
|
||||
(cdr (assq :colname-names params)) (cdr (assq :colnames params)))
|
||||
(org-babel-pick-name
|
||||
(cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))
|
||||
|
||||
(defvar org-babel-io-wrapper-method
|
||||
"(
|
||||
%s
|
||||
) asString print
|
||||
")
|
||||
|
||||
|
||||
(defun org-babel-io-evaluate (session body &optional result-type result-params)
|
||||
"Evaluate BODY in external Io process.
|
||||
If RESULT-TYPE equals `output' then return standard output as a string.
|
||||
If RESULT-TYPE equals `value' then return the value of the last statement
|
||||
in BODY as elisp."
|
||||
(when session (error "Sessions are not (yet) supported for Io"))
|
||||
(pcase result-type
|
||||
(`output
|
||||
(if (member "repl" result-params)
|
||||
(org-babel-eval org-babel-io-command body)
|
||||
(let ((src-file (org-babel-temp-file "io-")))
|
||||
(progn (with-temp-file src-file (insert body))
|
||||
(org-babel-eval
|
||||
(concat org-babel-io-command " " src-file) "")))))
|
||||
(`value (let* ((src-file (org-babel-temp-file "io-"))
|
||||
(wrapper (format org-babel-io-wrapper-method body)))
|
||||
(with-temp-file src-file (insert wrapper))
|
||||
(let ((raw (org-babel-eval
|
||||
(concat org-babel-io-command " " src-file) "")))
|
||||
(org-babel-result-cond result-params
|
||||
raw
|
||||
(org-babel-script-escape raw)))))))
|
||||
|
||||
(defun org-babel-prep-session:io (_session _params)
|
||||
"Prepare SESSION according to the header arguments specified in PARAMS."
|
||||
(error "Sessions are not (yet) supported for Io"))
|
||||
|
||||
(defun org-babel-io-initiate-session (&optional _session)
|
||||
"If there is not a current inferior-process-buffer in SESSION then create.
|
||||
Return the initialized session. Sessions are not
|
||||
supported in Io."
|
||||
nil)
|
||||
|
||||
(provide 'ob-io)
|
||||
|
||||
;;; ob-io.el ends here
|
||||
69
lisp/org-contrib/ob-ledger.el
Normal file
69
lisp/org-contrib/ob-ledger.el
Normal file
@@ -0,0 +1,69 @@
|
||||
;;; ob-ledger.el --- Babel Functions for Ledger -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Eric S Fraga
|
||||
;; Maintainer: Eric S Fraga
|
||||
;; Keywords: literate programming, reproducible research, accounting
|
||||
;; Homepage: https://orgmode.org
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Org-Babel support for evaluating ledger entries.
|
||||
;;
|
||||
;; This differs from most standard languages in that
|
||||
;;
|
||||
;; 1) there is no such thing as a "session" in ledger
|
||||
;;
|
||||
;; 2) we are generally only going to return output from the ledger program
|
||||
;;
|
||||
;; 3) we are adding the "cmdline" header argument
|
||||
;;
|
||||
;; 4) there are no variables
|
||||
|
||||
;;; Code:
|
||||
(require 'ob)
|
||||
|
||||
(defvar org-babel-default-header-args:ledger
|
||||
'((:results . "output") (:cmdline . "bal"))
|
||||
"Default arguments to use when evaluating a ledger source block.")
|
||||
|
||||
(defun org-babel-execute:ledger (body params)
|
||||
"Execute a block of Ledger entries with org-babel.
|
||||
This function is called by `org-babel-execute-src-block'."
|
||||
(message "executing Ledger source code block")
|
||||
(let ((cmdline (cdr (assq :cmdline params)))
|
||||
(in-file (org-babel-temp-file "ledger-"))
|
||||
(out-file (org-babel-temp-file "ledger-output-")))
|
||||
(with-temp-file in-file (insert body))
|
||||
(message "%s" (concat "ledger"
|
||||
" -f " (org-babel-process-file-name in-file)
|
||||
" " cmdline))
|
||||
(with-output-to-string
|
||||
(shell-command (concat "ledger"
|
||||
" -f " (org-babel-process-file-name in-file)
|
||||
" " cmdline
|
||||
" > " (org-babel-process-file-name out-file))))
|
||||
(with-temp-buffer (insert-file-contents out-file) (buffer-string))))
|
||||
|
||||
(defun org-babel-prep-session:ledger (_session _params)
|
||||
(error "Ledger does not support sessions"))
|
||||
|
||||
(provide 'ob-ledger)
|
||||
|
||||
;;; ob-ledger.el ends here
|
||||
95
lisp/org-contrib/ob-mathematica.el
Normal file
95
lisp/org-contrib/ob-mathematica.el
Normal file
@@ -0,0 +1,95 @@
|
||||
;;; ob-mathematica.el --- org-babel functions for Mathematica evaluation
|
||||
|
||||
;; Copyright (C) 2014, 2021 Yi Wang
|
||||
|
||||
;; Authors: Yi Wang
|
||||
;; Keywords: literate programming, reproducible research
|
||||
;; Homepage: https://github.com/tririver/ob-mathematica/
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
;;
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;; Org-Babel support for evaluating Mathematica source code.
|
||||
|
||||
;;; Code:
|
||||
(require 'ob)
|
||||
(require 'ob-ref)
|
||||
(require 'ob-comint)
|
||||
(require 'ob-eval)
|
||||
|
||||
(declare-function org-trim "org" (s &optional keep-lead))
|
||||
|
||||
;; Optionally require mma.el for font lock, etc
|
||||
(require 'mma nil 'noerror)
|
||||
(add-to-list 'org-src-lang-modes '("mathematica" . "mma"))
|
||||
|
||||
(defvar org-babel-tangle-lang-exts)
|
||||
(add-to-list 'org-babel-tangle-lang-exts '("mathematica" . "m"))
|
||||
|
||||
(defvar org-babel-default-header-args:mathematica '())
|
||||
|
||||
(defvar org-babel-mathematica-command "MathematicaScript -script"
|
||||
"Name of the command for executing Mathematica code.")
|
||||
|
||||
(defvar org-babel-mathematica-command-alt "math -noprompt"
|
||||
"Name of the command for executing Mathematica code.")
|
||||
|
||||
(defun org-babel-expand-body:mathematica (body params)
|
||||
"Expand BODY according to PARAMS, return the expanded body."
|
||||
(let ((vars (org-babel--get-vars params)))
|
||||
(concat
|
||||
(mapconcat ;; define any variables
|
||||
(lambda (pair)
|
||||
(format "%s=%s;"
|
||||
(car pair)
|
||||
(org-babel-mathematica-var-to-mathematica (cdr pair))))
|
||||
vars "\n") "\nPrint[\n" body "\n]\n")))
|
||||
|
||||
(defun org-babel-execute:mathematica (body params)
|
||||
"Execute a block of Mathematica code with org-babel. This function is
|
||||
called by `org-babel-execute-src-block'"
|
||||
(let* ((result-params (cdr (assq :result-params params)))
|
||||
(full-body (org-babel-expand-body:mathematica body params))
|
||||
(tmp-script-file (org-babel-temp-file "mathematica-"))
|
||||
(cmd org-babel-mathematica-command))
|
||||
;; actually execute the source-code block
|
||||
(with-temp-file tmp-script-file (insert full-body))
|
||||
;; (with-temp-file "/tmp/dbg" (insert full-body))
|
||||
((lambda (raw)
|
||||
(if (or (member "code" result-params)
|
||||
(member "pp" result-params)
|
||||
(and (member "output" result-params)
|
||||
(not (member "table" result-params))))
|
||||
raw
|
||||
(org-babel-script-escape (org-trim raw))))
|
||||
(org-babel-eval (concat cmd " " tmp-script-file) ""))))
|
||||
|
||||
(defun org-babel-prep-session:mathematica (session params)
|
||||
"This function does nothing so far"
|
||||
(error "Currently no support for sessions"))
|
||||
|
||||
(defun org-babel-prep-session:mathematica (session body params)
|
||||
"This function does nothing so far"
|
||||
(error "Currently no support for sessions"))
|
||||
|
||||
(defun org-babel-mathematica-var-to-mathematica (var)
|
||||
"Convert an elisp value to a Mathematica variable.
|
||||
Convert an elisp value, VAR, into a string of Mathematica source code
|
||||
specifying a variable of the same value."
|
||||
(if (listp var)
|
||||
(concat "{" (mapconcat #'org-babel-mathematica-var-to-mathematica var ", ") "}")
|
||||
(format "%S" var)))
|
||||
|
||||
(provide 'ob-mathematica)
|
||||
145
lisp/org-contrib/ob-mathomatic.el
Normal file
145
lisp/org-contrib/ob-mathomatic.el
Normal file
@@ -0,0 +1,145 @@
|
||||
;;; ob-mathomatic.el --- Org-babel functions for mathomatic evaluation
|
||||
|
||||
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Eric S Fraga
|
||||
;; Eric Schulte
|
||||
;; Luis Anaya (Mathomatic)
|
||||
|
||||
;; Keywords: literate programming, reproducible research, mathomatic
|
||||
;; Homepage: https://orgmode.org
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; This program is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Org-Babel support for evaluating mathomatic entries.
|
||||
;;
|
||||
;; This differs from most standard languages in that
|
||||
;;
|
||||
;; 1) there is no such thing as a "session" in mathomatic
|
||||
;;
|
||||
;; 2) we are adding the "cmdline" header argument
|
||||
|
||||
;;; Code:
|
||||
(require 'ob)
|
||||
|
||||
(defvar org-babel-tangle-lang-exts)
|
||||
(add-to-list 'org-babel-tangle-lang-exts '("mathomatic" . "math"))
|
||||
|
||||
(defvar org-babel-default-header-args:mathomatic '())
|
||||
|
||||
(defcustom org-babel-mathomatic-command
|
||||
(if (boundp 'mathomatic-command) mathomatic-command "mathomatic")
|
||||
"Command used to call mathomatic on the shell."
|
||||
:group 'org-babel)
|
||||
|
||||
(defun org-babel-mathomatic-expand (body params)
|
||||
"Expand a block of Mathomatic code according to its header arguments."
|
||||
(let ((vars (org-babel--get-vars params)))
|
||||
(mapconcat 'identity
|
||||
(list
|
||||
;; graphic output
|
||||
(let ((graphic-file (org-babel-mathomatic-graphical-output-file params)))
|
||||
(if graphic-file
|
||||
(cond
|
||||
((string-match ".\.eps$" graphic-file)
|
||||
(format ;; Need to add command to send to file.
|
||||
"set plot set terminal postscript eps\\;set output %S "
|
||||
graphic-file))
|
||||
((string-match ".\.ps$" graphic-file)
|
||||
(format ;; Need to add command to send to file.
|
||||
"set plot set terminal postscript\\;set output %S "
|
||||
graphic-file))
|
||||
|
||||
((string-match ".\.pic$" graphic-file)
|
||||
(format ;; Need to add command to send to file.
|
||||
"set plot set terminal gpic\\;set output %S "
|
||||
graphic-file))
|
||||
(t
|
||||
(format ;; Need to add command to send to file.
|
||||
"set plot set terminal png\\;set output %S "
|
||||
graphic-file)))
|
||||
""))
|
||||
;; variables
|
||||
(mapconcat 'org-babel-mathomatic-var-to-mathomatic vars "\n")
|
||||
;; body
|
||||
body
|
||||
"")
|
||||
"\n")))
|
||||
|
||||
(defun org-babel-execute:mathomatic (body params)
|
||||
"Execute a block of Mathomatic entries with org-babel. This function is
|
||||
called by `org-babel-execute-src-block'."
|
||||
(message "executing Mathomatic source code block")
|
||||
(let ((result-params (split-string (or (cdr (assq :results params)) "")))
|
||||
(result
|
||||
(let* ((cmdline (or (cdr (assq :cmdline params)) ""))
|
||||
(in-file (org-babel-temp-file "mathomatic-" ".math"))
|
||||
(cmd (format "%s -t -c -q %s %s"
|
||||
org-babel-mathomatic-command in-file cmdline)))
|
||||
(with-temp-file in-file (insert (org-babel-mathomatic-expand body params)))
|
||||
(message cmd)
|
||||
((lambda (raw) ;; " | grep -v batch | grep -v 'replaced' | sed '/^$/d' "
|
||||
(mapconcat
|
||||
#'identity
|
||||
(delq nil
|
||||
(mapcar (lambda (line)
|
||||
(unless (or (string-match "batch" line)
|
||||
(string-match "^rat: replaced .*$" line)
|
||||
(= 0 (length line)))
|
||||
line))
|
||||
(split-string raw "[\r\n]"))) "\n"))
|
||||
(org-babel-eval cmd "")))))
|
||||
(if (org-babel-mathomatic-graphical-output-file params)
|
||||
nil
|
||||
(if (or (member "scalar" result-params)
|
||||
(member "verbatim" result-params)
|
||||
(member "output" result-params))
|
||||
result
|
||||
(let ((tmp-file (org-babel-temp-file "mathomatic-res-")))
|
||||
(with-temp-file tmp-file (insert result))
|
||||
(org-babel-import-elisp-from-file tmp-file))))))
|
||||
|
||||
(defun org-babel-prep-session:mathomatic (session params)
|
||||
(error "Mathomatic does not support sessions"))
|
||||
|
||||
(defun org-babel-mathomatic-var-to-mathomatic (pair)
|
||||
"Convert an elisp val into a string of mathomatic code specifying a var
|
||||
of the same value."
|
||||
(let ((var (car pair))
|
||||
(val (cdr pair)))
|
||||
(when (symbolp val)
|
||||
(setq val (symbol-name val))
|
||||
(when (= (length val) 1)
|
||||
(setq val (string-to-char val))))
|
||||
(format "%s=%s" var
|
||||
(org-babel-mathomatic-elisp-to-mathomatic val))))
|
||||
|
||||
(defun org-babel-mathomatic-graphical-output-file (params)
|
||||
"Name of file to which mathomatic should send graphical output."
|
||||
(and (member "graphics" (cdr (assq :result-params params)))
|
||||
(cdr (assq :file params))))
|
||||
|
||||
(defun org-babel-mathomatic-elisp-to-mathomatic (val)
|
||||
"Return a string of mathomatic code which evaluates to VAL."
|
||||
(if (listp val)
|
||||
(mapconcat #'org-babel-mathomatic-elisp-to-mathomatic val " ")
|
||||
(format "%s" val)))
|
||||
|
||||
(provide 'ob-mathomatic)
|
||||
|
||||
;;; ob-mathomatic.el ends here
|
||||
82
lisp/org-contrib/ob-mscgen.el
Normal file
82
lisp/org-contrib/ob-mscgen.el
Normal file
@@ -0,0 +1,82 @@
|
||||
;;; ob-mscgen.el --- Babel Functions for Mscgen -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Juan Pechiar
|
||||
;; Maintainer: Justin Abrahms
|
||||
;; Keywords: literate programming, reproducible research
|
||||
;; Homepage: https://orgmode.org
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; This software provides EMACS org-babel export support for message
|
||||
;; sequence charts. The mscgen utility is used for processing the
|
||||
;; sequence definition, and must therefore be installed in the system.
|
||||
;;
|
||||
;; Mscgen is available and documented at
|
||||
;; https://www.mcternan.me.uk/mscgen/index.html
|
||||
;;
|
||||
;; This code is directly inspired by Eric Schulte's ob-dot.el
|
||||
;;
|
||||
;; Example:
|
||||
;;
|
||||
;; #+begin_src mscgen :file example.png
|
||||
;; msc {
|
||||
;; A,B;
|
||||
;; A -> B [ label = "send message" ];
|
||||
;; A <- B [ label = "get answer" ];
|
||||
;; }
|
||||
;; #+end_src
|
||||
;;
|
||||
;; Header for alternative file type:
|
||||
;;
|
||||
;; #+begin_src mscgen :file ex2.svg :filetype svg
|
||||
|
||||
;; This differs from most standard languages in that
|
||||
;;
|
||||
;; 1) there is no such thing as a "session" in mscgen
|
||||
;; 2) we are generally only going to return results of type "file"
|
||||
;; 3) we are adding the "file" and "filetype" header arguments
|
||||
;; 4) there are no variables
|
||||
|
||||
;;; Code:
|
||||
(require 'ob)
|
||||
|
||||
(defvar org-babel-default-header-args:mscgen
|
||||
'((:results . "file") (:exports . "results"))
|
||||
"Default arguments to use when evaluating a mscgen source block.")
|
||||
|
||||
(defun org-babel-execute:mscgen (body params)
|
||||
"Execute a block of Mscgen code with Babel.
|
||||
This function is called by `org-babel-execute-src-block'.
|
||||
Default filetype is png. Modify by setting :filetype parameter to
|
||||
mscgen supported formats."
|
||||
(let* ((out-file (or (cdr (assq :file params)) "output.png" ))
|
||||
(filetype (or (cdr (assq :filetype params)) "png" )))
|
||||
(unless (cdr (assq :file params))
|
||||
(error "ERROR: no output file specified. Add \":file name.png\" to the src header"))
|
||||
(org-babel-eval (concat "mscgen -T " filetype " -o " out-file) body)
|
||||
nil)) ;; signal that output has already been written to file
|
||||
|
||||
(defun org-babel-prep-session:mscgen (_session _params)
|
||||
"Raise an error because Mscgen doesn't support sessions."
|
||||
(error "Mscgen does not support sessions"))
|
||||
|
||||
(provide 'ob-mscgen)
|
||||
|
||||
;;; ob-mscgen.el ends here
|
||||
294
lisp/org-contrib/ob-oz.el
Normal file
294
lisp/org-contrib/ob-oz.el
Normal file
@@ -0,0 +1,294 @@
|
||||
;;; ob-oz.el --- Org-babel functions for Oz evaluation
|
||||
|
||||
;; Copyright (C) 2009-2014, 2021 Torsten Anders and Eric Schulte
|
||||
|
||||
;; Author: Torsten Anders and Eric Schulte
|
||||
;; Keywords: literate programming, reproducible research
|
||||
;; Homepage: https://orgmode.org
|
||||
;; Version: 0.02
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 3, 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 GNU Emacs; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||||
;; Boston, MA 02110-1301, USA.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Org-Babel support for evaluating Oz source code.
|
||||
;;
|
||||
;; Oz code is always send to the Oz Programming Environment (OPI), the
|
||||
;; Emacs mode and compiler interface for Oz programs. Therefore, only
|
||||
;; session mode is supported. In practice, non-session code blocks are
|
||||
;; handled equally well by the session mode. However, only a single
|
||||
;; session is supported. Consequently, the :session header argument is
|
||||
;; ignored.
|
||||
;;
|
||||
;; The Org-babel header argument :results is interpreted as
|
||||
;; follows. :results output requires the respective code block to be
|
||||
;; an Oz statement and :results value requires an Oz
|
||||
;; expression. Currently, results are only supported for expressions
|
||||
;; (i.e. the result of :results output is always nil).
|
||||
;;
|
||||
;; Expression evaluation happens synchronously. Therefore there is an
|
||||
;; additional header argument :wait-time <number>, which specifies the
|
||||
;; maximum time to wait for the result of a given expression. nil
|
||||
;; means to wait as long as it takes to get a result (potentially wait
|
||||
;; forever).
|
||||
;;
|
||||
;; NOTE: Currently the copyright of this file may not be in a state to
|
||||
;; permit inclusion as core software into Emacs or Org-mode.
|
||||
|
||||
;;; Requirements:
|
||||
|
||||
;; - Mozart Programming System, the implementation of the Oz
|
||||
;; programming language (http://www.mozart-oz.org/), which includes
|
||||
;; the major mode mozart for editing Oz programs.
|
||||
;;
|
||||
;; - StartOzServer.oz which is located in the contrib/scripts
|
||||
;; directory of the Org-mode repository
|
||||
|
||||
;;; TODO:
|
||||
|
||||
;; - Decide: set communication to \\switch -threadedqueries?
|
||||
;;
|
||||
;; - Only start Oz compiler when required, e.g., load Org-babel only when needed?
|
||||
;;
|
||||
;; - Avoid synchronous evaluation to avoid blocking Emacs (complex
|
||||
;; Strasheela programs can take long to find a result..). In order
|
||||
;; to cleanly map code blocks to their associated results (which can
|
||||
;; arrive then in any order) I could use IDs
|
||||
;; (e.g. integers). However, how do I do concurrency in Emacs Lisp,
|
||||
;; and how can I define org-babel-execute:oz concurrently.
|
||||
;;
|
||||
;; - Expressions are rarely used in Oz at the top-level, and using
|
||||
;; them in documentation and Literate Programs will cause
|
||||
;; confusion. Idea: hide expression from reader and instead show
|
||||
;; them statement (e.g., MIDI output statement) and then include
|
||||
;; result in Org file. Implementation: for expressions (:results
|
||||
;; value) support an additional header argument that takes arbitrary
|
||||
;; Oz code. This code is not seen by the reader, but will be used
|
||||
;; for the actual expression at the end. Alternative: feed all
|
||||
;; relevant code as statement (:results output), then add expression
|
||||
;; as extra code block which outputs, e.g., file name (so the file
|
||||
;; name must be accessible by global var), but the code of this
|
||||
;; extra codeblock is not seen. Hm, in that case it might be even
|
||||
;; more easy to manually add this link to the Org file.
|
||||
;;
|
||||
|
||||
|
||||
(require 'ob)
|
||||
;;; major mode for editing Oz programs
|
||||
(require 'mozart nil t)
|
||||
|
||||
;;
|
||||
;; Interface to communicate with Oz.
|
||||
;; (1) For statements without any results: oz-send-string
|
||||
;; (2) For expressions with a single result: oz-send-string-expression
|
||||
;; (defined in org-babel-oz-ResultsValue.el)
|
||||
;;
|
||||
|
||||
;; oz-send-string-expression implements an additional very direct
|
||||
;; communication between Org-babel and the Oz compiler. Communication
|
||||
;; with the Oz server works already without this code via the function
|
||||
;; oz-send-string from mozart.el.in, but this function does not get
|
||||
;; back any results from Oz to Emacs. The following code creates a
|
||||
;; socket for sending code to the OPI compiler and results are
|
||||
;; returned by the same socket. On the Oz side, a socket is opened and
|
||||
;; connected to the compiler of the OPI (via oz-send-string). On the
|
||||
;; Emacs side, a connection to this socket is created for feeding code
|
||||
;; and receiving results. This additional communication channel to the
|
||||
;; OPI compiler ensures that results are returned cleanly (e.g., only
|
||||
;; the result of the sent code is returned, no parsing or any
|
||||
;; processing of *Oz Emulator* is required).
|
||||
;;
|
||||
;; There is no buffer, nor sentinel involved. Oz code is send
|
||||
;; directly, and results from Oz are send back, but Emacs Lisp
|
||||
;; requires a filter function for processing results.
|
||||
|
||||
(defvar org-babel-oz-server-dir
|
||||
(file-name-as-directory
|
||||
(expand-file-name
|
||||
"contrib/scripts"
|
||||
(file-name-as-directory
|
||||
(expand-file-name
|
||||
"../../.."
|
||||
(file-name-directory (or load-file-name buffer-file-name))))))
|
||||
"Path to the contrib/scripts directory in which
|
||||
StartOzServer.oz is located.")
|
||||
|
||||
(defvar org-babel-oz-port 6001
|
||||
"Port for communicating with Oz compiler.")
|
||||
(defvar org-babel-oz-OPI-socket nil
|
||||
"Socket for communicating with OPI.")
|
||||
|
||||
(defvar org-babel-oz-collected-result nil
|
||||
"Aux var to hand result from org-babel-oz-filter to oz-send-string-expression.")
|
||||
(defun org-babel-oz-filter (proc string)
|
||||
"Processes output from socket org-babel-oz-OPI-socket."
|
||||
;; (setq org-babel-oz-collected-results (cons string org-babel-oz-collected-results))
|
||||
(setq org-babel-oz-collected-result string)
|
||||
)
|
||||
|
||||
|
||||
(defun org-babel-oz-create-socket ()
|
||||
(message "Create OPI socket for evaluating expressions")
|
||||
;; Start Oz directly
|
||||
(run-oz)
|
||||
;; Create socket on Oz side (after Oz was started).
|
||||
(oz-send-string (concat "\\insert '" org-babel-oz-server-dir "StartOzServer.oz'"))
|
||||
;; Wait until socket is created before connecting to it.
|
||||
;; Quick hack: wait 3 sec
|
||||
;;
|
||||
;; extending time to 30 secs does not help when starting Emacs for
|
||||
;; the first time (and computer does nothing else)
|
||||
(sit-for 3)
|
||||
;; connect to OPI socket
|
||||
(setq org-babel-oz-OPI-socket
|
||||
;; Creates a socket. I/O interface of Emacs sockets as for processes.
|
||||
(open-network-stream "*Org-babel-OPI-socket*" nil "localhost" org-babel-oz-port))
|
||||
;; install filter
|
||||
(set-process-filter org-babel-oz-OPI-socket #'org-babel-oz-filter)
|
||||
)
|
||||
|
||||
;; communication with org-babel-oz-OPI-socket is asynchronous, but
|
||||
;; oz-send-string-expression turns is into synchronous...
|
||||
(defun oz-send-string-expression (string &optional wait-time)
|
||||
"Similar to oz-send-string, oz-send-string-expression sends a string to the OPI compiler. However, string must be expression and this function returns the result of the expression (as string). oz-send-string-expression is synchronous, wait-time allows to specify a maximum wait time. After wait-time is over with no result, the function returns nil."
|
||||
(if (not org-babel-oz-OPI-socket)
|
||||
(org-babel-oz-create-socket))
|
||||
(let ((polling-delay 0.1)
|
||||
result)
|
||||
(process-send-string org-babel-oz-OPI-socket string)
|
||||
;; wait for result
|
||||
(if wait-time
|
||||
(let ((waited 0))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(while
|
||||
;; stop loop if org-babel-oz-collected-result \= nil or waiting time is over
|
||||
(not (or (not (equal org-babel-oz-collected-result nil))
|
||||
(> waited wait-time)))
|
||||
(progn
|
||||
(sit-for polling-delay)
|
||||
;; (message "org-babel-oz: next polling iteration")
|
||||
(setq waited (+ waited polling-delay))))
|
||||
;; (message "org-babel-oz: waiting over, got result or waiting timed out")
|
||||
;; (message (format "wait-time: %s, waited: %s" wait-time waited))
|
||||
(setq result org-babel-oz-collected-result)
|
||||
(setq org-babel-oz-collected-result nil))))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(while (equal org-babel-oz-collected-result nil)
|
||||
(sit-for polling-delay))
|
||||
(setq result org-babel-oz-collected-result)
|
||||
(setq org-babel-oz-collected-result nil))))
|
||||
result))
|
||||
|
||||
(defun org-babel-expand-body:oz (body params)
|
||||
(let ((vars (org-babel--get-vars params)))
|
||||
(if vars
|
||||
;; prepend code to define all arguments passed to the code block
|
||||
(let ((var-string (mapcar (lambda (pair)
|
||||
(format "%s=%s"
|
||||
(car pair)
|
||||
(org-babel-oz-var-to-oz (cdr pair))))
|
||||
vars)))
|
||||
;; only add var declarations if any variables are there
|
||||
(mapconcat #'identity
|
||||
(append (list "local") var-string (list "in" body "end"))
|
||||
"\n"))
|
||||
body)))
|
||||
|
||||
(defun org-babel-execute:oz (body params)
|
||||
"Execute a block of Oz code with org-babel. This function is
|
||||
called by `org-babel-execute-src-block' via multiple-value-bind."
|
||||
(let* ((result-params (cdr (assq :result-params params)))
|
||||
(full-body (org-babel-expand-body:oz body params))
|
||||
(wait-time (plist-get params :wait-time)))
|
||||
;; actually execute the source-code block
|
||||
(org-babel-reassemble-table
|
||||
(cond
|
||||
((member "output" result-params)
|
||||
(message "Org-babel: executing Oz statement")
|
||||
(oz-send-string full-body))
|
||||
((member "value" result-params)
|
||||
(message "Org-babel: executing Oz expression")
|
||||
(oz-send-string-expression full-body (or wait-time 1)))
|
||||
(t (error "either 'output' or 'results' must be members of :results")))
|
||||
(org-babel-pick-name (cdr (assq :colname-names params))
|
||||
(cdr (assq :colnames params)))
|
||||
(org-babel-pick-name (cdr (assq :roname-names params))
|
||||
(cdr (assq :rownames params))))))
|
||||
|
||||
;; This function should be used to assign any variables in params in
|
||||
;; the context of the session environment.
|
||||
(defun org-babel-prep-session:oz (session params)
|
||||
"Prepare SESSION according to the header arguments specified in PARAMS."
|
||||
(error "org-babel-prep-session:oz unimplemented"))
|
||||
;; TODO: testing... (copied from org-babel-haskell.el)
|
||||
;; (defun org-babel-prep-session:oz (session params)
|
||||
;; "Prepare SESSION according to the header arguments specified in PARAMS."
|
||||
;; (save-window-excursion
|
||||
;; (org-babel-oz-initiate-session session)
|
||||
;; (let* ((vars (org-babel-ref-variables params))
|
||||
;; (var-lines (mapconcat ;; define any variables
|
||||
;; (lambda (pair)
|
||||
;; (format "%s=%s"
|
||||
;; (car pair)
|
||||
;; (org-babel-ruby-var-to-ruby (cdr pair))))
|
||||
;; vars "\n"))
|
||||
;; (vars-file (concat (make-temp-file "org-babel-oz-vars") ".oz")))
|
||||
;; (when vars
|
||||
;; (with-temp-buffer
|
||||
;; (insert var-lines) (write-file vars-file)
|
||||
;; (oz-mode)
|
||||
;; ;; (inferior-oz-load-file) ; ??
|
||||
;; ))
|
||||
;; (current-buffer))))
|
||||
;;
|
||||
|
||||
|
||||
;; TODO: testing... (simplified version of def in org-babel-prep-session:ocaml)
|
||||
;;
|
||||
;; BUG: does not work yet. Error: ad-Orig-error: buffer none doesn't exist or has no process
|
||||
;; UNUSED DEF
|
||||
(defun org-babel-oz-initiate-session (&optional session params)
|
||||
"If there is not a current inferior-process-buffer in SESSION
|
||||
then create. Return the initialized session."
|
||||
(unless (string= session "none")
|
||||
;; TODO: make it possible to have multiple sessions
|
||||
(save-window-excursion
|
||||
;; (run-oz)
|
||||
(get-buffer oz-compiler-buffer))))
|
||||
|
||||
(defun org-babel-oz-var-to-oz (var)
|
||||
"Convert an elisp var into a string of Oz source code
|
||||
specifying a var of the same value."
|
||||
(if (listp var)
|
||||
;; (concat "[" (mapconcat #'org-babel-oz-var-to-oz var ", ") "]")
|
||||
(eval var)
|
||||
(format "%s" var) ; don't preserve string quotes.
|
||||
;; (format "%s" var)
|
||||
))
|
||||
|
||||
;; TODO:
|
||||
(defun org-babel-oz-table-or-string (results)
|
||||
"If the results look like a table, then convert them into an
|
||||
Emacs-lisp table, otherwise return the results as a string."
|
||||
(error "org-babel-oz-table-or-string unimplemented"))
|
||||
|
||||
|
||||
(provide 'ob-oz)
|
||||
;;; org-babel-oz.el ends here
|
||||
73
lisp/org-contrib/ob-php.el
Normal file
73
lisp/org-contrib/ob-php.el
Normal file
@@ -0,0 +1,73 @@
|
||||
;;; ob-php.el --- Execute PHP within org-mode blocks
|
||||
;; Copyright 2016, 2021 stardiviner
|
||||
|
||||
;; Author: stardiviner <numbchild@gmail.com>
|
||||
;; Maintainer: stardiviner <numbchild@gmail.com>
|
||||
;; Homepage: https://github.com/stardiviner/ob-php
|
||||
;; Keywords: org babel php
|
||||
;; Homepage: https://github.com/stardiviner/ob-php
|
||||
;; Created: 04th May 2016
|
||||
;; Version: 0.0.1
|
||||
;; Package-Requires: ((org "8"))
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
;;
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; Execute PHP within org-mode blocks.
|
||||
|
||||
;;; Code:
|
||||
(require 'org)
|
||||
(require 'ob)
|
||||
|
||||
(defgroup ob-php nil
|
||||
"org-mode blocks for PHP."
|
||||
:group 'org)
|
||||
|
||||
(defcustom org-babel-php-command "php"
|
||||
"The command to execute babel body code."
|
||||
:group 'ob-php
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-babel-php-command-options nil
|
||||
"The php command options to use when execute code."
|
||||
:group 'ob-php
|
||||
:type 'string)
|
||||
|
||||
(defcustom ob-php:inf-php-buffer "*php*"
|
||||
"Default PHP inferior buffer."
|
||||
:group 'ob-php
|
||||
:type 'string)
|
||||
|
||||
;;;###autoload
|
||||
(defun org-babel-execute:php (body params)
|
||||
"Orgmode Babel PHP evaluate function for `BODY' with `PARAMS'."
|
||||
(let* ((cmd (concat org-babel-php-command " " org-babel-php-command-options))
|
||||
(body (concat "<?php\n" body "\n?>")))
|
||||
(org-babel-eval cmd body)))
|
||||
|
||||
;;;###autoload
|
||||
(eval-after-load 'org
|
||||
'(add-to-list 'org-src-lang-modes '("php" . php)))
|
||||
|
||||
(defvar org-babel-default-header-args:php '())
|
||||
|
||||
(add-to-list 'org-babel-default-header-args:php
|
||||
'(:results . "output"))
|
||||
|
||||
(provide 'ob-php)
|
||||
|
||||
;;; ob-php.el ends here
|
||||
185
lisp/org-contrib/ob-picolisp.el
Normal file
185
lisp/org-contrib/ob-picolisp.el
Normal file
@@ -0,0 +1,185 @@
|
||||
;;; ob-picolisp.el --- Babel Functions for Picolisp -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Authors: Thorsten Jolitz
|
||||
;; Eric Schulte
|
||||
;; Keywords: literate programming, reproducible research
|
||||
;; Homepage: https://orgmode.org
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This library enables the use of PicoLisp in the multi-language
|
||||
;; programming framework Org-Babel. PicoLisp is a minimal yet
|
||||
;; fascinating Lisp dialect and a highly productive application
|
||||
;; framework for web-based client-server applications on top of
|
||||
;; object-oriented databases. A good way to learn PicoLisp is to first
|
||||
;; read Paul Grahams essay "The hundred year language"
|
||||
;; (http://www.paulgraham.com/hundred.html) and then study the various
|
||||
;; documents and essays published in the PicoLisp wiki
|
||||
;; (https://picolisp.com/5000/-2.html). PicoLisp is included in some
|
||||
;; GNU/Linux Distributions, and can be downloaded here:
|
||||
;; https://software-lab.de/down.html. It ships with a picolisp-mode and
|
||||
;; an inferior-picolisp-mode for Emacs (to be found in the /lib/el/
|
||||
;; directory).
|
||||
|
||||
;; Although it might seem more natural to use Emacs Lisp for most
|
||||
;; Lisp-based programming tasks inside Org, an Emacs library written
|
||||
;; in Emacs Lisp, PicoLisp has at least two outstanding features that
|
||||
;; make it a valuable addition to Org Babel:
|
||||
|
||||
;; PicoLisp _is_ an object-oriented database with a Prolog-based query
|
||||
;; language implemented in PicoLisp (Pilog). Database objects are
|
||||
;; first-class members of the language.
|
||||
|
||||
;; PicoLisp is an extremely productive framework for the development
|
||||
;; of interactive web-applications (on top of a database).
|
||||
|
||||
;;; Requirements:
|
||||
|
||||
;;; Code:
|
||||
(require 'ob)
|
||||
(require 'comint)
|
||||
|
||||
(declare-function run-picolisp "ext:inferior-picolisp" (cmd))
|
||||
(defvar org-babel-tangle-lang-exts) ;; Autoloaded
|
||||
|
||||
;; optionally define a file extension for this language
|
||||
(add-to-list 'org-babel-tangle-lang-exts '("picolisp" . "l"))
|
||||
|
||||
;;; interferes with settings in org-babel buffer?
|
||||
;; optionally declare default header arguments for this language
|
||||
;; (defvar org-babel-default-header-args:picolisp
|
||||
;; '((:colnames . "no"))
|
||||
;; "Default arguments for evaluating a picolisp source block.")
|
||||
|
||||
(defvar org-babel-picolisp-eoe "org-babel-picolisp-eoe"
|
||||
"String to indicate that evaluation has completed.")
|
||||
|
||||
(defcustom org-babel-picolisp-cmd "pil"
|
||||
"Name of command used to evaluate picolisp blocks."
|
||||
:group 'org-babel
|
||||
:version "24.1"
|
||||
:type 'string)
|
||||
|
||||
(defun org-babel-expand-body:picolisp (body params)
|
||||
"Expand BODY according to PARAMS, return the expanded body."
|
||||
(let ((vars (org-babel--get-vars params))
|
||||
(print-level nil)
|
||||
(print-length nil))
|
||||
(if (> (length vars) 0)
|
||||
(concat "(prog (let ("
|
||||
(mapconcat
|
||||
(lambda (var)
|
||||
(format "%S '%S)"
|
||||
(print (car var))
|
||||
(print (cdr var))))
|
||||
vars "\n ")
|
||||
" \n" body ") )")
|
||||
body)))
|
||||
|
||||
(defun org-babel-execute:picolisp (body params)
|
||||
"Execute a block of Picolisp code with org-babel.
|
||||
This function is called by `org-babel-execute-src-block'."
|
||||
(message "executing Picolisp source code block")
|
||||
(let* (
|
||||
;; Name of the session or "none".
|
||||
(session-name (cdr (assq :session params)))
|
||||
;; Set the session if the session variable is non-nil.
|
||||
(session (org-babel-picolisp-initiate-session session-name))
|
||||
;; Either OUTPUT or VALUE which should behave as described above.
|
||||
(result-params (cdr (assq :result-params params)))
|
||||
;; Expand the body with `org-babel-expand-body:picolisp'.
|
||||
(full-body (org-babel-expand-body:picolisp body params))
|
||||
;; Wrap body appropriately for the type of evaluation and results.
|
||||
(wrapped-body
|
||||
(cond
|
||||
((or (member "code" result-params)
|
||||
(member "pp" result-params))
|
||||
(format "(pretty (out \"%s\" %s))" null-device full-body))
|
||||
((and (member "value" result-params) (not session))
|
||||
(format "(print (out \"%s\" %s))" null-device full-body))
|
||||
((member "value" result-params)
|
||||
(format "(out \"%s\" %s)" null-device full-body))
|
||||
(t full-body)))
|
||||
(result
|
||||
(if (not (string= session-name "none"))
|
||||
;; Session based evaluation.
|
||||
(mapconcat ;; <- joins the list back into a single string
|
||||
#'identity
|
||||
(butlast ;; <- remove the org-babel-picolisp-eoe line
|
||||
(delq nil
|
||||
(mapcar
|
||||
(lambda (line)
|
||||
(org-babel-chomp ;; Remove trailing newlines.
|
||||
(when (> (length line) 0) ;; Remove empty lines.
|
||||
(cond
|
||||
;; Remove leading "-> " from return values.
|
||||
((and (>= (length line) 3)
|
||||
(string= "-> " (substring line 0 3)))
|
||||
(substring line 3))
|
||||
;; Remove trailing "-> <<return-value>>" on the
|
||||
;; last line of output.
|
||||
((and (member "output" result-params)
|
||||
(string-match-p "->" line))
|
||||
(substring line 0 (string-match "->" line)))
|
||||
(t line)
|
||||
)
|
||||
;;(if (and (>= (length line) 3);Remove leading "<-"
|
||||
;; (string= "-> " (substring line 0 3)))
|
||||
;; (substring line 3)
|
||||
;; line)
|
||||
)))
|
||||
;; Returns a list of the output of each evaluated exp.
|
||||
(org-babel-comint-with-output
|
||||
(session org-babel-picolisp-eoe)
|
||||
(insert wrapped-body) (comint-send-input)
|
||||
(insert "'" org-babel-picolisp-eoe)
|
||||
(comint-send-input)))))
|
||||
"\n")
|
||||
;; external evaluation
|
||||
(let ((script-file (org-babel-temp-file "picolisp-script-")))
|
||||
(with-temp-file script-file
|
||||
(insert (concat wrapped-body "(bye)")))
|
||||
(org-babel-eval
|
||||
(format "%s %s"
|
||||
org-babel-picolisp-cmd
|
||||
(org-babel-process-file-name script-file))
|
||||
"")))))
|
||||
(org-babel-result-cond result-params
|
||||
result
|
||||
(read result))))
|
||||
|
||||
(defun org-babel-picolisp-initiate-session (&optional session-name)
|
||||
"If there is not a current inferior-process-buffer in SESSION then create.
|
||||
Return the initialized session."
|
||||
(unless (string= session-name "none")
|
||||
(require 'inferior-picolisp)
|
||||
;; provide a reasonable default session name
|
||||
(let ((session (or session-name "*inferior-picolisp*")))
|
||||
;; check if we already have a live session by this name
|
||||
(if (org-babel-comint-buffer-livep session)
|
||||
(get-buffer session)
|
||||
(save-window-excursion
|
||||
(run-picolisp org-babel-picolisp-cmd)
|
||||
(rename-buffer session-name)
|
||||
(current-buffer))))))
|
||||
|
||||
(provide 'ob-picolisp)
|
||||
|
||||
;;; ob-picolisp.el ends here
|
||||
59
lisp/org-contrib/ob-redis.el
Normal file
59
lisp/org-contrib/ob-redis.el
Normal file
@@ -0,0 +1,59 @@
|
||||
;;; ob-redis.el --- Execute Redis queries within org-mode blocks
|
||||
;; Copyright 2016-2021 stardiviner
|
||||
|
||||
;; Author: stardiviner <numbchild@gmail.com>
|
||||
;; Maintainer: stardiviner <numbchild@gmail.com>
|
||||
;; Keywords: org babel redis
|
||||
;; Homepage: https://github.com/stardiviner/ob-redis
|
||||
;; Created: 28th Feb 2016
|
||||
;; Version: 0.0.1
|
||||
;; Package-Requires: ((org "8"))
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
;;
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; Execute Redis queries within org-mode blocks.
|
||||
|
||||
;;; Code:
|
||||
(require 'org)
|
||||
(require 'ob)
|
||||
|
||||
(defgroup ob-redis nil
|
||||
"org-mode blocks for Redis."
|
||||
:group 'org)
|
||||
|
||||
(defcustom ob-redis:default-db "127.0.0.1:6379"
|
||||
"Default Redis database."
|
||||
:group 'ob-redis
|
||||
:type 'string)
|
||||
|
||||
;;;###autoload
|
||||
(defun org-babel-execute:redis (body params)
|
||||
"org-babel redis hook."
|
||||
(let* ((db (or (cdr (assoc :db params))
|
||||
ob-redis:default-db))
|
||||
(cmd (mapconcat 'identity (list "redis-cli") " ")))
|
||||
(org-babel-eval cmd body)
|
||||
))
|
||||
|
||||
;;;###autoload
|
||||
(eval-after-load 'org
|
||||
'(add-to-list 'org-src-lang-modes '("redis" . redis)))
|
||||
|
||||
(provide 'ob-redis)
|
||||
|
||||
;;; ob-redis.el ends here
|
||||
93
lisp/org-contrib/ob-sclang.el
Normal file
93
lisp/org-contrib/ob-sclang.el
Normal file
@@ -0,0 +1,93 @@
|
||||
;;; ob-sclang.el --- SCLang support for Org-mode Babel
|
||||
;;; -*- coding: utf-8 -*-
|
||||
|
||||
;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Authors: stardiviner <numbchild@gmail.com>
|
||||
;; Homepage: https://github.com/stardiviner/ob-sclang
|
||||
;; Package-Version: 0.1
|
||||
;; Keywords: babel sclang
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; `ob-sclang' requires `sclang' from SuperCollider.
|
||||
;; Usually SuperCollider dependencies for Emacs are at /usr/share/emacs/site-lisp/SuperCollider/
|
||||
;; You can install SuperCollider following this article:
|
||||
;; https://github.com/supercollider/supercollider#building-the-source-code
|
||||
|
||||
;; Usage:
|
||||
|
||||
;; Support to evaluate sclang Org-mode src block with function `sclang-eval-string'.
|
||||
|
||||
;; For example:
|
||||
|
||||
;; #+BEGIN_SRC sclang :results none
|
||||
;; "Hello World".postln;
|
||||
;; #+END_SRC
|
||||
;;
|
||||
;; *NOTE* Temporary output to org-babel result output is not supported.
|
||||
;; Because `sclang-eval-string' will send output to Sclang Post Buffer.
|
||||
;; And command line `sclang' execute will not automatically stop after finished execution.
|
||||
;;
|
||||
;; #+BEGIN_SRC sclang :results none
|
||||
;; // modulate a sine frequency and a noise amplitude with another sine
|
||||
;; // whose frequency depends on the horizontal mouse pointer position
|
||||
;; {
|
||||
;; var x = SinOsc.ar(MouseX.kr(1, 100));
|
||||
;; SinOsc.ar(300 * x + 800, 0, 0.1)
|
||||
;; +
|
||||
;; PinkNoise.ar(0.1 * x + 0.1)
|
||||
;; }.play;
|
||||
;; #+END_SRC
|
||||
|
||||
|
||||
;;; Code:
|
||||
;;; ----------------------------------------------------------------------------
|
||||
(require 'org)
|
||||
(require 'ob)
|
||||
|
||||
(require 'sclang nil t)
|
||||
|
||||
(defgroup ob-sclang nil
|
||||
"org-mode blocks for SuperCollider SCLang."
|
||||
:group 'org)
|
||||
|
||||
;;;###autoload
|
||||
(defun org-babel-execute:sclang (body params)
|
||||
"Org-mode Babel sclang hook for evaluate `BODY' with `PARAMS'."
|
||||
(unless (or (equal (buffer-name) sclang-post-buffer)
|
||||
(sclang-get-process))
|
||||
(sclang-start))
|
||||
(sclang-eval-string body t))
|
||||
|
||||
(defvar org-babel-default-header-args:sclang nil)
|
||||
|
||||
(setq org-babel-default-header-args:sclang
|
||||
'((:session . "*SCLang:Workspace*")
|
||||
;; TODO: temporary can't find way to let sclang output to stdout for org-babel.
|
||||
(:output . "none")))
|
||||
|
||||
(eval-after-load 'org
|
||||
'(progn
|
||||
(add-to-list 'org-src-lang-modes '("sclang" . sclang))))
|
||||
|
||||
;;; ----------------------------------------------------------------------------
|
||||
|
||||
(provide 'ob-sclang)
|
||||
|
||||
;;; ob-sclang.el ends here
|
||||
79
lisp/org-contrib/ob-shen.el
Normal file
79
lisp/org-contrib/ob-shen.el
Normal file
@@ -0,0 +1,79 @@
|
||||
;;; ob-shen.el --- Babel Functions for Shen -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Eric Schulte
|
||||
;; Keywords: literate programming, reproducible research, shen
|
||||
;; Homepage: https://orgmode.org
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Currently this only works using session evaluation as there is no
|
||||
;; defined method for executing shen code outside of a session.
|
||||
|
||||
;;; Requirements:
|
||||
|
||||
;; - shen-mode and inf-shen will soon be available through the GNU
|
||||
;; elpa, however in the interim they are available at
|
||||
;; https://github.com/eschulte/shen-mode
|
||||
|
||||
;;; Code:
|
||||
(require 'ob)
|
||||
|
||||
(declare-function shen-eval-defun "ext:inf-shen" (&optional and-go))
|
||||
(declare-function org-babel-ruby-var-to-ruby "ob-ruby" (var))
|
||||
|
||||
(defvar org-babel-default-header-args:shen '()
|
||||
"Default header arguments for shen code blocks.")
|
||||
|
||||
(defun org-babel-expand-body:shen (body params)
|
||||
"Expand BODY according to PARAMS, return the expanded body."
|
||||
(let ((vars (org-babel--get-vars params)))
|
||||
(if (> (length vars) 0)
|
||||
(concat "(let "
|
||||
(mapconcat (lambda (var)
|
||||
(format "%s %s" (car var)
|
||||
(org-babel-shen-var-to-shen (cdr var))))
|
||||
vars " ")
|
||||
body ")")
|
||||
body)))
|
||||
|
||||
(defun org-babel-shen-var-to-shen (var)
|
||||
"Convert VAR into a shen variable."
|
||||
(if (listp var)
|
||||
(concat "[" (mapconcat #'org-babel-ruby-var-to-ruby var " ") "]")
|
||||
(format "%S" var)))
|
||||
|
||||
(defun org-babel-execute:shen (body params)
|
||||
"Execute a block of Shen code with org-babel.
|
||||
This function is called by `org-babel-execute-src-block'."
|
||||
(require 'inf-shen)
|
||||
(let* ((result-params (cdr (assq :result-params params)))
|
||||
(full-body (org-babel-expand-body:shen body params)))
|
||||
(let ((results
|
||||
(with-temp-buffer
|
||||
(insert full-body)
|
||||
(call-interactively #'shen-eval-defun))))
|
||||
(org-babel-result-cond result-params
|
||||
results
|
||||
(condition-case nil (org-babel-script-escape results)
|
||||
(error results))))))
|
||||
|
||||
(provide 'ob-shen)
|
||||
|
||||
;;; ob-shen.el ends here
|
||||
71
lisp/org-contrib/ob-smiles.el
Normal file
71
lisp/org-contrib/ob-smiles.el
Normal file
@@ -0,0 +1,71 @@
|
||||
;;; ob-smiles.el --- Org-mode Babel support for SMILES
|
||||
|
||||
;; Author: John Kitchin <jkitchin@andrew.cmu.edu>
|
||||
;; Maintainer: stardiviner <numbchild@gmail.com>
|
||||
;; Homepage: https://github.com/stardiviner/ob-smiles
|
||||
;; Keywords: org babel SMILES
|
||||
;; Version: 0.0.1
|
||||
;; Package-Requires: ((smiles-mode "0.0.1") (org "8"))
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
;;
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;; I copy code from:
|
||||
;;; https://kitchingroup.cheme.cmu.edu/blog/2016/03/26/A-molecule-link-for-org-mode
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ob)
|
||||
(require 'org-element)
|
||||
|
||||
;; Org-mode Babel
|
||||
(defun org-babel-execute:smiles (body params)
|
||||
"Execute SMILES babel `BODY' with `PARAMS'."
|
||||
(shell-command-to-string
|
||||
(format "obabel -:\"%s\" -osvg 2> /dev/null" body)))
|
||||
|
||||
;; Org-mode link
|
||||
(defun molecule-jump (name)
|
||||
"Jump to molecule `NAME' definition."
|
||||
(org-mark-ring-push)
|
||||
(org-link-open-from-string (format "[[%s]]" name)))
|
||||
|
||||
(defun molecule-export (path desc backend)
|
||||
"Export molecule to HTML format on `PATH' with `DESC' and `BACKEND'."
|
||||
(let ((name (save-window-excursion
|
||||
(molecule-jump path)
|
||||
(org-element-property :name (org-element-context)))))
|
||||
(cond
|
||||
((eq 'html backend)
|
||||
(format "<a href=\"#%s\">%s</a>" name name)))))
|
||||
|
||||
(org-link-set-parameters
|
||||
"molecule"
|
||||
:follow 'molecule-jump
|
||||
:export 'molecule-export)
|
||||
|
||||
;; org-mode element
|
||||
(org-element-map (org-element-parse-buffer)
|
||||
'src-block
|
||||
(lambda (src)
|
||||
(when (string= "smiles" (org-element-property :language src))
|
||||
(org-element-property :name src))))
|
||||
|
||||
|
||||
(provide 'ob-smiles)
|
||||
|
||||
;;; ob-smiles.el ends here
|
||||
182
lisp/org-contrib/ob-spice.el
Normal file
182
lisp/org-contrib/ob-spice.el
Normal file
@@ -0,0 +1,182 @@
|
||||
;;; ob-spice.el --- org-babel functions for spice evaluation
|
||||
;;; -*- coding: utf-8 -*-
|
||||
|
||||
;; Author: Tiago Oliveira Weber
|
||||
;; Maintainer: stardiviner <numbchild@gmail.com>
|
||||
;; Homepage: https://github.com/stardiviner/ob-spice
|
||||
;; Version: 0.4
|
||||
;; Package-Requires: ((spice-mode "0.0.1") (org "8"))
|
||||
|
||||
;; License: GPL v3, or any later version
|
||||
;;
|
||||
;; This file 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, or (at your option)
|
||||
;; any later version.
|
||||
;;
|
||||
;; This file is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Org-Babel support for evaluating spice script.
|
||||
;; Inspired by Ian Yang's org-export-blocks-format-plantuml (https://www.emacswiki.org/emacs/org-export-blocks-format-plantuml.el)
|
||||
|
||||
;;; Requirements:
|
||||
;;
|
||||
;; - ngspice
|
||||
|
||||
;;; Code:
|
||||
(require 'ob)
|
||||
|
||||
(add-to-list 'org-babel-tangle-lang-exts '("spice" . "cir"))
|
||||
|
||||
(defun ob-spice-concat (wordlist)
|
||||
"Concatenate elements of a `WORDLIST' into a string separated by spaces."
|
||||
;; example of usage
|
||||
;; (ob-spice-concat '("This" "is" "a" "long" "journey"))
|
||||
(setq newtext (car wordlist)) ; first word is without space before
|
||||
(setq wordlist (rest wordlist)) ; exclude the first word from the list
|
||||
(dolist (word wordlist newtext) ; loop through the list and concatenate the values
|
||||
(setq newtext (concat newtext " " word))))
|
||||
|
||||
(defun org-babel-expand-body:spice (body params)
|
||||
"Expand BODY according to PARAMS, return the expanded body."
|
||||
(let* ((vars (mapcar #'cdr (org-babel-get-header params :var))))
|
||||
(setq newbody "");
|
||||
(setq bodylinelist (split-string body "\n"))
|
||||
(dolist (line bodylinelist newbody)
|
||||
(progn ;loop through list of lines
|
||||
(setq wordlist (split-string line " "))
|
||||
(setq firstword 1)
|
||||
(dolist (word wordlist)
|
||||
(progn ;loop through the words
|
||||
(if (string-match "\\$\\(.*\\)\\[\\(.*\\)\\]" word)
|
||||
(progn
|
||||
;; if matches a vector variable format
|
||||
(setq varname (match-string 1 word))
|
||||
(setq varindex (match-string 2 word))
|
||||
;; search varname in vars and use the value of varindex to word
|
||||
(setq newword
|
||||
(nth (string-to-number varindex)
|
||||
(car (assoc-default varname vars
|
||||
(lambda (key candidate)
|
||||
(string= key candidate))))))
|
||||
(if (not (eq newword nil))
|
||||
(if (not (stringp newword))
|
||||
(setq word (number-to-string newword))
|
||||
(setq word newword)))
|
||||
)
|
||||
) ; end of (if (string-match "\\$\\(.*\\)\\[\\(.*\\)\\]" word))
|
||||
(if (string-match "\\$\\(.*\\)\\." word) ; if variable has a dot in the end
|
||||
(progn
|
||||
;; if matches a non-vector variable format
|
||||
(setq varname (match-string 1 word))
|
||||
(setq newword
|
||||
(assoc-default varname vars
|
||||
(lambda (key candidate)
|
||||
(string= key candidate))))
|
||||
(if (not (eq newword nil))
|
||||
(progn
|
||||
(if (not (stringp newword))
|
||||
(setq newword (number-to-string newword)))
|
||||
(setq word (replace-match (concat newword ".") nil nil word))
|
||||
;(setq word word)
|
||||
)
|
||||
))
|
||||
);; end of (if (string-match "\\$\\(.*\\)\\." word)
|
||||
(if (string-match "\\$\\(.*\\)" word)
|
||||
(progn
|
||||
;; if matches a non-vector variable format
|
||||
(setq varname (match-string 1 word))
|
||||
(setq newword
|
||||
(assoc-default varname vars
|
||||
(lambda (key candidate)
|
||||
(string= key candidate))))
|
||||
(if (not (eq newword nil))
|
||||
(if (not (stringp newword))
|
||||
(setq word (number-to-string newword))
|
||||
(setq word newword)
|
||||
))
|
||||
)
|
||||
) ; end of (if (string-match "\\$\\(.*\\)" word)
|
||||
|
||||
|
||||
(setq newbody (concat newbody
|
||||
(if (not (eq firstword 1)) " ")
|
||||
word))
|
||||
(setq firstword 0)
|
||||
) ; end of (progn
|
||||
) ; end of (dolist (word wordlist))
|
||||
|
||||
(setq newbody (concat newbody "\n"))
|
||||
) ; end of (progn ;; loop through list of lines ... )
|
||||
) ; end of (dolist (line bodylinelist) ...function ...)
|
||||
))
|
||||
|
||||
;;;###autoload
|
||||
(defun org-babel-execute:spice (body params)
|
||||
"Execute a block of Spice code `BODY' with org-babel and `PARAMS'."
|
||||
(let ((body (org-babel-expand-body:spice body params))
|
||||
(vars (mapcar #'cdr (org-babel-get-header params :var))))
|
||||
|
||||
;;******************************
|
||||
;; clean temporary files
|
||||
(mapc (lambda (pair)
|
||||
(when (string= (car pair) "file")
|
||||
(setq textfile (concat (cdr pair) ".txt"))
|
||||
(setq imagefile (concat (cdr pair) ".png"))
|
||||
)
|
||||
)
|
||||
vars)
|
||||
;; (if (file-readable-p textfile) (delete-file textfile))
|
||||
;; (if (file-readable-p imagefile) (delete-file imagefile))
|
||||
;;*******************************
|
||||
|
||||
(org-babel-eval "ngspice -b " body)
|
||||
|
||||
;; loop through all pairs (elements) of the list vars and set text and image file if finds "file" var
|
||||
(mapc (lambda (pair)
|
||||
(when (string= (car pair) "file")
|
||||
(setq textfile (concat (cdr pair) ".txt"))
|
||||
(setq imagefile (concat (cdr pair) ".png"))))
|
||||
vars)
|
||||
;; produce results
|
||||
;; THE FOLLOWING WAS COMMENTED TEMPORARILY
|
||||
;; (concat
|
||||
;; (if (file-readable-p textfile)
|
||||
;; (get-string-from-file textfile))
|
||||
;; (if (file-readable-p imagefile)
|
||||
;; (concat '"#+ATTR_HTML: :width 600px \n [[file:./" imagefile "]]")
|
||||
;; )
|
||||
;; )
|
||||
|
||||
;; ;; Get measurement values from text-file by splitting comma separated values
|
||||
(if (file-readable-p textfile)
|
||||
(progn
|
||||
(setq rawtext (get-string-from-file textfile))
|
||||
;;(setq rawtext (replace-regexp-in-string "\n" "" rawtext))
|
||||
(setq rawtext (replace-regexp-in-string "\n" "" rawtext))
|
||||
(setq result (split-string rawtext ","))))
|
||||
(if (file-readable-p imagefile)
|
||||
(progn
|
||||
;; test if result exist already
|
||||
;;(if (boundp 'result)
|
||||
(add-to-list 'result (concat '"[[file:./" imagefile "]]") t) ;; add imagefile to last entry
|
||||
;;(concat '"[[file:./" imagefile "]]")
|
||||
;;)
|
||||
))
|
||||
result
|
||||
;; Produce output like '(test test2)
|
||||
;;'(test test2)
|
||||
|
||||
)
|
||||
)
|
||||
|
||||
(provide 'ob-spice)
|
||||
;;; ob-spice.el ends here
|
||||
86
lisp/org-contrib/ob-stan.el
Normal file
86
lisp/org-contrib/ob-stan.el
Normal file
@@ -0,0 +1,86 @@
|
||||
;;; ob-stan.el --- Babel Functions for Stan -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Kyle Meyer
|
||||
;; Keywords: literate programming, reproducible research
|
||||
;; Homepage: https://git.kyleam.com/ob-stan
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Org-Babel support for evaluating Stan [1] source code.
|
||||
;;
|
||||
;; Evaluating a Stan block can produce two different results.
|
||||
;;
|
||||
;; 1) Dump the source code contents to a file.
|
||||
;;
|
||||
;; This file can then be used as a variable in other blocks, which
|
||||
;; allows interfaces like RStan to use the model.
|
||||
;;
|
||||
;; 2) Compile the contents to a model file.
|
||||
;;
|
||||
;; This provides access to the CmdStan interface. To use this, set
|
||||
;; `org-babel-stan-cmdstan-directory' and provide a :file argument
|
||||
;; that does not end in ".stan".
|
||||
;;
|
||||
;; For more information and usage examples, visit
|
||||
;; https://orgmode.org/worg/org-contrib/babel/languages/ob-doc-stan.html
|
||||
;;
|
||||
;; [1] https://mc-stan.org/
|
||||
|
||||
;;; Code:
|
||||
(require 'ob)
|
||||
(require 'org-compat)
|
||||
|
||||
(defcustom org-babel-stan-cmdstan-directory nil
|
||||
"CmdStan source directory.
|
||||
Call \"make\" from this directory to compile the Stan block.
|
||||
When nil, executing Stan blocks dumps the content to a file."
|
||||
:group 'org-babel
|
||||
:type '(choice
|
||||
(directory :tag "Compilation directory")
|
||||
(const :tag "Dump to a file" nil)))
|
||||
|
||||
(defvar org-babel-default-header-args:stan
|
||||
'((:results . "file")))
|
||||
|
||||
(defun org-babel-execute:stan (body params)
|
||||
"Generate Stan file from BODY according to PARAMS.
|
||||
A :file header argument must be given. If
|
||||
`org-babel-stan-cmdstan-directory' is non-nil and the file name
|
||||
does not have a \".stan\" extension, save an intermediate
|
||||
\".stan\" file and compile the block to the named file.
|
||||
Otherwise, write the Stan code directly to the named file."
|
||||
(let ((file (expand-file-name
|
||||
(or (cdr (assq :file params))
|
||||
(user-error "Set :file argument to execute Stan blocks")))))
|
||||
(if (or (not org-babel-stan-cmdstan-directory)
|
||||
(string-match-p "\\.stan\\'" file))
|
||||
(with-temp-file file (insert body))
|
||||
(with-temp-file (concat file ".stan") (insert body))
|
||||
(let ((default-directory org-babel-stan-cmdstan-directory))
|
||||
(call-process-shell-command (concat "make " file))))
|
||||
nil)) ; Signal that output has been written to file.
|
||||
|
||||
(defun org-babel-prep-session:stan (_session _params)
|
||||
"Return an error because Stan does not support sessions."
|
||||
(user-error "Stan does not support sessions"))
|
||||
|
||||
(provide 'ob-stan)
|
||||
|
||||
;;; ob-stan.el ends here
|
||||
311
lisp/org-contrib/ob-stata.el
Normal file
311
lisp/org-contrib/ob-stata.el
Normal file
@@ -0,0 +1,311 @@
|
||||
;;; ob-stata.el --- org-babel functions for stata code evaluation
|
||||
|
||||
;; Copyright (C) 2014, 2021 Ista Zahn
|
||||
;; Author: Ista Zahn istazahn@gmail.com
|
||||
;; G. Jay Kerns
|
||||
;; Eric Schulte
|
||||
;; Dan Davison
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 3, 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 GNU Emacs; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||||
;; Boston, MA 02110-1301, USA.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; The file provides Org-Babel support for evaluating stata code.
|
||||
;; It is basically result of find-and-replace "stata" for "julia"
|
||||
;; in ob-julia.el by G. Jay Kerns. Only ":results output" works: the
|
||||
;; header args must include ":results output" (this is the default).
|
||||
;; Note that I'm not sure ':results value' makes sense or is useful
|
||||
;; but I have left all the value-processing stuff inherited from
|
||||
;; ob-julia and ob-R. ':results graphics' would be nice, but I have
|
||||
;; not tried to implement it.
|
||||
;; --Ista, 07/30/2014
|
||||
|
||||
;;; Requirements:
|
||||
;; Stata: https://stata.com
|
||||
;; ESS: https://ess.r-project.org
|
||||
|
||||
;;; Code:
|
||||
(require 'ob)
|
||||
(require 'cl-lib)
|
||||
|
||||
(declare-function orgtbl-to-csv "org-table" (table params))
|
||||
(declare-function stata "ext:ess-stata" (&optional start-args))
|
||||
(declare-function inferior-ess-send-input "ext:ess-inf" ())
|
||||
(declare-function ess-make-buffer-current "ext:ess-inf" ())
|
||||
(declare-function ess-eval-buffer "ext:ess-inf" (vis))
|
||||
(declare-function org-number-sequence "org-compat" (from &optional to inc))
|
||||
|
||||
(defconst org-babel-header-args:stata
|
||||
'((width . :any)
|
||||
(horizontal . :any)
|
||||
(results . ((file list vector table scalar verbatim)
|
||||
(raw org html latex code pp wrap)
|
||||
(replace silent append prepend)
|
||||
;; NOTE: not sure 'value' makes sense in stata
|
||||
;; we may want to remove it from the list
|
||||
(output value graphics))))
|
||||
"stata-specific header arguments.")
|
||||
|
||||
(add-to-list 'org-babel-tangle-lang-exts '("stata" . "do"))
|
||||
|
||||
;; only ':results output' currently works, so make that the default
|
||||
(defvar org-babel-default-header-args:stata '((:results . "output")))
|
||||
|
||||
(defcustom org-babel-stata-command inferior-STA-program-name
|
||||
"Name of command to use for executing stata code."
|
||||
:group 'org-babel
|
||||
:version "24.4"
|
||||
:package-version '(Org . "8.3")
|
||||
:type 'string)
|
||||
|
||||
(defvar ess-local-process-name) ; dynamically scoped
|
||||
(defun org-babel-edit-prep:stata (info)
|
||||
(let ((session (cdr (assq :session (nth 2 info)))))
|
||||
(when (and session (string-match "^\\*\\(.+?\\)\\*$" session))
|
||||
(save-match-data (org-babel-stata-initiate-session session nil)))))
|
||||
|
||||
(defun org-babel-expand-body:stata (body params &optional graphics-file)
|
||||
"Expand BODY according to PARAMS, return the expanded body."
|
||||
(let ((graphics-file
|
||||
(or graphics-file (org-babel-stata-graphical-output-file params))))
|
||||
(mapconcat
|
||||
#'identity
|
||||
((lambda (inside)
|
||||
(if graphics-file
|
||||
inside
|
||||
inside))
|
||||
(append (org-babel-variable-assignments:stata params)
|
||||
(list body))) "\n")))
|
||||
|
||||
(defun org-babel-execute:stata (body params)
|
||||
"Execute a block of stata code.
|
||||
This function is called by `org-babel-execute-src-block'."
|
||||
(save-excursion
|
||||
(let* ((result-params (cdr (assq :result-params params)))
|
||||
(result-type (cdr (assq :result-type params)))
|
||||
(session (org-babel-stata-initiate-session
|
||||
(cdr (assq :session params)) params))
|
||||
(colnames-p (cdr (assq :colnames params)))
|
||||
(rownames-p (cdr (assq :rownames params)))
|
||||
(graphics-file (org-babel-stata-graphical-output-file params))
|
||||
(full-body (org-babel-expand-body:stata body params graphics-file))
|
||||
(result
|
||||
(org-babel-stata-evaluate
|
||||
session full-body result-type result-params
|
||||
(or (equal "yes" colnames-p)
|
||||
(org-babel-pick-name
|
||||
(cdr (assq :colname-names params)) colnames-p))
|
||||
(or (equal "yes" rownames-p)
|
||||
(org-babel-pick-name
|
||||
(cdr (assq :rowname-names params)) rownames-p)))))
|
||||
(if graphics-file nil result))))
|
||||
|
||||
(defun org-babel-prep-session:stata (session params)
|
||||
"Prepare SESSION according to the header arguments specified in PARAMS."
|
||||
(let* ((session (org-babel-stata-initiate-session session params))
|
||||
(var-lines (org-babel-variable-assignments:stata params)))
|
||||
(org-babel-comint-in-buffer session
|
||||
(mapc (lambda (var)
|
||||
(end-of-line 1) (insert var) (comint-send-input nil t)
|
||||
(org-babel-comint-wait-for-output session)) var-lines))
|
||||
session))
|
||||
|
||||
(defun org-babel-load-session:stata (session body params)
|
||||
"Load BODY into SESSION."
|
||||
(save-window-excursion
|
||||
(let ((buffer (org-babel-prep-session:stata session params)))
|
||||
(with-current-buffer buffer
|
||||
(goto-char (process-mark (get-buffer-process (current-buffer))))
|
||||
(insert (org-babel-chomp body)))
|
||||
buffer)))
|
||||
|
||||
;; helper functions
|
||||
|
||||
(defun org-babel-variable-assignments:stata (params)
|
||||
"Return list of stata statements assigning the block's variables."
|
||||
(let ((vars (org-babel--get-vars params)))
|
||||
(mapcar
|
||||
(lambda (pair)
|
||||
(org-babel-stata-assign-elisp
|
||||
(car pair) (cdr pair)
|
||||
(equal "yes" (cdr (assq :colnames params)))
|
||||
(equal "yes" (cdr (assq :rownames params)))))
|
||||
(mapcar
|
||||
(lambda (i)
|
||||
(cons (car (nth i vars))
|
||||
(org-babel-reassemble-table
|
||||
(cdr (nth i vars))
|
||||
(cdr (nth i (cdr (assq :colname-names params))))
|
||||
(cdr (nth i (cdr (assq :rowname-names params)))))))
|
||||
(org-number-sequence 0 (1- (length vars)))))))
|
||||
|
||||
(defun org-babel-stata-quote-csv-field (s)
|
||||
"Quote field S for export to stata."
|
||||
(if (stringp s)
|
||||
(concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"")
|
||||
(format "%S" s)))
|
||||
|
||||
(defun org-babel-stata-assign-elisp (name value colnames-p rownames-p)
|
||||
"Construct stata code assigning the elisp VALUE to a variable named NAME."
|
||||
(if (listp value)
|
||||
(let ((max (apply #'max (mapcar #'length (cl-remove-if-not
|
||||
#'sequencep value))))
|
||||
(min (apply #'min (mapcar #'length (cl-remove-if-not
|
||||
#'sequencep value))))
|
||||
(transition-file (org-babel-temp-file "stata-import-")))
|
||||
;; ensure VALUE has an orgtbl structure (depth of at least 2)
|
||||
(unless (listp (car value)) (setq value (list value)))
|
||||
(with-temp-file transition-file
|
||||
(insert
|
||||
(orgtbl-to-csv value '(:fmt org-babel-stata-quote-csv-field))
|
||||
"\n"))
|
||||
(let ((file (org-babel-process-file-name transition-file 'noquote))
|
||||
(header (if (or (eq (nth 1 value) 'hline) colnames-p)
|
||||
"TRUE" "FALSE"))
|
||||
(row-names (if rownames-p "1" "NULL")))
|
||||
(if (= max min)
|
||||
(format "%s = insheet using \"%s\"" name file)
|
||||
(format "%s = insheet using \"%s\""
|
||||
name file))))
|
||||
(format "%s = %s" name (org-babel-stata-quote-csv-field value))))
|
||||
|
||||
(defvar ess-ask-for-ess-directory) ; dynamically scoped
|
||||
|
||||
(defun org-babel-stata-initiate-session (session params)
|
||||
"If there is not a current stata process then create one."
|
||||
(unless (string= session "none")
|
||||
(let ((session (or session "*stata*"))
|
||||
(ess-ask-for-ess-directory
|
||||
(and (and (boundp 'ess-ask-for-ess-directory) ess-ask-for-ess-directory)
|
||||
(not (cdr (assq :dir params))))))
|
||||
(if (org-babel-comint-buffer-livep session)
|
||||
session
|
||||
(save-window-excursion
|
||||
(require 'ess) (stata)
|
||||
(rename-buffer
|
||||
(if (bufferp session)
|
||||
(buffer-name session)
|
||||
(if (stringp session)
|
||||
session
|
||||
(buffer-name))))
|
||||
(current-buffer))))))
|
||||
|
||||
(defun org-babel-stata-associate-session (session)
|
||||
"Associate stata code buffer with a stata session.
|
||||
Make SESSION be the inferior ESS process associated with the
|
||||
current code buffer."
|
||||
(setq ess-local-process-name
|
||||
(process-name (get-buffer-process session)))
|
||||
(ess-make-buffer-current))
|
||||
|
||||
(defun org-babel-stata-graphical-output-file (params)
|
||||
"Name of file to which stata should send graphical output."
|
||||
(and (member "graphics" (cdr (assq :result-params params)))
|
||||
(cdr (assq :file params))))
|
||||
|
||||
(defvar org-babel-stata-eoe-indicator "display \"org_babel_stata_eoe\"")
|
||||
(defvar org-babel-stata-eoe-output "org_babel_stata_eoe")
|
||||
|
||||
(defvar org-babel-stata-write-object-command "outsheet using \"%s\"")
|
||||
|
||||
(defun org-babel-stata-evaluate
|
||||
(session body result-type result-params column-names-p row-names-p)
|
||||
"Evaluate stata code in BODY."
|
||||
(if session
|
||||
(org-babel-stata-evaluate-session
|
||||
session body result-type result-params column-names-p row-names-p)
|
||||
(org-babel-stata-evaluate-external-process
|
||||
body result-type result-params column-names-p row-names-p)))
|
||||
|
||||
(defun org-babel-stata-evaluate-external-process
|
||||
(body result-type result-params column-names-p row-names-p)
|
||||
"Evaluate BODY in external stata process.
|
||||
If RESULT-TYPE equals 'output then return standard output as a
|
||||
string. If RESULT-TYPE equals 'value then return the value of the
|
||||
last statement in BODY, as elisp."
|
||||
(cl-case result-type
|
||||
(value
|
||||
(let ((tmp-file (org-babel-temp-file "stata-")))
|
||||
(org-babel-eval org-babel-stata-command
|
||||
(format org-babel-stata-write-object-command
|
||||
(org-babel-process-file-name tmp-file 'noquote)
|
||||
(format "begin\n%s\nend" body)))
|
||||
(org-babel-stata-process-value-result
|
||||
(org-babel-result-cond result-params
|
||||
(with-temp-buffer
|
||||
(insert-file-contents tmp-file)
|
||||
(buffer-string))
|
||||
(org-babel-import-elisp-from-file tmp-file '(4)))
|
||||
column-names-p)))
|
||||
(output (org-babel-eval org-babel-stata-command body))))
|
||||
|
||||
(defun org-babel-stata-evaluate-session
|
||||
(session body result-type result-params column-names-p row-names-p)
|
||||
"Evaluate BODY in SESSION.
|
||||
If RESULT-TYPE equals 'output then return standard output as a
|
||||
string. If RESULT-TYPE equals 'value then return the value of the
|
||||
last statement in BODY, as elisp."
|
||||
(cl-case result-type
|
||||
(value
|
||||
(with-temp-buffer
|
||||
(insert (org-babel-chomp body))
|
||||
(let ((ess-local-process-name
|
||||
(process-name (get-buffer-process session)))
|
||||
(ess-eval-visibly-p nil))
|
||||
(ess-eval-buffer nil)))
|
||||
(let ((tmp-file (org-babel-temp-file "stata-")))
|
||||
(org-babel-comint-eval-invisibly-and-wait-for-file
|
||||
session tmp-file
|
||||
(format org-babel-stata-write-object-command
|
||||
(org-babel-process-file-name tmp-file 'noquote) "ans"))
|
||||
(org-babel-stata-process-value-result
|
||||
(org-babel-result-cond result-params
|
||||
(with-temp-buffer
|
||||
(insert-file-contents tmp-file)
|
||||
(buffer-string))
|
||||
(org-babel-import-elisp-from-file tmp-file '(4)))
|
||||
column-names-p)))
|
||||
(output
|
||||
(mapconcat
|
||||
#'org-babel-chomp
|
||||
(butlast
|
||||
(delq nil
|
||||
(mapcar
|
||||
(lambda (line) (when (> (length line) 0) line))
|
||||
(mapcar
|
||||
(lambda (line) ;; cleanup extra prompts left in output
|
||||
(if (string-match
|
||||
"^\\([ ]*[>+\\.][ ]?\\)+\\([[0-9]+\\|[ ]\\)" line)
|
||||
(substring line (match-end 1))
|
||||
line))
|
||||
(org-babel-comint-with-output (session org-babel-stata-eoe-output)
|
||||
(insert (mapconcat #'org-babel-chomp
|
||||
(list body org-babel-stata-eoe-indicator)
|
||||
"\n"))
|
||||
(inferior-ess-send-input)))))) "\n"))))
|
||||
|
||||
(defun org-babel-stata-process-value-result (result column-names-p)
|
||||
"stata-specific processing of return value.
|
||||
Insert hline if column names in output have been requested."
|
||||
(if column-names-p
|
||||
(cons (car result) (cons 'hline (cdr result)))
|
||||
result))
|
||||
|
||||
(provide 'ob-stata)
|
||||
|
||||
;;; ob-stata.el ends here
|
||||
128
lisp/org-contrib/ob-tcl.el
Normal file
128
lisp/org-contrib/ob-tcl.el
Normal file
@@ -0,0 +1,128 @@
|
||||
;;; ob-tcl.el --- Org-babel functions for tcl evaluation
|
||||
|
||||
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Authors: Dan Davison
|
||||
;; Eric Schulte
|
||||
;; Luis Anaya (tcl)
|
||||
;;
|
||||
;; Keywords: literate programming, reproducible research
|
||||
;; Homepage: https://orgmode.org
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; This program is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Org-Babel support for evaluating tcl source code.
|
||||
|
||||
;;; Code:
|
||||
(require 'ob)
|
||||
(require 'ob-eval)
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(defvar org-babel-tangle-lang-exts)
|
||||
(add-to-list 'org-babel-tangle-lang-exts '("tcl" . "tcl"))
|
||||
|
||||
(defvar org-babel-default-header-args:tcl nil)
|
||||
|
||||
(defcustom org-babel-tcl-command "tclsh"
|
||||
"Name of command to use for executing Tcl code."
|
||||
:group 'org-babel
|
||||
:type 'string)
|
||||
|
||||
|
||||
(defun org-babel-execute:tcl (body params)
|
||||
"Execute a block of Tcl code with Babel.
|
||||
This function is called by `org-babel-execute-src-block'."
|
||||
(let* ((session (cdr (assq :session params)))
|
||||
(result-params (cdr (assq :result-params params)))
|
||||
(result-type (cdr (assq :result-type params)))
|
||||
(full-body (org-babel-expand-body:generic
|
||||
body params (org-babel-variable-assignments:tcl params)))
|
||||
(session (org-babel-tcl-initiate-session session)))
|
||||
(org-babel-reassemble-table
|
||||
(org-babel-tcl-evaluate session full-body result-type)
|
||||
(org-babel-pick-name
|
||||
(cdr (assq :colname-names params)) (cdr (assq :colnames params)))
|
||||
(org-babel-pick-name
|
||||
(cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))
|
||||
|
||||
(defun org-babel-prep-session:tcl (session params)
|
||||
"Prepare SESSION according to the header arguments in PARAMS."
|
||||
(error "Sessions are not supported for Tcl"))
|
||||
|
||||
(defun org-babel-variable-assignments:tcl (params)
|
||||
"Return list of tcl statements assigning the block's variables."
|
||||
(mapcar
|
||||
(lambda (pair)
|
||||
(format "set %s %s"
|
||||
(car pair)
|
||||
(org-babel-tcl-var-to-tcl (cdr pair))))
|
||||
(org-babel--get-vars params)))
|
||||
|
||||
;; helper functions
|
||||
|
||||
(defun org-babel-tcl-var-to-tcl (var)
|
||||
"Convert an elisp value to a tcl variable.
|
||||
The elisp value, VAR, is converted to a string of tcl source code
|
||||
specifying a var of the same value."
|
||||
(if (listp var)
|
||||
(concat "{" (mapconcat #'org-babel-tcl-var-to-tcl var " ") "}")
|
||||
(format "%s" var)))
|
||||
|
||||
(defvar org-babel-tcl-buffers '(:default . nil))
|
||||
|
||||
(defun org-babel-tcl-initiate-session (&optional session params)
|
||||
"Return nil because sessions are not supported by tcl."
|
||||
nil)
|
||||
|
||||
(defvar org-babel-tcl-wrapper-method
|
||||
"
|
||||
proc main {} {
|
||||
%s
|
||||
}
|
||||
|
||||
set r [eval main]
|
||||
set o [open \"%s\" \"w\"];
|
||||
puts $o $r
|
||||
flush $o
|
||||
close $o
|
||||
|
||||
")
|
||||
|
||||
(defvar org-babel-tcl-pp-wrapper-method
|
||||
nil)
|
||||
|
||||
(defun org-babel-tcl-evaluate (session body &optional result-type)
|
||||
"Pass BODY to the Tcl process in SESSION.
|
||||
If RESULT-TYPE equals 'output then return a list of the outputs
|
||||
of the statements in BODY, if RESULT-TYPE equals 'value then
|
||||
return the value of the last statement in BODY, as elisp."
|
||||
(when session (error "Sessions are not supported for Tcl"))
|
||||
(case result-type
|
||||
(output (org-babel-eval org-babel-tcl-command body))
|
||||
(value (let ((tmp-file (org-babel-temp-file "tcl-")))
|
||||
(org-babel-eval
|
||||
org-babel-tcl-command
|
||||
(format org-babel-tcl-wrapper-method body
|
||||
(org-babel-process-file-name tmp-file 'noquote)))
|
||||
(org-babel-eval-read-file tmp-file)))))
|
||||
|
||||
(provide 'ob-tcl)
|
||||
|
||||
|
||||
|
||||
;;; ob-tcl.el ends here
|
||||
114
lisp/org-contrib/ob-vala.el
Normal file
114
lisp/org-contrib/ob-vala.el
Normal file
@@ -0,0 +1,114 @@
|
||||
;;; ob-vala.el --- Babel functions for Vala -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Christian Garbs <mitch@cgarbs.de>
|
||||
;; Keywords: literate programming, reproducible research
|
||||
;; Homepage: https://orgmode.org
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; ob-vala.el provides Babel support for the Vala language
|
||||
;; (see https://live.gnome.org/Vala for details)
|
||||
|
||||
;;; Requirements:
|
||||
|
||||
;; - Vala compiler binary (valac)
|
||||
;; - Vala development environment (Vala libraries etc.)
|
||||
;;
|
||||
;; vala-mode.el is nice to have for code formatting, but is not needed
|
||||
;; for ob-vala.el
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ob)
|
||||
(require 'org-macs)
|
||||
|
||||
;; File extension.
|
||||
(add-to-list 'org-babel-tangle-lang-exts '("vala" . "vala"))
|
||||
|
||||
;; Header arguments empty by default.
|
||||
(defvar org-babel-default-header-args:vala '())
|
||||
|
||||
(defcustom org-babel-vala-compiler "valac"
|
||||
"Command used to compile a C source code file into an executable.
|
||||
May be either a command in the path, like \"valac\"
|
||||
or an absolute path name, like \"/usr/local/bin/valac\".
|
||||
Parameters may be used like this: \"valac -v\""
|
||||
:group 'org-babel
|
||||
:version "26.1"
|
||||
:package-version '(Org . "9.1")
|
||||
:type 'string)
|
||||
|
||||
;; This is the main function which is called to evaluate a code
|
||||
;; block.
|
||||
;;
|
||||
;; - run Vala compiler and create a binary in a temporary file
|
||||
;; - compiler/linker flags can be set via :flags header argument
|
||||
;; - if compilation succeeded, run the binary
|
||||
;; - commandline parameters to the binary can be set via :cmdline
|
||||
;; header argument
|
||||
;; - stdout will be parsed as RESULT (control via :result-params
|
||||
;; header argument)
|
||||
;;
|
||||
;; There is no session support because Vala is a compiled language.
|
||||
;;
|
||||
;; This function is heavily based on ob-C.el
|
||||
(defun org-babel-execute:vala (body params)
|
||||
"Execute a block of Vala code with Babel.
|
||||
This function is called by `org-babel-execute-src-block'."
|
||||
(message "executing Vala source code block")
|
||||
(let* ((tmp-src-file (org-babel-temp-file
|
||||
"vala-src-"
|
||||
".vala"))
|
||||
(tmp-bin-file (org-babel-temp-file "vala-bin-" org-babel-exeext))
|
||||
(cmdline (cdr (assq :cmdline params)))
|
||||
(flags (cdr (assq :flags params))))
|
||||
(with-temp-file tmp-src-file (insert body))
|
||||
(org-babel-eval
|
||||
(format "%s %s -o %s %s"
|
||||
org-babel-vala-compiler
|
||||
(mapconcat #'identity
|
||||
(if (listp flags) flags (list flags)) " ")
|
||||
(org-babel-process-file-name tmp-bin-file)
|
||||
(org-babel-process-file-name tmp-src-file)) "")
|
||||
(when (file-executable-p tmp-bin-file)
|
||||
(let ((results
|
||||
(org-trim
|
||||
(org-babel-eval
|
||||
(concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))
|
||||
(org-babel-reassemble-table
|
||||
(org-babel-result-cond (cdr (assq :result-params params))
|
||||
(org-babel-read results)
|
||||
(let ((tmp-file (org-babel-temp-file "vala-")))
|
||||
(with-temp-file tmp-file (insert results))
|
||||
(org-babel-import-elisp-from-file tmp-file)))
|
||||
(org-babel-pick-name
|
||||
(cdr (assq :colname-names params)) (cdr (assq :colnames params)))
|
||||
(org-babel-pick-name
|
||||
(cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))))
|
||||
|
||||
(defun org-babel-prep-session:vala (_session _params)
|
||||
"Prepare a session.
|
||||
This function does nothing as Vala is a compiled language with no
|
||||
support for sessions."
|
||||
(error "Vala is a compiled language -- no support for sessions"))
|
||||
|
||||
(provide 'ob-vala)
|
||||
|
||||
;;; ob-vala.el ends here
|
||||
84
lisp/org-contrib/ob-vbnet.el
Normal file
84
lisp/org-contrib/ob-vbnet.el
Normal file
@@ -0,0 +1,84 @@
|
||||
;;; ob-vbnet.el --- org-babel functions for VB.Net evaluation
|
||||
|
||||
;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: thomas "at" friendlyvillagers.com based on ob-java.el by Eric Schulte
|
||||
;; Keywords: literate programming, reproducible research
|
||||
;; Homepage: https://orgmode.org
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Currently this only supports the external compilation and execution
|
||||
;; of VB.Net code blocks (i.e., no session support).
|
||||
|
||||
;;; Code:
|
||||
(require 'ob)
|
||||
|
||||
(defvar org-babel-tangle-lang-exts)
|
||||
(add-to-list 'org-babel-tangle-lang-exts '("vbnet" . "vb"))
|
||||
|
||||
(defcustom org-babel-vbnet-command "mono"
|
||||
"Name of the mono command.
|
||||
May be either a command in the path, like mono
|
||||
or an absolute path name, like /usr/local/bin/mono
|
||||
parameters may be used, like mono -verbose"
|
||||
:group 'org-babel
|
||||
:version "24.3"
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-babel-vbnet-compiler "vbnc"
|
||||
"Name of the VB.Net compiler.
|
||||
May be either a command in the path, like vbnc
|
||||
or an absolute path name, like /usr/local/bin/vbnc
|
||||
parameters may be used, like vbnc /warnaserror+"
|
||||
:group 'org-babel
|
||||
:version "24.3"
|
||||
:type 'string)
|
||||
|
||||
(defun org-babel-execute:vbnet (body params)
|
||||
(let* ((full-body (org-babel-expand-body:generic body params))
|
||||
(cmpflag (or (cdr (assq :cmpflag params)) ""))
|
||||
(cmdline (or (cdr (assq :cmdline params)) ""))
|
||||
(src-file (org-babel-temp-file "vbnet-src-" ".vb"))
|
||||
(exe-file (concat (file-name-sans-extension src-file) ".exe"))
|
||||
(compile
|
||||
(progn (with-temp-file src-file (insert full-body))
|
||||
(org-babel-eval
|
||||
(concat org-babel-vbnet-compiler " " cmpflag " " src-file)
|
||||
""))))
|
||||
(let ((results (org-babel-eval (concat org-babel-vbnet-command " " cmdline " " exe-file) "")))
|
||||
(org-babel-reassemble-table
|
||||
(org-babel-result-cond (cdr (assq :result-params params))
|
||||
(org-babel-read results)
|
||||
(let ((tmp-file (org-babel-temp-file "c-")))
|
||||
(with-temp-file tmp-file (insert results))
|
||||
(org-babel-import-elisp-from-file tmp-file)))
|
||||
(org-babel-pick-name
|
||||
(cdr (assq :colname-names params)) (cdr (assq :colnames params)))
|
||||
(org-babel-pick-name
|
||||
(cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))))
|
||||
|
||||
(defun org-babel-prep-session:vbnet (session params)
|
||||
"Return an error because vbnet does not support sessions."
|
||||
(error "Sessions are not supported for VB.Net"))
|
||||
|
||||
(provide 'ob-vbnet)
|
||||
|
||||
|
||||
|
||||
;;; ob-vbnet.el ends here
|
||||
91
lisp/org-contrib/ol-bookmark.el
Normal file
91
lisp/org-contrib/ol-bookmark.el
Normal file
@@ -0,0 +1,91 @@
|
||||
;;; ol-bookmark.el --- Links to bookmarks
|
||||
|
||||
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
|
||||
;;
|
||||
;; Author: Tokuya Kameshima <kames AT fa2.so-net.ne.jp>
|
||||
;; Version: 1.0
|
||||
;; Keywords: outlines, hypermedia, calendar, wp
|
||||
;;
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; Emacs is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 3, 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 GNU Emacs; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||||
;; Boston, MA 02110-1301, USA.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(require 'org)
|
||||
(require 'bookmark)
|
||||
(require 'ol)
|
||||
|
||||
(defgroup org-bookmark nil
|
||||
"Options concerning the bookmark link."
|
||||
:tag "Org Startup"
|
||||
:group 'org-link)
|
||||
|
||||
(defcustom org-bookmark-in-dired nil
|
||||
"Use org-bookmark in dired."
|
||||
:group 'org-bookmark
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom org-bookmark-when-visiting-a-file nil
|
||||
"Use org-bookmark in any buffer visiting a file."
|
||||
:group 'org-bookmark
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom org-bookmark-use-first-bookmark nil
|
||||
"If several bookmarks links to the buffer, take the first one.
|
||||
Otherwise prompt the user for the right bookmark to use."
|
||||
:group 'org-bookmark
|
||||
:type 'boolean)
|
||||
|
||||
(org-link-set-parameters "bookmark"
|
||||
:follow #'org-bookmark-open
|
||||
:store #'org-bookmark-store-link)
|
||||
|
||||
(defun org-bookmark-open (bookmark _)
|
||||
"Visit the bookmark BOOKMARK."
|
||||
(bookmark-jump bookmark))
|
||||
|
||||
(defun org-bookmark-store-link ()
|
||||
"Store a link to the current line's bookmark in bookmark list."
|
||||
(let (file bookmark bmks)
|
||||
(cond ((and org-bookmark-in-dired
|
||||
(eq major-mode 'dired-mode))
|
||||
(setq file (abbreviate-file-name (dired-get-filename))))
|
||||
((and org-bookmark-when-visiting-a-file
|
||||
(buffer-file-name (buffer-base-buffer)))
|
||||
(setq file (abbreviate-file-name
|
||||
(buffer-file-name (buffer-base-buffer))))))
|
||||
(if (not file)
|
||||
(when (eq major-mode 'bookmark-bmenu-mode)
|
||||
(setq bookmark (bookmark-bmenu-bookmark)))
|
||||
(when (and (setq bmks
|
||||
(mapcar (lambda (name)
|
||||
(if (equal file
|
||||
(abbreviate-file-name
|
||||
(bookmark-location name)))
|
||||
name))
|
||||
(bookmark-all-names)))
|
||||
(setq bmks (delete nil bmks)))
|
||||
(setq bookmark
|
||||
(if (or (eq 1 (length bmks)) org-bookmark-use-first-bookmark)
|
||||
(car bmks)
|
||||
(completing-read "Bookmark: " bmks nil t nil nil (car bmks))))))
|
||||
(if bookmark
|
||||
(org-store-link-props :link (concat "bookmark:" bookmark)
|
||||
:description bookmark))))
|
||||
|
||||
(provide 'ol-bookmark)
|
||||
|
||||
;;; ol-bookmark.el ends here
|
||||
157
lisp/org-contrib/ol-elisp-symbol.el
Normal file
157
lisp/org-contrib/ol-elisp-symbol.el
Normal file
@@ -0,0 +1,157 @@
|
||||
;;; ol-elisp-symbol.el --- Links to Emacs-lisp symbols
|
||||
;;
|
||||
;; Copyright 2007-2021 Free Software Foundation, Inc.
|
||||
;;
|
||||
;; Author: Bastien Guerry <bzg@gnu.org>
|
||||
;; Version: 0.2
|
||||
;; Keywords: org, remember, lisp
|
||||
;; Homepage: https://git.sr.ht/~bzg/org-contrib
|
||||
;;
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 3, 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
;;
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; Org-mode already lets you store/insert links to emacs-lisp files,
|
||||
;; just like any other file. This package lets you precisely link to
|
||||
;; any emacs-lisp symbol and access useful information about the symbol.
|
||||
;;
|
||||
;; Here is the list of available properties when linking from a elisp-symbol:
|
||||
;;
|
||||
;; :name The symbol's name.
|
||||
;; :stype The symbol's type (commandp, function, etc.)
|
||||
;; :def The function used to set the symbol's value (defun, etc.)
|
||||
;; :keys The keys associated with the command.
|
||||
;; :args The arguments of the function.
|
||||
;; :docstring The docstring of the symbol.
|
||||
;; :doc The first line of the dostring.
|
||||
;; :comment A comment line just above the sexp, if any.
|
||||
;; :fixme A FIXME comment line just above the sexp, if any.
|
||||
;;
|
||||
;; Let's say we have a defun like this one:
|
||||
;;
|
||||
;; ;; FIXME update docstring
|
||||
;; (defun org-export-latex-lists ()
|
||||
;; "Convert lists to LaTeX."
|
||||
;; (goto-char (point-min))
|
||||
;; (while (re-search-forward org-export-latex-list-beginning-re nil t)
|
||||
;; (beginning-of-line)
|
||||
;; (insert (org-list-to-latex (org-list-parse-list t)) "\n")))
|
||||
;;
|
||||
;; And a remember template like:
|
||||
;;
|
||||
;; (setq org-remember-templates
|
||||
;; '((?s "* DEBUG `%:name' (%:args)\n\n%?\n\nFixme: %:fixme\n \
|
||||
;; Doc: \"%:doc\"\n\n%a")))
|
||||
;;
|
||||
;; Then M-x `org-remember' on this sexp will produce this buffer:
|
||||
;;
|
||||
;; =====================================================================
|
||||
;; * DEBUG `org-export-latex-lists' ()
|
||||
;;
|
||||
;; <== point
|
||||
;;
|
||||
;; Fixme: update the docstring
|
||||
;; Doc: "Convert lists to LaTeX."
|
||||
;;
|
||||
;; [[file:~/path/file.el::defun%20my-func][Function: my-func]]
|
||||
;; =====================================================================
|
||||
;;
|
||||
;; Put this file into your load-path and the following into your ~/.emacs:
|
||||
;; (require 'org-elisp-symbol)
|
||||
|
||||
;;; Code:
|
||||
|
||||
(provide 'ol-elisp-symbol)
|
||||
(require 'ol)
|
||||
(require 'org)
|
||||
|
||||
(org-link-set-parameters "elisp-symbol"
|
||||
:follow #'org-elisp-symbol-open
|
||||
:store #'org-elisp-symbol-store-link)
|
||||
|
||||
(defun org-elisp-symbol-open (symbol arg)
|
||||
(org-link-open-as-file symbol arg))
|
||||
|
||||
(defun org-elisp-symbol-store-link ()
|
||||
"Store a link to an emacs-lisp elisp-symbol."
|
||||
(when (eq major-mode 'emacs-lisp-mode)
|
||||
(save-excursion
|
||||
(or (looking-at "^(") (beginning-of-defun))
|
||||
(looking-at "^(\\([a-z]+\\) \\([^)\n ]+\\) ?\n?[ \t]*\\(?:(\\(.*\\))\\)?")
|
||||
(let* ((end (save-excursion
|
||||
(save-match-data
|
||||
(end-of-defun) (point))))
|
||||
(def (match-string 1))
|
||||
(name (match-string 2))
|
||||
(sym-name (intern-soft name))
|
||||
(stype (cond ((commandp sym-name) "Command")
|
||||
((functionp sym-name) "Function")
|
||||
((user-variable-p sym-name) "User variable")
|
||||
((string= def "defvar") "Variable")
|
||||
((string= def "defmacro") "Macro")
|
||||
((string= def "defun") "Function or command")
|
||||
(t "Symbol")))
|
||||
(args (if (match-string 3)
|
||||
(mapconcat (lambda (a) (unless (string-match "^&" a) a))
|
||||
(split-string (match-string 3)) " ")
|
||||
"no arg"))
|
||||
(docstring (cond ((functionp sym-name)
|
||||
(or (documentation sym-name)
|
||||
"[no documentation]"))
|
||||
((string-match "[Vv]ariable" stype)
|
||||
(documentation-property sym-name
|
||||
'variable-documentation))
|
||||
(t "no documentation")))
|
||||
(doc (and (string-match "^\\([^\n]+\\)$" docstring)
|
||||
(match-string 1 docstring)))
|
||||
(fixme (save-excursion
|
||||
(beginning-of-defun) (end-of-defun)
|
||||
(if (re-search-forward "^;+ ?FIXME[ :]*\\(.*\\)$" end t)
|
||||
(match-string 1) "nothing to fix")))
|
||||
(comment (save-excursion
|
||||
(beginning-of-defun) (end-of-defun)
|
||||
(if (re-search-forward "^;;+ ?\\(.*\\)$" end t)
|
||||
(match-string 1) "no comment")))
|
||||
keys keys-desc link description)
|
||||
(if (equal stype "Command")
|
||||
(setq keys (where-is-internal sym-name)
|
||||
keys-desc
|
||||
(if keys (mapconcat 'key-description keys " ") "none")))
|
||||
(setq link (concat "file:" (abbreviate-file-name buffer-file-name)
|
||||
"::" def " " name))
|
||||
(setq description (concat stype ": " name))
|
||||
(org-store-link-props
|
||||
:type "elisp-symbol"
|
||||
:link link
|
||||
:description description
|
||||
:def def
|
||||
:name name
|
||||
:stype stype
|
||||
:args args
|
||||
:keys keys-desc
|
||||
:docstring docstring
|
||||
:doc doc
|
||||
:fixme fixme
|
||||
:comment comment)))))
|
||||
|
||||
(provide 'org-elisp-symbol)
|
||||
|
||||
|
||||
;;;;##########################################################################
|
||||
;;;; User Options, Variables
|
||||
;;;;##########################################################################
|
||||
|
||||
;;; ol-elisp-symbol.el ends here
|
||||
231
lisp/org-contrib/ol-git-link.el
Normal file
231
lisp/org-contrib/ol-git-link.el
Normal file
@@ -0,0 +1,231 @@
|
||||
;;; ol-git-link.el --- Links to specific file version
|
||||
|
||||
;; Copyright (C) 2009-2014, 2021 Reimar Finken
|
||||
|
||||
;; Author: Reimar Finken <reimar.finken@gmx.de>
|
||||
;; Keywords: files, calendar, hypermedia
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distaributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; `org-git-link.el' defines two new link types. The `git' link
|
||||
;; type is meant to be used in the typical scenario and mimics the
|
||||
;; `file' link syntax as closely as possible. The `gitbare' link
|
||||
;; type exists mostly for debugging reasons, but also allows e.g.
|
||||
;; linking to files in a bare git repository for the experts.
|
||||
|
||||
;; * User friendy form
|
||||
;; [[git:/path/to/file::searchstring]]
|
||||
|
||||
;; This form is the familiar from normal org file links
|
||||
;; including search options. However, its use is
|
||||
;; restricted to files in a working directory and does not
|
||||
;; handle bare repositories on purpose (see the bare form for
|
||||
;; that).
|
||||
|
||||
;; The search string references a commit (a tree-ish in Git
|
||||
;; terminology). The two most useful types of search strings are
|
||||
|
||||
;; - A symbolic ref name, usually a branch or tag name (e.g.
|
||||
;; master or nobelprize).
|
||||
;; - A ref followed by the suffix @ with a date specification
|
||||
;; enclosed in a brace pair (e.g. {yesterday}, {1 month 2
|
||||
;; weeks 3 days 1 hour 1 second ago} or {1979-02-26 18:30:00})
|
||||
;; to specify the value of the ref at a prior point in time
|
||||
;;
|
||||
;; * Bare git form
|
||||
;; [[gitbare:$GIT_DIR::$OBJECT]]
|
||||
;;
|
||||
;; This is the more bare metal version, which gives the user most
|
||||
;; control. It directly translates to the git command
|
||||
;; git --no-pager --git-dir=$GIT_DIR show $OBJECT
|
||||
;; Using this version one can also view files from a bare git
|
||||
;; repository. For detailed information on how to specify an
|
||||
;; object, see the man page of `git-rev-parse' (section
|
||||
;; SPECIFYING REVISIONS). A specific blob (file) can be
|
||||
;; specified by a suffix clolon (:) followed by a path.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'org)
|
||||
(require 'ol)
|
||||
|
||||
(defcustom org-git-program "git"
|
||||
"Name of the git executable used to follow git links."
|
||||
:type '(string)
|
||||
:group 'org)
|
||||
|
||||
;; org link functions
|
||||
;; bare git link
|
||||
(org-link-set-parameters "gitbare" :follow #'org-gitbare-open)
|
||||
|
||||
(defun org-gitbare-open (str _)
|
||||
(let* ((strlist (org-git-split-string str))
|
||||
(gitdir (nth 0 strlist))
|
||||
(object (nth 1 strlist)))
|
||||
(org-git-open-file-internal gitdir object)))
|
||||
|
||||
|
||||
(defun org-git-open-file-internal (gitdir object)
|
||||
(let* ((sha (org-git-blob-sha gitdir object))
|
||||
(tmpdir (concat temporary-file-directory "org-git-" sha))
|
||||
(filename (org-git-link-filename object))
|
||||
(tmpfile (expand-file-name filename tmpdir)))
|
||||
(unless (file-readable-p tmpfile)
|
||||
(make-directory tmpdir)
|
||||
(with-temp-file tmpfile
|
||||
(org-git-show gitdir object (current-buffer))))
|
||||
(org-open-file tmpfile)
|
||||
(set-buffer (get-file-buffer tmpfile))
|
||||
(setq buffer-read-only t)))
|
||||
|
||||
;; user friendly link
|
||||
(org-link-set-parameters "git" :follow #'org-git-open :store #'org-git-store-link)
|
||||
|
||||
(defun org-git-open (str _)
|
||||
(let* ((strlist (org-git-split-string str))
|
||||
(filepath (nth 0 strlist))
|
||||
(commit (nth 1 strlist))
|
||||
(line (nth 2 strlist))
|
||||
(dirlist (org-git-find-gitdir (file-truename filepath)))
|
||||
(gitdir (nth 0 dirlist))
|
||||
(relpath (nth 1 dirlist)))
|
||||
(org-git-open-file-internal gitdir (concat commit ":" relpath))
|
||||
(when line
|
||||
(save-restriction
|
||||
(widen)
|
||||
(goto-char (point-min))
|
||||
(forward-line (1- (string-to-number line)))))))
|
||||
|
||||
|
||||
;; Utility functions (file names etc)
|
||||
|
||||
(defun org-git-split-dirpath (dirpath)
|
||||
"Given a directory name, return '(dirname basname)"
|
||||
(let ((dirname (file-name-directory (directory-file-name dirpath)))
|
||||
(basename (file-name-nondirectory (directory-file-name dirpath))))
|
||||
(list dirname basename)))
|
||||
|
||||
;; finding the git directory
|
||||
(defun org-git-find-gitdir (path)
|
||||
"Given a file (not necessarily existing) file path, return the
|
||||
a pair (gitdir relpath), where gitdir is the path to the first
|
||||
.git subdirectory found updstream and relpath is the rest of
|
||||
the path. Example: (org-git-find-gitdir
|
||||
\"~/gitrepos/foo/bar.txt\") returns
|
||||
'(\"/home/user/gitrepos/.git\" \"foo/bar.txt\"). When not in a git repository, return nil."
|
||||
(let ((dir (expand-file-name (file-name-directory path)))
|
||||
(relpath (file-name-nondirectory path)))
|
||||
(catch 'toplevel
|
||||
(while (not (file-exists-p (expand-file-name ".git" dir)))
|
||||
(let ((dirlist (org-git-split-dirpath dir)))
|
||||
(when (string= (nth 1 dirlist) "") ; at top level
|
||||
(throw 'toplevel nil))
|
||||
(setq dir (nth 0 dirlist)
|
||||
relpath (concat (file-name-as-directory (nth 1 dirlist)) relpath))))
|
||||
(list (expand-file-name ".git" dir) relpath))))
|
||||
|
||||
|
||||
(eval-and-compile
|
||||
(defalias 'org-git-gitrepos-p 'org-git-find-gitdir
|
||||
"Return non-nil if path is in git repository"))
|
||||
|
||||
;; splitting the link string
|
||||
|
||||
;; Both link open functions are called with a string of
|
||||
;; consisting of three parts separated by a double colon (::).
|
||||
(defun org-git-split-string (str)
|
||||
"Given a string of the form \"str1::str2::str3\", return a list of
|
||||
three substrings \'(\"str1\" \"str2\" \"str3\"). If there are less
|
||||
than two double colons, str2 and/or str3 may be set the empty string."
|
||||
(let ((strlist (split-string str "::")))
|
||||
(cond ((= 1 (length strlist))
|
||||
(list (car strlist) "" ""))
|
||||
((= 2 (length strlist))
|
||||
(append strlist (list "")))
|
||||
((= 3 (length strlist))
|
||||
strlist)
|
||||
(t (error "org-git-split-string: only one or two :: allowed: %s" str)))))
|
||||
|
||||
;; finding the file name part of a commit
|
||||
(defun org-git-link-filename (str)
|
||||
"Given an object description (see the man page of
|
||||
git-rev-parse), return the nondirectory part of the referenced
|
||||
filename, if it can be extracted. Otherwise, return a valid
|
||||
filename."
|
||||
(let* ((match (and (string-match "[^:]+$" str)
|
||||
(match-string 0 str)))
|
||||
(filename (and match (file-name-nondirectory match)))) ;extract the final part without slash
|
||||
filename))
|
||||
|
||||
;; creating a link
|
||||
(defun org-git-create-searchstring (branch timestring)
|
||||
(concat branch "@{" timestring "}"))
|
||||
|
||||
|
||||
(defun org-git-create-git-link (file &optional line)
|
||||
"Create git link part to file at specific time"
|
||||
(interactive "FFile: ")
|
||||
(let* ((gitdir (nth 0 (org-git-find-gitdir (file-truename file))))
|
||||
(branchname (org-git-get-current-branch gitdir))
|
||||
(timestring (format-time-string "%Y-%m-%d" (current-time))))
|
||||
(concat "git:" file "::" (org-git-create-searchstring branchname timestring)
|
||||
(if line (format "::%s" line) ""))))
|
||||
|
||||
(defun org-git-store-link ()
|
||||
"Store git link to current file."
|
||||
(when (buffer-file-name)
|
||||
(let ((file (abbreviate-file-name (buffer-file-name)))
|
||||
(line (line-number-at-pos)))
|
||||
(when (org-git-gitrepos-p file)
|
||||
(org-store-link-props
|
||||
:type "git"
|
||||
:link (org-git-create-git-link file line))))))
|
||||
|
||||
(defun org-git-insert-link-interactively (file searchstring &optional description)
|
||||
(interactive "FFile: \nsSearch string: \nsDescription: ")
|
||||
(insert (org-make-link-string (concat "git:" file "::" searchstring) description)))
|
||||
|
||||
;; Calling git
|
||||
(defun org-git-show (gitdir object buffer)
|
||||
"Show the output of git --git-dir=gitdir show object in buffer."
|
||||
(unless
|
||||
(zerop (call-process org-git-program nil buffer nil
|
||||
"--no-pager" (concat "--git-dir=" gitdir) "show" object))
|
||||
(error "git error: %s " (with-current-buffer buffer (buffer-string)))))
|
||||
|
||||
(defun org-git-blob-sha (gitdir object)
|
||||
"Return sha of the referenced object"
|
||||
(with-temp-buffer
|
||||
(if (zerop (call-process org-git-program nil t nil
|
||||
"--no-pager" (concat "--git-dir=" gitdir) "rev-parse" object))
|
||||
(buffer-substring (point-min) (1- (point-max))) ; to strip off final newline
|
||||
(error "git error: %s " (buffer-string)))))
|
||||
|
||||
(defun org-git-get-current-branch (gitdir)
|
||||
"Return the name of the current branch."
|
||||
(with-temp-buffer
|
||||
(if (not (zerop (call-process org-git-program nil t nil
|
||||
"--no-pager" (concat "--git-dir=" gitdir) "symbolic-ref" "-q" "HEAD")))
|
||||
(error "git error: %s " (buffer-string))
|
||||
(goto-char (point-min))
|
||||
(if (looking-at "^refs/heads/") ; 11 characters
|
||||
(buffer-substring 12 (1- (point-max))))))) ; to strip off final newline
|
||||
|
||||
(provide 'ol-git-link)
|
||||
|
||||
;;; ol-git-link.el ends here
|
||||
355
lisp/org-contrib/ol-mew.el
Normal file
355
lisp/org-contrib/ol-mew.el
Normal file
@@ -0,0 +1,355 @@
|
||||
;;; ol-mew.el --- Links to Mew messages
|
||||
|
||||
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp>
|
||||
;; Keywords: outlines, hypermedia, calendar, wp
|
||||
;; Homepage: https://orgmode.org
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; This program is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;;; Commentary:
|
||||
|
||||
;; This file implements links to Mew messages from within Org-mode.
|
||||
;; Org-mode loads this module by default - if this is not what you want,
|
||||
;; configure the variable `org-modules'.
|
||||
;;
|
||||
;; Here is an example of workflow:
|
||||
|
||||
;; In your ~/.mew.el configuration file:
|
||||
;;
|
||||
;; (define-key mew-summary-mode-map "'" 'org-mew-search)
|
||||
;; (eval-after-load "mew-summary"
|
||||
;; '(define-key mew-summary-mode-map "\C-o" 'org-mew-capture))
|
||||
|
||||
;; 1. In the Mew's inbox folder, take a glance at new messages to find
|
||||
;; a message that requires any action.
|
||||
|
||||
;; 2. If the message is a reply from somebody and associated with the
|
||||
;; existing orgmode entry, type M-x `org-mew-search' RET (or press
|
||||
;; the ' key simply) to find the entry. If you can find the entry
|
||||
;; successfully and think you should start the task right now,
|
||||
;; start the task by M-x `org-agenda-clock-in' RET.
|
||||
|
||||
;; 3. If the message is a new message, type M-x `org-mew-capture' RET,
|
||||
;; enter the refile folder, and the buffer to capture the message
|
||||
;; is shown up (without selecting the template by hand). Then you
|
||||
;; can fill the template and type C-c C-c to complete the capture.
|
||||
;; Note that you can configure `org-capture-templates' so that the
|
||||
;; captured entry has a link to the message.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'org)
|
||||
(require 'ol)
|
||||
|
||||
(defgroup org-mew nil
|
||||
"Options concerning the Mew link."
|
||||
:tag "Org Startup"
|
||||
:group 'org-link)
|
||||
|
||||
(defcustom org-mew-link-to-refile-destination t
|
||||
"Create a link to the refile destination if the message is marked as refile."
|
||||
:group 'org-mew
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom org-mew-inbox-folder nil
|
||||
"The folder where new messages are incorporated.
|
||||
If `org-mew-inbox-folder' is non-nil, `org-mew-open' locates the message
|
||||
in this inbox folder as well as the folder specified by the link."
|
||||
:group 'org-mew
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-mew-use-id-db t
|
||||
"Use ID database to locate the message if id.db is created."
|
||||
:group 'org-mew
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom org-mew-subject-alist
|
||||
(list (cons (concat "^\\(?:\\(?:re\\|fwd?\\): *\\)*"
|
||||
"\\(?:[[(][a-z0-9._-]+[:,]? [0-9]+[])]\\)? *"
|
||||
"\\(?:\\(?:re\\|fwd?\\): *\\)*"
|
||||
"\\(.*\\)[ \t]*")
|
||||
1))
|
||||
"Alist of subject regular expression and matched group number for search."
|
||||
:group 'org-mew
|
||||
:type '(repeat (cons (regexp) (integer))))
|
||||
|
||||
(defcustom org-mew-capture-inbox-folders nil
|
||||
"List of inbox folders whose messages need refile marked before capture.
|
||||
`org-mew-capture' will ask you to put the refile mark on the
|
||||
message if the message's folder is any of these folders and the
|
||||
message is not marked. Nil means `org-mew-capture' never ask you
|
||||
destination folders before capture."
|
||||
:group 'org-mew
|
||||
:type '(repeat string))
|
||||
|
||||
(defcustom org-mew-capture-guess-alist nil
|
||||
"Alist of the regular expression of the folder name and the capture
|
||||
template selection keys.
|
||||
|
||||
For example,
|
||||
'((\"^%emacs-orgmode$\" . \"o\")
|
||||
(\"\" . \"t\"))
|
||||
the messages in \"%emacs-orgmode\" folder will be captured with
|
||||
the capture template associated with \"o\" key, and any other
|
||||
messages will be captured with the capture template associated
|
||||
with \"t\" key."
|
||||
:group 'org-mew
|
||||
:type '(repeat (cons regexp string)))
|
||||
|
||||
;; Declare external functions and variables
|
||||
(declare-function mew-cache-hit "ext:mew-cache" (fld msg &optional must-hit))
|
||||
(declare-function mew-case-folder "ext:mew-func" (case folder))
|
||||
(declare-function mew-folder-path-to-folder
|
||||
"ext:mew-func" (path &optional has-proto))
|
||||
(declare-function mew-idstr-to-id-list "ext:mew-header" (idstr &optional rev))
|
||||
(declare-function mew-folder-remotep "ext:mew-func" (folder))
|
||||
(declare-function mew-folder-virtualp "ext:mew-func" (folder))
|
||||
(declare-function mew-header-get-value "ext:mew-header"
|
||||
(field &optional as-list))
|
||||
(declare-function mew-init "ext:mew" ())
|
||||
(declare-function mew-refile-get "ext:mew-refile" (msg))
|
||||
(declare-function mew-sinfo-get-case "ext:mew-summary" ())
|
||||
(declare-function mew-summary-diag-global "ext:mew-thread" (id opt who))
|
||||
(declare-function mew-summary-display "ext:mew-summary2" (&optional redisplay))
|
||||
(declare-function mew-summary-folder-name "ext:mew-syntax" (&optional ext))
|
||||
(declare-function mew-summary-get-mark "ext:mew-mark" ())
|
||||
(declare-function mew-summary-message-number2 "ext:mew-syntax" ())
|
||||
(declare-function mew-summary-pick-with-mewl "ext:mew-pick"
|
||||
(pattern folder src-msgs))
|
||||
(declare-function mew-summary-refile "ext:mew-refile" (&optional report))
|
||||
(declare-function mew-summary-search-msg "ext:mew-const" (msg))
|
||||
(declare-function mew-summary-set-message-buffer "ext:mew-summary3" (fld msg))
|
||||
(declare-function mew-summary-visit-folder "ext:mew-summary4"
|
||||
(folder &optional goend no-ls))
|
||||
(declare-function mew-window-push "ext:mew" ())
|
||||
(declare-function mew-expand-folder "ext:mew-func" (folder))
|
||||
(declare-function mew-case:folder-folder "ext:mew-func" (case:folder))
|
||||
(declare-function mew "ext:mew" (&optional arg))
|
||||
(declare-function mew-message-goto-summary "ext:mew-message" ())
|
||||
(declare-function mew-summary-mode "ext:mew-summary" ())
|
||||
|
||||
(defvar mew-init-p)
|
||||
(defvar mew-mark-afterstep-spec)
|
||||
(defvar mew-summary-goto-line-then-display)
|
||||
|
||||
;; Install the link type
|
||||
(org-link-set-parameters "mew" :follow #'org-mew-open :store #'org-mew-store-link)
|
||||
|
||||
;; Implementation
|
||||
(defun org-mew-store-link ()
|
||||
"Store a link to a Mew folder or message."
|
||||
(save-window-excursion
|
||||
(if (eq major-mode 'mew-message-mode)
|
||||
(mew-message-goto-summary))
|
||||
(when (memq major-mode '(mew-summary-mode mew-virtual-mode))
|
||||
(let ((msgnum (mew-summary-message-number2))
|
||||
(folder-name (org-mew-folder-name)))
|
||||
(if (fboundp 'mew-summary-set-message-buffer)
|
||||
(mew-summary-set-message-buffer folder-name msgnum)
|
||||
(set-buffer (mew-cache-hit folder-name msgnum t)))
|
||||
(let* ((message-id (mew-header-get-value "Message-Id:"))
|
||||
(from (mew-header-get-value "From:"))
|
||||
(to (mew-header-get-value "To:"))
|
||||
(date (mew-header-get-value "Date:"))
|
||||
(subject (mew-header-get-value "Subject:"))
|
||||
desc link)
|
||||
(org-store-link-props :type "mew" :from from :to to :date date
|
||||
:subject subject :message-id message-id)
|
||||
(setq message-id (org-unbracket-string "<" ">" message-id))
|
||||
(setq desc (org-email-link-description))
|
||||
(setq link (concat "mew:" folder-name "#" message-id))
|
||||
(org-add-link-props :link link :description desc)
|
||||
link)))))
|
||||
|
||||
(defun org-mew-folder-name ()
|
||||
"Return the folder name of the current message."
|
||||
(save-window-excursion
|
||||
(if (eq major-mode 'mew-message-mode)
|
||||
(mew-message-goto-summary))
|
||||
(let* ((msgnum (mew-summary-message-number2))
|
||||
(mark-info (mew-summary-get-mark)))
|
||||
(if (and org-mew-link-to-refile-destination
|
||||
(eq mark-info ?o)) ; marked as refile
|
||||
(mew-case-folder (mew-sinfo-get-case)
|
||||
(nth 1 (mew-refile-get msgnum)))
|
||||
(let ((folder-or-path (mew-summary-folder-name)))
|
||||
(mew-folder-path-to-folder folder-or-path t))))))
|
||||
|
||||
(defun org-mew-open (path _)
|
||||
"Follow the Mew message link specified by PATH."
|
||||
(let (folder message-id)
|
||||
(cond ((string-match "\\`\\(+.*\\)+\\+\\([0-9]+\\)\\'" path) ; for Bastien's
|
||||
(setq folder (match-string 1 path))
|
||||
(setq message-id (match-string 2 path)))
|
||||
((string-match "\\`\\(\\(%#\\)?[^#]+\\)\\(#\\(.*\\)\\)?" path)
|
||||
(setq folder (match-string 1 path))
|
||||
(setq message-id (match-string 4 path)))
|
||||
((and org-mew-use-id-db (string-match "\\`#\\(.+\\)" path))
|
||||
(setq folder nil)
|
||||
(setq message-id (match-string 1 path)))
|
||||
(t (error "Error in Mew link")))
|
||||
(require 'mew)
|
||||
(mew-window-push)
|
||||
(unless mew-init-p (mew-init))
|
||||
(if (null folder)
|
||||
(progn
|
||||
(mew t)
|
||||
(org-mew-open-by-message-id message-id))
|
||||
(or (org-mew-follow-link folder message-id)
|
||||
(and org-mew-inbox-folder (not (string= org-mew-inbox-folder folder))
|
||||
(org-mew-follow-link org-mew-inbox-folder message-id))
|
||||
(and org-mew-use-id-db
|
||||
(org-mew-open-by-message-id message-id))
|
||||
(error "Message not found")))))
|
||||
|
||||
(defun org-mew-follow-link (folder message-id)
|
||||
(unless (org-mew-folder-exists-p folder)
|
||||
(error "No such folder or wrong folder %s" folder))
|
||||
(mew-summary-visit-folder folder)
|
||||
(when message-id
|
||||
(let ((msgnum (org-mew-get-msgnum folder message-id)))
|
||||
(when (mew-summary-search-msg msgnum)
|
||||
(if mew-summary-goto-line-then-display
|
||||
(mew-summary-display))
|
||||
t))))
|
||||
|
||||
(defun org-mew-folder-exists-p (folder)
|
||||
(let ((dir (mew-expand-folder folder)))
|
||||
(cond
|
||||
((mew-folder-virtualp folder) (get-buffer folder))
|
||||
((null dir) nil)
|
||||
((mew-folder-remotep (mew-case:folder-folder folder)) t)
|
||||
(t (file-directory-p dir)))))
|
||||
|
||||
(defun org-mew-get-msgnum (folder message-id)
|
||||
(if (string-match "\\`[0-9]+\\'" message-id)
|
||||
message-id
|
||||
(let* ((pattern (concat "message-id=" message-id))
|
||||
(msgs (mew-summary-pick-with-mewl pattern folder nil)))
|
||||
(car msgs))))
|
||||
|
||||
(defun org-mew-open-by-message-id (message-id)
|
||||
"Open message using ID database."
|
||||
(let ((result (mew-summary-diag-global (format "<%s>" message-id)
|
||||
"-p" "Message")))
|
||||
(unless (eq result t)
|
||||
(error "Message not found"))))
|
||||
|
||||
;; In ~/.mew.el, add the following line:
|
||||
;; (define-key mew-summary-mode-map "'" 'org-mew-search)
|
||||
(defun org-mew-search (&optional arg)
|
||||
"Show all entries related to the message using `org-search-view'.
|
||||
|
||||
It shows entries which contains the message ID, the reference
|
||||
IDs, or the subject of the message.
|
||||
|
||||
With C-u prefix, search for the entries that contains the message
|
||||
ID or any of the reference IDs. With C-u C-u prefix, search for
|
||||
the message ID or the last reference ID.
|
||||
|
||||
The search phase for the subject is extracted with
|
||||
`org-mew-subject-alist', which defines the regular expression of
|
||||
the subject and the group number to extract. You can get rid of
|
||||
\"Re:\" and some other prefix from the subject text."
|
||||
(interactive "P")
|
||||
(when (memq major-mode '(mew-summary-mode mew-virtual-mode))
|
||||
(let ((last-reference-only (equal arg '(16)))
|
||||
(by-subject (null arg))
|
||||
(msgnum (mew-summary-message-number2))
|
||||
(folder-name (mew-summary-folder-name))
|
||||
subject message-id references id-list)
|
||||
(save-window-excursion
|
||||
(if (fboundp 'mew-summary-set-message-buffer)
|
||||
(mew-summary-set-message-buffer folder-name msgnum)
|
||||
(set-buffer (mew-cache-hit folder-name msgnum t)))
|
||||
(setq subject (mew-header-get-value "Subject:"))
|
||||
(setq message-id (mew-header-get-value "Message-Id:"))
|
||||
(setq references (mew-header-get-value "References:")))
|
||||
(setq id-list (mapcar (lambda (id) (org-unbracket-string "<" ">" id))
|
||||
(mew-idstr-to-id-list references)))
|
||||
(if last-reference-only
|
||||
(setq id-list (last id-list))
|
||||
(if message-id
|
||||
(setq id-list (cons (org-unbracket-string "<" ">" message-id)
|
||||
id-list))))
|
||||
(when (and by-subject (stringp subject))
|
||||
(catch 'matched
|
||||
(mapc (lambda (elem)
|
||||
(let ((regexp (car elem))
|
||||
(num (cdr elem)))
|
||||
(when (string-match regexp subject)
|
||||
(setq subject (match-string num subject))
|
||||
(throw 'matched t))))
|
||||
org-mew-subject-alist))
|
||||
(setq id-list (cons subject id-list)))
|
||||
(cond ((null id-list)
|
||||
(error "No message ID to search"))
|
||||
((equal (length id-list) 1)
|
||||
(org-search-view nil (car id-list)))
|
||||
(t
|
||||
(org-search-view nil (format "{\\(%s\\)}"
|
||||
(mapconcat 'regexp-quote
|
||||
id-list "\\|"))))))
|
||||
(delete-other-windows)))
|
||||
|
||||
(defun org-mew-capture (arg)
|
||||
"Guess the capture template from the folder name and invoke `org-capture'.
|
||||
|
||||
This selects a capture template in `org-capture-templates' by
|
||||
searching for capture template selection keys defined in
|
||||
`org-mew-capture-guess-alist' which are associated with the
|
||||
regular expression that matches the message's folder name, and
|
||||
then invokes `org-capture'.
|
||||
|
||||
If the message's folder is a inbox folder, you are prompted to
|
||||
put the refile mark on the message and the capture template is
|
||||
guessed from the refile destination folder. You can customize
|
||||
the inbox folders by `org-mew-capture-inbox-folders'.
|
||||
|
||||
If ARG is non-nil, this does not guess the capture template but
|
||||
asks you to select the capture template."
|
||||
(interactive "P")
|
||||
(or (not (member (org-mew-folder-name)
|
||||
org-mew-capture-inbox-folders))
|
||||
(eq (mew-summary-get-mark) ?o)
|
||||
(save-window-excursion
|
||||
(if (eq major-mode 'mew-message-mode)
|
||||
(mew-message-goto-summary))
|
||||
(let ((mew-mark-afterstep-spec '((?o 0 0 0 0 0 0 0))))
|
||||
(mew-summary-refile)))
|
||||
(error "No refile folder selected"))
|
||||
(let* ((org-mew-link-to-refile-destination t)
|
||||
(folder-name (org-mew-folder-name))
|
||||
(keys (if arg
|
||||
nil
|
||||
(org-mew-capture-guess-selection-keys folder-name))))
|
||||
(org-capture nil keys)))
|
||||
|
||||
(defun org-mew-capture-guess-selection-keys (folder-name)
|
||||
(catch 'found
|
||||
(let ((alist org-mew-capture-guess-alist))
|
||||
(while alist
|
||||
(let ((elem (car alist)))
|
||||
(if (string-match (car elem) folder-name)
|
||||
(throw 'found (cdr elem))))
|
||||
(setq alist (cdr alist))))))
|
||||
|
||||
(provide 'ol-mew)
|
||||
|
||||
;;; ol-mew.el ends here
|
||||
155
lisp/org-contrib/ol-notmuch.el
Normal file
155
lisp/org-contrib/ol-notmuch.el
Normal file
@@ -0,0 +1,155 @@
|
||||
;;; ol-notmuch.el --- Links to notmuch messages
|
||||
|
||||
;; Copyright (C) 2010-2014, 2021 Matthieu Lemerre
|
||||
|
||||
;; Author: Matthieu Lemerre <racin@free.fr>
|
||||
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
|
||||
;; Keywords: outlines, hypermedia, calendar, wp
|
||||
;; Homepage: https://git.sr.ht/~tarsius/ol-notmuch
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; This file 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, or (at your option)
|
||||
;; any later version.
|
||||
|
||||
;; This file is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file implements links to notmuch messages and "searches". A
|
||||
;; search is a query to be performed by notmuch; it is the equivalent
|
||||
;; to folders in other mail clients. Similarly, mails are referred to
|
||||
;; by a query, so both a link can refer to several mails.
|
||||
|
||||
;; Links have one the following form
|
||||
;; notmuch:<search terms>
|
||||
;; notmuch-search:<search terms>.
|
||||
|
||||
;; The first form open the queries in notmuch-show mode, whereas the
|
||||
;; second link open it in notmuch-search mode. Note that queries are
|
||||
;; performed at the time the link is opened, and the result may be
|
||||
;; different from when the link was stored.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ol)
|
||||
|
||||
;; customisable notmuch open functions
|
||||
(defcustom org-notmuch-open-function
|
||||
'org-notmuch-follow-link
|
||||
"Function used to follow notmuch links.
|
||||
|
||||
Should accept a notmuch search string as the sole argument."
|
||||
:group 'org-notmuch
|
||||
:version "24.4"
|
||||
:package-version '(Org . "8.0")
|
||||
:type 'function)
|
||||
|
||||
(defcustom org-notmuch-search-open-function
|
||||
'org-notmuch-search-follow-link
|
||||
"Function used to follow notmuch-search links.
|
||||
Should accept a notmuch search string as the sole argument."
|
||||
:group 'org-notmuch
|
||||
:version "24.4"
|
||||
:package-version '(Org . "8.0")
|
||||
:type 'function)
|
||||
|
||||
(make-obsolete-variable 'org-notmuch-search-open-function nil "9.3")
|
||||
|
||||
|
||||
|
||||
;; Install the link type
|
||||
(org-link-set-parameters "notmuch"
|
||||
:follow #'org-notmuch-open
|
||||
:store #'org-notmuch-store-link)
|
||||
|
||||
(defun org-notmuch-store-link ()
|
||||
"Store a link to a notmuch search or message."
|
||||
(when (memq major-mode '(notmuch-show-mode notmuch-tree-mode))
|
||||
(let* ((message-id (notmuch-show-get-message-id t))
|
||||
(subject (notmuch-show-get-subject))
|
||||
(to (notmuch-show-get-to))
|
||||
(from (notmuch-show-get-from))
|
||||
(date (org-trim (notmuch-show-get-date)))
|
||||
desc link)
|
||||
(org-link-store-props :type "notmuch" :from from :to to :date date
|
||||
:subject subject :message-id message-id)
|
||||
(setq desc (org-link-email-description))
|
||||
(setq link (concat "notmuch:id:" message-id))
|
||||
(org-link-add-props :link link :description desc)
|
||||
link)))
|
||||
|
||||
(defun org-notmuch-open (path _)
|
||||
"Follow a notmuch message link specified by PATH."
|
||||
(funcall org-notmuch-open-function path))
|
||||
|
||||
(defun org-notmuch-follow-link (search)
|
||||
"Follow a notmuch link to SEARCH.
|
||||
|
||||
Can link to more than one message, if so all matching messages are shown."
|
||||
(require 'notmuch)
|
||||
(notmuch-show search))
|
||||
|
||||
|
||||
|
||||
(org-link-set-parameters "notmuch-search"
|
||||
:follow #'org-notmuch-search-open
|
||||
:store #'org-notmuch-search-store-link)
|
||||
|
||||
(defun org-notmuch-search-store-link ()
|
||||
"Store a link to a notmuch search or message."
|
||||
(when (eq major-mode 'notmuch-search-mode)
|
||||
(let ((link (concat "notmuch-search:" notmuch-search-query-string))
|
||||
(desc (concat "Notmuch search: " notmuch-search-query-string)))
|
||||
(org-link-store-props :type "notmuch-search"
|
||||
:link link
|
||||
:description desc)
|
||||
link)))
|
||||
|
||||
(defun org-notmuch-search-open (path _)
|
||||
"Follow a notmuch message link specified by PATH."
|
||||
(message "%s" path)
|
||||
(org-notmuch-search-follow-link path))
|
||||
|
||||
(defun org-notmuch-search-follow-link (search)
|
||||
"Follow a notmuch link by displaying SEARCH in notmuch-search mode."
|
||||
(require 'notmuch)
|
||||
(notmuch-search search))
|
||||
|
||||
|
||||
|
||||
(org-link-set-parameters "notmuch-tree"
|
||||
:follow #'org-notmuch-tree-open
|
||||
:store #'org-notmuch-tree-store-link)
|
||||
|
||||
(defun org-notmuch-tree-store-link ()
|
||||
"Store a link to a notmuch search or message."
|
||||
(when (eq major-mode 'notmuch-tree-mode)
|
||||
(let ((link (concat "notmuch-tree:" (notmuch-tree-get-query)))
|
||||
(desc (concat "Notmuch tree: " (notmuch-tree-get-query))))
|
||||
(org-link-store-props :type "notmuch-tree"
|
||||
:link link
|
||||
:description desc)
|
||||
link)))
|
||||
|
||||
(defun org-notmuch-tree-open (path _)
|
||||
"Follow a notmuch message link specified by PATH."
|
||||
(message "%s" path)
|
||||
(org-notmuch-tree-follow-link path))
|
||||
|
||||
(defun org-notmuch-tree-follow-link (search)
|
||||
"Follow a notmuch link by displaying SEARCH in notmuch-tree mode."
|
||||
(require 'notmuch)
|
||||
(notmuch-tree search))
|
||||
|
||||
(provide 'ol-notmuch)
|
||||
|
||||
;;; ol-notmuch.el ends here
|
||||
167
lisp/org-contrib/ol-vm.el
Normal file
167
lisp/org-contrib/ol-vm.el
Normal file
@@ -0,0 +1,167 @@
|
||||
;;; ol-vm.el --- Links to VM messages
|
||||
|
||||
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
|
||||
;; Keywords: outlines, hypermedia, calendar, wp
|
||||
;; Homepage: https://orgmode.org
|
||||
;;
|
||||
;; Support for IMAP folders added
|
||||
;; by Konrad Hinsen <konrad dot hinsen at fastmail dot net>
|
||||
;; Requires VM 8.2.0a or later.
|
||||
;;
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; This program is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;;; Commentary:
|
||||
;; This file implements links to VM messages and folders from within Org-mode.
|
||||
;; Org-mode loads this module by default - if this is not what you want,
|
||||
;; configure the variable `org-modules'.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ol)
|
||||
(require 'org)
|
||||
|
||||
;; Declare external functions and variables
|
||||
(declare-function vm-preview-current-message "ext:vm-page" ())
|
||||
(declare-function vm-follow-summary-cursor "ext:vm-motion" ())
|
||||
(declare-function vm-get-header-contents "ext:vm-summary"
|
||||
(message header-name-regexp &optional clump-sep))
|
||||
(declare-function vm-isearch-narrow "ext:vm-search" ())
|
||||
(declare-function vm-isearch-update "ext:vm-search" ())
|
||||
(declare-function vm-select-folder-buffer "ext:vm-macro" ())
|
||||
(declare-function vm-su-message-id "ext:vm-summary" (m))
|
||||
(declare-function vm-su-subject "ext:vm-summary" (m))
|
||||
(declare-function vm-summarize "ext:vm-summary" (&optional display raise))
|
||||
(declare-function vm-imap-folder-p "ext:vm-save" ())
|
||||
(declare-function vm-imap-find-spec-for-buffer "ext:vm-imap" (buffer))
|
||||
(declare-function vm-imap-folder-for-spec "ext:vm-imap" (spec))
|
||||
(declare-function vm-imap-parse-spec-to-list "ext:vm-imap" (spec))
|
||||
(declare-function vm-imap-spec-for-account "ext:vm-imap" (account))
|
||||
(defvar vm-message-pointer)
|
||||
(defvar vm-folder-directory)
|
||||
|
||||
;; Install the link type
|
||||
(org-link-set-parameters "vm" :follow #'org-vm-open :store #'org-vm-store-link)
|
||||
(org-link-set-parameters "vm-imap" :follow #'org-vm-imap-open)
|
||||
|
||||
;; Implementation
|
||||
(defun org-vm-store-link ()
|
||||
"Store a link to a VM folder or message."
|
||||
(when (and (or (eq major-mode 'vm-summary-mode)
|
||||
(eq major-mode 'vm-presentation-mode))
|
||||
(save-window-excursion
|
||||
(vm-select-folder-buffer) buffer-file-name))
|
||||
(and (eq major-mode 'vm-presentation-mode) (vm-summarize))
|
||||
(vm-follow-summary-cursor)
|
||||
(save-excursion
|
||||
(vm-select-folder-buffer)
|
||||
(let* ((message (car vm-message-pointer))
|
||||
(subject (vm-su-subject message))
|
||||
(to (vm-get-header-contents message "To"))
|
||||
(from (vm-get-header-contents message "From"))
|
||||
(message-id (vm-su-message-id message))
|
||||
(link-type (if (vm-imap-folder-p) "vm-imap" "vm"))
|
||||
(date (vm-get-header-contents message "Date"))
|
||||
folder desc link)
|
||||
(if (vm-imap-folder-p)
|
||||
(let ((spec (vm-imap-find-spec-for-buffer (current-buffer))))
|
||||
(setq folder (vm-imap-folder-for-spec spec)))
|
||||
(progn
|
||||
(setq folder (abbreviate-file-name buffer-file-name))
|
||||
(if (and vm-folder-directory
|
||||
(string-match (concat "^" (regexp-quote vm-folder-directory))
|
||||
folder))
|
||||
(setq folder (replace-match "" t t folder)))))
|
||||
(setq message-id (org-unbracket-string "<" ">" message-id))
|
||||
(org-store-link-props :type link-type :from from :to to :subject subject
|
||||
:message-id message-id :date date)
|
||||
(setq desc (org-email-link-description))
|
||||
(setq link (concat (concat link-type ":") folder "#" message-id))
|
||||
(org-add-link-props :link link :description desc)
|
||||
link))))
|
||||
|
||||
(defun org-vm-open (path _)
|
||||
"Follow a VM message link specified by PATH."
|
||||
(let (folder article)
|
||||
(if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
|
||||
(error "Error in VM link"))
|
||||
(setq folder (match-string 1 path)
|
||||
article (match-string 3 path))
|
||||
;; The prefix argument will be interpreted as read-only
|
||||
(org-vm-follow-link folder article current-prefix-arg)))
|
||||
|
||||
(defun org-vm-follow-link (&optional folder article readonly)
|
||||
"Follow a VM link to FOLDER and ARTICLE."
|
||||
(require 'vm)
|
||||
(setq article (org-link-add-angle-brackets article))
|
||||
(if (string-match "^//\\([a-zA-Z]+@\\)?\\([^:]+\\):\\(.*\\)" folder)
|
||||
;; ange-ftp or efs or tramp access
|
||||
(let ((user (or (match-string 1 folder) (user-login-name)))
|
||||
(host (match-string 2 folder))
|
||||
(file (match-string 3 folder)))
|
||||
(cond
|
||||
((featurep 'tramp)
|
||||
;; use tramp to access the file
|
||||
(setq folder (format "/%s@%s:%s" user host file)))
|
||||
(t
|
||||
;; use ange-ftp or efs
|
||||
(require 'ange-ftp)
|
||||
(setq folder (format "/%s@%s:%s" user host file))))))
|
||||
(when folder
|
||||
(funcall (cdr (assq 'vm org-link-frame-setup)) folder readonly)
|
||||
(when article
|
||||
(org-vm-select-message (org-link-add-angle-brackets article)))))
|
||||
|
||||
(defun org-vm-imap-open (path _)
|
||||
"Follow a VM link to an IMAP folder."
|
||||
(require 'vm-imap)
|
||||
(when (string-match "\\([^:]+\\):\\([^#]+\\)#?\\(.+\\)?" path)
|
||||
(let* ((account-name (match-string 1 path))
|
||||
(mailbox-name (match-string 2 path))
|
||||
(message-id (match-string 3 path))
|
||||
(account-spec (vm-imap-parse-spec-to-list
|
||||
(vm-imap-spec-for-account account-name)))
|
||||
(mailbox-spec (mapconcat 'identity
|
||||
(append (butlast account-spec 4)
|
||||
(cons mailbox-name
|
||||
(last account-spec 3)))
|
||||
":")))
|
||||
(funcall (cdr (assq 'vm-imap org-link-frame-setup))
|
||||
mailbox-spec)
|
||||
(when message-id
|
||||
(org-vm-select-message (org-link-add-angle-brackets message-id))))))
|
||||
|
||||
(defun org-vm-select-message (message-id)
|
||||
"Go to the message with message-id in the current folder."
|
||||
(require 'vm-search)
|
||||
(sit-for 0.1)
|
||||
(vm-select-folder-buffer)
|
||||
(widen)
|
||||
(let ((case-fold-search t))
|
||||
(goto-char (point-min))
|
||||
(if (not (re-search-forward
|
||||
(concat "^" "message-id:\\s-*" (regexp-quote message-id))))
|
||||
(error "Could not find the specified message in this folder"))
|
||||
(vm-isearch-update)
|
||||
(vm-isearch-narrow)
|
||||
(vm-preview-current-message)
|
||||
(vm-summarize)))
|
||||
|
||||
(provide 'ol-vm)
|
||||
|
||||
;;; ol-vm.el ends here
|
||||
304
lisp/org-contrib/ol-wl.el
Normal file
304
lisp/org-contrib/ol-wl.el
Normal file
@@ -0,0 +1,304 @@
|
||||
;;; ol-wl.el --- Links to Wanderlust messages
|
||||
|
||||
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp>
|
||||
;; David Maus <dmaus at ictsoc dot de>
|
||||
;; Keywords: outlines, hypermedia, calendar, wp
|
||||
;; Homepage: https://orgmode.org
|
||||
;;
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; This program is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;;; Commentary:
|
||||
|
||||
;; This file implements links to Wanderlust messages from within Org-mode.
|
||||
;; Org-mode loads this module by default - if this is not what you want,
|
||||
;; configure the variable `org-modules'.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ol)
|
||||
(require 'org)
|
||||
|
||||
(defgroup org-wl nil
|
||||
"Options concerning the Wanderlust link."
|
||||
:tag "Org Startup"
|
||||
:group 'org-link)
|
||||
|
||||
(defcustom org-wl-link-to-refile-destination t
|
||||
"Create a link to the refile destination if the message is marked as refile."
|
||||
:group 'org-wl
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom org-wl-link-remove-filter nil
|
||||
"Remove filter condition if message is filter folder."
|
||||
:group 'org-wl
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom org-wl-shimbun-prefer-web-links nil
|
||||
"If non-nil create web links for shimbun messages."
|
||||
:group 'org-wl
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom org-wl-nntp-prefer-web-links nil
|
||||
"If non-nil create web links for nntp messages.
|
||||
When folder name contains string \"gmane\" link to gmane,
|
||||
googlegroups otherwise."
|
||||
:type 'boolean
|
||||
:group 'org-wl)
|
||||
|
||||
(defcustom org-wl-disable-folder-check t
|
||||
"Disable check for new messages when open a link."
|
||||
:type 'boolean
|
||||
:group 'org-wl)
|
||||
|
||||
(defcustom org-wl-namazu-default-index nil
|
||||
"Default namazu search index."
|
||||
:type '(choice (const nil) (directory))
|
||||
:group 'org-wl)
|
||||
|
||||
;; Declare external functions and variables
|
||||
(declare-function elmo-folder-exists-p "ext:elmo" (folder) t)
|
||||
(declare-function elmo-message-entity-field "ext:elmo-msgdb"
|
||||
(entity field &optional type))
|
||||
(declare-function elmo-message-field "ext:elmo"
|
||||
(folder number field &optional type) t)
|
||||
(declare-function elmo-msgdb-overview-get-entity "ext:elmo" (id msgdb) t)
|
||||
;; Backward compatibility to old version of wl
|
||||
(declare-function wl "ext:wl" () t)
|
||||
(declare-function wl-summary-buffer-msgdb "ext:wl-folder" () t)
|
||||
(declare-function wl-summary-jump-to-msg-by-message-id "ext:wl-summary"
|
||||
(&optional id))
|
||||
(declare-function wl-summary-jump-to-msg "ext:wl-summary"
|
||||
(&optional number beg end))
|
||||
(declare-function wl-summary-line-from "ext:wl-summary" ())
|
||||
(declare-function wl-summary-line-subject "ext:wl-summary" ())
|
||||
(declare-function wl-summary-message-number "ext:wl-summary" ())
|
||||
(declare-function wl-summary-redisplay "ext:wl-summary" (&optional arg))
|
||||
(declare-function wl-summary-registered-temp-mark "ext:wl-action" (number))
|
||||
(declare-function wl-folder-goto-folder-subr "ext:wl-folder"
|
||||
(&optional folder sticky))
|
||||
(declare-function wl-folder-get-petname "ext:wl-folder" (name))
|
||||
(declare-function wl-folder-get-entity-from-buffer "ext:wl-folder"
|
||||
(&optional getid))
|
||||
(declare-function wl-folder-buffer-group-p "ext:wl-folder")
|
||||
(defvar wl-init)
|
||||
(defvar wl-summary-buffer-elmo-folder)
|
||||
(defvar wl-summary-buffer-folder-name)
|
||||
(defvar wl-folder-group-regexp)
|
||||
(defvar wl-auto-check-folder-name)
|
||||
(defvar elmo-nntp-default-server)
|
||||
|
||||
(defconst org-wl-folder-types
|
||||
'(("%" . imap) ("-" . nntp) ("+" . mh) ("." . maildir)
|
||||
("=" . spool) ("$" . archive) ("&" . pop) ("@" . shimbun)
|
||||
("rss" . rss) ("[" . search) ("*" . multi) ("/" . filter)
|
||||
("|" . pipe) ("'" . internal) )
|
||||
"List of folder indicators. See Wanderlust manual, section 3.")
|
||||
|
||||
;; Install the link type
|
||||
(org-link-set-parameters "wl" :follow #'org-wl-open :store #'org-wl-store-link)
|
||||
|
||||
;; Implementation
|
||||
|
||||
(defun org-wl-folder-type (folder)
|
||||
"Return symbol that indicates the type of FOLDER.
|
||||
FOLDER is the wanderlust folder name. The first character of the
|
||||
folder name determines the folder type."
|
||||
(let* ((indicator (substring folder 0 1))
|
||||
(type (cdr (assoc indicator org-wl-folder-types))))
|
||||
;; maybe access or file folder
|
||||
(when (not type)
|
||||
(setq type
|
||||
(cond
|
||||
((and (>= (length folder) 5)
|
||||
(string= (substring folder 0 5) "file:"))
|
||||
'file)
|
||||
((and (>= (length folder) 7)
|
||||
(string= (substring folder 0 7) "access:"))
|
||||
'access)
|
||||
(t
|
||||
nil))))
|
||||
type))
|
||||
|
||||
(defun org-wl-message-field (field entity)
|
||||
"Return content of FIELD in ENTITY.
|
||||
FIELD is a symbol of a rfc822 message header field.
|
||||
ENTITY is a message entity."
|
||||
(let ((content (elmo-message-entity-field entity field 'string)))
|
||||
(if (listp content) (car content) content)))
|
||||
|
||||
(defun org-wl-store-link ()
|
||||
"Store a link to a WL message or folder."
|
||||
(unless (eobp)
|
||||
(cond
|
||||
((memq major-mode '(wl-summary-mode mime-view-mode))
|
||||
(org-wl-store-link-message))
|
||||
((eq major-mode 'wl-folder-mode)
|
||||
(org-wl-store-link-folder))
|
||||
(t
|
||||
nil))))
|
||||
|
||||
(defun org-wl-store-link-folder ()
|
||||
"Store a link to a WL folder."
|
||||
(let* ((folder (wl-folder-get-entity-from-buffer))
|
||||
(petname (wl-folder-get-petname folder))
|
||||
(link (concat "wl:" folder)))
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(unless (and (wl-folder-buffer-group-p)
|
||||
(looking-at wl-folder-group-regexp))
|
||||
(org-store-link-props :type "wl" :description petname
|
||||
:link link)
|
||||
link))))
|
||||
|
||||
(defun org-wl-store-link-message ()
|
||||
"Store a link to a WL message."
|
||||
(save-excursion
|
||||
(let ((buf (if (eq major-mode 'wl-summary-mode)
|
||||
(current-buffer)
|
||||
(and (boundp 'wl-message-buffer-cur-summary-buffer)
|
||||
wl-message-buffer-cur-summary-buffer))))
|
||||
(when buf
|
||||
(with-current-buffer buf
|
||||
(let* ((msgnum (wl-summary-message-number))
|
||||
(mark-info (wl-summary-registered-temp-mark msgnum))
|
||||
(folder-name
|
||||
(if (and org-wl-link-to-refile-destination
|
||||
mark-info
|
||||
(equal (nth 1 mark-info) "o")) ; marked as refile
|
||||
(nth 2 mark-info)
|
||||
wl-summary-buffer-folder-name))
|
||||
(folder-type (org-wl-folder-type folder-name))
|
||||
(wl-message-entity
|
||||
(if (fboundp 'elmo-message-entity)
|
||||
(elmo-message-entity
|
||||
wl-summary-buffer-elmo-folder msgnum)
|
||||
(elmo-msgdb-overview-get-entity
|
||||
msgnum (wl-summary-buffer-msgdb))))
|
||||
(message-id
|
||||
(org-wl-message-field 'message-id wl-message-entity))
|
||||
(message-id-no-brackets
|
||||
(org-unbracket-string "<" ">" message-id))
|
||||
(from (org-wl-message-field 'from wl-message-entity))
|
||||
(to (org-wl-message-field 'to wl-message-entity))
|
||||
(xref (org-wl-message-field 'xref wl-message-entity))
|
||||
(subject (org-wl-message-field 'subject wl-message-entity))
|
||||
(date (org-wl-message-field 'date wl-message-entity))
|
||||
desc link)
|
||||
|
||||
;; remove text properties of subject string to avoid possible bug
|
||||
;; when formatting the subject
|
||||
;; (Emacs bug #5306, fixed)
|
||||
(set-text-properties 0 (length subject) nil subject)
|
||||
|
||||
;; maybe remove filter condition
|
||||
(when (and (eq folder-type 'filter) org-wl-link-remove-filter)
|
||||
(while (eq (org-wl-folder-type folder-name) 'filter)
|
||||
(setq folder-name
|
||||
(replace-regexp-in-string "^/[^/]+/" "" folder-name))))
|
||||
|
||||
;; maybe create http link
|
||||
(cond
|
||||
((and (eq folder-type 'shimbun)
|
||||
org-wl-shimbun-prefer-web-links xref)
|
||||
(org-store-link-props :type "http" :link xref :description subject
|
||||
:from from :to to :message-id message-id
|
||||
:message-id-no-brackets message-id-no-brackets
|
||||
:subject subject))
|
||||
((and (eq folder-type 'nntp) org-wl-nntp-prefer-web-links)
|
||||
(setq link
|
||||
(format
|
||||
(if (string-match-p "gmane\\." folder-name)
|
||||
"http://mid.gmane.org/%s"
|
||||
"https://groups.google.com/groups/search?as_umsgid=%s")
|
||||
(url-encode-url message-id)))
|
||||
(org-store-link-props :type "http" :link link :description subject
|
||||
:from from :to to :message-id message-id
|
||||
:message-id-no-brackets message-id-no-brackets
|
||||
:subject subject))
|
||||
(t
|
||||
(org-store-link-props :type "wl" :from from :to to
|
||||
:subject subject :message-id message-id
|
||||
:message-id-no-brackets message-id-no-brackets)
|
||||
(setq desc (org-email-link-description))
|
||||
(setq link (concat "wl:" folder-name "#" message-id-no-brackets))
|
||||
(org-add-link-props :link link :description desc)))
|
||||
(org-add-link-props :date date)
|
||||
(or link xref)))))))
|
||||
|
||||
(defun org-wl-open-nntp (path)
|
||||
"Follow the nntp: link specified by PATH."
|
||||
(let* ((spec (split-string path "/"))
|
||||
(server (split-string (nth 2 spec) "@"))
|
||||
(group (nth 3 spec))
|
||||
(article (nth 4 spec)))
|
||||
(org-wl-open
|
||||
(concat "-" group ":" (if (cdr server)
|
||||
(car (split-string (car server) ":"))
|
||||
"")
|
||||
(if (string= elmo-nntp-default-server (nth 2 spec))
|
||||
""
|
||||
(concat "@" (or (cdr server) (car server))))
|
||||
(if article (concat "#" article) "")))))
|
||||
|
||||
(defun org-wl-open (path &rest _)
|
||||
"Follow the WL message link specified by PATH.
|
||||
When called with one prefix, open message in namazu search folder
|
||||
with `org-wl-namazu-default-index' as search index. When called
|
||||
with two prefixes or `org-wl-namazu-default-index' is nil, ask
|
||||
for namazu index."
|
||||
(require 'wl)
|
||||
(let ((wl-auto-check-folder-name
|
||||
(if org-wl-disable-folder-check
|
||||
'none
|
||||
wl-auto-check-folder-name)))
|
||||
(unless wl-init (wl))
|
||||
;; XXX: The imap-uw's MH folder names start with "%#".
|
||||
(if (not (string-match "\\`\\(\\(?:%#\\)?[^#]+\\)\\(#\\(.*\\)\\)?" path))
|
||||
(error "Error in Wanderlust link"))
|
||||
(let ((folder (match-string 1 path))
|
||||
(article (match-string 3 path)))
|
||||
;; maybe open message in namazu search folder
|
||||
(when current-prefix-arg
|
||||
(setq folder (concat "[" article "]"
|
||||
(if (and (equal current-prefix-arg '(4))
|
||||
org-wl-namazu-default-index)
|
||||
org-wl-namazu-default-index
|
||||
(read-directory-name "Namazu index: ")))))
|
||||
(if (not (elmo-folder-exists-p (with-no-warnings
|
||||
(wl-folder-get-elmo-folder folder))))
|
||||
(error "No such folder: %s" folder))
|
||||
(let ((old-buf (current-buffer))
|
||||
(old-point (point-marker)))
|
||||
(wl-folder-goto-folder-subr folder)
|
||||
(with-current-buffer old-buf
|
||||
;; XXX: `wl-folder-goto-folder-subr' moves point to the
|
||||
;; beginning of the current line. So, restore the point
|
||||
;; in the old buffer.
|
||||
(goto-char old-point))
|
||||
(when article
|
||||
(if (string-match-p "@" article)
|
||||
(wl-summary-jump-to-msg-by-message-id (org-link-add-angle-brackets
|
||||
article))
|
||||
(or (wl-summary-jump-to-msg (string-to-number article))
|
||||
(error "No such message: %s" article)))
|
||||
(wl-summary-redisplay))))))
|
||||
|
||||
(provide 'ol-wl)
|
||||
|
||||
;;; ol-wl.el ends here
|
||||
157
lisp/org-contrib/org-annotate-file.el
Normal file
157
lisp/org-contrib/org-annotate-file.el
Normal file
@@ -0,0 +1,157 @@
|
||||
;;; org-annotate-file.el --- Annotate a file with org syntax
|
||||
|
||||
;; Copyright (C) 2008-2014, 2021 Philip Jackson
|
||||
|
||||
;; Author: Philip Jackson <phil@shellarchive.co.uk>
|
||||
;; Version: 0.2
|
||||
|
||||
;; This file is not currently part of GNU Emacs.
|
||||
|
||||
;; This program is free software; you can redistribute it and/or
|
||||
;; modify it under the terms of the GNU General Public License as
|
||||
;; published by the Free Software Foundation; either version 3, 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 ; see the file COPYING. If not, write to
|
||||
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||||
;; Boston, MA 02111-1307, USA.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This is yet another implementation to allow the annotation of a
|
||||
;; file without modification of the file itself. The annotation is in
|
||||
;; org syntax so you can use all of the org features you are used to.
|
||||
|
||||
;; To use you might put the following in your .emacs:
|
||||
;;
|
||||
;; (require 'org-annotate-file)
|
||||
;; (global-set-key (kbd "C-c C-l") 'org-annotate-file) ; for example
|
||||
;;
|
||||
;; To change the location of the annotation file:
|
||||
;;
|
||||
;; (setq org-annotate-file-storage-file "~/annotated.org")
|
||||
;;
|
||||
;; Then when you visit any file and hit C-c C-l you will find yourself
|
||||
;; in an org buffer on a headline which links to the file you were
|
||||
;; visiting, e.g:
|
||||
|
||||
;; * ~/org-annotate-file.el
|
||||
|
||||
;; Under here you can put anything you like, save the file
|
||||
;; and next time you hit C-c C-l you will hit those notes again.
|
||||
;;
|
||||
;; To put a subheading with a text search for the current line set
|
||||
;; `org-annotate-file-add-search` to non-nil value. Then when you hit
|
||||
;; C-c C-l (on the above line for example) you will get:
|
||||
|
||||
;; * ~/org-annotate-file.el
|
||||
;; ** `org-annotate-file-add-search` to non-nil value. Then when...
|
||||
|
||||
;; Note that both of the above will be links.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'org)
|
||||
|
||||
(defgroup org-annotate-file nil
|
||||
"Org Annotate"
|
||||
:group 'org)
|
||||
|
||||
(defcustom org-annotate-file-storage-file "~/.org-annotate-file.org"
|
||||
"File in which to keep annotations."
|
||||
:group 'org-annotate-file
|
||||
:type 'file)
|
||||
|
||||
(defcustom org-annotate-file-add-search nil
|
||||
"If non-nil, add a link as a second level to the actual file location."
|
||||
:group 'org-annotate-file
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom org-annotate-file-always-open t
|
||||
"If non-nil, always expand the full tree when visiting the annotation file."
|
||||
:group 'org-annotate-file
|
||||
:type 'boolean)
|
||||
|
||||
(defun org-annotate-file-ellipsify-desc (string &optional after)
|
||||
"Return shortened STRING with appended ellipsis.
|
||||
Trim whitespace at beginning and end of STRING and replace any
|
||||
characters that appear after the occurrence of AFTER with '...'"
|
||||
(let* ((after (number-to-string (or after 30)))
|
||||
(replace-map (list (cons "^[ \t]*" "")
|
||||
(cons "[ \t]*$" "")
|
||||
(cons (concat "^\\(.\\{" after
|
||||
"\\}\\).*") "\\1..."))))
|
||||
(mapc (lambda (x)
|
||||
(when (string-match (car x) string)
|
||||
(setq string (replace-match (cdr x) nil nil string))))
|
||||
replace-map)
|
||||
string))
|
||||
|
||||
;;;###autoload
|
||||
(defun org-annotate-file ()
|
||||
"Visit `org-annotate-file-storage-file` and add a new annotation section.
|
||||
The annotation is opened at the new section which will be referencing
|
||||
the point in the current file."
|
||||
(interactive)
|
||||
(unless (buffer-file-name)
|
||||
(error "This buffer has no associated file!"))
|
||||
(switch-to-buffer
|
||||
(org-annotate-file-show-section org-annotate-file-storage-file)))
|
||||
|
||||
;;;###autoload
|
||||
(defun org-annotate-file-show-section (storage-file &optional annotated-buffer)
|
||||
"Add or show annotation entry in STORAGE-FILE and return the buffer.
|
||||
The annotation will link to ANNOTATED-BUFFER if specified,
|
||||
otherwise the current buffer is used."
|
||||
(let ((filename (abbreviate-file-name (or annotated-buffer
|
||||
(buffer-file-name))))
|
||||
(line (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
|
||||
(annotation-buffer (find-file-noselect storage-file)))
|
||||
(with-current-buffer annotation-buffer
|
||||
(org-annotate-file-annotate filename line))
|
||||
annotation-buffer))
|
||||
|
||||
(defun org-annotate-file-annotate (filename line)
|
||||
"Add annotation for FILENAME at LINE using current buffer."
|
||||
(let* ((link (org-make-link-string (concat "file:" filename) filename))
|
||||
(search-link (org-make-link-string
|
||||
(concat "file:" filename "::" line)
|
||||
(org-annotate-file-ellipsify-desc line))))
|
||||
(unless (eq major-mode 'org-mode)
|
||||
(org-mode))
|
||||
(goto-char (point-min))
|
||||
(widen)
|
||||
(when org-annotate-file-always-open
|
||||
(show-all))
|
||||
(unless (search-forward-regexp
|
||||
(concat "^* " (regexp-quote link)) nil t)
|
||||
(org-annotate-file-add-upper-level link))
|
||||
(beginning-of-line)
|
||||
(org-narrow-to-subtree)
|
||||
;; deal with a '::' search if need be
|
||||
(when org-annotate-file-add-search
|
||||
(unless (search-forward-regexp
|
||||
(concat "^** " (regexp-quote search-link)) nil t)
|
||||
(org-annotate-file-add-second-level search-link)))))
|
||||
|
||||
(defun org-annotate-file-add-upper-level (link)
|
||||
"Add and link heading to LINK."
|
||||
(goto-char (point-min))
|
||||
(call-interactively 'org-insert-heading)
|
||||
(insert link))
|
||||
|
||||
(defun org-annotate-file-add-second-level (link)
|
||||
"Add and link subheading to LINK."
|
||||
(goto-char (point-at-eol))
|
||||
(call-interactively 'org-insert-subheading)
|
||||
(insert link))
|
||||
|
||||
(provide 'org-annotate-file)
|
||||
|
||||
;;; org-annotate-file.el ends here
|
||||
132
lisp/org-contrib/org-attach-embedded-images.el
Normal file
132
lisp/org-contrib/org-attach-embedded-images.el
Normal file
@@ -0,0 +1,132 @@
|
||||
;;; org-attach-embedded-images.el --- Transmute images to attachments
|
||||
;;
|
||||
;; Copyright 2018-2021 Free Software Foundation, Inc.
|
||||
;;
|
||||
;; Author: Marco Wahl
|
||||
;; Homepage: https://gitlab.com/marcowahl/org-attach-embedded-imagse
|
||||
;; Version: 0.1
|
||||
;; Keywords: org, media
|
||||
;;
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 3, 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; There are occasions when images are displayed in a subtree which
|
||||
;; are not org attachments. For example if you copy and paste a part
|
||||
;; of a web page (containing images) from eww to an org subtree.
|
||||
|
||||
;; This module provides command `org-attach-embedded-images-in-subtree'
|
||||
;; to save such images as attachments and insert org links to them.
|
||||
|
||||
;; Install:
|
||||
|
||||
;; To use this module insert it to `org-modules'. The insert can be
|
||||
;; performed via {M-x customize-variable RET org-modules RET} followed
|
||||
;; by insertion of `org-attach-embedded-images' to the external
|
||||
;; modules section.
|
||||
|
||||
;; Alternatively you can add the line
|
||||
|
||||
;; (require 'org-attach-embedded-images)
|
||||
|
||||
;; to your emacs configuration.
|
||||
|
||||
;; Use
|
||||
|
||||
;; M-x org-attach-embedded-images-in-subtree
|
||||
|
||||
;; in a subtree with embedded images. The images get attached and can
|
||||
;; later be reviewed.
|
||||
|
||||
;; Note: Possibly
|
||||
|
||||
;; M-x org-toggle-inline-images
|
||||
|
||||
;; is needed to see the images in the Org mode window.
|
||||
|
||||
|
||||
;; Code:
|
||||
|
||||
(require 'org)
|
||||
(require 'org-attach)
|
||||
|
||||
|
||||
;; Auxiliary functions
|
||||
|
||||
(defun org-attach-embedded-images--next-property-display-data (position limit)
|
||||
"Return position of the next property-display location with image data.
|
||||
Return nil if there is no next display property.
|
||||
POSITION and LIMIT as in `next-single-property-change'."
|
||||
(let ((pos (next-single-property-change position 'display nil limit)))
|
||||
(while (and (< pos limit)
|
||||
(let ((display-prop
|
||||
(plist-get (text-properties-at pos) 'display)))
|
||||
(or (not display-prop)
|
||||
(not (plist-get (cdr display-prop) :data)))))
|
||||
(setq pos (next-single-property-change pos 'display nil limit)))
|
||||
pos))
|
||||
|
||||
(defun org-attach-embedded-images--attach-with-sha1-name (data)
|
||||
"Save the image given as DATA as org attachment with its sha1 as name.
|
||||
Return the filename."
|
||||
(let* ((extension (symbol-name (image-type-from-data data)))
|
||||
(basename (concat (sha1 data) "." extension))
|
||||
(dir (org-attach-dir t))
|
||||
(filename (concat dir "/" basename)))
|
||||
(unless (file-exists-p filename)
|
||||
(with-temp-file filename
|
||||
(setq buffer-file-coding-system 'binary)
|
||||
(set-buffer-multibyte nil)
|
||||
(insert data)))
|
||||
(org-attach-sync)
|
||||
basename))
|
||||
|
||||
|
||||
;; Command
|
||||
|
||||
;;;###autoload
|
||||
(defun org-attach-embedded-images-in-subtree ()
|
||||
"Save the displayed images as attachments and insert links to them."
|
||||
(interactive)
|
||||
(when (org-before-first-heading-p)
|
||||
(user-error "Before first heading. Nothing has been attached."))
|
||||
(save-excursion
|
||||
(org-attach-dir t)
|
||||
(let ((beg (progn (org-back-to-heading) (point)))
|
||||
(end (progn (org-end-of-subtree) (point)))
|
||||
names)
|
||||
;; pass 1
|
||||
(goto-char beg)
|
||||
(while (< (goto-char (org-attach-embedded-images--next-property-display-data (point) end)) end)
|
||||
(let ((data (plist-get (cdr (plist-get (text-properties-at (point)) 'display)) :data)))
|
||||
(assert data)
|
||||
(push (org-attach-embedded-images--attach-with-sha1-name data)
|
||||
names)))
|
||||
;; pass 2
|
||||
(setq names (nreverse names))
|
||||
(goto-char beg)
|
||||
(while names
|
||||
(goto-char (org-attach-embedded-images--next-property-display-data (point) end))
|
||||
(while (get-text-property (point) 'display)
|
||||
(goto-char (next-property-change (point) nil end)))
|
||||
(skip-chars-forward "]")
|
||||
(insert (concat "\n[[attachment:" (pop names) "]]"))))))
|
||||
|
||||
|
||||
(provide 'org-attach-embedded-images)
|
||||
|
||||
|
||||
;;; org-attach-embedded-images.el ends here
|
||||
137
lisp/org-contrib/org-bibtex-extras.el
Normal file
137
lisp/org-contrib/org-bibtex-extras.el
Normal file
@@ -0,0 +1,137 @@
|
||||
;;; org-bibtex-extras --- extras for working with org-bibtex entries
|
||||
|
||||
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Eric Schulte <eric dot schulte at gmx dot com>
|
||||
;; Keywords: outlines, hypermedia, bibtex, d3
|
||||
;; Homepage: https://orgmode.org
|
||||
;; Version: 0.01
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 3, 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Warning: This should certainly be considered EXPERIMENTAL and still
|
||||
;; in development, feedback is welcome, but don't expect it
|
||||
;; to work.
|
||||
|
||||
;; This file add some extra functionality to your bibtex entries which
|
||||
;; are stored as Org-mode headlines using org-bibtex.el. Most
|
||||
;; features expect that you keep all of your reading notes in a single
|
||||
;; file, set the `obe-bibtex-file' variable to the path to this file.
|
||||
;;
|
||||
;; - d3 view :: d3 is a Javascript library which supports interactive
|
||||
;; display of graphs. To view your citations as a d3
|
||||
;; graph, execute the following which will create a .json
|
||||
;; export of your references file, then grab a copy of
|
||||
;; d3, edit examples/force/force.js to replace
|
||||
;;
|
||||
;; var source`"miserables.json";
|
||||
;;
|
||||
;; with
|
||||
;;
|
||||
;; var source`"your-references.json";
|
||||
;;
|
||||
;; then view examples/force/force.html in your browser.
|
||||
;;
|
||||
;; - HTML export :: Customize the `obe-html-link-base' variable so
|
||||
;; that it points to an html export of your
|
||||
;; references, then add the following to your html
|
||||
;; export hook, and citations will be resolved during
|
||||
;; html export.
|
||||
;;
|
||||
;; (add-hook 'org-export-first-hook
|
||||
;; (lambda ()
|
||||
;; (when (equal org-export-current-backend 'html)
|
||||
;; (obe-html-export-citations))))
|
||||
|
||||
;;; Code:
|
||||
(require 'ol-bibtex)
|
||||
|
||||
(declare-function org-trim "org" (s &optional keep-lead))
|
||||
|
||||
(defcustom obe-bibtex-file nil "File holding bibtex entries.")
|
||||
|
||||
(defcustom obe-html-link-base nil
|
||||
"Base of citation links.
|
||||
For example, to point to your `obe-bibtex-file' use the following.
|
||||
|
||||
(setq obe-html-link-base (format \"file:%s\" obe-bibtex-file))
|
||||
")
|
||||
|
||||
(defvar obe-citations nil)
|
||||
(defun obe-citations ()
|
||||
"Return all citations from `obe-bibtex-file'."
|
||||
(or obe-citations
|
||||
(save-window-excursion
|
||||
(find-file (or obe-bibtex-file
|
||||
(error "`obe-bibtex-file' has not been configured")))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward " :CUSTOM_ID: \\(.+\\)$" nil t)
|
||||
(push (org-no-properties (match-string 1))
|
||||
obe-citations))
|
||||
obe-citations)))
|
||||
|
||||
(defun obe-html-export-citations ()
|
||||
"Convert all \\cite{...} citations in the current file into HTML links."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "\\\\cite{\\([^\000}]+\\)}" nil t)
|
||||
(replace-match
|
||||
(save-match-data
|
||||
(mapconcat (lambda (c) (format "[[%s#%s][%s]]" obe-html-link-base c c))
|
||||
(mapcar #'org-trim
|
||||
(split-string (match-string 1) ",")) ", "))))))
|
||||
|
||||
(defun obe-meta-to-json (meta &optional fields)
|
||||
"Turn a list of META data from citations into a string of json."
|
||||
(let ((counter 1) nodes links)
|
||||
(flet ((id (it) (position it nodes :test #'string= :key #'car))
|
||||
(col (k) (mapcar (lambda (r) (cdr (assoc k r))) meta))
|
||||
(add (lst)
|
||||
(dolist (el lst) (push (cons el counter) nodes))
|
||||
(incf counter)))
|
||||
;; build the nodes of the graph
|
||||
(add (col :title))
|
||||
(add (remove-if (lambda (author) (string-match "others" author))
|
||||
(remove-duplicates (apply #'append (col :authors))
|
||||
:test #'string=)))
|
||||
(dolist (field fields)
|
||||
(add (remove-duplicates (col field) :test #'string=)))
|
||||
;; build the links in the graph
|
||||
(dolist (citation meta)
|
||||
(let ((dest (id (cdr (assq :title citation)))))
|
||||
(dolist (author (mapcar #'id (cdr (assq :authors citation))))
|
||||
(when author (push (cons author dest) links)))
|
||||
(let ((jid (id (cdr (assq :journal citation)))))
|
||||
(when jid (push (cons jid dest) links)))
|
||||
(let ((cid (id (cdr (assq :category citation)))))
|
||||
(when cid (push (cons cid dest) links)))))
|
||||
;; build the json string
|
||||
(format "{\"nodes\":[%s],\"links\":[%s]}"
|
||||
(mapconcat
|
||||
(lambda (pair)
|
||||
(format "{\"name\":%S,\"group\":%d}"
|
||||
(car pair) (cdr pair)))
|
||||
nodes ",")
|
||||
(mapconcat
|
||||
(lambda (link)
|
||||
(format "{\"source\":%d,\"target\":%d,\"value\":1}"
|
||||
(car link) (cdr link)))
|
||||
(meta-to-links meta nodes) ",")))))
|
||||
|
||||
(provide 'org-bibtex-extras)
|
||||
;;; org-bibtex-extras ends here
|
||||
141
lisp/org-contrib/org-checklist.el
Normal file
141
lisp/org-contrib/org-checklist.el
Normal file
@@ -0,0 +1,141 @@
|
||||
;;; org-checklist.el --- org functions for checklist handling
|
||||
|
||||
;; Copyright (C) 2008-2014, 2021 James TD Smith
|
||||
|
||||
;; Author: James TD Smith (@ ahktenzero (. mohorovi cc))
|
||||
;; Version: 1.0
|
||||
;; Keywords: org, checklists
|
||||
;;
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 3, 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides some functions for handing repeated tasks which involve
|
||||
;; checking off a list of items. By setting the RESET_CHECK_BOXES property in an
|
||||
;; item, when the TODO state is set to done all checkboxes under that item are
|
||||
;; cleared. If the LIST_EXPORT_BASENAME property is set, a file will be created
|
||||
;; using the value of that property plus a timestamp, containing all the items
|
||||
;; in the list which are not checked. Additionally the user will be prompted to
|
||||
;; print the list.
|
||||
;;
|
||||
;; I use this for to keep track of stores of various things (food stores,
|
||||
;; components etc) which I check periodically and use the exported list of items
|
||||
;; which are not present as a shopping list.
|
||||
;;
|
||||
;;; Usage:
|
||||
;; (require 'org-checklist)
|
||||
;;
|
||||
;; Set the RESET_CHECK_BOXES and LIST_EXPORT_BASENAME properties in items as
|
||||
;; needed.
|
||||
;;
|
||||
;;; Code:
|
||||
(require 'org)
|
||||
(load "a2ps-print" 'no-error)
|
||||
|
||||
(setq org-default-properties (cons "RESET_CHECK_BOXES" (cons "LIST_EXPORT_BASENAME" org-default-properties)))
|
||||
|
||||
(defgroup org-checklist nil
|
||||
"Extended checklist handling for org"
|
||||
:tag "Org-checklist"
|
||||
:group 'org)
|
||||
|
||||
(defcustom org-checklist-export-time-format "%Y%m%d%H%M"
|
||||
"The format of timestamp appended to LIST_EXPORT_BASENAME to
|
||||
make the name of the export file."
|
||||
:link '(function-link format-time-string)
|
||||
:group 'org-checklist
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-checklist-export-function 'org-export-as-ascii
|
||||
"function used to prepare the export file for printing"
|
||||
:group 'org-checklist
|
||||
:type '(radio (function-item :tag "ascii text" org-export-as-ascii)
|
||||
(function-item :tag "HTML" org-export-as-html)
|
||||
(function-item :tag "LaTeX" :value org-export-as-latex)
|
||||
(function-item :tag "XOXO" :value org-export-as-xoxo)))
|
||||
|
||||
(defcustom org-checklist-export-params nil
|
||||
"options for the export function file for printing"
|
||||
:group 'org-checklist
|
||||
:type '(repeat string))
|
||||
|
||||
(defcustom org-checklist-a2ps-params nil
|
||||
"options for a2ps for printing"
|
||||
:group 'org-checklist
|
||||
:type '(repeat string))
|
||||
|
||||
(defun org-reset-checkbox-state-maybe ()
|
||||
"Reset all checkboxes in an entry if the `RESET_CHECK_BOXES' property is set"
|
||||
(interactive "*")
|
||||
(if (org-entry-get (point) "RESET_CHECK_BOXES")
|
||||
(org-reset-checkbox-state-subtree)))
|
||||
|
||||
|
||||
(defun org-make-checklist-export ()
|
||||
"Produce a checklist containing all unchecked items from a list
|
||||
of checkbox items"
|
||||
(interactive "*")
|
||||
(if (org-entry-get (point) "LIST_EXPORT_BASENAME")
|
||||
(let* ((export-file (concat (org-entry-get (point) "LIST_EXPORT_BASENAME" nil)
|
||||
"-" (format-time-string
|
||||
org-checklist-export-time-format)
|
||||
".org"))
|
||||
(print (case (org-entry-get (point) "PRINT_EXPORT" nil)
|
||||
(("" "nil" nil) nil)
|
||||
(t t)
|
||||
(nil (y-or-n-p "Print list? "))))
|
||||
exported-lines
|
||||
(title "Checklist export"))
|
||||
(save-restriction
|
||||
(save-excursion
|
||||
(org-narrow-to-subtree)
|
||||
(org-update-checkbox-count-maybe)
|
||||
(org-show-subtree)
|
||||
(goto-char (point-min))
|
||||
(when (looking-at org-complex-heading-regexp)
|
||||
(setq title (match-string 4)))
|
||||
(goto-char (point-min))
|
||||
(let ((end (point-max)))
|
||||
(while (< (point) end)
|
||||
(when (and (org-at-item-checkbox-p)
|
||||
(or (string= (match-string 0) "[ ]")
|
||||
(string= (match-string 0) "[-]")))
|
||||
(add-to-list 'exported-lines (thing-at-point 'line) t))
|
||||
(beginning-of-line 2)))
|
||||
(set-buffer (get-buffer-create export-file))
|
||||
(org-insert-heading)
|
||||
(insert (or title export-file) "\n")
|
||||
(dolist (entry exported-lines) (insert entry))
|
||||
(org-update-checkbox-count-maybe)
|
||||
(write-file export-file)
|
||||
(if (print)
|
||||
(progn (funcall org-checklist-export-function
|
||||
org-checklist-export-params)
|
||||
(let* ((current-a2ps-switches a2ps-switches)
|
||||
(a2ps-switches (append current-a2ps-switches
|
||||
org-checklist-a2ps-params)))
|
||||
(a2ps-buffer)))))))))
|
||||
|
||||
(defun org-checklist ()
|
||||
(when (member org-state org-done-keywords) ;; org-state dynamically bound in org.el/org-todo
|
||||
(org-make-checklist-export)
|
||||
(org-reset-checkbox-state-maybe)))
|
||||
|
||||
(add-hook 'org-after-todo-state-change-hook 'org-checklist)
|
||||
|
||||
(provide 'org-checklist)
|
||||
|
||||
;;; org-checklist.el ends here
|
||||
496
lisp/org-contrib/org-choose.el
Normal file
496
lisp/org-contrib/org-choose.el
Normal file
@@ -0,0 +1,496 @@
|
||||
;;; org-choose.el --- decision management for org-mode
|
||||
|
||||
;; Copyright (C) 2009-2014, 2021 Tom Breton (Tehom)
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; Author: Tom Breton (Tehom)
|
||||
;; Keywords: outlines, convenience
|
||||
|
||||
;; This file 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, or (at your option)
|
||||
;; any later version.
|
||||
|
||||
;; This file is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs; see the file COPYING. If not, write to
|
||||
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||||
;; Boston, MA 02111-1307, USA.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This is code to support decision management. It lets you treat a
|
||||
;; group of sibling items in org-mode as alternatives in a decision.
|
||||
|
||||
;; There are no user commands in this file. You use it by:
|
||||
;; * Loading it (manually or by M-x customize-apropos org-modules)
|
||||
|
||||
;; * Setting up at least one set of TODO keywords with the
|
||||
;; interpretation "choose" by either:
|
||||
|
||||
;; * Using the file directive #+CHOOSE_TODO:
|
||||
|
||||
;; * For instance, "#+CHOOSE_TODO: NO(,-) MAYBE(,0) YES"
|
||||
|
||||
;; * Or by M-x customize-apropos org-todo-keywords
|
||||
|
||||
;; * Operating on single items with the TODO commands.
|
||||
|
||||
;; * Use C-S-right to change the keyword set. Use this to change to
|
||||
;; the "choose" keyword set that you just defined.
|
||||
|
||||
;; * Use S-right to advance the TODO mark to the next setting.
|
||||
|
||||
;; For "choose", that means you like this alternative more than
|
||||
;; before. Other alternatives will be automatically demoted to
|
||||
;; keep your settings consistent.
|
||||
|
||||
;; * Use S-left to demote TODO to the previous setting.
|
||||
|
||||
;; For "choose", that means you don't like this alternative as much
|
||||
;; as before. Other alternatives will be automatically promoted,
|
||||
;; if this item was all that was keeping them down.
|
||||
|
||||
;; * All the other TODO commands are available and behave essentially
|
||||
;; the normal way.
|
||||
|
||||
;;; Requires
|
||||
|
||||
(require 'org)
|
||||
;(eval-when-compile
|
||||
; (require 'cl))
|
||||
(require 'cl)
|
||||
|
||||
;;; Body
|
||||
;;; The variables
|
||||
|
||||
(defstruct (org-choose-mark-data. (:type list))
|
||||
"The format of an entry in org-choose-mark-data.
|
||||
Indexes are 0-based or `nil'.
|
||||
"
|
||||
keyword
|
||||
bot-lower-range
|
||||
top-upper-range
|
||||
range-length
|
||||
static-default
|
||||
all-keywords)
|
||||
|
||||
(defvar org-choose-mark-data
|
||||
()
|
||||
"Alist of information for choose marks.
|
||||
|
||||
Each entry is an `org-choose-mark-data.'" )
|
||||
(make-variable-buffer-local 'org-choose-mark-data)
|
||||
;;;_ , For setup
|
||||
;;;_ . org-choose-filter-one
|
||||
|
||||
(defun org-choose-filter-one (i)
|
||||
"Return a list of
|
||||
* a canonized version of the string
|
||||
* optionally one symbol"
|
||||
|
||||
(if
|
||||
(not
|
||||
(string-match "(.*)" i))
|
||||
(list i i)
|
||||
(let*
|
||||
(
|
||||
(end-text (match-beginning 0))
|
||||
(vanilla-text (substring i 0 end-text))
|
||||
;;Get the parenthesized part.
|
||||
(match (match-string 0 i))
|
||||
;;Remove the parentheses.
|
||||
(args (substring match 1 -1))
|
||||
;;Split it
|
||||
(arglist
|
||||
(let
|
||||
((arglist-x (org-split-string args ",")))
|
||||
;;When string starts with "," `split-string' doesn't
|
||||
;;make a first arg, so in that case make one
|
||||
;;manually.
|
||||
(if
|
||||
(string-match "^," args)
|
||||
(cons nil arglist-x)
|
||||
arglist-x)))
|
||||
(decision-arg (second arglist))
|
||||
(type
|
||||
(cond
|
||||
((string= decision-arg "0")
|
||||
'default-mark)
|
||||
((string= decision-arg "+")
|
||||
'top-upper-range)
|
||||
((string= decision-arg "-")
|
||||
'bot-lower-range)
|
||||
(t nil)))
|
||||
(vanilla-arg (first arglist))
|
||||
(vanilla-mark
|
||||
(if vanilla-arg
|
||||
(concat vanilla-text "("vanilla-arg")")
|
||||
vanilla-text)))
|
||||
(if type
|
||||
(list vanilla-text vanilla-mark type)
|
||||
(list vanilla-text vanilla-mark)))))
|
||||
|
||||
;;;_ . org-choose-setup-vars
|
||||
(defun org-choose-setup-vars (bot-lower-range top-upper-range
|
||||
static-default num-items all-mark-texts)
|
||||
"Add to org-choose-mark-data according to arguments"
|
||||
(let*
|
||||
((tail
|
||||
;;If there's no bot-lower-range or no default, we don't
|
||||
;;have ranges.
|
||||
(cdr
|
||||
(if (and static-default bot-lower-range)
|
||||
(let*
|
||||
;;If there's no top-upper-range, use the last
|
||||
;;item.
|
||||
((top-upper-range
|
||||
(or top-upper-range (1- num-items)))
|
||||
(lower-range-length
|
||||
(1+ (- static-default bot-lower-range)))
|
||||
(upper-range-length
|
||||
(- top-upper-range static-default))
|
||||
(range-length
|
||||
(min upper-range-length lower-range-length)))
|
||||
(make-org-choose-mark-data.
|
||||
:keyword nil
|
||||
:bot-lower-range bot-lower-range
|
||||
:top-upper-range top-upper-range
|
||||
:range-length range-length
|
||||
:static-default static-default
|
||||
:all-keywords all-mark-texts))
|
||||
(make-org-choose-mark-data.
|
||||
:keyword nil
|
||||
:bot-lower-range nil
|
||||
:top-upper-range nil
|
||||
:range-length nil
|
||||
:static-default (or static-default 0)
|
||||
:all-keywords all-mark-texts)))))
|
||||
(dolist (text all-mark-texts)
|
||||
(pushnew (cons text tail)
|
||||
org-choose-mark-data
|
||||
:test
|
||||
(lambda (a b)
|
||||
(equal (car a) (car b)))))))
|
||||
|
||||
;;; org-choose-filter-tail
|
||||
(defun org-choose-filter-tail (raw)
|
||||
"Return a translation of RAW to vanilla and set appropriate
|
||||
buffer-local variables.
|
||||
|
||||
RAW is a list of strings representing the input text of a choose
|
||||
interpretation."
|
||||
(let
|
||||
((vanilla-list nil)
|
||||
(all-mark-texts nil)
|
||||
(index 0)
|
||||
bot-lower-range top-upper-range range-length static-default)
|
||||
(dolist (i raw)
|
||||
(destructuring-bind
|
||||
(vanilla-text vanilla-mark &optional type)
|
||||
(org-choose-filter-one i)
|
||||
(cond
|
||||
((eq type 'bot-lower-range)
|
||||
(setq bot-lower-range index))
|
||||
((eq type 'top-upper-range)
|
||||
(setq top-upper-range index))
|
||||
((eq type 'default-mark)
|
||||
(setq static-default index)))
|
||||
(incf index)
|
||||
(push vanilla-text all-mark-texts)
|
||||
(push vanilla-mark vanilla-list)))
|
||||
|
||||
(org-choose-setup-vars bot-lower-range top-upper-range
|
||||
static-default index (reverse all-mark-texts))
|
||||
(nreverse vanilla-list)))
|
||||
|
||||
;;; org-choose-setup-filter
|
||||
|
||||
(defun org-choose-setup-filter (raw)
|
||||
"A setup filter for choose interpretations."
|
||||
(when (eq (car raw) 'choose)
|
||||
(cons
|
||||
'choose
|
||||
(org-choose-filter-tail (cdr raw)))))
|
||||
|
||||
;;; org-choose-conform-after-promotion
|
||||
(defun org-choose-conform-after-promotion (entry-pos keywords highest-ok-ix)
|
||||
"Conform the current item after another item was promoted"
|
||||
(unless
|
||||
;;Skip the entry that triggered this by skipping any entry with
|
||||
;;the same starting position. plist uses the start of the
|
||||
;;header line as the position, but map no longer does, so we
|
||||
;;have to go back to the heading.
|
||||
(=
|
||||
(save-excursion
|
||||
(org-back-to-heading)
|
||||
(point))
|
||||
entry-pos)
|
||||
(let
|
||||
((ix
|
||||
(org-choose-get-entry-index keywords)))
|
||||
;;If the index of the entry exceeds the highest allowable
|
||||
;;index, change it to that.
|
||||
(when (and ix
|
||||
(> ix highest-ok-ix))
|
||||
(org-todo
|
||||
(nth highest-ok-ix keywords))))))
|
||||
;;;_ . org-choose-conform-after-demotion
|
||||
(defun org-choose-conform-after-demotion (entry-pos keywords
|
||||
raise-to-ix
|
||||
old-highest-ok-ix)
|
||||
"Conform the current item after another item was demoted."
|
||||
(unless
|
||||
;;Skip the entry that triggered this.
|
||||
(=
|
||||
(save-excursion
|
||||
(org-back-to-heading)
|
||||
(point))
|
||||
entry-pos)
|
||||
(let
|
||||
((ix
|
||||
(org-choose-get-entry-index keywords)))
|
||||
;;If the index of the entry was at or above the old allowable
|
||||
;;position, change it to the new mirror position if there is
|
||||
;;one.
|
||||
(when (and
|
||||
ix
|
||||
raise-to-ix
|
||||
(>= ix old-highest-ok-ix))
|
||||
(org-todo
|
||||
(nth raise-to-ix keywords))))))
|
||||
|
||||
;;; org-choose-keep-sensible (the org-trigger-hook function)
|
||||
(defun org-choose-keep-sensible (change-plist)
|
||||
"Bring the other items back into a sensible state after an item's
|
||||
setting was changed."
|
||||
(let*
|
||||
( (from (plist-get change-plist :from))
|
||||
(to (plist-get change-plist :to))
|
||||
(entry-pos
|
||||
(set-marker
|
||||
(make-marker)
|
||||
(plist-get change-plist :position)))
|
||||
(kwd-data
|
||||
(assoc to org-todo-kwd-alist)))
|
||||
(when
|
||||
(eq (nth 1 kwd-data) 'choose)
|
||||
(let*
|
||||
(
|
||||
(data
|
||||
(assoc to org-choose-mark-data))
|
||||
(keywords
|
||||
(org-choose-mark-data.-all-keywords data))
|
||||
(old-index
|
||||
(org-choose-get-index-in-keywords
|
||||
from
|
||||
keywords))
|
||||
(new-index
|
||||
(org-choose-get-index-in-keywords
|
||||
to
|
||||
keywords))
|
||||
(highest-ok-ix
|
||||
(org-choose-highest-other-ok
|
||||
new-index
|
||||
data))
|
||||
(funcdata
|
||||
(cond
|
||||
;;The entry doesn't participate in conformance,
|
||||
;;so give `nil' which does nothing.
|
||||
((not highest-ok-ix) nil)
|
||||
;;The entry was created or promoted
|
||||
((or
|
||||
(not old-index)
|
||||
(> new-index old-index))
|
||||
(list
|
||||
#'org-choose-conform-after-promotion
|
||||
entry-pos keywords
|
||||
highest-ok-ix))
|
||||
(t ;;Otherwise the entry was demoted.
|
||||
(let
|
||||
(
|
||||
(raise-to-ix
|
||||
(min
|
||||
highest-ok-ix
|
||||
(org-choose-mark-data.-static-default
|
||||
data)))
|
||||
(old-highest-ok-ix
|
||||
(org-choose-highest-other-ok
|
||||
old-index
|
||||
data)))
|
||||
(list
|
||||
#'org-choose-conform-after-demotion
|
||||
entry-pos
|
||||
keywords
|
||||
raise-to-ix
|
||||
old-highest-ok-ix))))))
|
||||
(if funcdata
|
||||
;;The funny-looking names are to make variable capture
|
||||
;;unlikely. (Poor-man's lexical bindings).
|
||||
(destructuring-bind (func-d473 . args-46k) funcdata
|
||||
(let
|
||||
((map-over-entries
|
||||
(org-choose-get-fn-map-group))
|
||||
;;We may call `org-todo', so let various hooks
|
||||
;;`nil' so we don't cause loops.
|
||||
org-after-todo-state-change-hook
|
||||
org-trigger-hook
|
||||
org-blocker-hook
|
||||
org-todo-get-default-hook
|
||||
;;Also let this alist `nil' so we don't log
|
||||
;;secondary transitions.
|
||||
org-todo-log-states)
|
||||
;;Map over group
|
||||
(funcall map-over-entries
|
||||
(lambda ()
|
||||
(apply func-d473 args-46k))))))))
|
||||
;;Remove the marker
|
||||
(set-marker entry-pos nil)))
|
||||
|
||||
;;; Getting the default mark
|
||||
;;; org-choose-get-index-in-keywords
|
||||
(defun org-choose-get-index-in-keywords (ix all-keywords)
|
||||
"Return the index of the current entry."
|
||||
(if ix
|
||||
(position ix all-keywords
|
||||
:test #'equal)))
|
||||
|
||||
;;; org-choose-get-entry-index
|
||||
(defun org-choose-get-entry-index (all-keywords)
|
||||
"Return index of current entry."
|
||||
(let*
|
||||
((state (org-entry-get (point) "TODO")))
|
||||
(org-choose-get-index-in-keywords state all-keywords)))
|
||||
|
||||
;;; org-choose-get-fn-map-group
|
||||
|
||||
(defun org-choose-get-fn-map-group ()
|
||||
"Return a function to map over the group"
|
||||
(lambda (fn)
|
||||
(require 'org-agenda) ;; `org-map-entries' seems to need it.
|
||||
(save-excursion
|
||||
(unless (org-up-heading-safe)
|
||||
(error "Choosing is only supported between siblings in a tree, not on top level"))
|
||||
(let
|
||||
((level (org-reduced-level (org-outline-level))))
|
||||
(save-restriction
|
||||
(org-map-entries
|
||||
fn
|
||||
(format "LEVEL=%d" level)
|
||||
'tree))))))
|
||||
|
||||
;;; org-choose-get-highest-mark-index
|
||||
|
||||
(defun org-choose-get-highest-mark-index (keywords)
|
||||
"Get the index of the highest current mark in the group.
|
||||
If there is none, return 0"
|
||||
(let*
|
||||
;;Func maps over applicable entries.
|
||||
((map-over-entries
|
||||
(org-choose-get-fn-map-group))
|
||||
(indexes-list
|
||||
(remove nil
|
||||
(funcall map-over-entries
|
||||
(lambda ()
|
||||
(org-choose-get-entry-index keywords))))))
|
||||
(if
|
||||
indexes-list
|
||||
(apply #'max indexes-list)
|
||||
0)))
|
||||
|
||||
;;; org-choose-highest-ok
|
||||
|
||||
(defun org-choose-highest-other-ok (ix data)
|
||||
"Return the highest index that any choose mark can sensibly have,
|
||||
given that another mark has index IX.
|
||||
DATA must be a `org-choose-mark-data.'."
|
||||
(let
|
||||
((bot-lower-range
|
||||
(org-choose-mark-data.-bot-lower-range data))
|
||||
(top-upper-range
|
||||
(org-choose-mark-data.-top-upper-range data))
|
||||
(range-length
|
||||
(org-choose-mark-data.-range-length data)))
|
||||
(when (and ix bot-lower-range)
|
||||
(let*
|
||||
((delta
|
||||
(- top-upper-range ix)))
|
||||
(unless
|
||||
(< range-length delta)
|
||||
(+ bot-lower-range delta))))))
|
||||
|
||||
;;; org-choose-get-default-mark-index
|
||||
|
||||
(defun org-choose-get-default-mark-index (data)
|
||||
"Return the index of the default mark in a choose interpretation.
|
||||
|
||||
DATA must be a `org-choose-mark-data.'."
|
||||
(or
|
||||
(let
|
||||
((highest-mark-index
|
||||
(org-choose-get-highest-mark-index
|
||||
(org-choose-mark-data.-all-keywords data))))
|
||||
(org-choose-highest-other-ok
|
||||
highest-mark-index data))
|
||||
(org-choose-mark-data.-static-default data)))
|
||||
|
||||
;;; org-choose-get-mark-N
|
||||
(defun org-choose-get-mark-N (n data)
|
||||
"Get the text of the nth mark in a choose interpretation."
|
||||
|
||||
(let*
|
||||
((l (org-choose-mark-data.-all-keywords data)))
|
||||
(nth n l)))
|
||||
|
||||
;;; org-choose-get-default-mark
|
||||
|
||||
(defun org-choose-get-default-mark (new-mark old-mark)
|
||||
"Get the default mark IFF in a choose interpretation.
|
||||
NEW-MARK and OLD-MARK are the text of the new and old marks."
|
||||
(let*
|
||||
((old-kwd-data
|
||||
(assoc old-mark org-todo-kwd-alist))
|
||||
(new-kwd-data
|
||||
(assoc new-mark org-todo-kwd-alist))
|
||||
(becomes-choose
|
||||
(and
|
||||
(or
|
||||
(not old-kwd-data)
|
||||
(not
|
||||
(eq (nth 1 old-kwd-data) 'choose)))
|
||||
(eq (nth 1 new-kwd-data) 'choose))))
|
||||
(when
|
||||
becomes-choose
|
||||
(let
|
||||
((new-mark-data
|
||||
(assoc new-mark org-choose-mark-data)))
|
||||
(if
|
||||
new-mark
|
||||
(org-choose-get-mark-N
|
||||
(org-choose-get-default-mark-index
|
||||
new-mark-data)
|
||||
new-mark-data)
|
||||
(error "Somehow got an unrecognizable mark"))))))
|
||||
|
||||
;;; Setting it all up
|
||||
|
||||
(eval-after-load 'org
|
||||
'(progn
|
||||
(add-to-list 'org-todo-setup-filter-hook
|
||||
#'org-choose-setup-filter)
|
||||
(add-to-list 'org-todo-get-default-hook
|
||||
#'org-choose-get-default-mark)
|
||||
(add-to-list 'org-trigger-hook
|
||||
#'org-choose-keep-sensible)
|
||||
(add-to-list 'org-todo-interpretation-widgets
|
||||
'(:tag "Choose (to record decisions)" choose)
|
||||
'append)))
|
||||
|
||||
(provide 'org-choose)
|
||||
|
||||
;;; org-choose.el ends here
|
||||
232
lisp/org-contrib/org-collector.el
Normal file
232
lisp/org-contrib/org-collector.el
Normal file
@@ -0,0 +1,232 @@
|
||||
;;; org-collector --- collect properties into tables
|
||||
|
||||
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Eric Schulte <schulte dot eric at gmail dot com>
|
||||
;; Keywords: outlines, hypermedia, calendar, wp, experimentation,
|
||||
;; organization, properties
|
||||
;; Homepage: https://orgmode.org
|
||||
;; Version: 0.01
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 3, 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Pass in an alist of columns, each column can be either a single
|
||||
;; property or a function which takes column names as arguments.
|
||||
;;
|
||||
;; For example the following propview block would collect the value of
|
||||
;; the 'amount' property from each header in the current buffer
|
||||
;;
|
||||
;; #+BEGIN: propview :cols (ITEM amount)
|
||||
;; | "ITEM" | "amount" |
|
||||
;; |---------------------+----------|
|
||||
;; | "December Spending" | 0 |
|
||||
;; | "Grocery Store" | 56.77 |
|
||||
;; | "Athletic club" | 75.0 |
|
||||
;; | "Restaurant" | 30.67 |
|
||||
;; | "January Spending" | 0 |
|
||||
;; | "Athletic club" | 75.0 |
|
||||
;; | "Restaurant" | 50.00 |
|
||||
;; |---------------------+----------|
|
||||
;; | | |
|
||||
;; #+END:
|
||||
;;
|
||||
;; This slightly more selective propview block will limit those
|
||||
;; headers included to those in the subtree with the id 'december'
|
||||
;; in which the spendtype property is equal to "food"
|
||||
;;
|
||||
;; #+BEGIN: propview :id "december" :conds ((string= spendtype "food")) :cols (ITEM amount)
|
||||
;; | "ITEM" | "amount" |
|
||||
;; |-----------------+----------|
|
||||
;; | "Grocery Store" | 56.77 |
|
||||
;; | "Restaurant" | 30.67 |
|
||||
;; |-----------------+----------|
|
||||
;; | | |
|
||||
;; #+END:
|
||||
;;
|
||||
;; Org Collector allows arbitrary processing of the property values
|
||||
;; through elisp in the cols: property. This allows for both simple
|
||||
;; computations as in the following example
|
||||
;;
|
||||
;; #+BEGIN: propview :id "results" :cols (ITEM f d list (apply '+ list) (+ f d))
|
||||
;; | "ITEM" | "f" | "d" | "list" | "(apply (quote +) list)" | "(+ f d)" |
|
||||
;; |--------+-----+-----+-------------------------+--------------------------+-----------|
|
||||
;; | "run1" | 2 | 33 | (quote (9 2 3 4 5 6 7)) | 36 | 35 |
|
||||
;; | "run2" | 2 | 34 | :na | :na | 36 |
|
||||
;; | "run3" | 2 | 35 | :na | :na | 37 |
|
||||
;; | "run4" | 2 | 36 | :na | :na | 38 |
|
||||
;; | | | | | | |
|
||||
;; #+END:
|
||||
;;
|
||||
;; or more complex computations as in the following example taken from
|
||||
;; an org file where each header in "results" subtree contained a
|
||||
;; property "sorted_hits" which was passed through the
|
||||
;; "average-precision" elisp function
|
||||
;;
|
||||
;; #+BEGIN: propview :id "results" :cols (ITEM (average-precision sorted_hits))
|
||||
;; | "ITEM" | "(average-precision sorted_hits)" |
|
||||
;; |-----------+-----------------------------------|
|
||||
;; | run (80) | 0.105092 |
|
||||
;; | run (70) | 0.108142 |
|
||||
;; | run (10) | 0.111348 |
|
||||
;; | run (60) | 0.113593 |
|
||||
;; | run (50) | 0.116446 |
|
||||
;; | run (100) | 0.118863 |
|
||||
;; #+END:
|
||||
;;
|
||||
|
||||
;;; Code:
|
||||
(require 'org)
|
||||
(require 'org-table)
|
||||
|
||||
(defvar org-propview-default-value 0
|
||||
"Default value to insert into the propview table when the no
|
||||
value is calculated either through lack of required variables for
|
||||
a column, or through the generation of an error.")
|
||||
|
||||
(defun and-rest (list)
|
||||
(if (listp list)
|
||||
(if (> (length list) 1)
|
||||
(and (car list) (and-rest (cdr list)))
|
||||
(car list))
|
||||
list))
|
||||
|
||||
(put 'org-collector-error
|
||||
'error-conditions
|
||||
'(error column-prop-error org-collector-error))
|
||||
|
||||
(defun org-dblock-write:propview (params)
|
||||
"collect the column specification from the #+cols line
|
||||
preceding the dblock, then update the contents of the dblock."
|
||||
(interactive)
|
||||
(condition-case er
|
||||
(let ((cols (plist-get params :cols))
|
||||
(inherit (plist-get params :inherit))
|
||||
(conds (plist-get params :conds))
|
||||
(match (plist-get params :match))
|
||||
(scope (plist-get params :scope))
|
||||
(noquote (plist-get params :noquote))
|
||||
(colnames (plist-get params :colnames))
|
||||
(defaultval (plist-get params :defaultval))
|
||||
(content-lines (org-split-string (plist-get params :content) "\n"))
|
||||
id table line pos)
|
||||
(save-excursion
|
||||
(when (setq id (plist-get params :id))
|
||||
(cond ((not id) nil)
|
||||
((eq id 'global) (goto-char (point-min)))
|
||||
((eq id 'local) nil)
|
||||
((setq idpos (org-find-entry-with-id id))
|
||||
(goto-char idpos))
|
||||
(t (error "Cannot find entry with :ID: %s" id))))
|
||||
(unless (eq id 'global) (org-narrow-to-subtree))
|
||||
(setq stringformat (if noquote "%s" "%S"))
|
||||
(let ((org-propview-default-value (if defaultval defaultval org-propview-default-value)))
|
||||
(setq table (org-propview-to-table
|
||||
(org-propview-collect cols stringformat conds match scope inherit
|
||||
(if colnames colnames cols)) stringformat)))
|
||||
(widen))
|
||||
(setq pos (point))
|
||||
(when content-lines
|
||||
(while (string-match "^#" (car content-lines))
|
||||
(insert (pop content-lines) "\n")))
|
||||
(insert table) (insert "\n|--") (org-cycle) (move-end-of-line 1)
|
||||
(message (format "point-%d" pos))
|
||||
(while (setq line (pop content-lines))
|
||||
(when (string-match "^#" line)
|
||||
(insert "\n" line)))
|
||||
(goto-char pos)
|
||||
(org-table-recalculate 'all))
|
||||
(org-collector-error (widen) (error "%s" er))
|
||||
(error (widen) (error "%s" er))))
|
||||
|
||||
(defun org-propview-eval-w-props (props body)
|
||||
"evaluate the BODY-FORMS binding the variables using the
|
||||
variables and values specified in props"
|
||||
(condition-case nil ;; catch any errors
|
||||
(eval `(let ,(mapcar
|
||||
(lambda (pair) (list (intern (car pair)) (cdr pair)))
|
||||
props)
|
||||
,body))
|
||||
(error nil)))
|
||||
|
||||
(defun org-propview-get-with-inherited (&optional inherit)
|
||||
(append
|
||||
(org-entry-properties)
|
||||
(delq nil
|
||||
(mapcar (lambda (i)
|
||||
(let* ((n (symbol-name i))
|
||||
(p (org-entry-get (point) n 'do-inherit)))
|
||||
(when p (cons n p))))
|
||||
inherit))))
|
||||
|
||||
(defun org-propview-collect (cols stringformat &optional conds match scope inherit colnames)
|
||||
(interactive)
|
||||
;; collect the properties from every header
|
||||
(let* ((header-props
|
||||
(let ((org-trust-scanner-tags t) alst)
|
||||
(org-map-entries
|
||||
(quote (cons (cons "ITEM" (org-get-heading t))
|
||||
(org-propview-get-with-inherited inherit)))
|
||||
match scope)))
|
||||
;; read property values
|
||||
(header-props
|
||||
(mapcar (lambda (props)
|
||||
(mapcar (lambda (pair)
|
||||
(let ((inhibit-lisp-eval (string= (car pair) "ITEM")))
|
||||
(cons (car pair) (org-babel-read (cdr pair) inhibit-lisp-eval))))
|
||||
props))
|
||||
header-props))
|
||||
;; collect all property names
|
||||
(prop-names
|
||||
(mapcar 'intern (delete-dups
|
||||
(apply 'append (mapcar (lambda (header)
|
||||
(mapcar 'car header))
|
||||
header-props))))))
|
||||
(append
|
||||
(list
|
||||
(if colnames colnames (mapcar (lambda (el) (format stringformat el)) cols))
|
||||
'hline) ;; ------------------------------------------------
|
||||
(mapcar ;; calculate the value of the column for each header
|
||||
(lambda (props) (mapcar (lambda (col)
|
||||
(let ((result (org-propview-eval-w-props props col)))
|
||||
(if result result org-propview-default-value)))
|
||||
cols))
|
||||
(if conds
|
||||
;; eliminate the headers which don't satisfy the property
|
||||
(delq nil
|
||||
(mapcar
|
||||
(lambda (props)
|
||||
(if (and-rest (mapcar
|
||||
(lambda (col)
|
||||
(org-propview-eval-w-props props col))
|
||||
conds))
|
||||
props))
|
||||
header-props))
|
||||
header-props)))))
|
||||
|
||||
(defun org-propview-to-table (results stringformat)
|
||||
;; (message (format "cols:%S" cols))
|
||||
(orgtbl-to-orgtbl
|
||||
(mapcar
|
||||
(lambda (row)
|
||||
(if (equal row 'hline)
|
||||
'hline
|
||||
(mapcar (lambda (el) (format stringformat el)) row)))
|
||||
(delq nil results)) '()))
|
||||
|
||||
(provide 'org-collector)
|
||||
;;; org-collector ends here
|
||||
1243
lisp/org-contrib/org-contacts.el
Normal file
1243
lisp/org-contrib/org-contacts.el
Normal file
File diff suppressed because it is too large
Load Diff
2
lisp/org-contrib/org-contrib-pkg.el
Normal file
2
lisp/org-contrib/org-contrib-pkg.el
Normal file
@@ -0,0 +1,2 @@
|
||||
;; Generated package description from org-contrib.el -*- no-byte-compile: t -*-
|
||||
(define-package "org-contrib" "0.3" "Unmaintained add-ons for Org-mode" '((emacs "25.1") (org "9.4.6")) :authors '(("Bastien Guerry" . "bzg@gnu.org")) :maintainer '("Bastien Guerry" . "bzg@gnu.org") :keywords '("org") :url "https://git.sr.ht/~bzg/org-contrib")
|
||||
55
lisp/org-contrib/org-contrib.el
Normal file
55
lisp/org-contrib/org-contrib.el
Normal file
@@ -0,0 +1,55 @@
|
||||
;;; org-contrib.el --- Unmaintained add-ons for Org-mode
|
||||
|
||||
;; Copyright (C) 2021 Bastien Guerry
|
||||
|
||||
;; Author: Bastien Guerry <bzg@gnu.org>
|
||||
;; Homepage: https://git.sr.ht/~bzg/org-contrib
|
||||
;; Package-Requires: ((emacs "25.1") (org "9.4.6"))
|
||||
;; Version: 0.3
|
||||
;; Keywords: org
|
||||
;; SPDX-License-Identifier: GPL-3.0-or-later
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; This program is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary
|
||||
|
||||
;; This package contains add-ons to Org-mode which are not part of GNU
|
||||
;; Emacs or of the official Org package.
|
||||
|
||||
;; ** This package receive little if no maintainance. **
|
||||
|
||||
;; Especially, there is no guaranty that it is compatible with the latest
|
||||
;; Org stable version. Would you would like to volunteer maintaining it?
|
||||
;; If so, please send me an email at bzg@gnu.org.
|
||||
|
||||
;; If you want to maintain only one or some of these add-ons please send
|
||||
;; me an email and consider hosting the add-ons on a separate repository.
|
||||
|
||||
;; These files used to live in the Org repository but have been filtered
|
||||
;; out of the Org 9.5 release and are stored here for archival purpose.
|
||||
;; The contrib/ directory used to contain a scripts/ directory that now
|
||||
;; lives on Worg: <https://code.orgmode.org/bzg/worg/src/master/code>.
|
||||
|
||||
;;; Note:
|
||||
|
||||
;; This file, org-contrib.el, provides metadata for the (future)
|
||||
;; org-contrib GNU ELPA package.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(provide 'org-contrib)
|
||||
|
||||
;;; org-contrib.el ends here
|
||||
38
lisp/org-contrib/org-contribdir.el
Normal file
38
lisp/org-contrib/org-contribdir.el
Normal file
@@ -0,0 +1,38 @@
|
||||
;;; org-contribdir.el --- Mark the location of the contrib directory
|
||||
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
|
||||
;;
|
||||
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
|
||||
;; Keywords: outlines, hypermedia, calendar, wp
|
||||
;; Homepage: https://orgmode.org
|
||||
;; Version: 0.01
|
||||
;;
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 3, 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 GNU Emacs; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||||
;; Boston, MA 02110-1301, USA.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;;; Commentary:
|
||||
;;
|
||||
|
||||
;; The sole purpose of this file is to be located in the same place
|
||||
;; as where the contributed Org files are located, typically in the
|
||||
;; contrib/lisp directory of the Org-mode distribution. This is to
|
||||
;; make sure that the command `org-reload' can reliably locate
|
||||
;; contributed org files.
|
||||
|
||||
(provide 'org-contribdir)
|
||||
|
||||
;;; org-contribdir.el ends here
|
||||
431
lisp/org-contrib/org-depend.el
Normal file
431
lisp/org-contrib/org-depend.el
Normal file
@@ -0,0 +1,431 @@
|
||||
;;; org-depend.el --- TODO dependencies for Org-mode
|
||||
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
|
||||
;;
|
||||
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
|
||||
;; Keywords: outlines, hypermedia, calendar, wp
|
||||
;; Homepage: https://orgmode.org
|
||||
;; Version: 0.08
|
||||
;;
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; This file 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, 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; WARNING: This file is just a PROOF OF CONCEPT, not a supported part
|
||||
;; of Org-mode.
|
||||
;;
|
||||
;; This is an example implementation of TODO dependencies in Org-mode.
|
||||
;; It uses the new hooks in version 5.13 of Org-mode,
|
||||
;; `org-trigger-hook' and `org-blocker-hook'.
|
||||
;;
|
||||
;; It implements the following:
|
||||
;;
|
||||
;; Triggering
|
||||
;; ----------
|
||||
;;
|
||||
;; 1) If an entry contains a TRIGGER property that contains the string
|
||||
;; "chain-siblings(KEYWORD)", then switching that entry to DONE does
|
||||
;; do the following:
|
||||
;; - The sibling following this entry switched to todo-state KEYWORD.
|
||||
;; - The sibling also gets a TRIGGER property "chain-sibling(KEYWORD)",
|
||||
;; property, to make sure that, when *it* is DONE, the chain will
|
||||
;; continue.
|
||||
;;
|
||||
;; 2) If an entry contains a TRIGGER property that contains the string
|
||||
;; "chain-siblings-scheduled", then switching that entry to DONE does
|
||||
;; the following actions, similarly to "chain-siblings(KEYWORD)":
|
||||
;; - The sibling receives the same scheduled time as the entry
|
||||
;; marked as DONE (or, in the case, in which there is no scheduled
|
||||
;; time, the sibling does not get any either).
|
||||
;; - The sibling also gets the same TRIGGER property
|
||||
;; "chain-siblings-scheduled", so the chain can continue.
|
||||
;;
|
||||
;; 3) If the TRIGGER property contains the string
|
||||
;; "chain-find-next(KEYWORD[,OPTIONS])", then switching that entry
|
||||
;; to DONE do the following:
|
||||
;; - All siblings are of the entry are collected into a temporary
|
||||
;; list and then filtered and sorted according to OPTIONS
|
||||
;; - The first sibling on the list is changed into KEYWORD state
|
||||
;; - The sibling also gets the same TRIGGER property
|
||||
;; "chain-find-next", so the chain can continue.
|
||||
;;
|
||||
;; OPTIONS should be a comma separated string without spaces, and
|
||||
;; can contain following options:
|
||||
;;
|
||||
;; - from-top the candidate list is all of the siblings in
|
||||
;; the current subtree
|
||||
;;
|
||||
;; - from-bottom candidate list are all siblings from bottom up
|
||||
;;
|
||||
;; - from-current candidate list are all siblings from current item
|
||||
;; until end of subtree, then wrapped around from
|
||||
;; first sibling
|
||||
;;
|
||||
;; - no-wrap candidate list are siblings from current one down
|
||||
;;
|
||||
;; - todo-only Only consider siblings that have a todo keyword
|
||||
;; -
|
||||
;; - todo-and-done-only
|
||||
;; Same as above but also include done items.
|
||||
;;
|
||||
;; - priority-up sort by highest priority
|
||||
;; - priority-down sort by lowest priority
|
||||
;; - effort-up sort by highest effort
|
||||
;; - effort-down sort by lowest effort
|
||||
;;
|
||||
;; Default OPTIONS are from-top
|
||||
;;
|
||||
;;
|
||||
;; 4) If the TRIGGER property contains any other words like
|
||||
;; XYZ(KEYWORD), these are treated as entry id's with keywords. That
|
||||
;; means Org-mode will search for an entry with the ID property XYZ
|
||||
;; and switch that entry to KEYWORD as well.
|
||||
;;
|
||||
;; Blocking
|
||||
;; --------
|
||||
;;
|
||||
;; 1) If an entry contains a BLOCKER property that contains the word
|
||||
;; "previous-sibling", the sibling above the current entry is
|
||||
;; checked when you try to mark it DONE. If it is still in a TODO
|
||||
;; state, the current state change is blocked.
|
||||
;;
|
||||
;; 2) If the BLOCKER property contains any other words, these are
|
||||
;; treated as entry id's. That means Org-mode will search for an
|
||||
;; entry with the ID property exactly equal to this word. If any
|
||||
;; of these entries is not yet marked DONE, the current state change
|
||||
;; will be blocked.
|
||||
;;
|
||||
;; 3) Whenever a state change is blocked, an org-mark is pushed, so that
|
||||
;; you can find the offending entry with `C-c &'.
|
||||
;;
|
||||
;;; Example:
|
||||
;;
|
||||
;; When trying this example, make sure that the settings for TODO keywords
|
||||
;; have been activated, i.e. include the following line and press C-c C-c
|
||||
;; on the line before working with the example:
|
||||
;;
|
||||
;; #+TYP_TODO: TODO NEXT | DONE
|
||||
;;
|
||||
;; * TODO Win a million in Las Vegas
|
||||
;; The "third" TODO (see above) cannot become a TODO without this money.
|
||||
;;
|
||||
;; :PROPERTIES:
|
||||
;; :ID: I-cannot-do-it-without-money
|
||||
;; :END:
|
||||
;;
|
||||
;; * Do this by doing a chain of TODO's
|
||||
;; ** NEXT This is the first in this chain
|
||||
;; :PROPERTIES:
|
||||
;; :TRIGGER: chain-siblings(NEXT)
|
||||
;; :END:
|
||||
;;
|
||||
;; ** This is the second in this chain
|
||||
;;
|
||||
;; ** This is the third in this chain
|
||||
;; :PROPERTIES:
|
||||
;; :BLOCKER: I-cannot-do-it-without-money
|
||||
;; :END:
|
||||
;;
|
||||
;; ** This is the forth in this chain
|
||||
;; When this is DONE, we will also trigger entry XYZ-is-my-id
|
||||
;; :PROPERTIES:
|
||||
;; :TRIGGER: XYZ-is-my-id(TODO)
|
||||
;; :END:
|
||||
;;
|
||||
;; ** This is the fifth in this chain
|
||||
;;
|
||||
;; * Start writing report
|
||||
;; :PROPERTIES:
|
||||
;; :ID: XYZ-is-my-id
|
||||
;; :END:
|
||||
;;
|
||||
;;
|
||||
|
||||
(require 'org)
|
||||
(eval-when-compile
|
||||
(require 'cl))
|
||||
|
||||
(defcustom org-depend-tag-blocked t
|
||||
"Whether to indicate blocked TODO items by a special tag."
|
||||
:group 'org
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom org-depend-find-next-options
|
||||
"from-current,todo-only,priority-up"
|
||||
"Default options for chain-find-next trigger"
|
||||
:group 'org
|
||||
:type 'string)
|
||||
|
||||
(defmacro org-depend-act-on-sibling (trigger-val &rest rest)
|
||||
"Perform a set of actions on the next sibling, if it exists,
|
||||
copying the sibling spec TRIGGER-VAL to the next sibling."
|
||||
`(catch 'exit
|
||||
(save-excursion
|
||||
(goto-char pos)
|
||||
;; find the sibling, exit if no more siblings
|
||||
(condition-case nil
|
||||
(outline-forward-same-level 1)
|
||||
(error (throw 'exit t)))
|
||||
;; mark the sibling TODO
|
||||
,@rest
|
||||
;; make sure the sibling will continue the chain
|
||||
(org-entry-add-to-multivalued-property
|
||||
nil "TRIGGER" ,trigger-val))))
|
||||
|
||||
(defvar org-depend-doing-chain-find-next nil)
|
||||
|
||||
(defun org-depend-trigger-todo (change-plist)
|
||||
"Trigger new TODO entries after the current is switched to DONE.
|
||||
This does two different kinds of triggers:
|
||||
|
||||
- If the current entry contains a TRIGGER property that contains
|
||||
\"chain-siblings(KEYWORD)\", it goes to the next sibling, marks it
|
||||
KEYWORD and also installs the \"chain-sibling\" trigger to continue
|
||||
the chain.
|
||||
- If the current entry contains a TRIGGER property that contains
|
||||
\"chain-siblings-scheduled\", we go to the next sibling and copy
|
||||
the scheduled time from the current task, also installing the property
|
||||
in the sibling.
|
||||
- Any other word (space-separated) like XYZ(KEYWORD) in the TRIGGER
|
||||
property is seen as an entry id. Org-mode finds the entry with the
|
||||
corresponding ID property and switches it to the state TODO as well."
|
||||
|
||||
;; Refresh the effort text properties
|
||||
(org-refresh-properties org-effort-property 'org-effort)
|
||||
;; Get information from the plist
|
||||
(let* ((type (plist-get change-plist :type))
|
||||
(pos (plist-get change-plist :position))
|
||||
(from (plist-get change-plist :from))
|
||||
(to (plist-get change-plist :to))
|
||||
(org-log-done nil) ; IMPORTANT!: no logging during automatic trigger!
|
||||
trigger triggers tr p1 p2 kwd id)
|
||||
(catch 'return
|
||||
(unless (eq type 'todo-state-change)
|
||||
;; We are only handling todo-state-change....
|
||||
(throw 'return t))
|
||||
(unless (and (member from org-not-done-keywords)
|
||||
(member to org-done-keywords))
|
||||
;; This is not a change from TODO to DONE, ignore it
|
||||
(throw 'return t))
|
||||
|
||||
;; OK, we just switched from a TODO state to a DONE state
|
||||
;; Lets see if this entry has a TRIGGER property.
|
||||
;; If yes, split it up on whitespace.
|
||||
(setq trigger (org-entry-get pos "TRIGGER")
|
||||
triggers (and trigger (split-string trigger)))
|
||||
|
||||
;; Go through all the triggers
|
||||
(while (setq tr (pop triggers))
|
||||
(cond
|
||||
((and (not org-depend-doing-chain-find-next)
|
||||
(string-match "\\`chain-find-next(\\b\\(.+?\\)\\b\\(.*\\))\\'" tr))
|
||||
;; smarter sibling selection
|
||||
(let* ((org-depend-doing-chain-find-next t)
|
||||
(kwd (match-string 1 tr))
|
||||
(options (match-string 2 tr))
|
||||
(options (if (or (null options)
|
||||
(equal options ""))
|
||||
org-depend-find-next-options
|
||||
options))
|
||||
(todo-only (string-match "todo-only" options))
|
||||
(todo-and-done-only (string-match "todo-and-done-only"
|
||||
options))
|
||||
(from-top (string-match "from-top" options))
|
||||
(from-bottom (string-match "from-bottom" options))
|
||||
(from-current (string-match "from-current" options))
|
||||
(no-wrap (string-match "no-wrap" options))
|
||||
(priority-up (string-match "priority-up" options))
|
||||
(priority-down (string-match "priority-down" options))
|
||||
(effort-up (string-match "effort-up" options))
|
||||
(effort-down (string-match "effort-down" options)))
|
||||
(save-excursion
|
||||
(org-back-to-heading t)
|
||||
(let ((this-item (point)))
|
||||
;; go up to the parent headline, then advance to next child
|
||||
(org-up-heading-safe)
|
||||
(let ((end (save-excursion (org-end-of-subtree t)
|
||||
(point)))
|
||||
(done nil)
|
||||
(items '()))
|
||||
(outline-next-heading)
|
||||
(while (not done)
|
||||
(if (not (looking-at org-complex-heading-regexp))
|
||||
(setq done t)
|
||||
(let ((todo-kwd (match-string 2))
|
||||
(tags (match-string 5))
|
||||
(priority (org-get-priority (or (match-string 3) "")))
|
||||
(effort (when (or effort-up effort-down)
|
||||
(let ((effort (get-text-property (point) 'org-effort)))
|
||||
(when effort
|
||||
(org-duration-to-minutes effort))))))
|
||||
(push (list (point) todo-kwd priority tags effort)
|
||||
items))
|
||||
(unless (org-goto-sibling)
|
||||
(setq done t))))
|
||||
;; massage the list according to options
|
||||
(setq items
|
||||
(cond (from-top (nreverse items))
|
||||
(from-bottom items)
|
||||
((or from-current no-wrap)
|
||||
(let* ((items (nreverse items))
|
||||
(pos (position this-item items :key #'first))
|
||||
(items-before (subseq items 0 pos))
|
||||
(items-after (subseq items pos)))
|
||||
(if no-wrap items-after
|
||||
(append items-after items-before))))
|
||||
(t (nreverse items))))
|
||||
(setq items (remove-if
|
||||
(lambda (item)
|
||||
(or (equal (first item) this-item)
|
||||
(and (not todo-and-done-only)
|
||||
(member (second item) org-done-keywords))
|
||||
(and (or todo-only
|
||||
todo-and-done-only)
|
||||
(null (second item)))))
|
||||
items))
|
||||
(setq items
|
||||
(sort
|
||||
items
|
||||
(lambda (item1 item2)
|
||||
(let* ((p1 (third item1))
|
||||
(p2 (third item2))
|
||||
(e1 (fifth item1))
|
||||
(e2 (fifth item2))
|
||||
(p1-lt (< p1 p2))
|
||||
(p1-gt (> p1 p2))
|
||||
(e1-lt (and e1 (or (not e2) (< e1 e2))))
|
||||
(e2-gt (and e2 (or (not e1) (> e1 e2)))))
|
||||
(cond (priority-up
|
||||
(or p1-gt
|
||||
(and (equal p1 p2)
|
||||
(or (and effort-up e1-lt)
|
||||
(and effort-down e2-gt)))))
|
||||
(priority-down
|
||||
(or p1-lt
|
||||
(and (equal p1 p2)
|
||||
(or (and effort-up e1-lt)
|
||||
(and effort-down e2-gt)))))
|
||||
(effort-up
|
||||
(or e2-gt (and (equal e1 e2) p1-gt)))
|
||||
(effort-down
|
||||
(or e1-lt (and (equal e1 e2) p1-gt))))))))
|
||||
(when items
|
||||
(goto-char (first (first items)))
|
||||
(org-entry-add-to-multivalued-property nil "TRIGGER" tr)
|
||||
(org-todo kwd)))))))
|
||||
((string-match "\\`chain-siblings(\\(.*?\\))\\'" tr)
|
||||
;; This is a TODO chain of siblings
|
||||
(setq kwd (match-string 1 tr))
|
||||
(org-depend-act-on-sibling (format "chain-siblings(%s)" kwd)
|
||||
(org-todo kwd)))
|
||||
((string-match "\\`\\(\\S-+\\)(\\(.*?\\))\\'" tr)
|
||||
;; This seems to be ENTRY_ID(KEYWORD)
|
||||
(setq id (match-string 1 tr)
|
||||
kwd (match-string 2 tr)
|
||||
p1 (org-find-entry-with-id id))
|
||||
;; First check current buffer, then all files.
|
||||
(if p1
|
||||
;; There is an entry with this ID, mark it TODO.
|
||||
(save-excursion
|
||||
(goto-char p1)
|
||||
(org-todo kwd))
|
||||
(when (setq p2 (org-id-find id))
|
||||
(save-excursion
|
||||
(with-current-buffer (find-file-noselect (car p2))
|
||||
(goto-char (cdr p2))
|
||||
(org-todo kwd))))))
|
||||
((string-match "\\`chain-siblings-scheduled\\'" tr)
|
||||
(let ((time (org-get-scheduled-time pos)))
|
||||
(when time
|
||||
(org-depend-act-on-sibling
|
||||
"chain-siblings-scheduled"
|
||||
(org-schedule nil time))))))))))
|
||||
|
||||
(defun org-depend-block-todo (change-plist)
|
||||
"Block turning an entry into a TODO.
|
||||
This checks for a BLOCKER property in an entry and checks
|
||||
all the entries listed there. If any of them is not done,
|
||||
block changing the current entry into a TODO entry. If the property contains
|
||||
the word \"previous-sibling\", the sibling above the current entry is checked.
|
||||
Any other words are treated as entry id's. If an entry exists with the
|
||||
this ID property, that entry is also checked."
|
||||
;; Get information from the plist
|
||||
(let* ((type (plist-get change-plist :type))
|
||||
(pos (plist-get change-plist :position))
|
||||
(from (plist-get change-plist :from))
|
||||
(to (plist-get change-plist :to))
|
||||
(org-log-done nil) ; IMPORTANT!: no logging during automatic trigger
|
||||
blocker blockers bl p1 p2
|
||||
(proceed-p
|
||||
(catch 'return
|
||||
;; If this is not a todo state change, or if this entry is
|
||||
;; DONE, do not block
|
||||
(when (or (not (eq type 'todo-state-change))
|
||||
(member from (cons 'done org-done-keywords))
|
||||
(member to (cons 'todo org-not-done-keywords))
|
||||
(not to))
|
||||
(throw 'return t))
|
||||
|
||||
;; OK, the plan is to switch from nothing to TODO
|
||||
;; Lets see if we will allow it. Find the BLOCKER property
|
||||
;; and split it on whitespace.
|
||||
(setq blocker (org-entry-get pos "BLOCKER")
|
||||
blockers (and blocker (split-string blocker)))
|
||||
|
||||
;; go through all the blockers
|
||||
(while (setq bl (pop blockers))
|
||||
(cond
|
||||
((equal bl "previous-sibling")
|
||||
;; the sibling is required to be DONE.
|
||||
(catch 'ignore
|
||||
(save-excursion
|
||||
(goto-char pos)
|
||||
;; find the older sibling, exit if no more siblings
|
||||
(unless (org-get-last-sibling)
|
||||
(throw 'ignore t))
|
||||
;; Check if this entry is not yet done and block
|
||||
(unless (org-entry-is-done-p)
|
||||
;; return nil, to indicate that we block the change!
|
||||
(org-mark-ring-push)
|
||||
(throw 'return nil)))))
|
||||
((setq p1 (org-find-entry-with-id bl))
|
||||
;; there is an entry with this ID, check it out
|
||||
(save-excursion
|
||||
(goto-char p1)
|
||||
(unless (org-entry-is-done-p)
|
||||
;; return nil, to indicate that we block the change!
|
||||
(org-mark-ring-push)
|
||||
(throw 'return nil))))
|
||||
((setq p2 (org-id-find bl))
|
||||
(save-excursion
|
||||
(with-current-buffer (find-file-noselect (car p2))
|
||||
(goto-char (cdr p2))
|
||||
(unless (org-entry-is-done-p)
|
||||
(org-mark-ring-push)
|
||||
(throw 'return nil)))))))
|
||||
;; Return t to indicate that we are not blocking.
|
||||
t)))
|
||||
(when org-depend-tag-blocked
|
||||
(org-toggle-tag "blocked" (if proceed-p 'off 'on)))
|
||||
|
||||
proceed-p))
|
||||
|
||||
(add-hook 'org-trigger-hook 'org-depend-trigger-todo)
|
||||
(add-hook 'org-blocker-hook 'org-depend-block-todo)
|
||||
|
||||
(provide 'org-depend)
|
||||
|
||||
;;; org-depend.el ends here
|
||||
369
lisp/org-contrib/org-effectiveness.el
Normal file
369
lisp/org-contrib/org-effectiveness.el
Normal file
@@ -0,0 +1,369 @@
|
||||
;;; org-effectiveness.el --- Measuring the personal effectiveness
|
||||
|
||||
;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: David Arroyo Menéndez <davidam@es.gnu.org>
|
||||
;; Keywords: effectiveness, plot
|
||||
;; Homepage: https://orgmode.org
|
||||
;;
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;;; Commentary:
|
||||
|
||||
;; This file implements functions to measure the effectiveness in org.
|
||||
;; Org-mode doesn't load this module by default - if this is not what
|
||||
;; you want, configure the variable `org-modules'. Thanks to #emacs-es
|
||||
;; irc channel for your support.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'org)
|
||||
|
||||
(defcustom org-effectiveness-max-todo 50
|
||||
"This variable is useful to advice to the user about
|
||||
many TODO pending"
|
||||
:type 'integer
|
||||
:group 'org-effectiveness)
|
||||
|
||||
(defun org-effectiveness-advice()
|
||||
"Advicing about a possible excess of TODOS"
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(if (< org-effectiveness-max-todo (count-matches "* TODO"))
|
||||
(message "An excess of TODOS!"))))
|
||||
|
||||
;; Check advice starting an org file
|
||||
(add-hook 'org-mode-hook 'org-effectiveness-advice)
|
||||
|
||||
(defun org-effectiveness-count-keyword(keyword)
|
||||
"Print a message with the number of keyword outline in the current buffer"
|
||||
(interactive "sKeyword: ")
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(message "Number of %s: %d" keyword (count-matches (concat "* " keyword)))))
|
||||
|
||||
(defun org-effectiveness-count-todo()
|
||||
"Print a message with the number of todo tasks in the current buffer"
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(message "Number of TODO: %d" (count-matches "* TODO"))))
|
||||
|
||||
(defun org-effectiveness-count-done()
|
||||
"Print a message with the number of done tasks in the current buffer"
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(message "Number of DONE: %d" (count-matches "* DONE"))))
|
||||
|
||||
(defun org-effectiveness-count-canceled()
|
||||
"Print a message with the number of canceled tasks in the current buffer"
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(message "Number of Canceled: %d" (count-matches "* CANCEL+ED"))))
|
||||
|
||||
(defun org-effectiveness-count-task()
|
||||
"Print a message with the number of tasks and subtasks in the current buffer"
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(message "Number of tasks: %d" (count-matches "^*"))))
|
||||
|
||||
(defun org-effectiveness()
|
||||
"Returns the effectiveness in the current org buffer"
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(let ((done (float (count-matches "* DONE.*\n.*")))
|
||||
(canc (float (count-matches "* CANCEL+ED.*\n.*"))))
|
||||
(if (and (= done canc) (zerop done))
|
||||
(setq effectiveness 0)
|
||||
(setq effectiveness (* 100 (/ done (+ done canc)))))
|
||||
(message "Effectiveness: %f" effectiveness))))
|
||||
|
||||
|
||||
(defun org-effectiveness-keywords-in-date(keyword date)
|
||||
(interactive "sKeyword: \nsDate: " keyword date)
|
||||
(setq count (count-matches (concat keyword ".*\n.*" date)))
|
||||
(message (concat "%sS: %d" keyword count)))
|
||||
|
||||
(defun org-effectiveness-dones-in-date(date &optional notmessage)
|
||||
(interactive "sGive me a date: " date)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(let ((count (count-matches (concat "DONE.*\n.*" date))))
|
||||
(if (eq notmessage 1)
|
||||
(message "%d" count)
|
||||
(message "DONES: %d " count)))))
|
||||
|
||||
(defun org-effectiveness-todos-in-date(date)
|
||||
(interactive "sGive me a date: " date)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(setq count (count-matches (concat "TODO.*\n.*" date)))
|
||||
(message "TODOS: %d" count)))
|
||||
|
||||
(defun org-effectiveness-canceled-in-date(date)
|
||||
(interactive "sGive me a date: " date)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(setq count (count-matches (concat "CANCEL+ED.*\n.*" date)))
|
||||
(message "CANCELEDS: %d" count)))
|
||||
|
||||
(defun org-effectiveness-ntasks-in-date(date &optional notmessage)
|
||||
(interactive "sGive me a date: " date)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(let ((tasks (float (count-matches (concat "^*.*\n.*" date)))))
|
||||
(message "%d" tasks))))
|
||||
|
||||
(defun org-effectiveness-in-date(date &optional notmessage)
|
||||
(interactive "sGive me a date: " date)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(let ((done (float (count-matches (concat "* DONE.*\n.*" date))))
|
||||
(canc (float (count-matches (concat "* CANCEL+ED.*\n.*" date)))))
|
||||
(if (and (= done canc) (zerop done))
|
||||
(setq effectiveness 0)
|
||||
(setq effectiveness (* 100 (/ done (+ done canc)))))
|
||||
(if (eq notmessage 1)
|
||||
(message "%d" effectiveness)
|
||||
(message "Effectiveness: %d " effectiveness)))))
|
||||
|
||||
(defun org-effectiveness-month-to-string (m)
|
||||
(if (< m 10)
|
||||
(concat "0" (number-to-string m))
|
||||
(number-to-string m)))
|
||||
|
||||
(defun org-effectiveness-plot(startdate enddate &optional save)
|
||||
(interactive "sGive me the start date: \nsGive me the end date: " startdate enddate)
|
||||
(setq dates (org-effectiveness-check-dates startdate enddate))
|
||||
(setq syear (cadr (assq 'startyear dates)))
|
||||
(setq smonth (cadr (assq 'startmonth dates)))
|
||||
(setq eyear (cadr (assq 'endyear dates)))
|
||||
(setq emonth (assq 'endmonth dates))
|
||||
;; Checking the format of the dates
|
||||
(if (not (string-match "[0-9][0-9][0-9][0-9]-[0-9][0-9]" startdate))
|
||||
(message "The start date must have the next format YYYY-MM"))
|
||||
(if (not (string-match "[0-9][0-9][0-9][0-9]-[0-9][0-9]" enddate))
|
||||
(message "The end date must have the next format YYYY-MM"))
|
||||
;; Checking if startdate < enddate
|
||||
(if (string-match "^[0-9][0-9][0-9][0-9]" startdate)
|
||||
(setq startyear (string-to-number (match-string 0 startdate))))
|
||||
(if (string-match "[0-9][0-9]$" startdate)
|
||||
(setq startmonth (string-to-number (match-string 0 startdate))))
|
||||
(if (string-match "^[0-9][0-9][0-9][0-9]" enddate)
|
||||
(setq endyear (string-to-number (match-string 0 enddate))))
|
||||
(if (string-match "[0-9][0-9]$" enddate)
|
||||
(setq endmonth (string-to-number (match-string 0 enddate))))
|
||||
(if (> startyear endyear)
|
||||
(message "The start date must be before that end date"))
|
||||
(if (and (= startyear endyear) (> startmonth endmonth))
|
||||
(message "The start date must be before that end date"))
|
||||
;; Create a file
|
||||
(let ((month startmonth)
|
||||
(year startyear)
|
||||
(str ""))
|
||||
(while (or (> endyear year) (and (= endyear year) (>= endmonth month)))
|
||||
(setq str (concat str (number-to-string year) "-" (org-effectiveness-month-to-string month) " " (org-effectiveness-in-date (concat (number-to-string year) "-" (org-effectiveness-month-to-string month)) 1) "\n"))
|
||||
(if (= month 12)
|
||||
(progn
|
||||
(setq year (+ 1 year))
|
||||
(setq month 1))
|
||||
(setq month (+ 1 month))))
|
||||
(write-region str nil "/tmp/org-effectiveness"))
|
||||
;; Create the bar graph
|
||||
(if (eq save t)
|
||||
(setq strplot "/usr/bin/gnuplot -e 'set term png; set output \"/tmp/org-effectiveness.png\"; plot \"/tmp/org-effectiveness\" using 2:xticlabels(1) with histograms' -p")
|
||||
(setq strplot "/usr/bin/gnuplot -e 'plot \"/tmp/org-effectiveness\" using 2:xticlabels(1) with histograms' -p"))
|
||||
(if (file-exists-p "/usr/bin/gnuplot")
|
||||
(call-process "/bin/bash" nil t nil "-c" strplot)
|
||||
(message "gnuplot is not installed")))
|
||||
|
||||
(defun org-effectiveness-plot-save(startdate enddate &optional save)
|
||||
(interactive "sGive me the start date: \nsGive me the end date: " startdate enddate)
|
||||
(org-effectiveness-plot startdate enddate t))
|
||||
|
||||
;; (defun org-effectiveness-plot(startdate enddate)
|
||||
|
||||
|
||||
(defun org-effectiveness-ascii-bar(n &optional label)
|
||||
"Print a bar with the percentage from 0 to 100 printed in ascii"
|
||||
(interactive "nPercentage: \nsLabel: ")
|
||||
(if (or (< n 0) (> n 100))
|
||||
(message "The percentage must be between 0 to 100")
|
||||
(let ((x 0)
|
||||
(y 0)
|
||||
(z 0))
|
||||
(insert (format "\n### %s ###" label))
|
||||
(insert "\n-")
|
||||
(while (< x n)
|
||||
(insert "-")
|
||||
(setq x (+ x 1)))
|
||||
(insert "+\n")
|
||||
(insert (format "%d" n))
|
||||
(if (> n 10)
|
||||
(setq y (+ y 1)))
|
||||
(while (< y n)
|
||||
(insert " ")
|
||||
(setq y (+ y 1)))
|
||||
(insert "|\n")
|
||||
(insert "-")
|
||||
(while (< z n)
|
||||
(insert "-")
|
||||
(setq z (+ z 1)))
|
||||
(insert "+"))))
|
||||
|
||||
(defun org-effectiveness-html-bar(n &optional label)
|
||||
"Print a bar with the percentage from 0 to 100 printed in html"
|
||||
(interactive "nPercentage: \nsLabel: ")
|
||||
(if (or (< n 0) (> n 100))
|
||||
(message "The percentage must be between 0 to 100")
|
||||
(let ((x 0)
|
||||
(y 0)
|
||||
(z 0))
|
||||
(insert (format "\n<div class='percentage-%d'>%d</div>" n n))
|
||||
)))
|
||||
|
||||
|
||||
(defun org-effectiveness-check-dates (startdate enddate)
|
||||
"Generate a list with ((startyear startmonth) (endyear endmonth))"
|
||||
(setq str nil)
|
||||
(if (not (string-match "[0-9][0-9][0-9][0-9]-[0-9][0-9]" startdate))
|
||||
(setq str "The start date must have the next format YYYY-MM"))
|
||||
(if (not (string-match "[0-9][0-9][0-9][0-9]-[0-9][0-9]" enddate))
|
||||
(setq str "The end date must have the next format YYYY-MM"))
|
||||
;; Checking if startdate < enddate
|
||||
(if (string-match "^[0-9][0-9][0-9][0-9]" startdate)
|
||||
(setq startyear (string-to-number (match-string 0 startdate))))
|
||||
(if (string-match "[0-9][0-9]$" startdate)
|
||||
(setq startmonth (string-to-number (match-string 0 startdate))))
|
||||
(if (string-match "^[0-9][0-9][0-9][0-9]" enddate)
|
||||
(setq endyear (string-to-number (match-string 0 enddate))))
|
||||
(if (string-match "[0-9][0-9]$" enddate)
|
||||
(setq endmonth (string-to-number (match-string 0 enddate))))
|
||||
(if (> startyear endyear)
|
||||
(setq str "The start date must be before that end date"))
|
||||
(if (and (= startyear endyear) (> startmonth endmonth))
|
||||
(setq str "The start date must be before that end date"))
|
||||
(if str
|
||||
(message str)
|
||||
;; (list (list startyear startmonth) (list endyear endmonth))))
|
||||
(list (list 'startyear startyear) (list 'startmonth startmonth) (list 'endyear endyear) (list 'endmonth endmonth))))
|
||||
|
||||
(defun org-effectiveness-plot-ascii (startdate enddate)
|
||||
(interactive "sGive me the start date: \nsGive me the end date: " startdate enddate)
|
||||
(setq dates (org-effectiveness-check-dates startdate enddate))
|
||||
(let ((syear (cadr (assq 'startyear dates)))
|
||||
(smonth (cadr (assq 'startmonth dates)))
|
||||
(year (cadr (assq 'startyear dates)))
|
||||
(month (cadr (assq 'startmonth dates)))
|
||||
(emonth (cadr (assq 'endmonth dates)))
|
||||
(eyear (cadr (assq 'endyear dates)))
|
||||
(buffer (current-buffer))
|
||||
(str ""))
|
||||
(while (or (> eyear year) (and (= eyear year) (>= emonth month)))
|
||||
(setq str (org-effectiveness-in-date (concat (number-to-string year) "-" (org-effectiveness-month-to-string month)) 1))
|
||||
(switch-to-buffer "*org-effectiveness*")
|
||||
(org-effectiveness-ascii-bar (string-to-number str) (format "%s-%s" year month))
|
||||
(switch-to-buffer buffer)
|
||||
(if (eq month 12)
|
||||
(progn
|
||||
(setq year (+ 1 year))
|
||||
(setq month 1))
|
||||
(setq month (+ 1 month)))))
|
||||
(switch-to-buffer "*org-effectiveness*"))
|
||||
|
||||
|
||||
(defun org-effectiveness-plot-ascii-ntasks (startdate enddate)
|
||||
(interactive "sGive me the start date: \nsGive me the end date: " startdate enddate)
|
||||
(setq dates (org-effectiveness-check-dates startdate enddate))
|
||||
(let ((syear (cadr (assq 'startyear dates)))
|
||||
(smonth (cadr (assq 'startmonth dates)))
|
||||
(year (cadr (assq 'startyear dates)))
|
||||
(month (cadr (assq 'startmonth dates)))
|
||||
(emonth (cadr (assq 'endmonth dates)))
|
||||
(eyear (cadr (assq 'endyear dates)))
|
||||
(buffer (current-buffer))
|
||||
(str ""))
|
||||
(while (or (> eyear year) (and (= eyear year) (>= emonth month)))
|
||||
(setq str (org-effectiveness-ntasks-in-date (concat (number-to-string year) "-" (org-effectiveness-month-to-string month)) 1))
|
||||
(switch-to-buffer "*org-effectiveness*")
|
||||
(org-effectiveness-ascii-bar (string-to-number str) (format "%s-%s" year month))
|
||||
(switch-to-buffer buffer)
|
||||
(if (eq month 12)
|
||||
(progn
|
||||
(setq year (+ 1 year))
|
||||
(setq month 1))
|
||||
(setq month (+ 1 month)))))
|
||||
(switch-to-buffer "*org-effectiveness*"))
|
||||
|
||||
(defun org-effectiveness-plot-ascii-dones (startdate enddate)
|
||||
(interactive "sGive me the start date: \nsGive me the end date: " startdate enddate)
|
||||
(setq dates (org-effectiveness-check-dates startdate enddate))
|
||||
(let ((syear (cadr (assq 'startyear dates)))
|
||||
(smonth (cadr (assq 'startmonth dates)))
|
||||
(year (cadr (assq 'startyear dates)))
|
||||
(month (cadr (assq 'startmonth dates)))
|
||||
(emonth (cadr (assq 'endmonth dates)))
|
||||
(eyear (cadr (assq 'endyear dates)))
|
||||
(buffer (current-buffer))
|
||||
(str ""))
|
||||
(while (or (> eyear year) (and (= eyear year) (>= emonth month)))
|
||||
(setq str (org-effectiveness-dones-in-date (concat (number-to-string year) "-" (org-effectiveness-month-to-string month)) 1))
|
||||
(switch-to-buffer "*org-effectiveness*")
|
||||
(org-effectiveness-ascii-bar (string-to-number str) (format "%s-%s" year month))
|
||||
(switch-to-buffer buffer)
|
||||
(if (eq month 12)
|
||||
(progn
|
||||
(setq year (+ 1 year))
|
||||
(setq month 1))
|
||||
(setq month (+ 1 month)))))
|
||||
(switch-to-buffer "*org-effectiveness*"))
|
||||
|
||||
|
||||
(defun org-effectiveness-plot-html (startdate enddate)
|
||||
"Print html bars about the effectiveness in a buffer"
|
||||
(interactive "sGive me the start date: \nsGive me the end date: " startdate enddate)
|
||||
(setq dates (org-effectiveness-check-dates startdate enddate))
|
||||
(let ((syear (cadr (assq 'startyear dates)))
|
||||
(smonth (cadr (assq 'startmonth dates)))
|
||||
(year (cadr (assq 'startyear dates)))
|
||||
(month (cadr (assq 'startmonth dates)))
|
||||
(emonth (cadr (assq 'endmonth dates)))
|
||||
(eyear (cadr (assq 'endyear dates)))
|
||||
(buffer (current-buffer))
|
||||
(str ""))
|
||||
(switch-to-buffer "*org-effectiveness-html*")
|
||||
(insert "<html><head><title>Graphbar</title><meta http-equiv='Content-type' content='text/html; charset=utf-8'><link rel='stylesheet' type='text/css' href='graphbar.css' title='graphbar'></head><body>")
|
||||
(while (or (> eyear year) (and (= eyear year) (>= emonth month)))
|
||||
(setq str (org-effectiveness-in-date (concat (number-to-string year) "-" (org-effectiveness-month-to-string month)) 1))
|
||||
(switch-to-buffer "*org-effectiveness-html*")
|
||||
(org-effectiveness-html-bar (string-to-number str) (format "%s-%s" year month))
|
||||
(switch-to-buffer buffer)
|
||||
(format "%s-%s" year month)
|
||||
(if (eq month 12)
|
||||
(progn
|
||||
(setq year (+ 1 year))
|
||||
(setq month 1))
|
||||
(setq month (+ 1 month))))
|
||||
(switch-to-buffer "*org-effectiveness-html*")
|
||||
(insert "</body></html>")))
|
||||
|
||||
(provide 'org-effectiveness)
|
||||
203
lisp/org-contrib/org-eldoc.el
Normal file
203
lisp/org-contrib/org-eldoc.el
Normal file
@@ -0,0 +1,203 @@
|
||||
;;; org-eldoc.el --- display org header and src block info using eldoc -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (c) 2014-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Łukasz Gruner <lukasz@gruner.lu>
|
||||
;; Maintainer: Łukasz Gruner <lukasz@gruner.lu>
|
||||
;; Version: 6
|
||||
;; Package-Requires: ((org "8"))
|
||||
;; Homepage: https://bitbucket.org/ukaszg/org-eldoc
|
||||
;; Created: 25/05/2014
|
||||
;; Keywords: eldoc, outline, breadcrumb, org, babel, minibuffer
|
||||
|
||||
;; This file is not part of Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;; Changelog:
|
||||
|
||||
;; As of 01/11/14 switching license to GPL3 to allow submission to org-mode.
|
||||
;; 08/11/14 switch code to automatically define eldoc-documentation-function, but don't autostart eldoc-mode.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'org)
|
||||
(require 'ob-core)
|
||||
(require 'eldoc)
|
||||
|
||||
(declare-function org-element-at-point "org-element" ())
|
||||
(declare-function org-element-property "org-element" (property element))
|
||||
(declare-function org-element-type "org-element" (element))
|
||||
|
||||
(defgroup org-eldoc nil "" :group 'org)
|
||||
|
||||
(defcustom org-eldoc-breadcrumb-separator "/"
|
||||
"Breadcrumb separator."
|
||||
:group 'org-eldoc
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-eldoc-test-buffer-name " *Org-eldoc test buffer*"
|
||||
"Name of the buffer used while testing for mode-local variable values."
|
||||
:group 'org-eldoc
|
||||
:type 'string)
|
||||
|
||||
(defun org-eldoc-get-breadcrumb ()
|
||||
"Return breadcrumb if on a headline or nil."
|
||||
(let ((case-fold-search t) cur)
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(save-match-data
|
||||
(when (looking-at org-complex-heading-regexp)
|
||||
(setq cur (match-string 4))
|
||||
(org-format-outline-path
|
||||
(append (org-get-outline-path) (list cur))
|
||||
(frame-width) "" org-eldoc-breadcrumb-separator))))))
|
||||
|
||||
(defun org-eldoc-get-src-header ()
|
||||
"Returns lang and list of header properties if on src definition line and nil otherwise."
|
||||
(let ((case-fold-search t) info lang hdr-args)
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(save-match-data
|
||||
(when (looking-at "^[ \t]*#\\+\\(begin\\|end\\)_src")
|
||||
(setq info (org-babel-get-src-block-info 'light)
|
||||
lang (propertize (or (nth 0 info) "no lang") 'face 'font-lock-string-face)
|
||||
hdr-args (nth 2 info))
|
||||
(concat
|
||||
lang
|
||||
": "
|
||||
(mapconcat
|
||||
(lambda (elem)
|
||||
(when (and (cdr elem) (not (string= "" (cdr elem))))
|
||||
(concat
|
||||
(propertize (symbol-name (car elem)) 'face 'org-list-dt)
|
||||
" "
|
||||
(propertize (cdr elem) 'face 'org-verbatim)
|
||||
" ")))
|
||||
hdr-args " ")))))))
|
||||
|
||||
(defun org-eldoc-get-src-lang ()
|
||||
"Return value of lang for the current block if in block body and nil otherwise."
|
||||
(let ((element (save-match-data (org-element-at-point))))
|
||||
(and (eq (org-element-type element) 'src-block)
|
||||
(>= (line-beginning-position)
|
||||
(org-element-property :post-affiliated element))
|
||||
(<=
|
||||
(line-end-position)
|
||||
(org-with-wide-buffer
|
||||
(goto-char (org-element-property :end element))
|
||||
(skip-chars-backward " \t\n")
|
||||
(line-end-position)))
|
||||
(org-element-property :language element))))
|
||||
|
||||
(defvar org-eldoc-local-functions-cache (make-hash-table :size 40 :test 'equal)
|
||||
"Cache of major-mode's eldoc-documentation-functions,
|
||||
used by \\[org-eldoc-get-mode-local-documentation-function].")
|
||||
|
||||
(defun org-eldoc-get-mode-local-documentation-function (lang)
|
||||
"Check if LANG-mode sets eldoc-documentation-function and return its value."
|
||||
(let ((cached-func (gethash lang org-eldoc-local-functions-cache 'empty))
|
||||
(mode-func (org-src-get-lang-mode lang))
|
||||
doc-func)
|
||||
(if (eq 'empty cached-func)
|
||||
(when (fboundp mode-func)
|
||||
(with-temp-buffer
|
||||
(funcall mode-func)
|
||||
(setq doc-func (if (boundp 'eldoc-documentation-functions)
|
||||
(let ((doc-funs eldoc-documentation-functions))
|
||||
(lambda (callback)
|
||||
(let ((eldoc-documentation-functions doc-funs))
|
||||
(run-hook-with-args-until-success
|
||||
'eldoc-documentation-functions
|
||||
callback))))
|
||||
(and eldoc-documentation-function
|
||||
(symbol-value 'eldoc-documentation-function))))
|
||||
(puthash lang doc-func org-eldoc-local-functions-cache))
|
||||
doc-func)
|
||||
cached-func)))
|
||||
|
||||
(declare-function c-eldoc-print-current-symbol-info "c-eldoc" ())
|
||||
(declare-function css-eldoc-function "css-eldoc" ())
|
||||
(declare-function php-eldoc-function "php-eldoc" ())
|
||||
(declare-function go-eldoc--documentation-function "go-eldoc" ())
|
||||
|
||||
(defun org-eldoc-documentation-function (&rest args)
|
||||
"Return breadcrumbs when on a headline, args for src block header-line,
|
||||
calls other documentation functions depending on lang when inside src body."
|
||||
(or
|
||||
(org-eldoc-get-breadcrumb)
|
||||
(org-eldoc-get-src-header)
|
||||
(let ((lang (org-eldoc-get-src-lang)))
|
||||
(cond ((or
|
||||
(string= lang "emacs-lisp")
|
||||
(string= lang "elisp"))
|
||||
(cond ((and (boundp 'eldoc-documentation-functions) ; Emacs>=28
|
||||
(fboundp 'elisp-eldoc-var-docstring)
|
||||
(fboundp 'elisp-eldoc-funcall))
|
||||
(let ((eldoc-documentation-functions
|
||||
'(elisp-eldoc-var-docstring elisp-eldoc-funcall)))
|
||||
(eldoc-print-current-symbol-info)))
|
||||
((fboundp 'elisp-eldoc-documentation-function)
|
||||
(elisp-eldoc-documentation-function))
|
||||
(t ; Emacs<25
|
||||
(let (eldoc-documentation-function)
|
||||
(eldoc-print-current-symbol-info)))))
|
||||
((or
|
||||
(string= lang "c") ;; https://github.com/nflath/c-eldoc
|
||||
(string= lang "C")) (when (require 'c-eldoc nil t)
|
||||
(c-eldoc-print-current-symbol-info)))
|
||||
;; https://github.com/zenozeng/css-eldoc
|
||||
((string= lang "css") (when (require 'css-eldoc nil t)
|
||||
(css-eldoc-function)))
|
||||
;; https://github.com/zenozeng/php-eldoc
|
||||
((string= lang "php") (when (require 'php-eldoc nil t)
|
||||
(php-eldoc-function)))
|
||||
((or
|
||||
(string= lang "go")
|
||||
(string= lang "golang")) (when (require 'go-eldoc nil t)
|
||||
(go-eldoc--documentation-function)))
|
||||
(t (let ((doc-fun (org-eldoc-get-mode-local-documentation-function lang))
|
||||
(callback (car args)))
|
||||
(when (functionp doc-fun)
|
||||
(if (functionp callback)
|
||||
(funcall doc-fun callback)
|
||||
(funcall doc-fun)))))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun org-eldoc-load ()
|
||||
"Set up org-eldoc documentation function."
|
||||
(interactive)
|
||||
;; This approach is taken from python.el.
|
||||
(with-no-warnings
|
||||
(cond
|
||||
((null eldoc-documentation-function) ; Emacs<25
|
||||
(setq-local eldoc-documentation-function
|
||||
#'org-eldoc-documentation-function))
|
||||
((boundp 'eldoc-documentation-functions) ; Emacs>=28
|
||||
(add-hook 'eldoc-documentation-functions
|
||||
#'org-eldoc-documentation-function nil t))
|
||||
(t
|
||||
(add-function :before-until (local 'eldoc-documentation-function)
|
||||
#'org-eldoc-documentation-function)))))
|
||||
|
||||
;;;###autoload
|
||||
(add-hook 'org-mode-hook #'org-eldoc-load)
|
||||
|
||||
(provide 'org-eldoc)
|
||||
|
||||
;; -*- coding: utf-8-emacs; -*-
|
||||
|
||||
;;; org-eldoc.el ends here
|
||||
199
lisp/org-contrib/org-eval-light.el
Normal file
199
lisp/org-contrib/org-eval-light.el
Normal file
@@ -0,0 +1,199 @@
|
||||
;;; org-eval-light.el --- Display result of evaluating code in various languages (light)
|
||||
|
||||
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Carsten Dominik <carsten.dominik@gmail.com>,
|
||||
;; Eric Schulte <schulte dot eric at gmail dot com>
|
||||
;; Keywords: outlines, hypermedia, calendar, wp, literate programming,
|
||||
;; reproducible research
|
||||
;; Homepage: https://orgmode.org
|
||||
;; Version: 0.04
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 3, 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file is based off of org-eval, with the following changes.
|
||||
;;
|
||||
;; 1) forms are only executed manually, (allowing for the execution of
|
||||
;; an entire subtree of forms)
|
||||
;; 2) use the org-mode style src blocks, rather than the muse style
|
||||
;; <code></code> blocks
|
||||
;; 3) forms are not replaced by their outputs, but rather the output
|
||||
;; is placed in the buffer immediately following the src block
|
||||
;; commented by `org-eval-light-make-region-example' (when
|
||||
;; evaluated with a prefix argument no output is placed in the
|
||||
;; buffer)
|
||||
;; 4) add defadvice to org-ctrl-c-ctrl-c so that when called inside of
|
||||
;; a source block it will call `org-eval-light-current-snippet'
|
||||
|
||||
;;; Code:
|
||||
(require 'org)
|
||||
|
||||
(defgroup org-eval-light nil
|
||||
"Options concerning including output from commands into the Org-mode buffer."
|
||||
:tag "Org Eval"
|
||||
:group 'org)
|
||||
|
||||
(defvar org-eval-light-example-size-cutoff 10
|
||||
"The number of lines under which an example is considered
|
||||
'small', and is exported with the '^:' syntax instead of in a
|
||||
large example block")
|
||||
|
||||
(defvar org-eval-light-regexp nil)
|
||||
|
||||
(defun org-eval-light-set-interpreters (var value)
|
||||
(set-default var value)
|
||||
(setq org-eval-light-regexp
|
||||
(concat "#\\+begin_src \\("
|
||||
(mapconcat 'regexp-quote value "\\|")
|
||||
"\\)\\([^\000]+?\\)#\\+end_src")))
|
||||
|
||||
(defcustom org-eval-light-interpreters '("lisp" "emacs-lisp" "ruby" "shell")
|
||||
"Interpreters allows for evaluation tags.
|
||||
This is a list of program names (as strings) that can evaluate code and
|
||||
insert the output into an Org-mode buffer. Valid choices are
|
||||
|
||||
lisp Interpret Emacs Lisp code and display the result
|
||||
shell Pass command to the shell and display the result
|
||||
perl The perl interpreter
|
||||
python Thy python interpreter
|
||||
ruby The ruby interpreter"
|
||||
:group 'org-eval-light
|
||||
:set 'org-eval-light-set-interpreters
|
||||
:type '(set :greedy t
|
||||
(const "lisp")
|
||||
(const "emacs-lisp")
|
||||
(const "perl")
|
||||
(const "python")
|
||||
(const "ruby")
|
||||
(const "shell")))
|
||||
|
||||
;;; functions
|
||||
(defun org-eval-light-inside-snippet ()
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(let ((case-fold-search t)
|
||||
(start-re "^#\\+begin_src\\( \\([^ \t\n]+\\)\\)?.*\n")
|
||||
(end-re "\n#\\+end_src")
|
||||
(pos (point))
|
||||
beg end)
|
||||
(if (and (setq beg (re-search-backward start-re nil t))
|
||||
(setq end (re-search-forward end-re nil t))
|
||||
(<= beg pos) (>= end pos))
|
||||
t))))
|
||||
|
||||
(defun org-eval-light-make-region-example (beg end)
|
||||
"Comment out region using either the '^:' or the BEGIN_EXAMPLE
|
||||
syntax based on the size of the region as compared to
|
||||
`org-eval-light-example-size-cutoff'."
|
||||
(interactive "*r")
|
||||
(let ((size (abs (- (line-number-at-pos end)
|
||||
(line-number-at-pos beg)))))
|
||||
(if (= size 0)
|
||||
(let ((result (buffer-substring beg end)))
|
||||
(delete-region beg end)
|
||||
(insert (concat ": " result)))
|
||||
(if (<= size org-eval-light-example-size-cutoff)
|
||||
(save-excursion
|
||||
(goto-char beg)
|
||||
(dotimes (n size)
|
||||
(move-beginning-of-line 1) (insert ": ") (forward-line 1)))
|
||||
(let ((result (buffer-substring beg end)))
|
||||
(delete-region beg end)
|
||||
(insert (concat "#+BEGIN_EXAMPLE\n" result "#+END_EXAMPLE\n")))))))
|
||||
|
||||
(defun org-eval-light-current-snippet (&optional arg)
|
||||
"Execute the current #+begin_src #+end_src block, and dump the
|
||||
results into the buffer immediately following the src block,
|
||||
commented by `org-eval-light-make-region-example'."
|
||||
(interactive "P")
|
||||
(let ((line (org-current-line))
|
||||
(case-fold-search t)
|
||||
(info (org-edit-src-find-region-and-lang))
|
||||
beg end lang result)
|
||||
(setq beg (nth 0 info)
|
||||
end (nth 1 info)
|
||||
lang (nth 2 info))
|
||||
(unless (member lang org-eval-light-interpreters)
|
||||
(error "Language is not in `org-eval-light-interpreters': %s" lang))
|
||||
(goto-line line)
|
||||
(setq result (org-eval-light-code lang (buffer-substring beg end)))
|
||||
(unless arg
|
||||
(save-excursion
|
||||
(re-search-forward "^#\\+end_src" nil t) (open-line 1) (forward-char 2)
|
||||
(let ((beg (point))
|
||||
(end (progn (insert result)
|
||||
(point))))
|
||||
(message (format "from %S %S" beg end))
|
||||
(org-eval-light-make-region-example beg end))))))
|
||||
|
||||
(defun org-eval-light-eval-subtree (&optional arg)
|
||||
"Replace EVAL snippets in the entire subtree."
|
||||
(interactive "P")
|
||||
(save-excursion
|
||||
(org-narrow-to-subtree)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward org-eval-light-regexp nil t)
|
||||
(org-eval-light-current-snippet arg))
|
||||
(widen)))
|
||||
|
||||
(defun org-eval-light-code (interpreter code)
|
||||
(cond
|
||||
((member interpreter '("lisp" "emacs-lisp"))
|
||||
(org-eval-light-lisp (concat "(progn\n" code "\n)")))
|
||||
((equal interpreter "shell")
|
||||
(shell-command-to-string code))
|
||||
((member interpreter '("perl" "python" "ruby"))
|
||||
(org-eval-light-run (executable-find interpreter) code))
|
||||
(t (error "Cannot evaluate code type %s" interpreter))))
|
||||
|
||||
(defun org-eval-light-lisp (form)
|
||||
"Evaluate the given form and return the result as a string."
|
||||
(require 'pp)
|
||||
(save-match-data
|
||||
(condition-case err
|
||||
(let ((object (eval (read form))))
|
||||
(cond
|
||||
((stringp object) object)
|
||||
((and (listp object)
|
||||
(not (eq object nil)))
|
||||
(let ((string (pp-to-string object)))
|
||||
(substring string 0 (1- (length string)))))
|
||||
((numberp object)
|
||||
(number-to-string object))
|
||||
((eq object nil) "")
|
||||
(t
|
||||
(pp-to-string object))))
|
||||
(error
|
||||
(org-display-warning (format "%s: Error evaluating %s: %s"
|
||||
"???" form err))
|
||||
"; INVALID LISP CODE"))))
|
||||
|
||||
(defun org-eval-light-run (cmd code)
|
||||
(with-temp-buffer
|
||||
(insert code)
|
||||
(shell-command-on-region (point-min) (point-max) cmd nil 'replace)
|
||||
(buffer-string)))
|
||||
|
||||
(defadvice org-ctrl-c-ctrl-c (around org-cc-eval-source activate)
|
||||
(if (org-eval-light-inside-snippet)
|
||||
(call-interactively 'org-eval-light-current-snippet)
|
||||
ad-do-it))
|
||||
|
||||
(provide 'org-eval-light)
|
||||
|
||||
;;; org-eval-light.el ends here
|
||||
216
lisp/org-contrib/org-eval.el
Normal file
216
lisp/org-contrib/org-eval.el
Normal file
@@ -0,0 +1,216 @@
|
||||
;;; org-eval.el --- Display result of evaluating code in various languages
|
||||
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
|
||||
;;
|
||||
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
|
||||
;; Keywords: outlines, hypermedia, calendar, wp
|
||||
;; Homepage: https://orgmode.org
|
||||
;; Version: 0.04
|
||||
;;
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 3, 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; This modules allows to include output from various commands into an
|
||||
;; Org-mode buffer, both for live display, and for export.
|
||||
;; This technique has been copied from emacs-wiki and Emacs Muse, and
|
||||
;; we try to make it work here in a way as similar as possible to
|
||||
;; Muse, so that people who move between both worlds don't need to learn
|
||||
;; new syntax.
|
||||
;;
|
||||
;; Basically it works like this:
|
||||
;;
|
||||
;; <lisp>(concat "aaa" "bbb")</lisp>
|
||||
;;
|
||||
;; will display "aaabbb" in the buffer and export like that as well.
|
||||
;; The leading lisp tag will also accept the attributes "markup" and
|
||||
;; "lang", to specify how the text should be formatted during export.
|
||||
;; For example,
|
||||
;;
|
||||
;; <lisp markup="src" lang="emacs-lisp"> .... </lisp>
|
||||
;;
|
||||
;; will format the result of the lisp form as if it was lisp source
|
||||
;; code. Internally, it will wrap the text into a
|
||||
;;
|
||||
;; #+begin_src emacs-lisp
|
||||
;; #+end_src
|
||||
;;
|
||||
;; structure so that the right things happen when the exporter is running.
|
||||
;;
|
||||
;; By default, only the <lisp> tag is turned on, but you can configure
|
||||
;; the variable `org-eval-interpreters' to add more interpreters like
|
||||
;; `perl', `python', or the `shell'.
|
||||
;;
|
||||
;; You can edit the code snippets with "C-c '" (org-edit-src-code).
|
||||
;;
|
||||
;; Please note that this mechanism is potentially dangerous, because it
|
||||
;; executes code that you don't even see. This gives you great power,
|
||||
;; but also enough rope to hang yourself. And, it gives your friends
|
||||
;; who send you Org files plenty of opportunity for good and bad jokes.
|
||||
;; This is also why this module is not turned on by default, but only
|
||||
;; available as a contributed package.
|
||||
;;
|
||||
;;
|
||||
;;
|
||||
(require 'org)
|
||||
|
||||
;;; Customization
|
||||
|
||||
(defgroup org-eval nil
|
||||
"Options concerning including output from commands into the Org-mode buffer."
|
||||
:tag "Org Eval"
|
||||
:group 'org)
|
||||
|
||||
(defface org-eval
|
||||
(org-compatible-face nil
|
||||
'((((class color grayscale) (min-colors 88) (background light))
|
||||
(:foreground "grey40"))
|
||||
(((class color grayscale) (min-colors 88) (background dark))
|
||||
(:foreground "grey60"))
|
||||
(((class color) (min-colors 8) (background light))
|
||||
(:foreground "green"))
|
||||
(((class color) (min-colors 8) (background dark))
|
||||
(:foreground "yellow"))))
|
||||
"Face for command output that is included into an Org-mode buffer."
|
||||
:group 'org-eval
|
||||
:group 'org-faces)
|
||||
|
||||
(defvar org-eval-regexp nil)
|
||||
|
||||
(defun org-eval-set-interpreters (var value)
|
||||
(set-default var value)
|
||||
(setq org-eval-regexp
|
||||
(concat "<\\("
|
||||
(mapconcat 'regexp-quote value "\\|")
|
||||
"\\)"
|
||||
"\\([^>]\\{0,50\\}?\\)>"
|
||||
"\\([^\000]+?\\)</\\1>")))
|
||||
|
||||
(defcustom org-eval-interpreters '("lisp")
|
||||
"Interpreters allows for evaluation tags.
|
||||
This is a list of program names (as strings) that can evaluate code and
|
||||
insert the output into an Org-mode buffer. Valid choices are
|
||||
|
||||
lisp Interpret Emacs Lisp code and display the result
|
||||
shell Pass command to the shell and display the result
|
||||
perl The perl interpreter
|
||||
python Thy python interpreter
|
||||
ruby The ruby interpreter"
|
||||
:group 'org-eval
|
||||
:set 'org-eval-set-interpreters
|
||||
:type '(set :greedy t
|
||||
(const "lisp")
|
||||
(const "perl")
|
||||
(const "python")
|
||||
(const "ruby")
|
||||
(const "shell")))
|
||||
|
||||
(defun org-eval-handle-snippets (limit &optional replace)
|
||||
"Evaluate code snippets and display the results as display property.
|
||||
When REPLACE is non-nil, replace the code region with the result (used
|
||||
for export)."
|
||||
(let (a)
|
||||
(while (setq a (text-property-any (point) (or limit (point-max))
|
||||
'org-eval t))
|
||||
(remove-text-properties
|
||||
a (next-single-property-change a 'org-eval nil limit)
|
||||
'(display t intangible t org-eval t))))
|
||||
(while (re-search-forward org-eval-regexp limit t)
|
||||
(let* ((beg (match-beginning 0))
|
||||
(end (match-end 0))
|
||||
(kind (match-string 1))
|
||||
(attr (match-string 2))
|
||||
(code (match-string 3))
|
||||
(value (org-eval-code kind code))
|
||||
markup lang)
|
||||
(if replace
|
||||
(progn
|
||||
(setq attr (save-match-data (org-eval-get-attributes attr))
|
||||
markup (cdr (assoc "markup" attr))
|
||||
lang (cdr (assoc "lang" attr)))
|
||||
(replace-match
|
||||
(concat (if markup (format "#+BEGIN_%s" (upcase markup)))
|
||||
(if (and markup (equal (downcase markup) "src"))
|
||||
(concat " " (or lang "fundamental")))
|
||||
"\n"
|
||||
value
|
||||
(if markup (format "\n#+END_%s\n" (upcase markup))))
|
||||
t t))
|
||||
(add-text-properties
|
||||
beg end
|
||||
(list 'display value 'intangible t 'font-lock-multiline t
|
||||
'face 'org-eval
|
||||
'org-eval t))))))
|
||||
|
||||
(defun org-eval-replace-snippts ()
|
||||
"Replace EVAL snippets in the entire buffer.
|
||||
This should go into the `org-export-preprocess-hook'."
|
||||
(goto-char (point-min))
|
||||
(org-eval-handle-snippets nil 'replace))
|
||||
|
||||
(add-hook 'org-export-preprocess-hook 'org-eval-replace-snippts)
|
||||
(add-hook 'org-font-lock-hook 'org-eval-handle-snippets)
|
||||
|
||||
(defun org-eval-get-attributes (str)
|
||||
(let ((start 0) key value rtn)
|
||||
(while (string-match "\\<\\([a-zA-Z]+\\)\\>=\"\\([^\"]+\\)\"" str start)
|
||||
(setq key (match-string 1 str)
|
||||
value (match-string 2 str)
|
||||
start (match-end 0))
|
||||
(push (cons key value) rtn))
|
||||
rtn))
|
||||
|
||||
(defun org-eval-code (interpreter code)
|
||||
(cond
|
||||
((equal interpreter "lisp")
|
||||
(org-eval-lisp (concat "(progn\n" code "\n)")))
|
||||
((equal interpreter "shell")
|
||||
(shell-command-to-string code))
|
||||
((member interpreter '("perl" "python" "ruby"))
|
||||
(org-eval-run (executable-find interpreter) code))
|
||||
(t (error "Cannot evaluate code type %s" interpreter))))
|
||||
|
||||
(defun org-eval-lisp (form)
|
||||
"Evaluate the given form and return the result as a string."
|
||||
(require 'pp)
|
||||
(save-match-data
|
||||
(condition-case err
|
||||
(let ((object (eval (read form))))
|
||||
(cond
|
||||
((stringp object) object)
|
||||
((and (listp object)
|
||||
(not (eq object nil)))
|
||||
(let ((string (pp-to-string object)))
|
||||
(substring string 0 (1- (length string)))))
|
||||
((numberp object)
|
||||
(number-to-string object))
|
||||
((eq object nil) "")
|
||||
(t
|
||||
(pp-to-string object))))
|
||||
(error
|
||||
(org-display-warning (format "%s: Error evaluating %s: %s"
|
||||
"???" form err))
|
||||
"; INVALID LISP CODE"))))
|
||||
|
||||
(defun org-eval-run (cmd code)
|
||||
(with-temp-buffer
|
||||
(insert code)
|
||||
(shell-command-on-region (point-min) (point-max) cmd nil 'replace)
|
||||
(buffer-string)))
|
||||
|
||||
(provide 'org-eval)
|
||||
|
||||
;;; org-eval.el ends here
|
||||
362
lisp/org-contrib/org-expiry.el
Normal file
362
lisp/org-contrib/org-expiry.el
Normal file
@@ -0,0 +1,362 @@
|
||||
;;; org-expiry.el --- expiry mechanism for Org entries
|
||||
;;
|
||||
;; Copyright 2007-2021 Free Software Foundation, Inc.
|
||||
;;
|
||||
;; Author: Bastien Guerry <bzg@gnu.org>
|
||||
;; Version: 0.2
|
||||
;; Keywords: org, expiry
|
||||
;; Homepage: https://git.sr.ht/~bzg/org-contrib
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 3, 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
;;
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; This gives you a chance to get rid of old entries in your Org files
|
||||
;; by expiring them.
|
||||
;;
|
||||
;; By default, entries that have no EXPIRY property are considered to be
|
||||
;; new (i.e. 0 day old) and only entries older than one year go to the
|
||||
;; expiry process, which consist in adding the ARCHIVE tag. None of
|
||||
;; your tasks will be deleted with the default settings.
|
||||
;;
|
||||
;; When does an entry expires?
|
||||
;;
|
||||
;; Consider this entry:
|
||||
;;
|
||||
;; * Stop watching TV
|
||||
;; :PROPERTIES:
|
||||
;; :CREATED: <2008-01-07 lun 08:01>
|
||||
;; :EXPIRY: <2008-01-09 08:01>
|
||||
;; :END:
|
||||
;;
|
||||
;; This entry will expire on the 9th, january 2008.
|
||||
|
||||
;; * Stop watching TV
|
||||
;; :PROPERTIES:
|
||||
;; :CREATED: <2008-01-07 lun 08:01>
|
||||
;; :EXPIRY: +1w
|
||||
;; :END:
|
||||
;;
|
||||
;; This entry will expire on the 14th, january 2008, one week after its
|
||||
;; creation date.
|
||||
;;
|
||||
;; What happen when an entry is expired? Nothing until you explicitly
|
||||
;; M-x org-expiry-process-entries When doing this, org-expiry will check
|
||||
;; for expired entries and request permission to process them.
|
||||
;;
|
||||
;; Processing an expired entries means calling the function associated
|
||||
;; with `org-expiry-handler-function'; the default is to add the tag
|
||||
;; :ARCHIVE:, but you can also add a EXPIRED keyword or even archive
|
||||
;; the subtree.
|
||||
;;
|
||||
;; Is this useful? Well, when you're in a brainstorming session, it
|
||||
;; might be useful to know about the creation date of an entry, and be
|
||||
;; able to archive those entries that are more than xxx days/weeks old.
|
||||
;;
|
||||
;; When you're in such a session, you can insinuate org-expiry like
|
||||
;; this: M-x org-expiry-insinuate
|
||||
;;
|
||||
;; Then, each time you're pressing M-RET to insert an item, the CREATION
|
||||
;; property will be automatically added. Same when you're scheduling or
|
||||
;; deadlining items. You can deinsinuate: M-x org-expiry-deinsinuate
|
||||
|
||||
;;; Code:
|
||||
|
||||
;;; User variables:
|
||||
|
||||
(defgroup org-expiry nil
|
||||
"Org expiry process."
|
||||
:tag "Org Expiry"
|
||||
:group 'org)
|
||||
|
||||
(defcustom org-expiry-inactive-timestamps nil
|
||||
"Insert inactive timestamps for created/expired properties."
|
||||
:type 'boolean
|
||||
:group 'org-expiry)
|
||||
|
||||
(defcustom org-expiry-created-property-name "CREATED"
|
||||
"The name of the property for setting the creation date."
|
||||
:type 'string
|
||||
:group 'org-expiry)
|
||||
|
||||
(defcustom org-expiry-expiry-property-name "EXPIRY"
|
||||
"The name of the property for setting the expiry date/delay."
|
||||
:type 'string
|
||||
:group 'org-expiry)
|
||||
|
||||
(defcustom org-expiry-keyword "EXPIRED"
|
||||
"The default keyword for `org-expiry-add-keyword'."
|
||||
:type 'string
|
||||
:group 'org-expiry)
|
||||
|
||||
(defcustom org-expiry-wait "+1y"
|
||||
"Time span between the creation date and the expiry.
|
||||
The default value for this variable (\"+1y\") means that entries
|
||||
will expire if there are at least one year old.
|
||||
|
||||
If the expiry delay cannot be retrieved from the entry or the
|
||||
subtree above, the expiry process compares the expiry delay with
|
||||
`org-expiry-wait'. This can be either an ISO date or a relative
|
||||
time specification. See `org-read-date' for details."
|
||||
:type 'string
|
||||
:group 'org-expiry)
|
||||
|
||||
(defcustom org-expiry-created-date "+0d"
|
||||
"The default creation date.
|
||||
The default value of this variable (\"+0d\") means that entries
|
||||
without a creation date will be handled as if they were created
|
||||
today.
|
||||
|
||||
If the creation date cannot be retrieved from the entry or the
|
||||
subtree above, the expiry process will compare the expiry delay
|
||||
with this date. This can be either an ISO date or a relative
|
||||
time specification. See `org-read-date' for details on relative
|
||||
time specifications."
|
||||
:type 'string
|
||||
:group 'org-expiry)
|
||||
|
||||
(defcustom org-expiry-handler-function 'org-toggle-archive-tag
|
||||
"Function to process expired entries.
|
||||
Possible candidates for this function are:
|
||||
|
||||
`org-toggle-archive-tag'
|
||||
`org-expiry-add-keyword'
|
||||
`org-expiry-archive-subtree'"
|
||||
:type 'function
|
||||
:group 'org-expiry)
|
||||
|
||||
(defcustom org-expiry-confirm-flag t
|
||||
"Non-nil means confirm expiration process."
|
||||
:type '(choice
|
||||
(const :tag "Always require confirmation" t)
|
||||
(const :tag "Do not require confirmation" nil)
|
||||
(const :tag "Require confirmation in interactive expiry process"
|
||||
interactive))
|
||||
:group 'org-expiry)
|
||||
|
||||
(defcustom org-expiry-advised-functions
|
||||
'(org-scheduled org-deadline org-time-stamp)
|
||||
"A list of advised functions.
|
||||
`org-expiry-insinuate' will activate the expiry advice for these
|
||||
functions. `org-expiry-deinsinuate' will deactivate them."
|
||||
:type 'boolean
|
||||
:group 'list)
|
||||
|
||||
;;; Advices and insinuation:
|
||||
|
||||
(defadvice org-schedule (after org-schedule-update-created)
|
||||
"Update the creation-date property when calling `org-schedule'."
|
||||
(org-expiry-insert-created))
|
||||
|
||||
(defadvice org-deadline (after org-deadline-update-created)
|
||||
"Update the creation-date property when calling `org-deadline'."
|
||||
(org-expiry-insert-created))
|
||||
|
||||
(defadvice org-time-stamp (after org-time-stamp-update-created)
|
||||
"Update the creation-date property when calling `org-time-stamp'."
|
||||
(org-expiry-insert-created))
|
||||
|
||||
(defun org-expiry-insinuate (&optional arg)
|
||||
"Add hooks and activate advices for org-expiry.
|
||||
If ARG, also add a hook to `before-save-hook' in `org-mode' and
|
||||
restart `org-mode' if necessary."
|
||||
(interactive "P")
|
||||
(ad-activate 'org-schedule)
|
||||
(ad-activate 'org-time-stamp)
|
||||
(ad-activate 'org-deadline)
|
||||
(add-hook 'org-insert-heading-hook 'org-expiry-insert-created)
|
||||
(add-hook 'org-after-todo-state-change-hook 'org-expiry-insert-created)
|
||||
(add-hook 'org-after-tags-change-hook 'org-expiry-insert-created)
|
||||
(when arg
|
||||
(add-hook 'org-mode-hook
|
||||
(lambda() (add-hook 'before-save-hook
|
||||
'org-expiry-process-entries t t)))
|
||||
;; need this to refresh org-mode hooks
|
||||
(when (eq major-mode 'org-mode)
|
||||
(org-mode)
|
||||
(if (called-interactively-p 'any)
|
||||
(message "Org-expiry insinuated, `org-mode' restarted.")))))
|
||||
|
||||
(defun org-expiry-deinsinuate (&optional arg)
|
||||
"Remove hooks and deactivate advices for org-expiry.
|
||||
If ARG, also remove org-expiry hook in Org's `before-save-hook'
|
||||
and restart `org-mode' if necessary."
|
||||
(interactive "P")
|
||||
(ad-deactivate 'org-schedule)
|
||||
(ad-deactivate 'org-time-stamp)
|
||||
(ad-deactivate 'org-deadline)
|
||||
(remove-hook 'org-insert-heading-hook 'org-expiry-insert-created)
|
||||
(remove-hook 'org-after-todo-state-change-hook 'org-expiry-insert-created)
|
||||
(remove-hook 'org-after-tags-change-hook 'org-expiry-insert-created)
|
||||
(remove-hook 'org-mode-hook
|
||||
(lambda() (add-hook 'before-save-hook
|
||||
'org-expiry-process-entries t t)))
|
||||
(when arg
|
||||
;; need this to refresh org-mode hooks
|
||||
(when (eq major-mode 'org-mode)
|
||||
(org-mode)
|
||||
(if (called-interactively-p 'any)
|
||||
(message "Org-expiry de-insinuated, `org-mode' restarted.")))))
|
||||
|
||||
;;; org-expiry-expired-p:
|
||||
|
||||
(defun org-expiry-expired-p ()
|
||||
"Check if the entry at point is expired.
|
||||
Return nil if the entry is not expired. Otherwise return the
|
||||
amount of time between today and the expiry date.
|
||||
|
||||
If there is no creation date, use `org-expiry-created-date'.
|
||||
If there is no expiry date, use `org-expiry-wait'."
|
||||
(let* ((ex-prop org-expiry-expiry-property-name)
|
||||
(cr-prop org-expiry-created-property-name)
|
||||
(ct (current-time))
|
||||
(cr (org-read-date nil t (or (org-entry-get (point) cr-prop t)
|
||||
org-expiry-created-date)))
|
||||
(ex-field (or (org-entry-get (point) ex-prop t) org-expiry-wait))
|
||||
(ex (if (string-match "^[ \t]?[+-]" ex-field)
|
||||
(time-add cr (time-subtract (org-read-date nil t ex-field) ct))
|
||||
(org-read-date nil t ex-field))))
|
||||
(if (time-less-p ex ct)
|
||||
(time-subtract ct ex))))
|
||||
|
||||
;;; Expire an entry or a region/buffer:
|
||||
|
||||
(defun org-expiry-process-entry (&optional force)
|
||||
"Call `org-expiry-handler-function' on entry.
|
||||
If FORCE is non-nil, don't require confirmation from the user.
|
||||
Otherwise rely on `org-expiry-confirm-flag' to decide."
|
||||
(interactive "P")
|
||||
(save-excursion
|
||||
(when (called-interactively-p) (org-reveal))
|
||||
(when (org-expiry-expired-p)
|
||||
(org-back-to-heading)
|
||||
(looking-at org-complex-heading-regexp)
|
||||
(let* ((ov (make-overlay (point) (match-end 0)))
|
||||
(e (org-expiry-expired-p))
|
||||
(d (time-to-number-of-days e)))
|
||||
(overlay-put ov 'face 'secondary-selection)
|
||||
(if (or force
|
||||
(null org-expiry-confirm-flag)
|
||||
(and (eq org-expiry-confirm-flag 'interactive)
|
||||
(not (interactive)))
|
||||
(and org-expiry-confirm-flag
|
||||
(y-or-n-p (format "Entry expired by %d days. Process? " d))))
|
||||
(funcall org-expiry-handler-function))
|
||||
(delete-overlay ov)))))
|
||||
|
||||
(defun org-expiry-process-entries (beg end)
|
||||
"Process all expired entries between BEG and END.
|
||||
The expiry process will run the function defined by
|
||||
`org-expiry-handler-functions'."
|
||||
(interactive "r")
|
||||
(save-excursion
|
||||
(let ((beg (if (org-region-active-p)
|
||||
(region-beginning) (point-min)))
|
||||
(end (if (org-region-active-p)
|
||||
(region-end) (point-max))))
|
||||
(goto-char beg)
|
||||
(let ((expired 0) (processed 0))
|
||||
(while (and (outline-next-heading) (< (point) end))
|
||||
(when (org-expiry-expired-p)
|
||||
(setq expired (1+ expired))
|
||||
(if (if (called-interactively-p 'any)
|
||||
(call-interactively 'org-expiry-process-entry)
|
||||
(org-expiry-process-entry))
|
||||
(setq processed (1+ processed)))))
|
||||
(if (equal expired 0)
|
||||
(message "No expired entry")
|
||||
(message "Processed %d on %d expired entries"
|
||||
processed expired))))))
|
||||
|
||||
;;; Insert created/expiry property:
|
||||
|
||||
(defun org-expiry-insert-created (&optional arg)
|
||||
"Insert or update a property with the creation date.
|
||||
If ARG, always update it. With one `C-u' prefix, silently update
|
||||
to today's date. With two `C-u' prefixes, prompt the user for to
|
||||
update the date."
|
||||
(interactive "P")
|
||||
(let* ((d (org-entry-get (point) org-expiry-created-property-name))
|
||||
d-time d-hour timestr)
|
||||
(when (or (null d) arg)
|
||||
;; update if no date or non-nil prefix argument
|
||||
;; FIXME Use `org-time-string-to-time'
|
||||
(setq d-time (if d (org-time-string-to-time d)
|
||||
(current-time)))
|
||||
(setq d-hour (format-time-string "%H:%M" d-time))
|
||||
(setq timestr
|
||||
;; two C-u prefixes will call org-read-date
|
||||
(if (equal arg '(16))
|
||||
(concat "<" (org-read-date
|
||||
nil nil nil nil d-time d-hour) ">")
|
||||
(format-time-string (cdr org-time-stamp-formats))))
|
||||
;; maybe transform to inactive timestamp
|
||||
(if org-expiry-inactive-timestamps
|
||||
(setq timestr (concat "[" (substring timestr 1 -1) "]")))
|
||||
(save-excursion
|
||||
(org-entry-put
|
||||
(point) org-expiry-created-property-name timestr)))))
|
||||
|
||||
(defun org-expiry-insert-expiry (&optional today)
|
||||
"Insert a property with the expiry date.
|
||||
With one `C-u' prefix, don't prompt interactively for the date
|
||||
and insert today's date."
|
||||
(interactive "P")
|
||||
(let* ((d (org-entry-get (point) org-expiry-expiry-property-name))
|
||||
d-time d-hour)
|
||||
(setq d-time (if d (org-time-string-to-time d)
|
||||
(current-time)))
|
||||
(setq d-hour (format-time-string "%H:%M" d-time))
|
||||
(setq timestr (if today
|
||||
(format-time-string (cdr org-time-stamp-formats))
|
||||
(concat "<" (org-read-date
|
||||
nil nil nil nil d-time d-hour) ">")))
|
||||
;; maybe transform to inactive timestamp
|
||||
(if org-expiry-inactive-timestamps
|
||||
(setq timestr (concat "[" (substring timestr 1 -1) "]")))
|
||||
|
||||
(save-excursion
|
||||
(org-entry-put
|
||||
(point) org-expiry-expiry-property-name timestr))))
|
||||
|
||||
;;; Functions to process expired entries:
|
||||
|
||||
(defun org-expiry-archive-subtree ()
|
||||
"Archive the entry at point if it is expired."
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(if (org-expiry-expired-p)
|
||||
(org-archive-subtree)
|
||||
(if (called-interactively-p 'any)
|
||||
(message "Entry at point is not expired.")))))
|
||||
|
||||
(defun org-expiry-add-keyword (&optional keyword)
|
||||
"Add KEYWORD to the entry at point if it is expired."
|
||||
(interactive "sKeyword: ")
|
||||
(if (or (member keyword org-todo-keywords-1)
|
||||
(setq keyword org-expiry-keyword))
|
||||
(save-excursion
|
||||
(if (org-expiry-expired-p)
|
||||
(org-todo keyword)
|
||||
(if (called-interactively-p 'any)
|
||||
(message "Entry at point is not expired."))))
|
||||
(error "\"%s\" is not a to-do keyword in this buffer" keyword)))
|
||||
|
||||
;; FIXME what about using org-refile ?
|
||||
|
||||
(provide 'org-expiry)
|
||||
|
||||
;;; org-expiry.el ends here
|
||||
314
lisp/org-contrib/org-interactive-query.el
Normal file
314
lisp/org-contrib/org-interactive-query.el
Normal file
@@ -0,0 +1,314 @@
|
||||
;;; org-interactive-query.el --- Interactive modification of agenda query
|
||||
;;
|
||||
;; Copyright 2007-2021 Free Software Foundation, Inc.
|
||||
;;
|
||||
;; Author: Christopher League <league at contrapunctus dot net>
|
||||
;; Version: 1.0
|
||||
;; Keywords: org, wp
|
||||
;;
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 3, 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
;;
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; This file is DEPRECATED. The functionality here has been mostly subsumed by
|
||||
;; features added to Org agenda, especially commands that begin with
|
||||
;; org-agenda-filter*.
|
||||
|
||||
;; This library implements interactive modification of a tags/todo query
|
||||
;; in the org-agenda. It adds 4 keys to the agenda
|
||||
;;
|
||||
;; / add a keyword as a positive selection criterion
|
||||
;; \ add a keyword as a newgative selection criterion
|
||||
;; = clear a keyword from the selection string
|
||||
;; ;
|
||||
|
||||
(require 'org)
|
||||
|
||||
(org-defkey org-agenda-mode-map "=" 'org-agenda-query-clear-cmd)
|
||||
(org-defkey org-agenda-mode-map "/" 'org-agenda-query-and-cmd)
|
||||
(org-defkey org-agenda-mode-map ";" 'org-agenda-query-or-cmd)
|
||||
(org-defkey org-agenda-mode-map "\\" 'org-agenda-query-not-cmd)
|
||||
|
||||
;;; Agenda interactive query manipulation
|
||||
|
||||
(defcustom org-agenda-query-selection-single-key t
|
||||
"Non-nil means query manipulation exits after first change.
|
||||
When nil, you have to press RET to exit it.
|
||||
During query selection, you can toggle this flag with `C-c'.
|
||||
This variable can also have the value `expert'. In this case, the window
|
||||
displaying the tags menu is not even shown, until you press C-c again."
|
||||
:group 'org-agenda
|
||||
:type '(choice
|
||||
(const :tag "No" nil)
|
||||
(const :tag "Yes" t)
|
||||
(const :tag "Expert" expert)))
|
||||
|
||||
(defun org-agenda-query-selection (current op table &optional todo-table)
|
||||
"Fast query manipulation with single keys.
|
||||
CURRENT is the current query string, OP is the initial
|
||||
operator (one of \"+|-=\"), TABLE is an alist of tags and
|
||||
corresponding keys, possibly with grouping information.
|
||||
TODO-TABLE is a similar table with TODO keywords, should these
|
||||
have keys assigned to them. If the keys are nil, a-z are
|
||||
automatically assigned. Returns the new query string, or nil to
|
||||
not change the current one."
|
||||
(let* ((fulltable (append table todo-table))
|
||||
(maxlen (apply 'max (mapcar
|
||||
(lambda (x)
|
||||
(if (stringp (car x)) (string-width (car x)) 0))
|
||||
fulltable)))
|
||||
(fwidth (+ maxlen 3 1 3))
|
||||
(ncol (/ (- (window-width) 4) fwidth))
|
||||
(expert (eq org-agenda-query-selection-single-key 'expert))
|
||||
(exit-after-next org-agenda-query-selection-single-key)
|
||||
(done-keywords org-done-keywords)
|
||||
tbl char cnt e groups ingroup
|
||||
tg c2 c c1 ntable rtn)
|
||||
(save-window-excursion
|
||||
(if expert
|
||||
(set-buffer (get-buffer-create " *Org tags*"))
|
||||
(delete-other-windows)
|
||||
(split-window-vertically)
|
||||
(org-switch-to-buffer-other-window (get-buffer-create " *Org tags*")))
|
||||
(erase-buffer)
|
||||
(setq-local org-done-keywords done-keywords)
|
||||
(insert "Query: " current "\n")
|
||||
(org-agenda-query-op-line op)
|
||||
(insert "\n\n")
|
||||
(org-fast-tag-show-exit exit-after-next)
|
||||
(setq tbl fulltable char ?a cnt 0)
|
||||
(while (setq e (pop tbl))
|
||||
(cond
|
||||
((equal e '(:startgroup))
|
||||
(push '() groups) (setq ingroup t)
|
||||
(when (not (= cnt 0))
|
||||
(setq cnt 0)
|
||||
(insert "\n"))
|
||||
(insert "{ "))
|
||||
((equal e '(:endgroup))
|
||||
(setq ingroup nil cnt 0)
|
||||
(insert "}\n"))
|
||||
(t
|
||||
(setq tg (car e) c2 nil)
|
||||
(if (cdr e)
|
||||
(setq c (cdr e))
|
||||
;; automatically assign a character.
|
||||
(setq c1 (string-to-char
|
||||
(downcase (substring
|
||||
tg (if (= (string-to-char tg) ?@) 1 0)))))
|
||||
(if (or (rassoc c1 ntable) (rassoc c1 table))
|
||||
(while (or (rassoc char ntable) (rassoc char table))
|
||||
(setq char (1+ char)))
|
||||
(setq c2 c1))
|
||||
(setq c (or c2 char)))
|
||||
(if ingroup (push tg (car groups)))
|
||||
(setq tg (org-add-props tg nil 'face
|
||||
(cond
|
||||
((not (assoc tg table))
|
||||
(org-get-todo-face tg))
|
||||
(t nil))))
|
||||
(if (and (= cnt 0) (not ingroup)) (insert " "))
|
||||
(insert "[" c "] " tg (make-string
|
||||
(- fwidth 4 (length tg)) ?\ ))
|
||||
(push (cons tg c) ntable)
|
||||
(when (= (setq cnt (1+ cnt)) ncol)
|
||||
(insert "\n")
|
||||
(if ingroup (insert " "))
|
||||
(setq cnt 0)))))
|
||||
(setq ntable (nreverse ntable))
|
||||
(insert "\n")
|
||||
(goto-char (point-min))
|
||||
(if (and (not expert) (fboundp 'fit-window-to-buffer))
|
||||
(fit-window-to-buffer))
|
||||
(setq rtn
|
||||
(catch 'exit
|
||||
(while t
|
||||
(message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free%s%s"
|
||||
(if groups " [!] no groups" " [!]groups")
|
||||
(if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi")))
|
||||
(setq c (let ((inhibit-quit t)) (read-char-exclusive)))
|
||||
(cond
|
||||
((= c ?\r) (throw 'exit t))
|
||||
((= c ?!)
|
||||
(setq groups (not groups))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "[{}]" nil t) (replace-match " ")))
|
||||
((= c ?\C-c)
|
||||
(if (not expert)
|
||||
(org-fast-tag-show-exit
|
||||
(setq exit-after-next (not exit-after-next)))
|
||||
(setq expert nil)
|
||||
(delete-other-windows)
|
||||
(split-window-vertically)
|
||||
(org-switch-to-buffer-other-window " *Org tags*")
|
||||
(and (fboundp 'fit-window-to-buffer)
|
||||
(fit-window-to-buffer))))
|
||||
((or (= c ?\C-g)
|
||||
(and (= c ?q) (not (rassoc c ntable))))
|
||||
(setq quit-flag t))
|
||||
((= c ?\ )
|
||||
(setq current "")
|
||||
(if exit-after-next (setq exit-after-next 'now)))
|
||||
((= c ?\[) ; clear left
|
||||
(org-agenda-query-decompose current)
|
||||
(setq current (concat "/" (match-string 2 current)))
|
||||
(if exit-after-next (setq exit-after-next 'now)))
|
||||
((= c ?\]) ; clear right
|
||||
(org-agenda-query-decompose current)
|
||||
(setq current (match-string 1 current))
|
||||
(if exit-after-next (setq exit-after-next 'now)))
|
||||
((= c ?\t)
|
||||
(condition-case nil
|
||||
(setq current (read-string "Query: " current))
|
||||
(quit))
|
||||
(if exit-after-next (setq exit-after-next 'now)))
|
||||
;; operators
|
||||
((or (= c ?/) (= c ?+)) (setq op "+"))
|
||||
((or (= c ?\;) (= c ?|)) (setq op "|"))
|
||||
((or (= c ?\\) (= c ?-)) (setq op "-"))
|
||||
((= c ?=) (setq op "="))
|
||||
;; todos
|
||||
((setq e (rassoc c todo-table) tg (car e))
|
||||
(setq current (org-agenda-query-manip
|
||||
current op groups 'todo tg))
|
||||
(if exit-after-next (setq exit-after-next 'now)))
|
||||
;; tags
|
||||
((setq e (rassoc c ntable) tg (car e))
|
||||
(setq current (org-agenda-query-manip
|
||||
current op groups 'tag tg))
|
||||
(if exit-after-next (setq exit-after-next 'now))))
|
||||
(if (eq exit-after-next 'now) (throw 'exit t))
|
||||
(goto-char (point-min))
|
||||
(beginning-of-line 1)
|
||||
(delete-region (point) (point-at-eol))
|
||||
(insert "Query: " current)
|
||||
(beginning-of-line 2)
|
||||
(delete-region (point) (point-at-eol))
|
||||
(org-agenda-query-op-line op)
|
||||
(goto-char (point-min)))))
|
||||
(if rtn current nil))))
|
||||
|
||||
(defun org-agenda-query-op-line (op)
|
||||
(insert "Operator: "
|
||||
(org-agenda-query-op-entry (equal op "+") "/+" "and")
|
||||
(org-agenda-query-op-entry (equal op "|") ";|" "or")
|
||||
(org-agenda-query-op-entry (equal op "-") "\\-" "not")
|
||||
(org-agenda-query-op-entry (equal op "=") "=" "clear")))
|
||||
|
||||
(defun org-agenda-query-op-entry (matchp chars str)
|
||||
(if matchp
|
||||
(org-add-props (format "[%s %s] " chars (upcase str))
|
||||
nil 'face 'org-todo)
|
||||
(format "[%s]%s " chars str)))
|
||||
|
||||
(defun org-agenda-query-decompose (current)
|
||||
(string-match "\\([^/]*\\)/?\\(.*\\)" current))
|
||||
|
||||
(defun org-agenda-query-clear (current prefix tag)
|
||||
(if (string-match (concat prefix "\\b" (regexp-quote tag) "\\b") current)
|
||||
(replace-match "" t t current)
|
||||
current))
|
||||
|
||||
(defun org-agenda-query-manip (current op groups kind tag)
|
||||
"Apply an operator to a query string and a tag.
|
||||
CURRENT is the current query string, OP is the operator, GROUPS is a
|
||||
list of lists of tags that are mutually exclusive. KIND is 'tag for a
|
||||
regular tag, or 'todo for a TODO keyword, and TAG is the tag or
|
||||
keyword string."
|
||||
;; If this tag is already in query string, remove it.
|
||||
(setq current (org-agenda-query-clear current "[-\\+&|]?" tag))
|
||||
(if (equal op "=") current
|
||||
;; When using AND, also remove mutually exclusive tags.
|
||||
(if (equal op "+")
|
||||
(loop for g in groups do
|
||||
(if (member tag g)
|
||||
(mapc (lambda (x)
|
||||
(setq current
|
||||
(org-agenda-query-clear current "\\+" x)))
|
||||
g))))
|
||||
;; Decompose current query into q1 (tags) and q2 (TODOs).
|
||||
(org-agenda-query-decompose current)
|
||||
(let* ((q1 (match-string 1 current))
|
||||
(q2 (match-string 2 current)))
|
||||
(cond
|
||||
((eq kind 'tag)
|
||||
(concat q1 op tag "/" q2))
|
||||
;; It's a TODO; when using AND, drop all other TODOs.
|
||||
((equal op "+")
|
||||
(concat q1 "/+" tag))
|
||||
(t
|
||||
(concat q1 "/" q2 op tag))))))
|
||||
|
||||
(defun org-agenda-query-global-todo-keys (&optional files)
|
||||
"Return alist of all TODO keywords and their fast keys, in all FILES."
|
||||
(let (alist)
|
||||
(unless (and files (car files))
|
||||
(setq files (org-agenda-files)))
|
||||
(save-excursion
|
||||
(loop for f in files do
|
||||
(set-buffer (find-file-noselect f))
|
||||
(loop for k in org-todo-key-alist do
|
||||
(setq alist (org-agenda-query-merge-todo-key
|
||||
alist k)))))
|
||||
alist))
|
||||
|
||||
(defun org-agenda-query-merge-todo-key (alist entry)
|
||||
(let (e)
|
||||
(cond
|
||||
;; if this is not a keyword (:startgroup, etc), ignore it
|
||||
((not (stringp (car entry))))
|
||||
;; if keyword already exists, replace char if it's null
|
||||
((setq e (assoc (car entry) alist))
|
||||
(when (null (cdr e)) (setcdr e (cdr entry))))
|
||||
;; if char already exists, prepend keyword but drop char
|
||||
((rassoc (cdr entry) alist)
|
||||
(message "TRACE POSITION 2")
|
||||
(setq alist (cons (cons (car entry) nil) alist)))
|
||||
;; else, prepend COPY of entry
|
||||
(t
|
||||
(setq alist (cons (cons (car entry) (cdr entry)) alist)))))
|
||||
alist)
|
||||
|
||||
(defun org-agenda-query-generic-cmd (op)
|
||||
"Activate query manipulation with OP as initial operator."
|
||||
(let ((q (org-agenda-query-selection org-agenda-query-string op
|
||||
org-tag-alist
|
||||
(org-agenda-query-global-todo-keys))))
|
||||
(when q
|
||||
(setq org-agenda-query-string q)
|
||||
(org-agenda-redo))))
|
||||
|
||||
(defun org-agenda-query-clear-cmd ()
|
||||
"Activate query manipulation, to clear a tag from the string."
|
||||
(interactive)
|
||||
(org-agenda-query-generic-cmd "="))
|
||||
|
||||
(defun org-agenda-query-and-cmd ()
|
||||
"Activate query manipulation, initially using the AND (+) operator."
|
||||
(interactive)
|
||||
(org-agenda-query-generic-cmd "+"))
|
||||
|
||||
(defun org-agenda-query-or-cmd ()
|
||||
"Activate query manipulation, initially using the OR (|) operator."
|
||||
(interactive)
|
||||
(org-agenda-query-generic-cmd "|"))
|
||||
|
||||
(defun org-agenda-query-not-cmd ()
|
||||
"Activate query manipulation, initially using the NOT (-) operator."
|
||||
(interactive)
|
||||
(org-agenda-query-generic-cmd "-"))
|
||||
|
||||
(provide 'org-interactive-query)
|
||||
397
lisp/org-contrib/org-invoice.el
Normal file
397
lisp/org-contrib/org-invoice.el
Normal file
@@ -0,0 +1,397 @@
|
||||
;;; org-invoice.el --- Help manage client invoices in OrgMode
|
||||
;;
|
||||
;; Copyright (C) 2008-2014, 2021 pmade inc. (Peter Jones pjones@pmade.com)
|
||||
;;
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; This program is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; Building on top of the terrific OrgMode, org-invoice tries to
|
||||
;; provide functionality for managing invoices. Currently, it does
|
||||
;; this by implementing an OrgMode dynamic block where invoice
|
||||
;; information is aggregated so that it can be exported.
|
||||
;;
|
||||
;; It also provides a library of functions that can be used to collect
|
||||
;; this invoice information and use it in other ways, such as
|
||||
;; submitting it to on-line invoicing tools.
|
||||
;;
|
||||
;; I'm already working on an elisp package to submit this invoice data
|
||||
;; to the FreshBooks on-line accounting tool.
|
||||
;;
|
||||
;; Usage:
|
||||
;;
|
||||
;; In your ~/.emacs:
|
||||
;; (autoload 'org-invoice-report "org-invoice")
|
||||
;; (autoload 'org-dblock-write:invoice "org-invoice")
|
||||
;;
|
||||
;; See the documentation in the following functions:
|
||||
;;
|
||||
;; `org-invoice-report'
|
||||
;; `org-dblock-write:invoice'
|
||||
;;
|
||||
;; Latest version:
|
||||
;;
|
||||
;; git clone git://pmade.com/elisp
|
||||
(eval-when-compile
|
||||
(require 'cl)
|
||||
(require 'org))
|
||||
|
||||
(declare-function org-duration-from-minutes "org-duration" (minutes &optional fmt fractional))
|
||||
|
||||
(defgroup org-invoice nil
|
||||
"OrgMode Invoice Helper"
|
||||
:tag "Org-Invoice" :group 'org)
|
||||
|
||||
(defcustom org-invoice-long-date-format "%A, %B %d, %Y"
|
||||
"The format string for long dates."
|
||||
:type 'string :group 'org-invoice)
|
||||
|
||||
(defcustom org-invoice-strip-ts t
|
||||
"Remove org timestamps that appear in headings."
|
||||
:type 'boolean :group 'org-invoice)
|
||||
|
||||
(defcustom org-invoice-default-level 2
|
||||
"The heading level at which a new invoice starts. This value
|
||||
is used if you don't specify a scope option to the invoice block,
|
||||
and when other invoice helpers are trying to find the heading
|
||||
that starts an invoice.
|
||||
|
||||
The default is 2, assuming that you structure your invoices so
|
||||
that they fall under a single heading like below:
|
||||
|
||||
* Invoices
|
||||
** This is invoice number 1...
|
||||
** This is invoice number 2...
|
||||
|
||||
If you don't structure your invoices using those conventions,
|
||||
change this setting to the number that corresponds to the heading
|
||||
at which an invoice begins."
|
||||
:type 'integer :group 'org-invoice)
|
||||
|
||||
(defcustom org-invoice-start-hook nil
|
||||
"Hook called when org-invoice is about to collect data from an
|
||||
invoice heading. When this hook is called, point will be on the
|
||||
heading where the invoice begins.
|
||||
|
||||
When called, `org-invoice-current-invoice' will be set to the
|
||||
alist that represents the info for this invoice."
|
||||
:type 'hook :group 'org-invoice)
|
||||
|
||||
(defcustom org-invoice-heading-hook nil
|
||||
"Hook called when org-invoice is collecting data from a
|
||||
heading. You can use this hook to add additional information to
|
||||
the alist that represents the heading.
|
||||
|
||||
When this hook is called, point will be on the current heading
|
||||
being processed, and `org-invoice-current-item' will contain the
|
||||
alist for the current heading.
|
||||
|
||||
This hook is called repeatedly for each invoice item processed."
|
||||
:type 'hook :group 'org-invoice)
|
||||
|
||||
(defvar org-invoice-current-invoice nil
|
||||
"Information about the current invoice.")
|
||||
|
||||
(defvar org-invoice-current-item nil
|
||||
"Information about the current invoice item.")
|
||||
|
||||
(defvar org-invoice-table-params nil
|
||||
"The table parameters currently being used.")
|
||||
|
||||
(defvar org-invoice-total-time nil
|
||||
"The total invoice time for the summary line.")
|
||||
|
||||
(defvar org-invoice-total-price nil
|
||||
"The total invoice price for the summary line.")
|
||||
|
||||
(defconst org-invoice-version "1.0.0"
|
||||
"The org-invoice version number.")
|
||||
|
||||
(defun org-invoice-goto-tree (&optional tree)
|
||||
"Move point to the heading that represents the head of the
|
||||
current invoice. The heading level will be taken from
|
||||
`org-invoice-default-level' unless tree is set to a string that
|
||||
looks like tree2, where the level is 2."
|
||||
(let ((level org-invoice-default-level))
|
||||
(save-match-data
|
||||
(when (and tree (string-match "^tree\\([0-9]+\\)$" tree))
|
||||
(setq level (string-to-number (match-string 1 tree)))))
|
||||
(org-back-to-heading)
|
||||
(while (and (> (org-reduced-level (org-outline-level)) level)
|
||||
(org-up-heading-safe)))))
|
||||
|
||||
(defun org-invoice-heading-info ()
|
||||
"Return invoice information from the current heading."
|
||||
(let ((title (org-no-properties (org-get-heading t)))
|
||||
(date (org-entry-get nil "TIMESTAMP" 'selective))
|
||||
(work (org-entry-get nil "WORK" nil))
|
||||
(rate (or (org-entry-get nil "RATE" t) "0"))
|
||||
(level (org-outline-level))
|
||||
raw-date long-date)
|
||||
(unless date (setq date (org-entry-get nil "TIMESTAMP_IA" 'selective)))
|
||||
(unless date (setq date (org-entry-get nil "TIMESTAMP" t)))
|
||||
(unless date (setq date (org-entry-get nil "TIMESTAMP_IA" t)))
|
||||
(unless work (setq work (org-entry-get nil "CLOCKSUM" nil)))
|
||||
(unless work (setq work "00:00"))
|
||||
(when date
|
||||
(setq raw-date (apply 'encode-time (org-parse-time-string date)))
|
||||
(setq long-date (format-time-string org-invoice-long-date-format raw-date)))
|
||||
(when (and org-invoice-strip-ts (string-match org-ts-regexp-both title))
|
||||
(setq title (replace-match "" nil nil title)))
|
||||
(when (string-match "^[ \t]+" title)
|
||||
(setq title (replace-match "" nil nil title)))
|
||||
(when (string-match "[ \t]+$" title)
|
||||
(setq title (replace-match "" nil nil title)))
|
||||
(setq work (org-duration-to-minutes work))
|
||||
(setq rate (string-to-number rate))
|
||||
(setq org-invoice-current-item (list (cons 'title title)
|
||||
(cons 'date date)
|
||||
(cons 'raw-date raw-date)
|
||||
(cons 'long-date long-date)
|
||||
(cons 'work work)
|
||||
(cons 'rate rate)
|
||||
(cons 'level level)
|
||||
(cons 'price (* rate (/ work 60.0)))))
|
||||
(run-hook-with-args 'org-invoice-heading-hook)
|
||||
org-invoice-current-item))
|
||||
|
||||
(defun org-invoice-level-min-max (ls)
|
||||
"Return a list where the car is the min level, and the cdr the max."
|
||||
(let ((max 0) min level)
|
||||
(dolist (info ls)
|
||||
(when (cdr (assq 'date info))
|
||||
(setq level (cdr (assq 'level info)))
|
||||
(when (or (not min) (< level min)) (setq min level))
|
||||
(when (> level max) (setq max level))))
|
||||
(cons (or min 0) max)))
|
||||
|
||||
(defun org-invoice-collapse-list (ls)
|
||||
"Reorganize the given list by dates."
|
||||
(let ((min-max (org-invoice-level-min-max ls)) new)
|
||||
(dolist (info ls)
|
||||
(let* ((date (cdr (assq 'date info)))
|
||||
(work (cdr (assq 'work info)))
|
||||
(price (cdr (assq 'price info)))
|
||||
(long-date (cdr (assq 'long-date info)))
|
||||
(level (cdr (assq 'level info)))
|
||||
(bucket (cdr (assoc date new))))
|
||||
(if (and (/= (car min-max) (cdr min-max))
|
||||
(= (car min-max) level)
|
||||
(= work 0) (not bucket) date)
|
||||
(progn
|
||||
(setq info (assq-delete-all 'work info))
|
||||
(push (cons 'total-work 0) info)
|
||||
(push (cons date (list info)) new)
|
||||
(setq bucket (cdr (assoc date new))))
|
||||
(when (and date (not bucket))
|
||||
(setq bucket (list (list (cons 'date date)
|
||||
(cons 'title long-date)
|
||||
(cons 'total-work 0)
|
||||
(cons 'price 0))))
|
||||
(push (cons date bucket) new)
|
||||
(setq bucket (cdr (assoc date new))))
|
||||
(when (and date bucket)
|
||||
(setcdr (assq 'total-work (car bucket))
|
||||
(+ work (cdr (assq 'total-work (car bucket)))))
|
||||
(setcdr (assq 'price (car bucket))
|
||||
(+ price (cdr (assq 'price (car bucket)))))
|
||||
(nconc bucket (list info))))))
|
||||
(nreverse new)))
|
||||
|
||||
(defun org-invoice-info-to-table (info)
|
||||
"Create a single org table row from the given info alist."
|
||||
(let ((title (cdr (assq 'title info)))
|
||||
(total (cdr (assq 'total-work info)))
|
||||
(work (cdr (assq 'work info)))
|
||||
(price (cdr (assq 'price info)))
|
||||
(with-price (plist-get org-invoice-table-params :price)))
|
||||
(unless total
|
||||
(setq
|
||||
org-invoice-total-time (+ org-invoice-total-time work)
|
||||
org-invoice-total-price (+ org-invoice-total-price price)))
|
||||
(setq total (and total (org-duration-from-minutes total)))
|
||||
(setq work (and work (org-duration-from-minutes work)))
|
||||
(insert-before-markers
|
||||
(concat "|" title
|
||||
(cond
|
||||
(total (concat "|" total))
|
||||
(work (concat "|" work)))
|
||||
(and with-price price (concat "|" (format "%.2f" price)))
|
||||
"|" "\n"))))
|
||||
|
||||
(defun org-invoice-list-to-table (ls)
|
||||
"Convert a list of heading info to an org table"
|
||||
(let ((with-price (plist-get org-invoice-table-params :price))
|
||||
(with-summary (plist-get org-invoice-table-params :summary))
|
||||
(with-header (plist-get org-invoice-table-params :headers))
|
||||
(org-invoice-total-time 0)
|
||||
(org-invoice-total-price 0))
|
||||
(insert-before-markers
|
||||
(concat "| Task / Date | Time" (and with-price "| Price") "|\n"))
|
||||
(dolist (info ls)
|
||||
(insert-before-markers "|-\n")
|
||||
(mapc 'org-invoice-info-to-table (if with-header (cdr info) (cdr (cdr info)))))
|
||||
(when with-summary
|
||||
(insert-before-markers
|
||||
(concat "|-\n|Total:|"
|
||||
(org-duration-from-minutes org-invoice-total-time)
|
||||
(and with-price (concat "|" (format "%.2f" org-invoice-total-price)))
|
||||
"|\n")))))
|
||||
|
||||
(defun org-invoice-collect-invoice-data ()
|
||||
"Collect all the invoice data from the current OrgMode tree and
|
||||
return it. Before you call this function, move point to the
|
||||
heading that begins the invoice data, usually using the
|
||||
`org-invoice-goto-tree' function."
|
||||
(let ((org-invoice-current-invoice
|
||||
(list (cons 'point (point)) (cons 'buffer (current-buffer))))
|
||||
(org-invoice-current-item nil))
|
||||
(save-restriction
|
||||
(org-narrow-to-subtree)
|
||||
(org-clock-sum)
|
||||
(run-hook-with-args 'org-invoice-start-hook)
|
||||
(cons org-invoice-current-invoice
|
||||
(org-invoice-collapse-list
|
||||
(org-map-entries 'org-invoice-heading-info t 'tree 'archive))))))
|
||||
|
||||
(defun org-dblock-write:invoice (params)
|
||||
"Function called by OrgMode to write the invoice dblock. To
|
||||
create an invoice dblock you can use the `org-invoice-report'
|
||||
function.
|
||||
|
||||
The following parameters can be given to the invoice block (for
|
||||
information about dblock parameters, please see the Org manual):
|
||||
|
||||
:scope Allows you to override the `org-invoice-default-level'
|
||||
variable. The only supported values right now are ones
|
||||
that look like :tree1, :tree2, etc.
|
||||
|
||||
:prices Set to nil to turn off the price column.
|
||||
|
||||
:headers Set to nil to turn off the group headers.
|
||||
|
||||
:summary Set to nil to turn off the final summary line."
|
||||
(let ((scope (plist-get params :scope))
|
||||
(org-invoice-table-params params)
|
||||
(zone (point-marker))
|
||||
table)
|
||||
(unless scope (setq scope 'default))
|
||||
(unless (plist-member params :price) (plist-put params :price t))
|
||||
(unless (plist-member params :summary) (plist-put params :summary t))
|
||||
(unless (plist-member params :headers) (plist-put params :headers t))
|
||||
(save-excursion
|
||||
(cond
|
||||
((eq scope 'tree) (org-invoice-goto-tree "tree1"))
|
||||
((eq scope 'default) (org-invoice-goto-tree))
|
||||
((symbolp scope) (org-invoice-goto-tree (symbol-name scope))))
|
||||
(setq table (org-invoice-collect-invoice-data))
|
||||
(goto-char zone)
|
||||
(org-invoice-list-to-table (cdr table))
|
||||
(goto-char zone)
|
||||
(org-table-align)
|
||||
(move-marker zone nil))))
|
||||
|
||||
(defun org-invoice-in-report-p ()
|
||||
"Check to see if point is inside an invoice report."
|
||||
(let ((pos (point)) start)
|
||||
(save-excursion
|
||||
(end-of-line 1)
|
||||
(and (re-search-backward "^#\\+BEGIN:[ \t]+invoice" nil t)
|
||||
(setq start (match-beginning 0))
|
||||
(re-search-forward "^#\\+END:.*" nil t)
|
||||
(>= (match-end 0) pos)
|
||||
start))))
|
||||
|
||||
(defun org-invoice-report (&optional jump)
|
||||
"Create or update an invoice dblock report. If point is inside
|
||||
an existing invoice report, the report is updated. If point
|
||||
isn't inside an invoice report, a new report is created.
|
||||
|
||||
When called with a prefix argument, move to the first invoice
|
||||
report after point and update it.
|
||||
|
||||
For information about various settings for the invoice report,
|
||||
see the `org-dblock-write:invoice' function documentation.
|
||||
|
||||
An invoice report is created by reading a heading tree and
|
||||
collecting information from various properties. It is assumed
|
||||
that all invoices start at a second level heading, but this can
|
||||
be configured using the `org-invoice-default-level' variable.
|
||||
|
||||
Here is an example, where all invoices fall under the first-level
|
||||
heading Invoices:
|
||||
|
||||
* Invoices
|
||||
** Client Foo (Jan 01 - Jan 15)
|
||||
*** [2008-01-01 Tue] Built New Server for Production
|
||||
*** [2008-01-02 Wed] Meeting with Team to Design New System
|
||||
** Client Bar (Jan 01 - Jan 15)
|
||||
*** [2008-01-01 Tue] Searched for Widgets on Google
|
||||
*** [2008-01-02 Wed] Billed You for Taking a Nap
|
||||
|
||||
In this layout, invoices begin at level two, and invoice
|
||||
items (tasks) are at level three. You'll notice that each level
|
||||
three heading starts with an inactive timestamp. The timestamp
|
||||
can actually go anywhere you want, either in the heading, or in
|
||||
the text under the heading. But you must have a timestamp
|
||||
somewhere so that the invoice report can group your items by
|
||||
date.
|
||||
|
||||
Properties are used to collect various bits of information for
|
||||
the invoice. All properties can be set on the invoice item
|
||||
headings, or anywhere in the tree. The invoice report will scan
|
||||
up the tree looking for each of the properties.
|
||||
|
||||
Properties used:
|
||||
|
||||
CLOCKSUM: You can use the Org clock-in and clock-out commands to
|
||||
create a CLOCKSUM property. Also see WORK.
|
||||
|
||||
WORK: An alternative to the CLOCKSUM property. This property
|
||||
should contain the amount of work that went into this
|
||||
invoice item formatted as HH:MM (e.g. 01:30).
|
||||
|
||||
RATE: Used to calculate the total price for an invoice item.
|
||||
Should be the price per hour that you charge (e.g. 45.00).
|
||||
It might make more sense to place this property higher in
|
||||
the hierarchy than on the invoice item headings.
|
||||
|
||||
Using this information, a report is generated that details the
|
||||
items grouped by days. For each day you will be able to see the
|
||||
total number of hours worked, the total price, and the items
|
||||
worked on.
|
||||
|
||||
You can place the invoice report anywhere in the tree you want.
|
||||
I place mine under a third-level heading like so:
|
||||
|
||||
* Invoices
|
||||
** An Invoice Header
|
||||
*** [2008-11-25 Tue] An Invoice Item
|
||||
*** Invoice Report
|
||||
#+BEGIN: invoice
|
||||
#+END:"
|
||||
(interactive "P")
|
||||
(let ((report (org-invoice-in-report-p)))
|
||||
(when (and (not report) jump)
|
||||
(when (re-search-forward "^#\\+BEGIN:[ \t]+invoice" nil t)
|
||||
(org-show-entry)
|
||||
(beginning-of-line)
|
||||
(setq report (point))))
|
||||
(if report (goto-char report)
|
||||
(org-create-dblock (list :name "invoice")))
|
||||
(org-update-dblock)))
|
||||
|
||||
(provide 'org-invoice)
|
||||
177
lisp/org-contrib/org-learn.el
Normal file
177
lisp/org-contrib/org-learn.el
Normal file
@@ -0,0 +1,177 @@
|
||||
;;; org-learn.el --- Implements SuperMemo's incremental learning algorithm
|
||||
|
||||
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: John Wiegley <johnw at gnu dot org>
|
||||
;; Keywords: outlines, hypermedia, calendar, wp
|
||||
;; Homepage: https://orgmode.org
|
||||
;; Version: 6.32trans
|
||||
;;
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; This program is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;;; Commentary:
|
||||
|
||||
;; The file implements the learning algorithm described at
|
||||
;; https://supermemo.com/english/ol/sm5.htm, which is a system for reading
|
||||
;; material according to "spaced repetition". See
|
||||
;; https://en.wikipedia.org/wiki/Spaced_repetition for more details.
|
||||
;;
|
||||
;; To use, turn on state logging and schedule some piece of information you
|
||||
;; want to read. Then in the agenda buffer type
|
||||
|
||||
(require 'org)
|
||||
(eval-when-compile
|
||||
(require 'cl))
|
||||
|
||||
(defgroup org-learn nil
|
||||
"Options concerning the learning code in Org-mode."
|
||||
:tag "Org Learn"
|
||||
:group 'org-progress)
|
||||
|
||||
(defcustom org-learn-always-reschedule nil
|
||||
"If non-nil, always reschedule items, even if retention was \"perfect\"."
|
||||
:type 'boolean
|
||||
:group 'org-learn)
|
||||
|
||||
(defcustom org-learn-fraction 0.5
|
||||
"Controls the rate at which EF is increased or decreased.
|
||||
Must be a number between 0 and 1 (the greater it is the faster
|
||||
the changes of the OF matrix)."
|
||||
:type 'float
|
||||
:group 'org-learn)
|
||||
|
||||
(defun initial-optimal-factor (n ef)
|
||||
(if (= 1 n)
|
||||
4
|
||||
ef))
|
||||
|
||||
(defun get-optimal-factor (n ef of-matrix)
|
||||
(let ((factors (assoc n of-matrix)))
|
||||
(or (and factors
|
||||
(let ((ef-of (assoc ef (cdr factors))))
|
||||
(and ef-of (cdr ef-of))))
|
||||
(initial-optimal-factor n ef))))
|
||||
|
||||
(defun set-optimal-factor (n ef of-matrix of)
|
||||
(let ((factors (assoc n of-matrix)))
|
||||
(if factors
|
||||
(let ((ef-of (assoc ef (cdr factors))))
|
||||
(if ef-of
|
||||
(setcdr ef-of of)
|
||||
(push (cons ef of) (cdr factors))))
|
||||
(push (cons n (list (cons ef of))) of-matrix)))
|
||||
of-matrix)
|
||||
|
||||
(defun inter-repetition-interval (n ef &optional of-matrix)
|
||||
(let ((of (get-optimal-factor n ef of-matrix)))
|
||||
(if (= 1 n)
|
||||
of
|
||||
(* of (inter-repetition-interval (1- n) ef of-matrix)))))
|
||||
|
||||
(defun modify-e-factor (ef quality)
|
||||
(if (< ef 1.3)
|
||||
1.3
|
||||
(+ ef (- 0.1 (* (- 5 quality) (+ 0.08 (* (- 5 quality) 0.02)))))))
|
||||
|
||||
(defun modify-of (of q fraction)
|
||||
(let ((temp (* of (+ 0.72 (* q 0.07)))))
|
||||
(+ (* (- 1 fraction) of) (* fraction temp))))
|
||||
|
||||
(defun calculate-new-optimal-factor (interval-used quality used-of
|
||||
old-of fraction)
|
||||
"This implements the SM-5 learning algorithm in Lisp.
|
||||
INTERVAL-USED is the last interval used for the item in question.
|
||||
QUALITY is the quality of the repetition response.
|
||||
USED-OF is the optimal factor used in calculation of the last
|
||||
interval used for the item in question.
|
||||
OLD-OF is the previous value of the OF entry corresponding to the
|
||||
relevant repetition number and the E-Factor of the item.
|
||||
FRACTION is a number belonging to the range (0,1) determining the
|
||||
rate of modifications (the greater it is the faster the changes
|
||||
of the OF matrix).
|
||||
|
||||
Returns the newly calculated value of the considered entry of the
|
||||
OF matrix."
|
||||
(let (;; the value proposed for the modifier in case of q=5
|
||||
(mod5 (/ (1+ interval-used) interval-used))
|
||||
;; the value proposed for the modifier in case of q=2
|
||||
(mod2 (/ (1- interval-used) interval-used))
|
||||
;; the number determining how many times the OF value will
|
||||
;; increase or decrease
|
||||
modifier)
|
||||
(if (< mod5 1.05)
|
||||
(setq mod5 1.05))
|
||||
(if (< mod2 0.75)
|
||||
(setq mod5 0.75))
|
||||
(if (> quality 4)
|
||||
(setq modifier (1+ (* (- mod5 1) (- quality 4))))
|
||||
(setq modifier (- 1 (* (/ (- 1 mod2) 2) (- 4 quality)))))
|
||||
(if (< modifier 0.05)
|
||||
(setq modifier 0.05))
|
||||
(setq new-of (* used-of modifier))
|
||||
(if (> quality 4)
|
||||
(if (< new-of old-of)
|
||||
(setq new-of old-of)))
|
||||
(if (< quality 4)
|
||||
(if (> new-of old-of)
|
||||
(setq new-of old-of)))
|
||||
(setq new-of (+ (* new-of fraction) (* old-of (- 1 fraction))))
|
||||
(if (< new-of 1.2)
|
||||
(setq new-of 1.2)
|
||||
new-of)))
|
||||
|
||||
(defvar initial-repetition-state '(-1 1 2.5 nil))
|
||||
|
||||
(defun determine-next-interval (n ef quality of-matrix)
|
||||
(assert (> n 0))
|
||||
(assert (and (>= quality 0) (<= quality 5)))
|
||||
(if (< quality 3)
|
||||
(list (inter-repetition-interval n ef) (1+ n) ef nil)
|
||||
(let ((next-ef (modify-e-factor ef quality)))
|
||||
(setq of-matrix
|
||||
(set-optimal-factor n next-ef of-matrix
|
||||
(modify-of (get-optimal-factor n ef of-matrix)
|
||||
quality org-learn-fraction))
|
||||
ef next-ef)
|
||||
;; For a zero-based quality of 4 or 5, don't repeat
|
||||
(if (and (>= quality 4)
|
||||
(not org-learn-always-reschedule))
|
||||
(list 0 (1+ n) ef of-matrix)
|
||||
(list (inter-repetition-interval n ef of-matrix) (1+ n)
|
||||
ef of-matrix)))))
|
||||
|
||||
(defun org-smart-reschedule (quality)
|
||||
(interactive "nHow well did you remember the information (on a scale of 0-5)? ")
|
||||
(let* ((learn-str (org-entry-get (point) "LEARN_DATA"))
|
||||
(learn-data (or (and learn-str
|
||||
(read learn-str))
|
||||
(copy-list initial-repetition-state)))
|
||||
closed-dates)
|
||||
(setq learn-data
|
||||
(determine-next-interval (nth 1 learn-data)
|
||||
(nth 2 learn-data)
|
||||
quality
|
||||
(nth 3 learn-data)))
|
||||
(org-entry-put (point) "LEARN_DATA" (prin1-to-string learn-data))
|
||||
(if (= 0 (nth 0 learn-data))
|
||||
(org-schedule t)
|
||||
(org-schedule nil (time-add (current-time)
|
||||
(days-to-time (nth 0 learn-data)))))))
|
||||
|
||||
(provide 'org-learn)
|
||||
|
||||
;;; org-learn.el ends here
|
||||
540
lisp/org-contrib/org-license.el
Normal file
540
lisp/org-contrib/org-license.el
Normal file
@@ -0,0 +1,540 @@
|
||||
;;; org-license.el --- Add a license to your org files
|
||||
|
||||
;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: David Arroyo Menéndez <davidam@es.gnu.org>
|
||||
;; Keywords: licenses, creative commons
|
||||
;; Homepage: https://orgmode.org
|
||||
;;
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;;; Commentary:
|
||||
|
||||
;; This file implements functions to add a license fast in org files.
|
||||
;; Org-mode doesn't load this module by default - if this is not what
|
||||
;; you want, configure the variable `org-modules'. Thanks to #emacs-es
|
||||
;; irc channel for your support.
|
||||
|
||||
;;; Code:
|
||||
|
||||
;;
|
||||
;;
|
||||
;; You can download the images from http://www.davidam/img/licenses.tar.gz
|
||||
;;
|
||||
;;; CHANGELOG:
|
||||
;; v 0.2 - add public domain functions
|
||||
;; v 0.1 - Initial release
|
||||
|
||||
|
||||
(defvar org-license-images-directory "")
|
||||
|
||||
(defun org-license-cc-by (language)
|
||||
(interactive "MLanguage ( br | ca | de | en | es | eo | eu | fi | fr | gl | it | jp | nl | pt ): " language)
|
||||
(cond ((equal language "br")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/br/deed.pt_BR")
|
||||
(insert (concat "* Licença
|
||||
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição 3.0 Brasil]]\n")))
|
||||
((equal language "ca")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/es/deed.ca")
|
||||
(insert (concat "* Licència
|
||||
El text està disponible sota la [[" org-license-cc-url "][Reconeixement 3.0 Espanya]]\n")))
|
||||
((equal language "de")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/de/deed.de")
|
||||
(insert (concat "* Lizenz
|
||||
Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url "][Lizenz Creative Commons Namensnennung 3.0 Deutschland]]\n")))
|
||||
((equal language "eo")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/eo/deed.eo")
|
||||
(insert (concat "* Licenco
|
||||
Ĉi tiu verko estas disponebla laŭ la permesilo [[" org-license-cc-url "][Krea Komunaĵo Atribuite 3.0 Neadaptita]]\n")))
|
||||
((equal language "es")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/es/deed.es")
|
||||
(insert (concat "* Licencia
|
||||
Este documento está bajo una [[" org-license-cc-url "][Licencia Creative Commons Atribución 3.0 España]]\n")))
|
||||
((equal language "eu")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/es/deed.eu")
|
||||
(insert (concat "* Licenzua
|
||||
Testua [[" org-license-cc-url "][Aitortu 3.0 Espainia]] lizentziari jarraituz erabil daiteke\n")))
|
||||
((equal language "fi")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by/1.0/fi/deed.fi")
|
||||
(insert (concat "* Lisenssi
|
||||
Teksti on saatavilla [[" org-license-cc-url "][Nimeä 1.0 Suomi]] lisenssillä\n")))
|
||||
((equal language "fr")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/fr/deed.fr")
|
||||
(insert (concat "* Licence
|
||||
Ce(tte) œuvre est mise à disposition selon les termes de la [[" org-license-cc-url "][Licence Creative Commons Attribution 3.0 France]]\n")))
|
||||
((equal language "gl")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/es/deed.gl")
|
||||
(insert (concat "* Licenza
|
||||
Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza Creative Commons recoñecemento compartir igual 3.0]].\n")))
|
||||
((equal language "it")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/it/deed.it")
|
||||
(insert (concat "* Licenza
|
||||
Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza Creative Commons Attribuzione 3.0 Italia]]\n")))
|
||||
((equal language "jp")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by/2.1/jp/deed.en")
|
||||
(insert (concat "* ライセンス
|
||||
この文書は [[" org-license-cc-url "][Creative Commons Attribution 2.1 ]] ライセンスの下である\n")))
|
||||
((equal language "nl")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/nl/deed.nl")
|
||||
(insert (concat "* Licentie
|
||||
Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsvermelding 3.0 Nederland]]\n")))
|
||||
((equal language "pt")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/pt/deed.pt")
|
||||
(insert (concat "* Licença
|
||||
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição 3.0 Portugal]]\n")))
|
||||
(t
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by/4.0/deed")
|
||||
(concat (insert "* License
|
||||
This document is under a [[" org-license-cc-url "][Creative Commons Attribution 4.0 International]]\n"))))
|
||||
(if (string= "" org-license-images-directory)
|
||||
(insert (concat "\n[[" org-license-cc-url "][file:https://i.creativecommons.org/l/by/3.0/80x15.png]]\n"))
|
||||
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by/3.0/80x15.png]]\n"))))
|
||||
|
||||
(defun org-license-cc-by-sa (language)
|
||||
(interactive "MLanguage ( br | ca | de | en | es | eu | fi | fr | it | jp | nl | pt ): " language)
|
||||
(cond ((equal language "br")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/br/deed.pt_BR")
|
||||
(concat (insert "* Licença
|
||||
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Compartil ha Igual 3.0 Brasil]]\n")))
|
||||
((equal language "ca")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/es/deed.ca")
|
||||
(insert (concat "* Licència
|
||||
El text està disponible sota la [[" org-license-cc-url "][Reconeixement-CompartirIgual 3.0 Espanya]]\n")))
|
||||
((equal language "de")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/de/deed.de")
|
||||
(insert (concat "* Lizenz
|
||||
Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url "][Namensnennung - Weitergabe unter gleichen Bedingungen 3.0 Deutschland]]\n")))
|
||||
((equal language "es")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/es/deed.es")
|
||||
(concat (insert "* Licencia
|
||||
Este documento está bajo una [[" org-license-cc-url "][Licencia Creative Commons Atribución Compartir por Igual 3.0 España]]\n")))
|
||||
((equal language "eu")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/es/deed.eu")
|
||||
(concat (insert "* Licenzua
|
||||
Testua [[" org-license-cc-url "][Aitortu-PartekatuBerdin 3.0 Espainia]] lizentziari jarraituz erabil daiteke\n")))
|
||||
((equal language "fi")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/1.0/fi/deed.fi")
|
||||
(insert (concat "* Lisenssi
|
||||
Teksti on saatavilla [[" org-license-cc-url "][Nimeä-JaaSamoin 1.0 Suomi]] lisenssillä\n")))
|
||||
((equal language "fr")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/fr/deed.fr")
|
||||
(concat (insert "* Licence
|
||||
Ce(tte) œuvre est mise à disposition selon les termes de la [[" org-license-cc-url "][Licence Creative Commons Attribution - Partage dans les Mêmes Conditions 3.0 France]]\n")))
|
||||
((equal language "gl")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/es/deed.gl")
|
||||
(insert (concat "* Licenza
|
||||
Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza Creative Commons recoñecemento compartir igual 3.0]].\n")))
|
||||
((equal language "it")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/it/deed.it")
|
||||
(insert (concat "* Licenza
|
||||
Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza Creative Commons Attribuzione - Condividi allo stesso modo 3.0 Italia]]\n")))
|
||||
((equal language "jp")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/2.1/jp/deed.en")
|
||||
(insert (concat "* ライセンス
|
||||
この文書は、[[" org-license-cc-url "][Creative Commons Attribution 2.1 ]] ライセンスの下である\n")))
|
||||
((equal language "nl")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/nl/deed.nl")
|
||||
(insert (concat "* Licentie
|
||||
Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsvermelding Gelijk Delen 3.0 Nederland]]\n")))
|
||||
((equal language "pt")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/pt/deed.pt")
|
||||
(insert (concat "* Licença
|
||||
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição-CompartilhaIgual 3.0 Portugal]]\n")))
|
||||
(t
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/4.0/deed")
|
||||
(insert (concat "* License
|
||||
This document is under a [[" org-license-cc-url "][Creative Commons Attribution-ShareAlike 4.0 International]]\n"))))
|
||||
(if (string= "" org-license-images-directory)
|
||||
(insert (concat "\n[[" org-license-cc-url "][file:https://i.creativecommons.org/l/by-sa/3.0/80x15.png]]\n"))
|
||||
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-sa/3.0/80x15.png]]\n"))))
|
||||
|
||||
(defun org-license-cc-by-nd (language)
|
||||
(interactive "MLanguage ( br | ca | de | en | es | eu | fi | fr | it | pt ): " language)
|
||||
(cond ((equal language "br")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/br/deed.pt_BR")
|
||||
(insert (concat "* Licença
|
||||
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Compartil ha Igual 3.0 Brasil]]\n")))
|
||||
((equal language "ca")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/es/deed.ca")
|
||||
(insert (concat "* Licència
|
||||
El text està disponible sota la [[" org-license-cc-url "][Reconeixement-SenseObraDerivada 3.0 Espanya]]\n")))
|
||||
((equal language "de")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/de/deed.de")
|
||||
(insert (concat "* Lizenz
|
||||
Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url "][Namensnennung-Keine Bearbeitung 3.0 Deutschland]]\n")))
|
||||
((equal language "es")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/es/deed.es")
|
||||
(insert (concat "* Licencia
|
||||
Este documento está bajo una [[" org-license-cc-url "][Licencia Creative Commons Atribución-SinDerivadas 3.0]]\n")))
|
||||
((equal language "eu")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/es/deed.eu")
|
||||
(insert (concat "* Licenzua
|
||||
Testua [[" org-license-cc-url "][Aitortu-LanEratorririkGabe 3.0 Espainia]] lizentziari jarraituz erabil daiteke\n")))
|
||||
((equal language "fi")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/1.0/fi/deed.fi")
|
||||
(insert (concat "* Lisenssi
|
||||
Teksti on saatavilla [[" org-license-cc-url "][Nimeä-JaaSamoin 1.0 Suomi]] lisenssillä\n")))
|
||||
((equal language "fr")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/fr/deed.fr")
|
||||
(insert (concat "* Licence
|
||||
Ce(tte) œuvre est mise à disposition selon les termes de la [[" org-license-cc-url "][Licence Creative Commons Attribution - Pas de Modification 3.0 France]]\n")))
|
||||
((equal language "gl")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/es/deed.gl")
|
||||
(insert (concat "* Licenza
|
||||
Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza Creative Commons recoñecemento compartir igual 3.0]].\n")))
|
||||
((equal language "it")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/it/deed.it")
|
||||
(insert (concat "* Licenza
|
||||
Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza Creative Commons Attribuzione - Non opere derivate 3.0 Italia]]\n")))
|
||||
((equal language "jp")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/2.1/jp/deed.en")
|
||||
(insert (concat "* ライセンス
|
||||
この文書は、[[" org-license-cc-url "][Creative Commons No Derivatives 2.1]] ライセンスの下である\n")))
|
||||
((equal language "nl")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/nl/deed.nl")
|
||||
(insert (concat "* Licentie
|
||||
Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsvermelding GeenAfgeleideWerken 3.0 Nederland]]\n")))
|
||||
((equal language "pt")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/pt/deed.pt")
|
||||
(insert (concat "* Licença
|
||||
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Sem Derivados 3.0 Portugal]]\n")))
|
||||
(t
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/4.0/deed")
|
||||
(insert (concat "* License
|
||||
This document is under a [[" org-license-cc-url "][Creative Commons No Derivatives 4.0 International]]\n"))))
|
||||
(if (string= "" org-license-images-directory)
|
||||
(insert (concat "\n[[" org-license-cc-url "][file:https://i.creativecommons.org/l/by-nd/3.0/80x15.png]]\n"))
|
||||
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-nd/3.0/80x15.png]]\n"))))
|
||||
|
||||
|
||||
(defun org-license-cc-by-nc (language)
|
||||
(interactive "MLanguage ( br | ca | de | en | es | eu | fi | fr | it | jp | nl | pt ): " language)
|
||||
(cond ((equal language "br")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/br/deed.pt_BR")
|
||||
(insert (concat "* Licença
|
||||
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Não Comercial 3.0 Brasil]]\n")))
|
||||
((equal language "ca")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/es/deed.ca")
|
||||
(insert (concat "* Licència
|
||||
El text està disponible sota la [[" org-license-cc-url "][Reconeixement-NoComercial 3.0 Espanya]]\n")))
|
||||
((equal language "de")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/de/deed.de")
|
||||
(insert (concat "* Lizenz
|
||||
Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url "][Namensnennung-Nicht-kommerziell 3.0 Deutschland]]\n")))
|
||||
((equal language "es")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/es/deed.es")
|
||||
(insert (concat "* Licencia
|
||||
Este documento está bajo una [[" org-license-cc-url "][Licencia Creative Commons Reconocimiento-NoComercial 3.0]]\n")))
|
||||
((equal language "eu")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/es/deed.eu")
|
||||
(insert "* Licenzua
|
||||
Testua [[" org-license-cc-url "][Aitortu-EzKomertziala 3.0 Espainia]] lizentziari jarraituz erabil daiteke\n"))
|
||||
((equal language "fi")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/1.0/fi/deed.fi")
|
||||
(insert (concat "* Lisenssi
|
||||
Teksti on saatavilla [[" org-license-cc-url "][Nimeä-Epäkaupallinen 1.0 Suomi]] lisenssillä\n")))
|
||||
((equal language "fr")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/fr/deed.fr")
|
||||
(insert (concat "* Licence
|
||||
Ce(tte) œuvre est mise à disposition selon les termes de la [[" org-license-cc-url "][Licence Creative Commons Attribution - Pas d'Utilisation Commerciale 3.0 France]]\n")))
|
||||
((equal language "gl")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/es/deed.gl")
|
||||
(insert (concat "* Licenza
|
||||
Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza Creative Commons recoñecemento compartir igual 3.0]].\n")))
|
||||
((equal language "it")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/it/deed.it")
|
||||
(insert (concat "* Licenza
|
||||
Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza Creative Commons Attribuzione - Non commerciale 3.0 Italia]]\n")))
|
||||
((equal language "jp")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/2.1/jp/deed.en")
|
||||
(insert (concat "* ライセンス
|
||||
この文書は、[[" org-license-cc-url "][Creative Commons Attribution-NonCommercial 2.1 ]] ライセンスの下である\n")))
|
||||
((equal language "nl")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/nl/deed.nl")
|
||||
(insert (concat "* Licentie
|
||||
Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsvermelding NietCommercieel 3.0 Nederland 3.0 Nederland]]\n")))
|
||||
((equal language "pt")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/pt/deed.pt")
|
||||
(insert (concat "* Licença
|
||||
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Não Comercial 3.0 Portugal]]\n")))
|
||||
(t
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/4.0/deed")
|
||||
(insert (concat "* License
|
||||
This document is under a [[" org-license-cc-url "][Creative Commons Attribution-NonCommercial 4.0 International]]\n"))))
|
||||
(if (string= "" org-license-images-directory)
|
||||
(insert (concat "\n[[" org-license-cc-url "][file:https://i.creativecommons.org/l/by-nc/3.0/80x15.png]]\n"))
|
||||
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-nc/3.0/80x15.png]]\n"))))
|
||||
|
||||
(defun org-license-cc-by-nc-sa (language)
|
||||
(interactive "MLanguage ( br | ca | de | en | es | eu | fi | fr | gl | it | jp | nl | pt ): " language)
|
||||
(cond ((equal language "br")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/3.0/br/deed.pt_BR")
|
||||
(insert (concat "* Licença
|
||||
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Não Comercial - Compartil ha Igual 3.0 Brasil]]\n")))
|
||||
((equal language "ca")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/3.0/es/deed.ca")
|
||||
(insert (concat "* Licència
|
||||
El text està disponible sota la [[" org-license-cc-url "][Reconeixement-NoComercial 3.0 Espanya]]\n")))
|
||||
((equal language "de")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/3.0/de/deed.de")
|
||||
(insert (concat "* Lizenz
|
||||
Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url "][Namensnennung - Weitergabe unter gleichen Bedingungen 3.0 Deutschland]]\n")))
|
||||
((equal language "es")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/3.0/es/deed.es")
|
||||
(insert (concat "* Licencia
|
||||
Este documento está bajo una [[" org-license-cc-url "][Licencia Creative Commons Reconocimiento-NoComercial 3.0]]\n")))
|
||||
((equal language "eu")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/3.0/es/deed.eu")
|
||||
(insert "* Licenzua
|
||||
Testua [[" org-license-cc-url "][Aitortu-EzKomertziala-PartekatuBerdin 3.0 Espainia]] lizentziari jarraituz erabil daiteke\n"))
|
||||
((equal language "fi")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/1.0/fi/deed.fi")
|
||||
(insert (concat "* Lisenssi
|
||||
Teksti on saatavilla [[" org-license-cc-url "][Nimeä-Epäkaupallinen-JaaSamoin 1.0 Suomi]] lisenssillä\n")))
|
||||
((equal language "fr")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/3.0/fr/deed.fr")
|
||||
(insert (concat "* Licence
|
||||
Ce(tte) œuvre est mise à disposition selon les termes de la [[" org-license-cc-url "][Licence Creative Commons Attribution - Pas d’Utilisation Commerciale - Partage dans les Mêmes Conditions 3.0 France]]\n")))
|
||||
((equal language "gl")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/3.0/es/deed.gl")
|
||||
(insert (concat "* Licenza
|
||||
Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza Creative Commons recoñecemento compartir igual 3.0]].\n")))
|
||||
((equal language "it")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/3.0/it/deed.it")
|
||||
(insert (concat "* Licenza
|
||||
Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza Creative Commons Attribuzione - Non opere derivate 3.0 Italia]]\n")))
|
||||
((equal language "jp")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/2.1/jp/deed.en")
|
||||
(insert (concat "* ライセンス
|
||||
この文書は、[[" org-license-cc-url "][License Creative Commons Attribution Non Commercial Share Alike 2.1 ]] ライセンスの下である\n")))
|
||||
((equal language "nl")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/3.0/nl/deed.nl")
|
||||
(insert (concat "* Licentie
|
||||
Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsvermelding NietCommercieel GelijkDelen 3.0 Nederland]]\n")))
|
||||
((equal language "pt")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/pt/deed.pt")
|
||||
(insert (concat "* Licença
|
||||
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição NãoComercial Compartil ha Igual 3.0 Portugal]]\n")))
|
||||
(t
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/4.0/deed")
|
||||
(insert (concat "* License
|
||||
This document is under a [[" org-license-cc-url "][License Creative Commons Attribution Non Commercial Share Alike 4.0 International]]\n"))))
|
||||
(if (string= "" org-license-images-directory)
|
||||
(insert (concat "\n[[" org-license-cc-url "][file:https://i.creativecommons.org/l/by-nc-sa/3.0/80x15.png]]\n"))
|
||||
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-nc-sa/3.0/80x15.png]]\n"))))
|
||||
|
||||
(defun org-license-cc-by-nc-nd (language)
|
||||
(interactive "MLanguage ( br | ca | de | en | es | eu | fi | fr | gl | it | pt ): " language)
|
||||
(cond ((equal language "br")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/pt/deed.pt")
|
||||
(insert (concat "* Licença
|
||||
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Não Comercial Sem Derivados 3.0 Brasil]]\n")))
|
||||
((equal language "ca")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/es/deed.ca")
|
||||
(insert (concat "* Licència
|
||||
El text està disponible sota la [[" org-license-cc-url "][Reconeixement-NoComercial-SenseObraDerivada 3.0 Espanya]]\n")))
|
||||
((equal language "de")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/de/deed.de")
|
||||
(insert (concat "* Lizenz
|
||||
Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url "][Namensnennung-NichtKommerziell-KeineBearbeitung 3.0 Deutschland]]\n")))
|
||||
((equal language "es")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/es/deed.es")
|
||||
(insert (concat "* Licencia
|
||||
Este documento está bajo una [[" org-license-cc-url "][Licencia Creative Commons Reconocimiento-NoComercial-SinObraDerivada 3.0]]\n")))
|
||||
((equal language "eu")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/es/deed.eu")
|
||||
(insert (concat "* Licenzua
|
||||
Testua [[" org-license-cc-url "][Aitortu-LanEratorririkGabe 3.0 Espainia]] lizentziari jarraituz erabil daiteke\n")))
|
||||
((equal language "fi")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/1.0/fi/deed.fi")
|
||||
(insert (concat "* Lisenssi
|
||||
Teksti on saatavilla [[" org-license-cc-url "][Nimeä-Ei muutoksia-Epäkaupallinen 1.0 Suomi]] lisenssillä\n")))
|
||||
((equal language "fr")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/fr/deed.fr")
|
||||
(insert (concat "* Licence
|
||||
Ce(tte) œuvre est mise à disposition selon les termes de la [[" org-license-cc-url "][Licence Creative Commons Attribution - Pas de Modification 3.0 France]]\n")))
|
||||
((equal language "gl")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/es/deed.gl")
|
||||
(insert (concat "* Licenza
|
||||
Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza Creative Commons recoñecemento compartir igual 3.0]].\n")))
|
||||
((equal language "it")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/it/deed.it")
|
||||
(insert (concat "* Licenza
|
||||
Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza Creative Commons Attribuzione - Non opere derivate 3.0 Italia]]\n")))
|
||||
((equal language "jp")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/2.1/jp/deed.en")
|
||||
(insert (concat "* ライセンス
|
||||
この文書は [[" org-license-cc-url "][License Creative Commons Attribution Non Commercial - No Derivs 2.1]] ライセンスの下である\n")))
|
||||
((equal language "nl")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/nl/deed.nl")
|
||||
(insert (concat "* Licentie
|
||||
Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsvermelding NietCommercieel GeenAfgeleideWerken 3.0 Nederland]]\n")))
|
||||
((equal language "pt")
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/pt/deed.pt")
|
||||
(insert (concat "* Licença
|
||||
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Não Comercial Sem Derivados 3.0 Portugal]]\n")))
|
||||
(t
|
||||
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/4.0/deed")
|
||||
(insert (concat "* License
|
||||
This document is under a [[" org-license-cc-url "][License Creative Commons Attribution-NonCommercial-NoDerivatives 4.0 International]]\n"))))
|
||||
(if (string= "" org-license-images-directory)
|
||||
(insert (concat "\n[[" org-license-cc-url "][file:https://i.creativecommons.org/l/by-nc-nd/3.0/80x15.png]]\n"))
|
||||
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-nc-nd/3.0/80x15.png]]\n"))))
|
||||
|
||||
(defun org-license-gfdl (language)
|
||||
(interactive "MLanguage (es | en): " language)
|
||||
(cond ((equal language "es")
|
||||
(insert "* Licencia
|
||||
Copyright (C) " (format-time-string "%Y") " " user-full-name
|
||||
"\n Se permite copiar, distribuir y/o modificar este documento
|
||||
bajo los términos de la GNU Free Documentation License, Version 1.3
|
||||
o cualquier versión publicada por la Free Software Foundation;
|
||||
sin Secciones Invariantes y sin Textos de Portada o Contraportada.
|
||||
Una copia de la licencia está incluida en [[https://www.gnu.org/copyleft/fdl.html][GNU Free Documentation License]].\n"))
|
||||
(t (insert (concat "* License
|
||||
Copyright (C) " (format-time-string "%Y") " " user-full-name
|
||||
"\n Permission is granted to copy, distribute and/or modify this document
|
||||
under the terms of the GNU Free Documentation License, Version 1.3
|
||||
or any later version published by the Free Software Foundation;
|
||||
with no Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts.
|
||||
A copy of the license is included in [[https://www.gnu.org/copyleft/fdl.html][GNU Free Documentation License]].\n"))))
|
||||
(if (string= "" org-license-images-directory)
|
||||
(insert "\n[[https://www.gnu.org/copyleft/fdl.html][file:https://upload.wikimedia.org/wikipedia/commons/thumb/4/42/GFDL_Logo.svg/200px-GFDL_Logo.svg.png]]\n")
|
||||
(insert (concat "\n[[https://www.gnu.org/copyleft/fdl.html][file:" org-license-images-directory "/gfdl/gfdl.png]]\n"))))
|
||||
|
||||
(defun org-license-publicdomain-zero (language)
|
||||
(interactive "MLanguage ( en | es ): " language)
|
||||
(setq org-license-pd-url "https://creativecommons.org/publicdomain/zero/1.0/")
|
||||
(setq org-license-pd-file "zero/1.0/80x15.png")
|
||||
(if (equal language "es")
|
||||
(insert (concat "* Licencia
|
||||
Este documento está bajo una licencia [[" org-license-pd-url "][Public Domain Zero]]\n"))
|
||||
(insert (concat "* License
|
||||
This documento is under a [[" org-license-pd-url "][Public Domain Zero]] license\n")))
|
||||
(if (string= "" org-license-images-directory)
|
||||
(insert (concat "\n[[" org-license-pd-url "][file:https://i.creativecommons.org/p/zero/1.0/80x15.png]]\n"))
|
||||
(insert (concat "\n[[" org-license-pd-url "][file:" org-license-images-directory org-license-pd-file "]]\n"))))
|
||||
|
||||
(defun org-license-publicdomain-mark (language)
|
||||
(interactive "MLanguage ( en | es ): " language)
|
||||
(setq org-license-pd-url "https://creativecommons.org/publicdomain/mark/1.0/")
|
||||
(setq org-license-pd-file "mark/1.0/80x15.png")
|
||||
(if (equal language "es")
|
||||
(insert (concat "* Licencia
|
||||
Este documento está bajo una licencia [[" org-license-pd-url "][Etiqueta de Dominio Público 1.0]]\n"))
|
||||
(insert (concat "* License
|
||||
This documento is under a [[" org-license-pd-url "][Public Domain Mark]] license\n")))
|
||||
(if (string= "" org-license-images-directory)
|
||||
(insert (concat "\n[[" org-license-pd-url "][file:https://i.creativecommons.org/p/mark/1.0/80x15.png]]\n"))
|
||||
(insert (concat "\n[[" org-license-pd-url "][file:" org-license-images-directory org-license-pd-file "]]\n"))))
|
||||
|
||||
(defun org-license-print-all ()
|
||||
"Print all combinations of licenses and languages, it's useful to find bugs"
|
||||
(interactive)
|
||||
(org-license-gfdl "es")
|
||||
(org-license-gfdl "en")
|
||||
(org-license-publicdomain-mark "es")
|
||||
(org-license-publicdomain-mark "en")
|
||||
(org-license-publicdomain-zero "es")
|
||||
(org-license-publicdomain-zero "en")
|
||||
(org-license-cc-by "br")
|
||||
(org-license-cc-by "ca")
|
||||
(org-license-cc-by "de")
|
||||
(org-license-cc-by "es")
|
||||
(org-license-cc-by "en")
|
||||
(org-license-cc-by "eo")
|
||||
(org-license-cc-by "eu")
|
||||
(org-license-cc-by "fi")
|
||||
(org-license-cc-by "fr")
|
||||
(org-license-cc-by "gl")
|
||||
(org-license-cc-by "it")
|
||||
(org-license-cc-by "jp")
|
||||
(org-license-cc-by "nl")
|
||||
(org-license-cc-by "pt")
|
||||
(org-license-cc-by-sa "br")
|
||||
(org-license-cc-by-sa "ca")
|
||||
(org-license-cc-by-sa "de")
|
||||
(org-license-cc-by-sa "es")
|
||||
(org-license-cc-by-sa "en")
|
||||
;; (org-license-cc-by-sa "eo")
|
||||
(org-license-cc-by-sa "eu")
|
||||
(org-license-cc-by-sa "fi")
|
||||
(org-license-cc-by-sa "fr")
|
||||
(org-license-cc-by-sa "gl")
|
||||
(org-license-cc-by-sa "it")
|
||||
(org-license-cc-by-sa "jp")
|
||||
(org-license-cc-by-sa "nl")
|
||||
(org-license-cc-by-sa "pt")
|
||||
(org-license-cc-by-nd "br")
|
||||
(org-license-cc-by-nd "ca")
|
||||
(org-license-cc-by-nd "de")
|
||||
(org-license-cc-by-nd "es")
|
||||
(org-license-cc-by-nd "en")
|
||||
;; (org-license-cc-by-nd "eo")
|
||||
(org-license-cc-by-nd "eu")
|
||||
(org-license-cc-by-nd "fi")
|
||||
(org-license-cc-by-nd "fr")
|
||||
(org-license-cc-by-nd "gl")
|
||||
(org-license-cc-by-nd "it")
|
||||
(org-license-cc-by-nd "jp")
|
||||
(org-license-cc-by-nd "nl")
|
||||
(org-license-cc-by-nd "pt")
|
||||
(org-license-cc-by-nc "br")
|
||||
(org-license-cc-by-nc "ca")
|
||||
(org-license-cc-by-nc "de")
|
||||
(org-license-cc-by-nc "es")
|
||||
(org-license-cc-by-nc "en")
|
||||
;; (org-license-cc-by-nc "eo")
|
||||
(org-license-cc-by-nc "eu")
|
||||
(org-license-cc-by-nc "fi")
|
||||
(org-license-cc-by-nc "fr")
|
||||
(org-license-cc-by-nc "gl")
|
||||
(org-license-cc-by-nc "it")
|
||||
(org-license-cc-by-nc "jp")
|
||||
(org-license-cc-by-nc "nl")
|
||||
(org-license-cc-by-nc "pt")
|
||||
(org-license-cc-by-nc-sa "br")
|
||||
(org-license-cc-by-nc-sa "ca")
|
||||
(org-license-cc-by-nc-sa "de")
|
||||
(org-license-cc-by-nc-sa "es")
|
||||
(org-license-cc-by-nc-sa "en")
|
||||
;; (org-license-cc-by-nc-sa "eo")
|
||||
(org-license-cc-by-nc-sa "eu")
|
||||
(org-license-cc-by-nc-sa "fi")
|
||||
(org-license-cc-by-nc-sa "fr")
|
||||
(org-license-cc-by-nc-sa "gl")
|
||||
(org-license-cc-by-nc-sa "it")
|
||||
(org-license-cc-by-nc-sa "jp")
|
||||
(org-license-cc-by-nc-sa "nl")
|
||||
(org-license-cc-by-nc-sa "pt")
|
||||
(org-license-cc-by-nc-nd "br")
|
||||
(org-license-cc-by-nc-nd "ca")
|
||||
(org-license-cc-by-nc-nd "de")
|
||||
(org-license-cc-by-nc-nd "es")
|
||||
(org-license-cc-by-nc-nd "en")
|
||||
;; (org-license-cc-by-nc-nd "eo")
|
||||
(org-license-cc-by-nc-nd "eu")
|
||||
(org-license-cc-by-nc-nd "fi")
|
||||
(org-license-cc-by-nc-nd "fr")
|
||||
(org-license-cc-by-nc-nd "gl")
|
||||
(org-license-cc-by-nc-nd "it")
|
||||
(org-license-cc-by-nc-nd "jp")
|
||||
(org-license-cc-by-nc-nd "nl")
|
||||
(org-license-cc-by-nc-nd "pt")
|
||||
)
|
||||
|
||||
|
||||
392
lisp/org-contrib/org-link-edit.el
Normal file
392
lisp/org-contrib/org-link-edit.el
Normal file
@@ -0,0 +1,392 @@
|
||||
;;; org-link-edit.el --- Slurp and barf with Org links -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2015-2021 Kyle Meyer <kyle@kyleam.com>
|
||||
|
||||
;; Author: Kyle Meyer <kyle@kyleam.com>
|
||||
;; Homepage: https://git.kyleam.com/org-link-edit/about
|
||||
;; Keywords: convenience
|
||||
;; Version: 1.2.1
|
||||
;; Package-Requires: ((cl-lib "0.5") (org "9.3"))
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Org Link Edit provides Paredit-inspired slurping and barfing
|
||||
;; commands for Org link descriptions.
|
||||
;;
|
||||
;; There are four slurp and barf commands, all which operate when
|
||||
;; point is on an Org link.
|
||||
;;
|
||||
;; - org-link-edit-forward-slurp
|
||||
;; - org-link-edit-backward-slurp
|
||||
;; - org-link-edit-forward-barf
|
||||
;; - org-link-edit-backward-barf
|
||||
;;
|
||||
;; Org Link Edit doesn't bind these commands to any keys. Finding
|
||||
;; good keys for these commands is difficult because, while it's
|
||||
;; convenient to be able to quickly repeat these commands, they won't
|
||||
;; be used frequently enough to be worthy of a short, repeat-friendly
|
||||
;; binding. Using Hydra [1] provides a nice solution to this. After
|
||||
;; an initial key sequence, any of the commands will be repeatable
|
||||
;; with a single key. (Plus, you get a nice interface that displays
|
||||
;; the key for each command.) Below is one example of how you could
|
||||
;; configure this.
|
||||
;;
|
||||
;; (define-key org-mode-map YOUR-KEY
|
||||
;; (defhydra hydra-org-link-edit ()
|
||||
;; "Org Link Edit"
|
||||
;; ("j" org-link-edit-forward-slurp "forward slurp")
|
||||
;; ("k" org-link-edit-forward-barf "forward barf")
|
||||
;; ("u" org-link-edit-backward-slurp "backward slurp")
|
||||
;; ("i" org-link-edit-backward-barf "backward barf")
|
||||
;; ("q" nil "cancel")))
|
||||
;;
|
||||
;; In addition to the slurp and barf commands, the command
|
||||
;; `org-link-edit-transport-next-link' searches for the next (or
|
||||
;; previous) link and moves it to point, using the word at point or
|
||||
;; the selected region as the link's description.
|
||||
;;
|
||||
;; [1] https://github.com/abo-abo/hydra
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'org)
|
||||
(require 'org-element)
|
||||
(require 'cl-lib)
|
||||
|
||||
(defun org-link-edit--on-link-p (&optional element)
|
||||
(org-element-lineage (or element (org-element-context)) '(link) t))
|
||||
|
||||
(defun org-link-edit--link-data ()
|
||||
"Return list with information about the link at point.
|
||||
The list includes
|
||||
- the position at the start of the link
|
||||
- the position at the end of the link
|
||||
- the link text
|
||||
- the link description (nil when on a plain link)"
|
||||
(let ((el (org-element-context)))
|
||||
(unless (org-link-edit--on-link-p el)
|
||||
(user-error "Point is not on a link"))
|
||||
(save-excursion
|
||||
(goto-char (org-element-property :begin el))
|
||||
(cond
|
||||
;; Use match-{beginning,end} because match-end is consistently
|
||||
;; positioned after ]], while the :end property is positioned
|
||||
;; at the next word on the line, if one is present.
|
||||
((looking-at org-link-bracket-re)
|
||||
(list (match-beginning 0)
|
||||
(match-end 0)
|
||||
(save-match-data
|
||||
(org-link-unescape (match-string-no-properties 1)))
|
||||
(or (match-string-no-properties 2) "")))
|
||||
((looking-at org-link-plain-re)
|
||||
(list (match-beginning 0)
|
||||
(match-end 0)
|
||||
(match-string-no-properties 0)
|
||||
nil))
|
||||
(t
|
||||
(error "What am I looking at?"))))))
|
||||
|
||||
(defun org-link-edit--forward-blob (n &optional no-punctuation)
|
||||
"Move forward N blobs (backward if N is negative).
|
||||
|
||||
A block of non-whitespace characters is a blob. If
|
||||
NO-PUNCTUATION is non-nil, trailing punctuation characters are
|
||||
not considered part of the blob when going in the forward
|
||||
direction.
|
||||
|
||||
If the edge of the buffer is reached before completing the
|
||||
movement, return nil. Otherwise, return t."
|
||||
(let* ((forward-p (> n 0))
|
||||
(nblobs (abs n))
|
||||
(skip-func (if forward-p 'skip-syntax-forward 'skip-syntax-backward))
|
||||
skip-func-retval)
|
||||
(while (/= nblobs 0)
|
||||
(funcall skip-func " ")
|
||||
(setq skip-func-retval (funcall skip-func "^ "))
|
||||
(setq nblobs (1- nblobs)))
|
||||
(when (and forward-p no-punctuation)
|
||||
(let ((punc-tail-offset (save-excursion (skip-syntax-backward "."))))
|
||||
;; Don't consider trailing punctuation as part of the blob
|
||||
;; unless the whole blob consists of punctuation.
|
||||
(unless (= skip-func-retval (- punc-tail-offset))
|
||||
(goto-char (+ (point) punc-tail-offset)))))
|
||||
(/= skip-func-retval 0)))
|
||||
|
||||
;;;###autoload
|
||||
(defun org-link-edit-forward-slurp (&optional n)
|
||||
"Slurp N trailing blobs into link's description.
|
||||
|
||||
The \[\[https://orgmode.org/\]\[Org mode\]\] site
|
||||
|
||||
|
|
||||
v
|
||||
|
||||
The \[\[https://orgmode.org/\]\[Org mode site\]\]
|
||||
|
||||
A blob is a block of non-whitespace characters. When slurping
|
||||
forward, trailing punctuation characters are not considered part
|
||||
of a blob.
|
||||
|
||||
After slurping, return the slurped text and move point to the
|
||||
beginning of the link.
|
||||
|
||||
If N is negative, slurp leading blobs instead of trailing blobs."
|
||||
(interactive "p")
|
||||
(setq n (or n 1))
|
||||
(cond
|
||||
((= n 0))
|
||||
((< n 0)
|
||||
(org-link-edit-backward-slurp (- n)))
|
||||
(t
|
||||
(cl-multiple-value-bind (beg end link desc) (org-link-edit--link-data)
|
||||
(goto-char (save-excursion
|
||||
(goto-char end)
|
||||
(or (org-link-edit--forward-blob n 'no-punctuation)
|
||||
(user-error "Not enough blobs after the link"))
|
||||
(point)))
|
||||
(let ((slurped (buffer-substring-no-properties end (point))))
|
||||
(setq slurped (replace-regexp-in-string "\n+" " " slurped))
|
||||
(when (and (= (length desc) 0)
|
||||
(string-match "^\\s-+\\(.*\\)" slurped))
|
||||
(setq slurped (match-string 1 slurped)))
|
||||
(setq desc (concat desc slurped)
|
||||
end (+ end (length slurped)))
|
||||
(delete-region beg (point))
|
||||
(insert (org-link-make-string link desc))
|
||||
(goto-char beg)
|
||||
slurped)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun org-link-edit-backward-slurp (&optional n)
|
||||
"Slurp N leading blobs into link's description.
|
||||
|
||||
The \[\[https://orgmode.org/\]\[Org mode\]\] site
|
||||
|
||||
|
|
||||
v
|
||||
|
||||
\[\[https://orgmode.org/\]\[The Org mode\]\] site
|
||||
|
||||
A blob is a block of non-whitespace characters.
|
||||
|
||||
After slurping, return the slurped text and move point to the
|
||||
beginning of the link.
|
||||
|
||||
If N is negative, slurp trailing blobs instead of leading blobs."
|
||||
(interactive "p")
|
||||
(setq n (or n 1))
|
||||
(cond
|
||||
((= n 0))
|
||||
((< n 0)
|
||||
(org-link-edit-forward-slurp (- n)))
|
||||
(t
|
||||
(cl-multiple-value-bind (beg end link desc) (org-link-edit--link-data)
|
||||
(goto-char (save-excursion
|
||||
(goto-char beg)
|
||||
(or (org-link-edit--forward-blob (- n))
|
||||
(user-error "Not enough blobs before the link"))
|
||||
(point)))
|
||||
(let ((slurped (buffer-substring-no-properties (point) beg)))
|
||||
(when (and (= (length desc) 0)
|
||||
(string-match "\\(.*\\)\\s-+$" slurped))
|
||||
(setq slurped (match-string 1 slurped)))
|
||||
(setq slurped (replace-regexp-in-string "\n+" " " slurped))
|
||||
(setq desc (concat slurped desc)
|
||||
beg (- beg (length slurped)))
|
||||
(delete-region (point) end)
|
||||
(insert (org-link-make-string link desc))
|
||||
(goto-char beg)
|
||||
slurped)))))
|
||||
|
||||
(defun org-link-edit--split-first-blobs (string n)
|
||||
"Split STRING into (N first blobs . other) cons cell.
|
||||
'N first blobs' contains all text from the start of STRING up to
|
||||
the start of the N+1 blob. 'other' includes the remaining text
|
||||
of STRING. If the number of blobs in STRING is fewer than N,
|
||||
'other' is nil."
|
||||
(when (< n 0) (user-error "N cannot be negative"))
|
||||
(with-temp-buffer
|
||||
(insert string)
|
||||
(goto-char (point-min))
|
||||
(with-syntax-table org-mode-syntax-table
|
||||
(let ((within-bound (org-link-edit--forward-blob n)))
|
||||
(skip-syntax-forward " ")
|
||||
(cons (buffer-substring 1 (point))
|
||||
(and within-bound
|
||||
(buffer-substring (point) (point-max))))))))
|
||||
|
||||
(defun org-link-edit--split-last-blobs (string n)
|
||||
"Split STRING into (other . N last blobs) cons cell.
|
||||
'N last blobs' contains all text from the end of STRING back to
|
||||
the end of the N+1 last blob. 'other' includes the remaining
|
||||
text of STRING. If the number of blobs in STRING is fewer than
|
||||
N, 'other' is nil."
|
||||
(when (< n 0) (user-error "N cannot be negative"))
|
||||
(with-temp-buffer
|
||||
(insert string)
|
||||
(goto-char (point-max))
|
||||
(with-syntax-table org-mode-syntax-table
|
||||
(let ((within-bound (org-link-edit--forward-blob (- n))))
|
||||
(skip-syntax-backward " ")
|
||||
(cons (and within-bound
|
||||
(buffer-substring 1 (point)))
|
||||
(buffer-substring (point) (point-max)))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun org-link-edit-forward-barf (&optional n)
|
||||
"Barf N trailing blobs from link's description.
|
||||
|
||||
The \[\[https://orgmode.org/\]\[Org mode\]\] site
|
||||
|
||||
|
|
||||
v
|
||||
|
||||
The \[\[https://orgmode.org/\]\[Org\]\] mode site
|
||||
|
||||
A blob is a block of non-whitespace characters.
|
||||
|
||||
After barfing, return the barfed text and move point to the
|
||||
beginning of the link.
|
||||
|
||||
If N is negative, barf leading blobs instead of trailing blobs."
|
||||
(interactive "p")
|
||||
(setq n (or n 1))
|
||||
(cond
|
||||
((= n 0))
|
||||
((< n 0)
|
||||
(org-link-edit-backward-barf (- n)))
|
||||
(t
|
||||
(cl-multiple-value-bind (beg end link desc) (org-link-edit--link-data)
|
||||
(when (= (length desc) 0)
|
||||
(user-error "Link has no description"))
|
||||
(pcase-let ((`(,new-desc . ,barfed) (org-link-edit--split-last-blobs
|
||||
desc n)))
|
||||
(unless new-desc (user-error "Not enough blobs in description"))
|
||||
(goto-char beg)
|
||||
(delete-region beg end)
|
||||
(insert (org-link-make-string link new-desc))
|
||||
(when (string= new-desc "")
|
||||
(setq barfed (concat " " barfed)))
|
||||
(insert barfed)
|
||||
(goto-char beg)
|
||||
barfed)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun org-link-edit-backward-barf (&optional n)
|
||||
"Barf N leading blobs from link's description.
|
||||
|
||||
The \[\[https://orgmode.org/\]\[Org mode\]\] site
|
||||
|
||||
|
|
||||
v
|
||||
|
||||
The Org \[\[https://orgmode.org/\]\[mode\]\] site
|
||||
|
||||
A blob is a block of non-whitespace characters.
|
||||
|
||||
After barfing, return the barfed text and move point to the
|
||||
beginning of the link.
|
||||
|
||||
If N is negative, barf trailing blobs instead of leading blobs."
|
||||
(interactive "p")
|
||||
(setq n (or n 1))
|
||||
(cond
|
||||
((= n 0))
|
||||
((< n 0)
|
||||
(org-link-edit-forward-barf (- n)))
|
||||
(t
|
||||
(cl-multiple-value-bind (beg end link desc) (org-link-edit--link-data)
|
||||
(when (= (length desc) 0)
|
||||
(user-error "Link has no description"))
|
||||
(pcase-let ((`(,barfed . ,new-desc) (org-link-edit--split-first-blobs
|
||||
desc n)))
|
||||
(unless new-desc (user-error "Not enough blobs in description"))
|
||||
(goto-char beg)
|
||||
(delete-region beg end)
|
||||
(insert (org-link-make-string link new-desc))
|
||||
(when (string= new-desc "")
|
||||
(setq barfed (concat barfed " ")))
|
||||
(goto-char beg)
|
||||
(insert barfed)
|
||||
barfed)))))
|
||||
|
||||
(defun org-link-edit--next-link-data (&optional previous)
|
||||
(save-excursion
|
||||
(if (funcall (if previous #'re-search-backward #'re-search-forward)
|
||||
org-link-any-re nil t)
|
||||
(org-link-edit--link-data)
|
||||
(user-error "No %s link found" (if previous "previous" "next")))))
|
||||
|
||||
;;;###autoload
|
||||
(defun org-link-edit-transport-next-link (&optional previous beg end overwrite)
|
||||
"Move the next link to point.
|
||||
|
||||
If the region is active, use the selected text as the link's
|
||||
description. Otherwise, use the word at point.
|
||||
|
||||
With prefix argument PREVIOUS, move the previous link instead of
|
||||
the next link.
|
||||
|
||||
Non-interactively, use the text between BEG and END as the
|
||||
description, moving the next (or previous) link relative to BEG
|
||||
and END. By default, refuse to overwrite an existing
|
||||
description. If OVERWRITE is `ask', prompt for confirmation
|
||||
before overwriting; for any other non-nil value, overwrite
|
||||
without asking."
|
||||
(interactive `(,current-prefix-arg
|
||||
,@(if (use-region-p)
|
||||
(list (region-beginning) (region-end))
|
||||
(list nil nil))
|
||||
ask))
|
||||
(let ((pt (point))
|
||||
(desc-bounds (cond
|
||||
((and beg end)
|
||||
(cons (progn (goto-char beg)
|
||||
(point-marker))
|
||||
(progn (goto-char end)
|
||||
(point-marker))))
|
||||
((not (looking-at-p "\\s-"))
|
||||
(progn (skip-syntax-backward "w")
|
||||
(let ((beg (point-marker)))
|
||||
(skip-syntax-forward "w")
|
||||
(cons beg (point-marker))))))))
|
||||
(when (or (and desc-bounds
|
||||
(or (progn (goto-char (car desc-bounds))
|
||||
(org-link-edit--on-link-p))
|
||||
(progn (goto-char (cdr desc-bounds))
|
||||
(org-link-edit--on-link-p))))
|
||||
(progn (goto-char pt)
|
||||
(org-link-edit--on-link-p)))
|
||||
(user-error "Cannot transport next link with point on a link"))
|
||||
(goto-char (or (car desc-bounds) pt))
|
||||
(cl-multiple-value-bind (link-beg link-end link orig-desc)
|
||||
(org-link-edit--next-link-data previous)
|
||||
(unless (or (not desc-bounds)
|
||||
(= (length orig-desc) 0)
|
||||
(if (eq overwrite 'ask)
|
||||
(y-or-n-p "Overwrite existing description?")
|
||||
overwrite))
|
||||
(user-error "Link already has a description"))
|
||||
(delete-region link-beg link-end)
|
||||
(insert (org-link-make-string
|
||||
link
|
||||
(if desc-bounds
|
||||
(delete-and-extract-region (car desc-bounds)
|
||||
(cdr desc-bounds))
|
||||
orig-desc))))))
|
||||
|
||||
(provide 'org-link-edit)
|
||||
;;; org-link-edit.el ends here
|
||||
250
lisp/org-contrib/org-mac-iCal.el
Normal file
250
lisp/org-contrib/org-mac-iCal.el
Normal file
@@ -0,0 +1,250 @@
|
||||
;;; org-mac-iCal.el --- Imports events from iCal.app to the Emacs diary
|
||||
|
||||
;; Copyright (C) 2009-2014, 2021 Christopher Suckling
|
||||
|
||||
;; Author: Christopher Suckling <suckling at gmail dot com>
|
||||
;; Version: 0.1057.104
|
||||
;; Keywords: outlines, calendar
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; This program is Free Software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 3, 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; This file provides the import of events from Mac OS X 10.5 iCal.app
|
||||
;; into the Emacs diary (it is not compatible with OS X < 10.5). The
|
||||
;; function org-mac-iCal will import events in all checked iCal.app
|
||||
;; calendars for the date range org-mac-iCal-range months, centered
|
||||
;; around the current date.
|
||||
;;
|
||||
;; CAVEAT: This function is destructive; it will overwrite the current
|
||||
;; contents of the Emacs diary.
|
||||
;;
|
||||
;; Installation: add (require 'org-mac-iCal) to your .emacs.
|
||||
;;
|
||||
;; If you view Emacs diary entries in org-agenda, the following hook
|
||||
;; will ensure that all-day events are not orphaned below TODO items
|
||||
;; and that any supplementary fields to events (e.g. Location) are
|
||||
;; grouped with their parent event
|
||||
;;
|
||||
;; (add-hook 'org-agenda-cleanup-fancy-diary-hook
|
||||
;; (lambda ()
|
||||
;; (goto-char (point-min))
|
||||
;; (save-excursion
|
||||
;; (while (re-search-forward "^[a-z]" nil t)
|
||||
;; (goto-char (match-beginning 0))
|
||||
;; (insert "0:00-24:00 ")))
|
||||
;; (while (re-search-forward "^ [a-z]" nil t)
|
||||
;; (goto-char (match-beginning 0))
|
||||
;; (save-excursion
|
||||
;; (re-search-backward "^[0-9]+:[0-9]+-[0-9]+:[0-9]+ " nil t))
|
||||
;; (insert (match-string 0)))))
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defcustom org-mac-iCal-range 2
|
||||
"The range in months to import iCal.app entries into the Emacs
|
||||
diary. The import is centered around today's date; thus a value
|
||||
of 2 imports entries for one month before and one month after
|
||||
today's date"
|
||||
:group 'org-time
|
||||
:type 'integer)
|
||||
|
||||
(defun org-mac-iCal ()
|
||||
"Selects checked calendars in iCal.app and imports them into
|
||||
the the Emacs diary"
|
||||
(interactive)
|
||||
|
||||
;; kill diary buffers then empty diary files to avoid duplicates
|
||||
(setq currentBuffer (buffer-name))
|
||||
(setq openBuffers (mapcar (function buffer-name) (buffer-list)))
|
||||
(omi-kill-diary-buffer openBuffers)
|
||||
(with-temp-buffer
|
||||
(insert-file-contents diary-file)
|
||||
(delete-region (point-min) (point-max))
|
||||
(write-region (point-min) (point-max) diary-file))
|
||||
|
||||
;; determine available calendars
|
||||
(setq caldav-folders (directory-files "~/Library/Calendars" 1 ".*caldav$"))
|
||||
(setq caldav-calendars nil)
|
||||
(mapc
|
||||
(lambda (x)
|
||||
(setq caldav-calendars (nconc caldav-calendars (directory-files x 1 ".*calendar$"))))
|
||||
caldav-folders)
|
||||
|
||||
(setq local-calendars nil)
|
||||
(setq local-calendars (directory-files "~/Library/Calendars" 1 ".*calendar$"))
|
||||
|
||||
(setq all-calendars (append caldav-calendars local-calendars))
|
||||
|
||||
;; parse each calendar's Info.plist to see if calendar is checked in iCal
|
||||
(setq all-calendars (delq 'nil (mapcar
|
||||
(lambda (x)
|
||||
(omi-checked x))
|
||||
all-calendars)))
|
||||
|
||||
;; for each calendar, concatenate individual events into a single ics file
|
||||
(with-temp-buffer
|
||||
(shell-command "sw_vers" (current-buffer))
|
||||
(when (re-search-backward "10\\.[5678]" nil t)
|
||||
(omi-concat-leopard-ics all-calendars)))
|
||||
|
||||
;; move all caldav ics files to the same place as local ics files
|
||||
(mapc
|
||||
(lambda (x)
|
||||
(mapc
|
||||
(lambda (y)
|
||||
(rename-file (concat x "/" y);
|
||||
(concat "~/Library/Calendars/" y)))
|
||||
(directory-files x nil ".*ics$")))
|
||||
caldav-folders)
|
||||
|
||||
;; check calendar has contents and import
|
||||
(setq import-calendars (directory-files "~/Library/Calendars" 1 ".*ics$"))
|
||||
(mapc
|
||||
(lambda (x)
|
||||
(when (/= (nth 7 (file-attributes x 'string)) 0)
|
||||
(omi-import-ics x)))
|
||||
import-calendars)
|
||||
|
||||
;; tidy up intermediate files and buffers
|
||||
(setq usedCalendarsBuffers (mapcar (function buffer-name) (buffer-list)))
|
||||
(omi-kill-ics-buffer usedCalendarsBuffers)
|
||||
(setq usedCalendarsFiles (directory-files "~/Library/Calendars" 1 ".*ics$"))
|
||||
(omi-delete-ics-file usedCalendarsFiles)
|
||||
|
||||
(org-pop-to-buffer-same-window currentBuffer))
|
||||
|
||||
(defun omi-concat-leopard-ics (list)
|
||||
"Leopard stores each iCal.app event in a separate ics file.
|
||||
Whilst useful for Spotlight indexing, this is less helpful for
|
||||
icalendar-import-file. omi-concat-leopard-ics concatenates these
|
||||
individual event files into a single ics file"
|
||||
(mapc
|
||||
(lambda (x)
|
||||
(setq omi-leopard-events (directory-files (concat x "/Events") 1 ".*ics$"))
|
||||
(with-temp-buffer
|
||||
(mapc
|
||||
(lambda (y)
|
||||
(insert-file-contents (expand-file-name y)))
|
||||
omi-leopard-events)
|
||||
(write-region (point-min) (point-max) (concat (expand-file-name x) ".ics"))))
|
||||
list))
|
||||
|
||||
(defun omi-import-ics (string)
|
||||
"Imports an ics file into the Emacs diary. First tidies up the
|
||||
ics file so that it is suitable for import and selects a sensible
|
||||
date range so that Emacs calendar view doesn't grind to a halt"
|
||||
(with-temp-buffer
|
||||
(insert-file-contents string)
|
||||
(goto-char (point-min))
|
||||
(while
|
||||
(re-search-forward "^BEGIN:VCALENDAR$" nil t)
|
||||
(setq startEntry (match-beginning 0))
|
||||
(re-search-forward "^END:VCALENDAR$" nil t)
|
||||
(setq endEntry (match-end 0))
|
||||
(save-restriction
|
||||
(narrow-to-region startEntry endEntry)
|
||||
(goto-char (point-min))
|
||||
(re-search-forward "\\(^DTSTART;.*:\\)\\([0-9][0-9][0-9][0-9]\\)\\([0-9][0-9]\\)" nil t)
|
||||
(if (or (eq (match-string 2) nil) (eq (match-string 3) nil))
|
||||
(progn
|
||||
(setq yearEntry 1)
|
||||
(setq monthEntry 1))
|
||||
(setq yearEntry (string-to-number (match-string 2)))
|
||||
(setq monthEntry (string-to-number (match-string 3))))
|
||||
(setq year (string-to-number (format-time-string "%Y")))
|
||||
(setq month (string-to-number (format-time-string "%m")))
|
||||
(setq now (list month 1 year))
|
||||
(setq entryDate (list monthEntry 1 yearEntry))
|
||||
;; Check to see if this is a repeating event
|
||||
(goto-char (point-min))
|
||||
(setq isRepeating (re-search-forward "^RRULE:" nil t))
|
||||
;; Delete if outside range and not repeating
|
||||
(when (and
|
||||
(not isRepeating)
|
||||
(> (abs (- (calendar-absolute-from-gregorian now)
|
||||
(calendar-absolute-from-gregorian entryDate)))
|
||||
(* (/ org-mac-iCal-range 2) 30))
|
||||
(delete-region startEntry endEntry)))
|
||||
(goto-char (point-max))))
|
||||
(while
|
||||
(re-search-forward "^END:VEVENT$" nil t)
|
||||
(delete-blank-lines))
|
||||
(goto-line 1)
|
||||
(insert "BEGIN:VCALENDAR\n\n")
|
||||
(goto-line 2)
|
||||
(while
|
||||
(re-search-forward "^BEGIN:VCALENDAR$" nil t)
|
||||
(replace-match "\n"))
|
||||
(goto-line 2)
|
||||
(while
|
||||
(re-search-forward "^END:VCALENDAR$" nil t)
|
||||
(replace-match "\n"))
|
||||
(insert "END:VCALENDAR")
|
||||
(goto-line 1)
|
||||
(delete-blank-lines)
|
||||
(while
|
||||
(re-search-forward "^END:VEVENT$" nil t)
|
||||
(delete-blank-lines))
|
||||
(goto-line 1)
|
||||
(while
|
||||
(re-search-forward "^ORG.*" nil t)
|
||||
(replace-match "\n"))
|
||||
(goto-line 1)
|
||||
(write-region (point-min) (point-max) string))
|
||||
|
||||
(icalendar-import-file string diary-file))
|
||||
|
||||
(defun omi-kill-diary-buffer (list)
|
||||
(mapc
|
||||
(lambda (x)
|
||||
(if (string-match "^diary" x)
|
||||
(kill-buffer x)))
|
||||
list))
|
||||
|
||||
(defun omi-kill-ics-buffer (list)
|
||||
(mapc
|
||||
(lambda (x)
|
||||
(if (string-match "ics$" x)
|
||||
(kill-buffer x)))
|
||||
list))
|
||||
|
||||
(defun omi-delete-ics-file (list)
|
||||
(mapc
|
||||
(lambda (x)
|
||||
(delete-file x))
|
||||
list))
|
||||
|
||||
(defun omi-checked (directory)
|
||||
"Parse Info.plist in iCal.app calendar folder and determine
|
||||
whether Checked key is 1. If Checked key is not 1, remove
|
||||
calendar from list of calendars for import"
|
||||
(let* ((root (xml-parse-file (car (directory-files directory 1 "Info.plist"))))
|
||||
(plist (car root))
|
||||
(dict (car (xml-get-children plist 'dict)))
|
||||
(keys (cdr (xml-node-children dict)))
|
||||
(keys (mapcar
|
||||
(lambda (x)
|
||||
(cond ((listp x)
|
||||
x)))
|
||||
keys))
|
||||
(keys (delq 'nil keys)))
|
||||
(when (equal "1" (car (cddr (lax-plist-get keys '(key nil "Checked")))))
|
||||
directory)))
|
||||
|
||||
(provide 'org-mac-iCal)
|
||||
|
||||
;;; org-mac-iCal.el ends here
|
||||
1074
lisp/org-contrib/org-mac-link.el
Normal file
1074
lisp/org-contrib/org-mac-link.el
Normal file
File diff suppressed because it is too large
Load Diff
333
lisp/org-contrib/org-mairix.el
Normal file
333
lisp/org-contrib/org-mairix.el
Normal file
@@ -0,0 +1,333 @@
|
||||
;;; org-mairix.el - Support for hooking mairix search into Org for different MUAs
|
||||
;;
|
||||
;; Copyright (C) 2007-2014, 2021 Georg C. F. Greve
|
||||
;; mutt support by Adam Spiers <orgmode at adamspiers dot org>
|
||||
;;
|
||||
;; Author: Georg C. F. Greve <greve at fsfeurope dot org>
|
||||
;; Keywords: outlines, hypermedia, calendar, wp, email, mairix
|
||||
;; Purpose: Integrate mairix email searching into Org mode
|
||||
;; See https://orgmode.org and http://www.rpcurnow.force9.co.uk/mairix/
|
||||
;; Version: 0.5
|
||||
;;
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; This file 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, or (at your option)
|
||||
;; any later version.
|
||||
|
||||
;; It is distributed in the hope that it will be useful, but WITHOUT
|
||||
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
|
||||
;; License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; USAGE NOTE
|
||||
;;
|
||||
;; You will need to configure mairix first, which involves setting up your
|
||||
;; .mairixrc in your home directory. Once it is working, you should set up
|
||||
;; your way to display results in your favorite way -- usually a MUA.
|
||||
;; Currently gnus and mutt are supported.
|
||||
;;
|
||||
;; After both steps are done, all you should need to hook mairix, org
|
||||
;; and your MUA together is to do (require 'org-mairix) in your
|
||||
;; startup file. Everything can then be configured normally through
|
||||
;; Emacs customisation.
|
||||
;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(require 'org)
|
||||
|
||||
;;; The custom variables
|
||||
|
||||
(defgroup org-mairix nil
|
||||
"Mairix support/integration in org."
|
||||
:tag "Org Mairix"
|
||||
:group 'org)
|
||||
|
||||
(defcustom org-mairix-threaded-links t
|
||||
"Should new links be created as threaded links?
|
||||
If t, links will be stored as threaded searches.
|
||||
If nil, links will be stored as non-threaded searches."
|
||||
:group 'org-mairix
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom org-mairix-augmented-links nil
|
||||
"Should new links be created as augmenting searches?
|
||||
If t, links will be stored as augmenting searches.
|
||||
If nil, links will be stored as normal searches.
|
||||
|
||||
Attention: When activating this option, you will need
|
||||
to remove old articles from your mairix results group
|
||||
in some other way, mairix will not do it for you."
|
||||
:group 'org-mairix
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom org-mairix-display-hook 'org-mairix-gnus-display-results
|
||||
"Hook to call to display the results of a successful mairix search.
|
||||
Defaults to Gnus, feel free to add your own MUAs or methods."
|
||||
:group 'org-mairix
|
||||
:type 'hook)
|
||||
|
||||
(defcustom org-mairix-open-command "mairix %args% '%search%'"
|
||||
"The mairix command-line to use. If your paths are set up
|
||||
correctly, you should not need to change this.
|
||||
|
||||
'%search%' will get substituted with the search expression, and
|
||||
'%args%' with any additional arguments."
|
||||
:group 'org-mairix
|
||||
:type 'string)
|
||||
|
||||
;;; The hooks to integrate mairix into org
|
||||
|
||||
(org-link-set-parameters "mairix"
|
||||
:follow #'org-mairix-open
|
||||
:store #'org-mairix-store-gnus-link)
|
||||
|
||||
;;; Generic org-mairix functions
|
||||
|
||||
(defun org-mairix-construct-link (message-id)
|
||||
"Construct a mairix: hyperlink based on message-id."
|
||||
(concat "mairix:"
|
||||
(if org-mairix-threaded-links "t:")
|
||||
(if org-mairix-augmented-links "a:")
|
||||
"@@"
|
||||
(org-unbracket-string "<" ">" message-id)))
|
||||
|
||||
(defun org-store-mairix-link-props (&rest plist)
|
||||
"Take a property list describing a mail, and add mairix link
|
||||
and description properties so that org can build a mairix link to
|
||||
it."
|
||||
;; We have to call `org-store-link-props' twice:
|
||||
;;
|
||||
;; - It extracts 'fromname'/'fromaddress' from 'from' property,
|
||||
;; and stores the updated plist to `org-store-link-plist'.
|
||||
;;
|
||||
;; - `org-email-link-description' uses these new properties to
|
||||
;; build a description from the previously stored plist. I
|
||||
;; wrote a tiny patch to `org-email-link-description' so it
|
||||
;; could take a non-stored plist as an optional 2nd argument,
|
||||
;; but the plist provided still needs 'fromname'/'fromaddress'.
|
||||
;;
|
||||
;; - Ideally we would decouple the storing bit of
|
||||
;; `org-store-link-props' from the extraction bit, but lots of
|
||||
;; stuff in `org-store-link' which calls it would need to be
|
||||
;; changed. Maybe just factor out the extraction so it can be
|
||||
;; reused separately?
|
||||
(let ((mid (plist-get plist :message-id)))
|
||||
(apply 'org-store-link-props
|
||||
(append plist
|
||||
(list :type "mairix"
|
||||
:link (org-mairix-construct-link mid))))
|
||||
(apply 'org-store-link-props
|
||||
(append org-store-link-plist
|
||||
(list :description (org-email-link-description))))))
|
||||
|
||||
(defun org-mairix-message-send-and-exit-with-link ()
|
||||
"Function that can be assigned as an alternative sending function,
|
||||
it sends the message and then stores a mairix link to it before burying
|
||||
the buffer just like 'message-send-and-exit' does."
|
||||
(interactive)
|
||||
(message-send)
|
||||
(let* ((message-id (message-fetch-field "Message-Id"))
|
||||
(subject (message-fetch-field "Subject"))
|
||||
(link (org-mairix-construct-link message-id))
|
||||
(desc (concat "Email: '" subject "'")))
|
||||
(setq org-stored-links
|
||||
(cons (list link desc) org-stored-links)))
|
||||
(message-bury (current-buffer)))
|
||||
|
||||
(defun org-mairix-open (search _)
|
||||
"Function to open mairix link.
|
||||
|
||||
We first need to split it into its individual parts, and then
|
||||
extract the message-id to be passed on to the display function
|
||||
before call mairix, evaluate the number of matches returned, and
|
||||
make sure to only call display of mairix succeeded in matching."
|
||||
(let* ((args ""))
|
||||
(if (equal (substring search 0 2) "t:" )
|
||||
(progn (setq search (substring search 2 nil))
|
||||
(setq args (concat args " --threads"))))
|
||||
(if (equal (substring search 0 2) "a:")
|
||||
(progn (setq search (substring search 2 nil))
|
||||
(setq args (concat args " --augment"))))
|
||||
(let ((cmdline (org-mairix-command-substitution
|
||||
org-mairix-open-command search args)))
|
||||
(print cmdline)
|
||||
(setq retval (shell-command-to-string cmdline))
|
||||
(string-match "\[0-9\]+" retval)
|
||||
(setq matches (string-to-number (match-string 0 retval)))
|
||||
(if (eq matches 0) (message "Link failed: no matches, sorry")
|
||||
(message "Link returned %d matches" matches)
|
||||
(run-hook-with-args 'org-mairix-display-hook search args)))))
|
||||
|
||||
(defun org-mairix-command-substitution (cmd search args)
|
||||
"Substitute '%search%' and '%args% in mairix search command."
|
||||
(while (string-match "%search%" cmd)
|
||||
(setq cmd (replace-match search 'fixedcase 'literal cmd)))
|
||||
(while (string-match "%args%" cmd)
|
||||
(setq cmd (replace-match args 'fixedcase 'literal cmd)))
|
||||
cmd)
|
||||
|
||||
;;; Functions necessary for integration of external MUAs.
|
||||
|
||||
;; Of course we cannot call `org-store-link' from within an external
|
||||
;; MUA, so we need some other way of storing a link for later
|
||||
;; retrieval by org-mode and/or remember-mode. To do this we use a
|
||||
;; temporary file as a kind of dedicated clipboard.
|
||||
|
||||
(defcustom org-mairix-link-clipboard "~/.org-mairix-link"
|
||||
"Pseudo-clipboard file where mairix URLs get copied to by external
|
||||
applications in order to mimic `org-store-link'. Used by
|
||||
`org-mairix-insert-link'."
|
||||
:group 'org-mairix
|
||||
:type 'string)
|
||||
|
||||
;; When we resolve some of the issues with `org-store-link' detailed
|
||||
;; at <https://orgmode.org/list/20071105181739.GB13544@atlantic.linksys.moosehall
|
||||
;; we might not need org-mairix-insert-link.
|
||||
|
||||
(defun org-mairix-insert-link ()
|
||||
"Insert link from file defined by `org-mairix-link-clipboard'."
|
||||
(interactive)
|
||||
(let ((bytes (cadr (insert-file-contents
|
||||
(expand-file-name org-mairix-link-clipboard)))))
|
||||
(forward-char bytes)
|
||||
(save-excursion
|
||||
(forward-char -1)
|
||||
(if (looking-at "\n")
|
||||
(delete-char 1)))))
|
||||
|
||||
;;; Functions necessary for mutt integration
|
||||
|
||||
(defgroup org-mairix-mutt nil
|
||||
"Use mutt for mairix support in org."
|
||||
:tag "Org Mairix Mutt"
|
||||
:group 'org-mairix)
|
||||
|
||||
(defcustom org-mairix-mutt-display-command
|
||||
"xterm -title 'mairix search: %search%' -e 'unset COLUMNS; mutt -f
|
||||
~/mail/mairix -e \"push <display-message>\"' &"
|
||||
"Command to execute to display mairix search results via mutt within
|
||||
an xterm.
|
||||
|
||||
'%search%' will get substituted with the search expression, and
|
||||
'%args%' with any additional arguments used in the search."
|
||||
:group 'org-mairix-mutt
|
||||
:type 'string)
|
||||
|
||||
(defun org-mairix-mutt-display-results (search args)
|
||||
"Display results of mairix search in mutt, using the command line
|
||||
defined in `org-mairix-mutt-display-command'."
|
||||
;; By default, async `shell-command' invocations display the temp
|
||||
;; buffer, which is annoying here. We choose a deterministic
|
||||
;; buffer name so we can hide it again immediately.
|
||||
;; Note: `call-process' is synchronous so not useful here.
|
||||
(let ((cmd (org-mairix-command-substitution
|
||||
org-mairix-mutt-display-command search args))
|
||||
(tmpbufname (generate-new-buffer-name " *mairix-view*")))
|
||||
(shell-command cmd tmpbufname)
|
||||
(delete-windows-on (get-buffer tmpbufname))))
|
||||
|
||||
;;; Functions necessary for gnus integration
|
||||
|
||||
(defgroup org-mairix-gnus nil
|
||||
"Use gnus for mairix support in org."
|
||||
:tag "Org Mairix Gnus"
|
||||
:group 'org-mairix)
|
||||
|
||||
(defcustom org-mairix-gnus-results-group "nnmaildir:mairix"
|
||||
"The group that is configured to hold the mairix search results,
|
||||
which needs to be setup independently of the org-mairix integration,
|
||||
along with general mairix configuration."
|
||||
:group 'org-mairix-gnus
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-mairix-gnus-select-display-group-function
|
||||
'org-mairix-gnus-select-display-group-function-gg
|
||||
"Hook to call to select the group that contains the matching articles.
|
||||
We should not need this, it is owed to a problem of gnus that people were
|
||||
not yet able to figure out, see
|
||||
http://article.gmane.org/gmane.emacs.gnus.general/65248
|
||||
http://article.gmane.org/gmane.emacs.gnus.general/65265
|
||||
http://article.gmane.org/gmane.emacs.gnus.user/9596
|
||||
for reference.
|
||||
|
||||
It seems gnus needs a 'forget/ignore everything you think you
|
||||
know about that group' function. Volunteers?"
|
||||
:group 'org-mairix-gnus
|
||||
:type 'hook)
|
||||
|
||||
(defun org-mairix-store-gnus-link ()
|
||||
"Store a link to the current gnus message as a Mairix search for its
|
||||
Message ID."
|
||||
|
||||
;; gnus integration
|
||||
(when (memq major-mode '(gnus-summary-mode gnus-article-mode))
|
||||
(and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary))
|
||||
(let* ((article (gnus-summary-article-number))
|
||||
(header (gnus-summary-article-header article))
|
||||
(from (mail-header-from header))
|
||||
(message-id (mail-header-id header))
|
||||
(subject (gnus-summary-subject-string)))
|
||||
(org-store-mairix-link-props :from from
|
||||
:subject subject
|
||||
:message-id message-id))))
|
||||
|
||||
(defun org-mairix-gnus-display-results (search args)
|
||||
"Display results of mairix search in Gnus.
|
||||
|
||||
Note: This does not work as cleanly as I would like it to. The
|
||||
problem being that Gnus should simply reread the group cleanly,
|
||||
without remembering anything. At the moment it seems to be unable
|
||||
to do that -- so you're likely to see zombies floating around.
|
||||
|
||||
If you can improve this, please do!"
|
||||
(if (not (equal (substring search 0 2) "m:" ))
|
||||
(error "org-mairix-gnus-display-results: display of search other than
|
||||
message-id not implemented yet"))
|
||||
(setq message-id (substring search 2 nil))
|
||||
(require 'gnus)
|
||||
(require 'gnus-sum)
|
||||
;; FIXME: (bzg/gg) We might need to make sure gnus is running here,
|
||||
;; and to start it in case it isn't running already. Does
|
||||
;; anyone know a function to do that? It seems main org mode
|
||||
;; does not do this, either.
|
||||
(funcall (cdr (assq 'gnus org-link-frame-setup)))
|
||||
(if gnus-other-frame-object (select-frame gnus-other-frame-object))
|
||||
|
||||
;; FIXME: This is horribly broken. Please see
|
||||
;; http://article.gmane.org/gmane.emacs.gnus.general/65248
|
||||
;; http://article.gmane.org/gmane.emacs.gnus.general/65265
|
||||
;; http://article.gmane.org/gmane.emacs.gnus.user/9596
|
||||
;; for reference.
|
||||
;;
|
||||
;; It seems gnus needs a "forget/ignore everything you think you
|
||||
;; know about that group" function. Volunteers?
|
||||
;;
|
||||
;; For now different methods seem to work differently well for
|
||||
;; different people. So we're playing hook-selection here to make
|
||||
;; it easy to play around until we found a proper solution.
|
||||
(run-hook-with-args 'org-mairix-gnus-select-display-group-function)
|
||||
(gnus-summary-select-article
|
||||
nil t t (car (gnus-find-matching-articles "message-id" message-id))))
|
||||
|
||||
(defun org-mairix-gnus-select-display-group-function-gg ()
|
||||
"Georg's hack to select a group that gnus (falsely) believes to be
|
||||
empty to then call rebuilding of the summary. It leaves zombies of
|
||||
old searches around, though."
|
||||
(gnus-group-quick-select-group 0 org-mairix-gnus-results-group)
|
||||
(gnus-group-clear-data)
|
||||
(gnus-summary-reselect-current-group t t))
|
||||
|
||||
(defun org-mairix-gnus-select-display-group-function-bzg ()
|
||||
"This is the classic way the org mode is using, and it seems to be
|
||||
using better for Bastien, so it may work for you."
|
||||
(gnus-group-clear-data org-mairix-gnus-results-group)
|
||||
(gnus-group-read-group t nil org-mairix-gnus-results-group))
|
||||
|
||||
(provide 'org-mairix)
|
||||
|
||||
;;; org-mairix.el ends here
|
||||
407
lisp/org-contrib/org-notify.el
Normal file
407
lisp/org-contrib/org-notify.el
Normal file
@@ -0,0 +1,407 @@
|
||||
;;; org-notify.el --- Notifications for Org-mode
|
||||
|
||||
;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Peter Münster <pmrb@free.fr>
|
||||
;; Homepage: https://github.com/p-m/org-notify
|
||||
;; Keywords: notification, todo-list, alarm, reminder, pop-up
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Get notifications, when there is something to do.
|
||||
;; Sometimes, you need a reminder a few days before a deadline, e.g. to buy a
|
||||
;; present for a birthday, and then another notification one hour before to
|
||||
;; have enough time to choose the right clothes.
|
||||
;; For other events, e.g. rolling the dustbin to the roadside once per week,
|
||||
;; you probably need another kind of notification strategy.
|
||||
;; This package tries to satisfy the various needs.
|
||||
|
||||
;; In order to activate this package, you must add the following code
|
||||
;; into your .emacs:
|
||||
;;
|
||||
;; (require 'org-notify)
|
||||
;; (org-notify-start)
|
||||
|
||||
;; Example setup:
|
||||
;;
|
||||
;; (org-notify-add 'appt
|
||||
;; '(:time "-1s" :period "20s" :duration 10
|
||||
;; :actions (-message -ding))
|
||||
;; '(:time "15m" :period "2m" :duration 100
|
||||
;; :actions -notify)
|
||||
;; '(:time "2h" :period "5m" :actions -message)
|
||||
;; '(:time "3d" :actions -email))
|
||||
;;
|
||||
;; This means for todo-items with `notify' property set to `appt': 3 days
|
||||
;; before deadline, send a reminder-email, 2 hours before deadline, start to
|
||||
;; send messages every 5 minutes, then 15 minutes before deadline, start to
|
||||
;; pop up notification windows every 2 minutes. The timeout of the window is
|
||||
;; set to 100 seconds. Finally, when deadline is overdue, send messages and
|
||||
;; make noise."
|
||||
|
||||
;; Take also a look at the function `org-notify-add'.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
(require 'org-element)
|
||||
|
||||
(declare-function appt-delete-window "appt" ())
|
||||
(declare-function notifications-notify "notifications" (&rest prms))
|
||||
(declare-function article-lapsed-string "gnus-art" (t &optional ms))
|
||||
|
||||
(defgroup org-notify nil
|
||||
"Options for Org-mode notifications."
|
||||
:tag "Org Notify"
|
||||
:group 'org)
|
||||
|
||||
(defcustom org-notify-audible t
|
||||
"Non-nil means beep to indicate notification."
|
||||
:type 'boolean
|
||||
:group 'org-notify)
|
||||
|
||||
(defcustom org-notify-max-notifications-per-run 3
|
||||
"Maximum number of notifications per run of `org-notify-process'."
|
||||
:type 'integer
|
||||
:group 'org-notify)
|
||||
|
||||
(defconst org-notify-actions
|
||||
'("show" "show" "done" "done" "hour" "one hour later" "day" "one day later"
|
||||
"week" "one week later")
|
||||
"Possible actions for call-back functions.")
|
||||
|
||||
(defconst org-notify-window-buffer-name "*org-notify-%s*"
|
||||
"Buffer-name for the `org-notify-action-window' function.")
|
||||
|
||||
(defvar org-notify-map nil
|
||||
"Mapping between names and parameter lists.")
|
||||
|
||||
(defvar org-notify-timer nil
|
||||
"Timer of the notification daemon.")
|
||||
|
||||
(defvar org-notify-parse-file nil
|
||||
"Index of current file, that `org-element-parse-buffer' is parsing.")
|
||||
|
||||
(defvar org-notify-on-action-map nil
|
||||
"Mapping between on-action identifiers and parameter lists.")
|
||||
|
||||
(defun org-notify-string->seconds (str)
|
||||
"Convert time string STR to number of seconds."
|
||||
(when str
|
||||
(let* ((conv `(("s" . 1) ("m" . 60) ("h" . ,(* 60 60))
|
||||
("d" . ,(* 24 60 60)) ("w" . ,(* 7 24 60 60))
|
||||
("M" . ,(* 30 24 60 60))))
|
||||
(letters (concat
|
||||
(mapcar (lambda (x) (string-to-char (car x))) conv)))
|
||||
(case-fold-search nil))
|
||||
(string-match (concat "\\(-?\\)\\([0-9]+\\)\\([" letters "]\\)") str)
|
||||
(* (string-to-number (match-string 2 str))
|
||||
(cdr (assoc (match-string 3 str) conv))
|
||||
(if (= (length (match-string 1 str)) 1) -1 1)))))
|
||||
|
||||
(defun org-notify-convert-deadline (orig)
|
||||
"Convert original deadline from `org-element-parse-buffer' to
|
||||
simple timestamp string."
|
||||
(if orig
|
||||
(replace-regexp-in-string "^<\\|>$" ""
|
||||
(plist-get (plist-get orig 'timestamp)
|
||||
:raw-value))))
|
||||
|
||||
(defun org-notify-make-todo (heading &rest ignored)
|
||||
"Create one todo item."
|
||||
(cl-macrolet ((get (k) `(plist-get list ,k))
|
||||
(pr (k v) `(setq result (plist-put result ,k ,v))))
|
||||
(let* ((list (nth 1 heading)) (notify (or (get :NOTIFY) "default"))
|
||||
(deadline (org-notify-convert-deadline (get :deadline)))
|
||||
(heading (get :raw-value))
|
||||
result)
|
||||
(when (and (eq (get :todo-type) 'todo) heading deadline)
|
||||
(pr :heading heading) (pr :notify (intern notify))
|
||||
(pr :begin (get :begin))
|
||||
(pr :file (nth org-notify-parse-file (org-agenda-files 'unrestricted)))
|
||||
(pr :timestamp deadline) (pr :uid (md5 (concat heading deadline)))
|
||||
(pr :deadline (- (org-time-string-to-seconds deadline)
|
||||
(float-time))))
|
||||
result)))
|
||||
|
||||
(defun org-notify-todo-list ()
|
||||
"Create the todo-list for one org-agenda file."
|
||||
(let* ((files (org-agenda-files 'unrestricted))
|
||||
(max (1- (length files))))
|
||||
(when files
|
||||
(setq org-notify-parse-file
|
||||
(if (or (not org-notify-parse-file) (>= org-notify-parse-file max))
|
||||
0
|
||||
(1+ org-notify-parse-file)))
|
||||
(save-excursion
|
||||
(with-current-buffer (find-file-noselect
|
||||
(nth org-notify-parse-file files))
|
||||
(org-element-map (org-element-parse-buffer 'headline)
|
||||
'headline 'org-notify-make-todo))))))
|
||||
|
||||
(defun org-notify-maybe-too-late (diff period heading)
|
||||
"Print warning message, when notified significantly later than defined by
|
||||
PERIOD."
|
||||
(if (> (/ diff period) 1.5)
|
||||
(message "Warning: notification for \"%s\" behind schedule!" heading))
|
||||
t)
|
||||
|
||||
(cl-defun org-notify-process ()
|
||||
"Process the todo-list, and possibly notify user about upcoming or
|
||||
forgotten tasks."
|
||||
(let ((notification-cnt 0))
|
||||
(cl-macrolet ((prm (k) `(plist-get prms ,k)) (td (k) `(plist-get todo ,k)))
|
||||
(dolist (todo (org-notify-todo-list))
|
||||
(let* ((deadline (td :deadline)) (heading (td :heading))
|
||||
(uid (td :uid)) (last-run-sym
|
||||
(intern (concat ":last-run-" uid))))
|
||||
(cl-dolist (prms (plist-get org-notify-map (td :notify)))
|
||||
(when (< deadline (org-notify-string->seconds (prm :time)))
|
||||
(let ((period (org-notify-string->seconds (prm :period)))
|
||||
(last-run (prm last-run-sym)) (now (float-time))
|
||||
(actions (prm :actions)) diff plist)
|
||||
(when (or (not last-run)
|
||||
(and period (< period (setq diff (- now last-run)))
|
||||
(org-notify-maybe-too-late diff period heading)))
|
||||
(setq prms (plist-put prms last-run-sym now)
|
||||
plist (append todo prms))
|
||||
(if (if (plist-member prms :audible)
|
||||
(prm :audible)
|
||||
org-notify-audible)
|
||||
(ding))
|
||||
(unless (listp actions)
|
||||
(setq actions (list actions)))
|
||||
(cl-incf notification-cnt)
|
||||
(dolist (action actions)
|
||||
(funcall (if (fboundp action) action
|
||||
(intern (concat "org-notify-action"
|
||||
(symbol-name action))))
|
||||
plist))
|
||||
(when (>= notification-cnt org-notify-max-notifications-per-run)
|
||||
(cl-return-from org-notify-process)))
|
||||
(cl-return)))))))))
|
||||
|
||||
(defun org-notify-add (name &rest params)
|
||||
"Add a new notification type.
|
||||
The NAME can be used in Org-mode property `notify'. If NAME is
|
||||
`default', the notification type applies for todo items without
|
||||
the `notify' property. This file predefines such a default
|
||||
notification type.
|
||||
|
||||
Each element of PARAMS is a list with parameters for a given time
|
||||
distance to the deadline. This distance must increase from one
|
||||
element to the next.
|
||||
|
||||
List of possible parameters:
|
||||
|
||||
:time Time distance to deadline, when this type of notification shall
|
||||
start. It's a string: an integral value (positive or negative)
|
||||
followed by a unit (s, m, h, d, w, M).
|
||||
:actions A function or a list of functions to be called to notify the
|
||||
user. Instead of a function name, you can also supply a suffix
|
||||
of one of the various predefined `org-notify-action-xxx'
|
||||
functions.
|
||||
:period Optional: can be used to repeat the actions periodically.
|
||||
Same format as :time.
|
||||
:duration Some actions use this parameter to specify the duration of the
|
||||
notification. It's an integral number in seconds.
|
||||
:audible Overwrite the value of `org-notify-audible' for this action.
|
||||
|
||||
For the actions, you can use your own functions or some of the predefined
|
||||
ones, whose names are prefixed with `org-notify-action-'."
|
||||
(setq org-notify-map (plist-put org-notify-map name params)))
|
||||
|
||||
(defun org-notify-start (&optional secs)
|
||||
"Start the notification daemon.
|
||||
If SECS is positive, it's the period in seconds for processing
|
||||
the notifications of one org-agenda file, and if negative,
|
||||
notifications will be checked only when emacs is idle for -SECS
|
||||
seconds. The default value for SECS is 20."
|
||||
(interactive)
|
||||
(if org-notify-timer
|
||||
(org-notify-stop))
|
||||
(setq secs (or secs 20)
|
||||
org-notify-timer (if (< secs 0)
|
||||
(run-with-idle-timer (* -1 secs) t
|
||||
'org-notify-process)
|
||||
(run-with-timer secs secs 'org-notify-process))))
|
||||
|
||||
(defun org-notify-stop ()
|
||||
"Stop the notification daemon."
|
||||
(when org-notify-timer
|
||||
(cancel-timer org-notify-timer)
|
||||
(setq org-notify-timer nil)))
|
||||
|
||||
(defun org-notify-on-action (plist key)
|
||||
"User wants to see action."
|
||||
(let ((file (plist-get plist :file))
|
||||
(begin (plist-get plist :begin)))
|
||||
(if (string-equal key "show")
|
||||
(progn
|
||||
(switch-to-buffer (find-file-noselect file))
|
||||
(org-with-wide-buffer
|
||||
(goto-char begin)
|
||||
(outline-show-entry))
|
||||
(goto-char begin)
|
||||
(search-forward "DEADLINE: <")
|
||||
(search-forward ":")
|
||||
(if (display-graphic-p)
|
||||
(x-focus-frame nil)))
|
||||
(save-excursion
|
||||
(with-current-buffer (find-file-noselect file)
|
||||
(org-with-wide-buffer
|
||||
(goto-char begin)
|
||||
(search-forward "DEADLINE: <")
|
||||
(cond
|
||||
((string-equal key "done") (org-todo))
|
||||
((string-equal key "hour") (org-timestamp-change 60 'minute))
|
||||
((string-equal key "day") (org-timestamp-up-day))
|
||||
((string-equal key "week") (org-timestamp-change 7 'day)))))))))
|
||||
|
||||
(defun org-notify-on-action-notify (id key)
|
||||
"User wants to see action after mouse-click in notify window."
|
||||
(org-notify-on-action (plist-get org-notify-on-action-map id) key)
|
||||
(org-notify-on-close id nil))
|
||||
|
||||
(defun org-notify-on-action-button (button)
|
||||
"User wants to see action after button activation."
|
||||
(cl-macrolet ((get (k) `(button-get button ,k)))
|
||||
(org-notify-on-action (get 'plist) (get 'key))
|
||||
(org-notify-delete-window (get 'buffer))
|
||||
(cancel-timer (get 'timer))))
|
||||
|
||||
(defun org-notify-delete-window (buffer)
|
||||
"Delete the notification window."
|
||||
(require 'appt)
|
||||
(let ((appt-buffer-name buffer)
|
||||
(appt-audible nil))
|
||||
(appt-delete-window)))
|
||||
|
||||
(defun org-notify-on-close (id reason)
|
||||
"Notification window has been closed."
|
||||
(setq org-notify-on-action-map (plist-put org-notify-on-action-map id nil)))
|
||||
|
||||
(defun org-notify-action-message (plist)
|
||||
"Print a message."
|
||||
(message "TODO: \"%s\" at %s!" (plist-get plist :heading)
|
||||
(plist-get plist :timestamp)))
|
||||
|
||||
(defun org-notify-action-ding (plist)
|
||||
"Make noise."
|
||||
(let ((timer (run-with-timer 0 1 'ding)))
|
||||
(run-with-timer (or (plist-get plist :duration) 3) nil
|
||||
'cancel-timer timer)))
|
||||
|
||||
(defun org-notify-body-text (plist)
|
||||
"Make human readable string for remaining time to deadline."
|
||||
(require 'gnus-art)
|
||||
(format "%s\n(%s)"
|
||||
(replace-regexp-in-string
|
||||
" in the future" ""
|
||||
(article-lapsed-string
|
||||
(time-add (current-time)
|
||||
(seconds-to-time (plist-get plist :deadline))) 2))
|
||||
(plist-get plist :timestamp)))
|
||||
|
||||
(defun org-notify-action-email (plist)
|
||||
"Send email to user."
|
||||
(compose-mail user-mail-address (concat "TODO: " (plist-get plist :heading)))
|
||||
(insert (org-notify-body-text plist))
|
||||
(funcall send-mail-function)
|
||||
(cl-letf (((symbol-function 'yes-or-no-p) (lambda (x) t)))
|
||||
(kill-buffer)))
|
||||
|
||||
(defun org-notify-select-highest-window ()
|
||||
"Select the highest window on the frame, that is not is not an
|
||||
org-notify window. Mostly copied from `appt-select-lowest-window'."
|
||||
(let ((highest-window (selected-window))
|
||||
(bottom-edge (nth 3 (window-edges)))
|
||||
next-bottom-edge)
|
||||
(walk-windows (lambda (w)
|
||||
(when (and
|
||||
(not (string-match "^\\*org-notify-.*\\*$"
|
||||
(buffer-name
|
||||
(window-buffer w))))
|
||||
(> bottom-edge (setq next-bottom-edge
|
||||
(nth 3 (window-edges w)))))
|
||||
(setq bottom-edge next-bottom-edge
|
||||
highest-window w))) 'nomini)
|
||||
(select-window highest-window)))
|
||||
|
||||
(defun org-notify-action-window (plist)
|
||||
"Pop up a window, mostly copied from `appt-disp-window'."
|
||||
(save-excursion
|
||||
(cl-macrolet ((get (k) `(plist-get plist ,k)))
|
||||
(let ((this-window (selected-window))
|
||||
(buf (get-buffer-create
|
||||
(format org-notify-window-buffer-name (get :uid)))))
|
||||
(when (minibufferp)
|
||||
(other-window 1)
|
||||
(and (minibufferp) (display-multi-frame-p) (other-frame 1)))
|
||||
(if (cdr (assq 'unsplittable (frame-parameters)))
|
||||
(progn (set-buffer buf) (display-buffer buf))
|
||||
(unless (or (special-display-p (buffer-name buf))
|
||||
(same-window-p (buffer-name buf)))
|
||||
(org-notify-select-highest-window)
|
||||
(when (>= (window-height) (* 2 window-min-height))
|
||||
(select-window (split-window nil nil 'above))))
|
||||
(switch-to-buffer buf))
|
||||
(setq buffer-read-only nil buffer-undo-list t)
|
||||
(erase-buffer)
|
||||
(insert (format "TODO: %s, %s.\n" (get :heading)
|
||||
(org-notify-body-text plist)))
|
||||
(let ((timer (run-with-timer (or (get :duration) 10) nil
|
||||
'org-notify-delete-window buf)))
|
||||
(dotimes (i (/ (length org-notify-actions) 2))
|
||||
(let ((key (nth (* i 2) org-notify-actions))
|
||||
(text (nth (1+ (* i 2)) org-notify-actions)))
|
||||
(insert-button text 'action 'org-notify-on-action-button
|
||||
'key key 'buffer buf 'plist plist 'timer timer)
|
||||
(insert " "))))
|
||||
(shrink-window-if-larger-than-buffer (get-buffer-window buf t))
|
||||
(set-buffer-modified-p nil) (setq buffer-read-only t)
|
||||
(raise-frame (selected-frame)) (select-window this-window)))))
|
||||
|
||||
(defun org-notify-action-notify (plist)
|
||||
"Pop up a notification window."
|
||||
(require 'notifications)
|
||||
(let* ((duration (plist-get plist :duration))
|
||||
(id (notifications-notify
|
||||
:title (plist-get plist :heading)
|
||||
:body (org-notify-body-text plist)
|
||||
:timeout (if duration (* duration 1000))
|
||||
:urgency (plist-get plist :urgency)
|
||||
:actions org-notify-actions
|
||||
:on-action 'org-notify-on-action-notify)))
|
||||
(setq org-notify-on-action-map
|
||||
(plist-put org-notify-on-action-map id plist))))
|
||||
|
||||
(defun org-notify-action-notify/window (plist)
|
||||
"For a graphics display, pop up a notification window, for a text
|
||||
terminal an emacs window."
|
||||
(if (display-graphic-p)
|
||||
(org-notify-action-notify plist)
|
||||
(org-notify-action-window plist)))
|
||||
|
||||
;;; Provide a minimal default setup.
|
||||
(org-notify-add 'default '(:time "1h" :actions -notify/window
|
||||
:period "2m" :duration 60))
|
||||
|
||||
(provide 'org-notify)
|
||||
|
||||
;;; org-notify.el ends here
|
||||
626
lisp/org-contrib/org-panel.el
Normal file
626
lisp/org-contrib/org-panel.el
Normal file
@@ -0,0 +1,626 @@
|
||||
;;; org-panel.el --- Simple routines for us with bad memory
|
||||
;;
|
||||
;; Author: Lennart Borgman (lennart O borgman A gmail O com)
|
||||
;; Created: Thu Nov 15 15:35:03 2007
|
||||
;; Version: 0.21
|
||||
;; Lxast-Updated: Wed Nov 21 03:06:03 2007 (3600 +0100)
|
||||
;;
|
||||
;; Features that might be required by this library:
|
||||
;;
|
||||
;; `easymenu', `font-lock', `noutline', `org', `outline', `syntax',
|
||||
;; `time-date'.
|
||||
;;
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; This program is free software; you can redistribute it and/or
|
||||
;; modify it under the terms of the GNU General Public License as
|
||||
;; published by the Free Software Foundation; either version 3, 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
;;
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; This defines a kind of control panel for `org-mode'. This control
|
||||
;; panel should make it fast to move around and edit structure etc.
|
||||
;;
|
||||
;; To bring up the control panel type
|
||||
;;
|
||||
;; M-x orgpan-panel
|
||||
;;
|
||||
;; Type ? there for help.
|
||||
;;
|
||||
;; I suggest you add the following to your .emacs for quick access of
|
||||
;; the panel:
|
||||
;;
|
||||
;; (eval-after-load 'org-mode
|
||||
;; (define-key org-mode-map [(control ?c) ?p] 'orgpan-panel))
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(require 'org)
|
||||
(require 'outline)
|
||||
|
||||
;; Fix-me: this is for testing. A minor mode version interferes badly
|
||||
;; with emulation minor modes. On the other hand, the other version
|
||||
;; interferes badly with (interactive ...).
|
||||
(defvar orgpan-minor-mode-version t)
|
||||
|
||||
(defface orgpan-field
|
||||
'((t (:inherit 'widget-field)))
|
||||
"Face for fields."
|
||||
:group 'winsize)
|
||||
(defvar orgpan-field-face 'orgpan-field)
|
||||
|
||||
(defface orgpan-active-field
|
||||
'((t (:inherit 'highlight)))
|
||||
"Face for fields."
|
||||
:group 'winsize)
|
||||
(defvar orgpan-active-field-face 'orgpan-active-field)
|
||||
|
||||
(defface orgpan-spaceline
|
||||
'((t (:height 0.2)))
|
||||
"Face for spacing lines."
|
||||
:group 'winsize)
|
||||
|
||||
(defcustom orgpan-panel-buttons nil
|
||||
"Panel style, if non-nil use buttons.
|
||||
If there are buttons in the panel they are used to change the way
|
||||
the arrow keys work. The panel looks something like this, with
|
||||
the first button chosen:
|
||||
|
||||
[Navigate] [Restructure] [TODO/Priority]
|
||||
----------
|
||||
up/down, left: Go to, right: Visibility
|
||||
|
||||
The line below the buttons try to give a short hint about what
|
||||
the arrow keys does. \(Personally I prefer the version without
|
||||
buttons since I then do not have to remember which button is
|
||||
active.)"
|
||||
:type 'boolean
|
||||
:group 'winsize)
|
||||
|
||||
;; Fix-me: add org-mode-map
|
||||
(defconst orgpan-org-mode-commands nil)
|
||||
(defconst orgpan-org-commands
|
||||
'(
|
||||
orgpan-copy-subtree
|
||||
orgpan-cut-subtree
|
||||
orgpan-paste-subtree
|
||||
undo
|
||||
;;
|
||||
;orgpan-occur
|
||||
;;
|
||||
org-cycle
|
||||
org-global-cycle
|
||||
outline-up-heading
|
||||
outline-next-visible-heading
|
||||
outline-previous-visible-heading
|
||||
outline-forward-same-level
|
||||
outline-backward-same-level
|
||||
org-todo
|
||||
org-show-todo-tree
|
||||
org-priority-up
|
||||
org-priority-down
|
||||
org-move-subtree-up
|
||||
org-move-subtree-down
|
||||
org-do-promote
|
||||
org-do-demote
|
||||
org-promote-subtree
|
||||
org-demote-subtree))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; Hook functions etc
|
||||
|
||||
(defun orgpan-delete-panel ()
|
||||
"Remove the panel."
|
||||
(interactive)
|
||||
(when (buffer-live-p orgpan-panel-buffer)
|
||||
(delete-windows-on orgpan-panel-buffer)
|
||||
(kill-buffer orgpan-panel-buffer))
|
||||
(setq orgpan-panel-buffer nil)
|
||||
(setq orgpan-panel-window nil)
|
||||
(orgpan-panel-minor-mode 0)
|
||||
(remove-hook 'post-command-hook 'orgpan-minor-post-command)
|
||||
(remove-hook 'post-command-hook 'orgpan-mode-post-command)
|
||||
;;(remove-hook 'window-configuration-change-hook 'orgpan-window-config-change)
|
||||
)
|
||||
|
||||
(defvar orgpan-last-command-was-from-panel nil)
|
||||
(defun orgpan-mode-pre-command ()
|
||||
(setq orgpan-last-command-was-from-panel nil)
|
||||
(condition-case err
|
||||
(if (not (and (windowp orgpan-org-window)
|
||||
(window-live-p orgpan-org-window)))
|
||||
(progn
|
||||
(setq this-command 'ignore)
|
||||
(orgpan-delete-panel)
|
||||
(message "The window belonging to the panel had disappeared, removed panel."))
|
||||
(let ((buf (window-buffer orgpan-org-window)))
|
||||
(when (with-current-buffer buf
|
||||
(derived-mode-p 'org-mode))
|
||||
(setq orgpan-last-org-buffer buf))
|
||||
;; Fix me: add a list of those commands that are not
|
||||
;; meaningful from the panel (for example org-time-stamp)
|
||||
(when (or (memq this-command orgpan-org-commands)
|
||||
(memq this-command orgpan-org-mode-commands)
|
||||
;; For some reason not all org commands are found above:
|
||||
(string= "org-" (substring (format "%s" this-command) 0 4)))
|
||||
(if (not (with-current-buffer buf
|
||||
(derived-mode-p 'org-mode)))
|
||||
(progn
|
||||
(if (buffer-live-p orgpan-org-buffer)
|
||||
(set-window-buffer orgpan-org-window orgpan-org-buffer)
|
||||
(message "Please use `l' or `b' to choose an org-mode buffer"))
|
||||
(setq this-command 'ignore))
|
||||
(setq orgpan-org-buffer (window-buffer orgpan-org-window))
|
||||
(setq orgpan-last-command-was-from-panel t)
|
||||
(select-window orgpan-org-window)
|
||||
;;(when (active-minibuffer-window
|
||||
;;(set-buffer orgpan-org-buffer)
|
||||
))))
|
||||
(error (lwarn 't :warning "orgpan-pre: %S" err))))
|
||||
|
||||
(defun orgpan-mode-post-command ()
|
||||
(condition-case err
|
||||
(progn
|
||||
(unless (and (windowp orgpan-panel-window)
|
||||
(window-live-p orgpan-panel-window)
|
||||
(bufferp orgpan-panel-buffer)
|
||||
(buffer-live-p orgpan-panel-buffer))
|
||||
;;(orgpan-delete-panel)
|
||||
)
|
||||
(when (and orgpan-last-command-was-from-panel
|
||||
(windowp orgpan-panel-window)
|
||||
(window-live-p orgpan-panel-window))
|
||||
(select-window orgpan-panel-window)
|
||||
(when (derived-mode-p 'orgpan-mode)
|
||||
(setq deactivate-mark t)
|
||||
(when orgpan-panel-buttons
|
||||
(unless (and orgpan-point
|
||||
(= (point) orgpan-point))
|
||||
;; Go backward so it is possible to click on a "button":
|
||||
(orgpan-backward-field))))))
|
||||
(error (lwarn 't :warning "orgpan-post: %S" err))))
|
||||
|
||||
;; (defun orgpan-window-config-change ()
|
||||
;; "Check if any frame is displaying an orgpan panel.
|
||||
;; If not remove `orgpan-mode-post-command' and this function from
|
||||
;; the hooks."
|
||||
;; (condition-case err
|
||||
;; (unless (and (
|
||||
;; (let ((found-pan nil))
|
||||
;; (dolist (f (frame-list))
|
||||
;; (dolist (w (window-list f 'nomini))
|
||||
;; (with-current-buffer (window-buffer w)
|
||||
;; (when (derived-mode-p 'orgpan-mode)
|
||||
;; (setq found-pan t)))))
|
||||
;; (unless found-pan
|
||||
;; (remove-hook 'post-command-hook 'orgpan-mode-post-command)
|
||||
;; (remove-hook 'window-configuration-change-hook 'orgpan-window-config-change)))
|
||||
;; (error (lwarn 't :warning "Error in orgpan-config-change: %S" err))))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; Commands
|
||||
|
||||
(defun orgpan-last-buffer ()
|
||||
"Open last org-mode buffer in panels org window."
|
||||
(interactive)
|
||||
(let ((buf (window-buffer orgpan-org-window))
|
||||
(last-buf orgpan-last-org-buffer))
|
||||
(when (with-current-buffer buf
|
||||
(derived-mode-p 'org-mode))
|
||||
(setq orgpan-last-org-buffer buf))
|
||||
(when (eq last-buf buf)
|
||||
(setq last-buf nil))
|
||||
(if (not last-buf)
|
||||
(orgpan-switch-buffer)
|
||||
(set-window-buffer orgpan-org-window last-buf))))
|
||||
|
||||
(defun orgpan-switch-buffer ()
|
||||
"Switch to next org-mode buffer in panels org window."
|
||||
(interactive)
|
||||
(let ((buf (window-buffer orgpan-org-window))
|
||||
(org-buffers nil))
|
||||
(with-current-buffer buf
|
||||
(when (derived-mode-p 'org-mode)
|
||||
(bury-buffer buf)
|
||||
(setq orgpan-last-org-buffer buf)))
|
||||
(setq org-buffers (delq nil (mapcar (lambda (buf)
|
||||
(when (with-current-buffer buf
|
||||
(derived-mode-p 'org-mode))
|
||||
buf))
|
||||
(buffer-list))))
|
||||
(setq org-buffers (delq buf org-buffers))
|
||||
(set-window-buffer orgpan-org-window (car org-buffers))
|
||||
(setq orgpan-org-buffer (car org-buffers))))
|
||||
|
||||
(defun orgpan-paste-subtree ()
|
||||
(interactive)
|
||||
(if (y-or-n-p "Paste subtree here? ")
|
||||
(org-paste-subtree)
|
||||
(message "Nothing was pasted")))
|
||||
|
||||
(defun orgpan-cut-subtree ()
|
||||
(interactive)
|
||||
(let ((heading (progn
|
||||
(org-back-to-heading)
|
||||
(buffer-substring (point) (line-end-position))
|
||||
)))
|
||||
(if (y-or-n-p (format "Do you want to cut the subtree\n%s\n? " heading))
|
||||
(org-cut-subtree)
|
||||
(message "Nothing was cut"))))
|
||||
|
||||
(defun orgpan-copy-subtree ()
|
||||
(interactive)
|
||||
(let ((heading (progn
|
||||
(org-back-to-heading)
|
||||
(buffer-substring (point) (line-end-position))
|
||||
)))
|
||||
(if (y-or-n-p (format "Do you want to copy the subtree\n%s\n? " heading))
|
||||
(org-copy-subtree)
|
||||
(message "Nothing was copied"))))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; Buttons
|
||||
|
||||
(defvar orgpan-ovl-help nil)
|
||||
|
||||
(defun orgpan-check-panel-mode ()
|
||||
(unless (derived-mode-p 'orgpan-mode)
|
||||
(error "Not orgpan-mode in buffer: %s" major-mode)))
|
||||
|
||||
(defun orgpan-display-bindings-help ()
|
||||
(orgpan-check-panel-mode)
|
||||
(setq orgpan-point (point))
|
||||
(let* ((ovls (overlays-at (point)))
|
||||
(ovl (car ovls))
|
||||
(help (when ovl (overlay-get ovl 'orgpan-explain))))
|
||||
(dolist (o (overlays-in (point-min) (point-max)))
|
||||
(overlay-put o 'face orgpan-field-face))
|
||||
(overlay-put ovl 'face orgpan-active-field-face)
|
||||
(overlay-put orgpan-ovl-help 'before-string help)))
|
||||
|
||||
(defun orgpan-forward-field ()
|
||||
(interactive)
|
||||
(orgpan-check-panel-mode)
|
||||
(let ((pos (next-overlay-change (point))))
|
||||
(unless (overlays-at pos)
|
||||
(setq pos (next-overlay-change pos)))
|
||||
(when (= pos (point-max))
|
||||
(setq pos (point-min))
|
||||
(unless (overlays-at pos)
|
||||
(setq pos (next-overlay-change pos))))
|
||||
(goto-char pos))
|
||||
(orgpan-display-bindings-help))
|
||||
|
||||
(defun orgpan-backward-field ()
|
||||
(interactive)
|
||||
(orgpan-check-panel-mode)
|
||||
(when (= (point) (point-min))
|
||||
(goto-char (point-max)))
|
||||
(let ((pos (previous-overlay-change (point))))
|
||||
(unless (overlays-at pos)
|
||||
(setq pos (previous-overlay-change pos)))
|
||||
(goto-char pos))
|
||||
(orgpan-display-bindings-help))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; Mode
|
||||
|
||||
(defconst orgpan-mode-map
|
||||
;; Fix-me: clean up here!
|
||||
;; Fix-me: viper support
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map [?q] 'orgpan-delete-panel)
|
||||
(define-key map [??] 'orgpan-help)
|
||||
;; Copying etc
|
||||
(define-key map [?c] 'orgpan-copy-subtree)
|
||||
(define-key map [?x] 'orgpan-cut-subtree)
|
||||
(define-key map [?p] 'orgpan-paste-subtree)
|
||||
(define-key map [?z] 'undo)
|
||||
;; Buffers:
|
||||
(define-key map [?b] 'orgpan-switch-buffer)
|
||||
(define-key map [?l] 'orgpan-last-buffer)
|
||||
;; Some keys for moving between headings. Emacs keys for next/prev
|
||||
;; line seems ok:
|
||||
(define-key map [(control ?p)] 'outline-previous-visible-heading)
|
||||
(define-key map [(control ?n)] 'outline-next-visible-heading)
|
||||
(define-key map [(shift control ?p)] 'outline-backward-same-level)
|
||||
(define-key map [(shift control ?n)] 'outline-forward-same-level)
|
||||
;; A mnemunic for up:
|
||||
(define-key map [(control ?u)] 'outline-up-heading)
|
||||
;; Search sparse tree:
|
||||
;;
|
||||
;; Fix-me: Search does not work, some problem with
|
||||
;; interactive. Probably have to turn the whole thing around and
|
||||
;; always be in the org buffer, but with a minor mode running
|
||||
;; there.
|
||||
;;
|
||||
;;(define-key map [?s] 'org-sparse-tree)
|
||||
(define-key map [?s] 'orgpan-occur)
|
||||
;; Same as in org-mode:
|
||||
;;(define-key map [(control ?c)(control ?v)] 'org-show-todo-tree)
|
||||
;; Fix-me: This leads to strange problems:
|
||||
;;(define-key map [t] 'ignore)
|
||||
map))
|
||||
|
||||
(defun orgpan-occur ()
|
||||
"Replacement for `org-occur'.
|
||||
Technical reasons."
|
||||
(interactive)
|
||||
(let ((rgx (read-from-minibuffer "my mini Regexp: ")))
|
||||
(setq orgpan-last-command-was-from-panel t)
|
||||
(select-window orgpan-org-window)
|
||||
(org-occur rgx)))
|
||||
|
||||
(defvar orgpan-panel-window nil
|
||||
"The window showing `orgpan-panel-buffer'.")
|
||||
|
||||
(defvar orgpan-panel-buffer nil
|
||||
"The panel buffer.
|
||||
There can be only one such buffer at any time.")
|
||||
|
||||
(defvar orgpan-org-window nil)
|
||||
;;(make-variable-buffer-local 'orgpan-org-window)
|
||||
|
||||
;; Fix-me: used?
|
||||
(defvar orgpan-org-buffer nil)
|
||||
;;(make-variable-buffer-local 'orgpan-org-buffer)
|
||||
|
||||
(defvar orgpan-last-org-buffer nil)
|
||||
;;(make-variable-buffer-local 'orgpan-last-org-buffer)
|
||||
|
||||
(defvar orgpan-point nil)
|
||||
;;(make-variable-buffer-local 'orgpan-point)
|
||||
|
||||
(defvar viper-emacs-state-mode-list)
|
||||
(defvar viper-new-major-mode-buffer-list)
|
||||
|
||||
(defun orgpan-avoid-viper-in-buffer ()
|
||||
;; Fix-me: This is ugly. However see `this-major-mode-requires-vi-state':
|
||||
(set (make-local-variable 'viper-emacs-state-mode-list) '(orgpan-mode))
|
||||
(set (make-local-variable 'viper-new-major-mode-buffer-list) nil)
|
||||
(local-set-key [?\ ] 'ignore))
|
||||
|
||||
(define-derived-mode orgpan-mode nil "Org-Panel"
|
||||
"Mode for org-simple.el control panel."
|
||||
(setq buffer-read-only t)
|
||||
(unless orgpan-minor-mode-version
|
||||
(add-hook 'pre-command-hook 'orgpan-mode-pre-command nil t)
|
||||
(add-hook 'post-command-hook 'orgpan-mode-post-command t))
|
||||
(orgpan-avoid-viper-in-buffer)
|
||||
(setq cursor-type nil))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; Panel layout
|
||||
|
||||
(defun orgpan-insert-field (text keymap explain)
|
||||
(insert text)
|
||||
(let* ((end (point))
|
||||
(len (length text))
|
||||
(beg (- end len))
|
||||
(ovl (make-overlay beg end)))
|
||||
(overlay-put ovl 'face orgpan-field-face)
|
||||
(overlay-put ovl 'keymap keymap)
|
||||
(overlay-put ovl 'orgpan-explain explain)))
|
||||
|
||||
(defconst orgpan-with-keymap
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map org-mode-map)
|
||||
;; Users are used to tabbing between fields:
|
||||
(define-key map [(tab)] 'orgpan-forward-field)
|
||||
(define-key map [(shift tab)] 'orgpan-backward-field)
|
||||
;; Now we must use something else for visibility (first does not work if Viper):
|
||||
(define-key map [(meta tab)] 'org-cycle)
|
||||
(define-key map [(control meta tab)] 'org-global-cycle)
|
||||
map))
|
||||
|
||||
(defconst orgpan-without-keymap
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map org-mode-map)
|
||||
;; Visibility (those are in org-mode-map):
|
||||
;;(define-key map [tab] 'org-cycle)
|
||||
;;(define-key map [(shift tab)] 'org-global-cycle)
|
||||
;; Navigate:
|
||||
(define-key map [left] 'outline-up-heading)
|
||||
(define-key map [right] 'org-cycle)
|
||||
(define-key map [up] 'outline-previous-visible-heading)
|
||||
(define-key map [down] 'outline-next-visible-heading)
|
||||
(define-key map [(shift down)] 'outline-forward-same-level)
|
||||
(define-key map [(shift up)] 'outline-backward-same-level)
|
||||
;; Restructure:
|
||||
(define-key map [(control up)] 'org-move-subtree-up)
|
||||
(define-key map [(control down)] 'org-move-subtree-down)
|
||||
(define-key map [(control left)] 'org-do-promote)
|
||||
(define-key map [(control right)] 'org-do-demote)
|
||||
(define-key map [(control shift left)] 'org-promote-subtree)
|
||||
(define-key map [(control shift right)] 'org-demote-subtree)
|
||||
;; Todo etc
|
||||
(define-key map [?+] 'org-priority-up)
|
||||
(define-key map [?-] 'org-priority-down)
|
||||
(define-key map [?t] 'org-todo)
|
||||
map))
|
||||
|
||||
(defun orgpan-make-panel-without-buttons (buf)
|
||||
(with-current-buffer buf
|
||||
(insert (propertize "Org Panel" 'face 'orgpan-active-field))
|
||||
(insert " ? for help, q quit\n")
|
||||
(insert (propertize "arrows" 'face 'font-lock-keyword-face)
|
||||
": Go to, "
|
||||
(propertize "C-arrows" 'face 'font-lock-keyword-face)
|
||||
": Edit tree\n"
|
||||
(propertize "cxpz" 'face 'font-lock-keyword-face)
|
||||
": copy cut paste undo, "
|
||||
(propertize "tT+-" 'face 'font-lock-keyword-face)
|
||||
": todo priority, "
|
||||
(propertize "s" 'face 'font-lock-keyword-face)
|
||||
" search"
|
||||
)
|
||||
(set-keymap-parent orgpan-mode-map orgpan-without-keymap)
|
||||
))
|
||||
|
||||
(defun orgpan-make-panel-with-buttons (buf)
|
||||
(with-current-buffer buf
|
||||
(let* ((base-map (make-sparse-keymap))
|
||||
(space-line (propertize "\n\n" 'face 'orgpan-spaceline))
|
||||
(arrow-face 'font-lock-keyword-face)
|
||||
(L (propertize "left" 'face arrow-face))
|
||||
(R (propertize "right" 'face arrow-face))
|
||||
(U (propertize "up" 'face arrow-face))
|
||||
(D (propertize "down" 'face arrow-face)))
|
||||
;;(message D)(sit-for 2)
|
||||
(define-key base-map [left] 'ignore)
|
||||
(define-key base-map [right] 'ignore)
|
||||
(define-key base-map [up] 'ignore)
|
||||
(define-key base-map [down] 'ignore)
|
||||
(define-key base-map [?q] 'delete-window)
|
||||
(define-key base-map [??] 'orgpan-help)
|
||||
;; Navigating
|
||||
(let ((map (copy-keymap base-map)))
|
||||
(define-key map [left] 'outline-up-heading)
|
||||
(define-key map [right] 'org-cycle)
|
||||
(define-key map [up] 'outline-previous-visible-heading)
|
||||
(define-key map [down] 'outline-next-visible-heading)
|
||||
(define-key map [(shift down)] 'outline-forward-same-level)
|
||||
(define-key map [(shift up)] 'outline-backward-same-level)
|
||||
(orgpan-insert-field "Navigate" map (concat U "/" D ", " L ": Go to, " R ": Visibility")))
|
||||
(insert " ")
|
||||
(let ((map (copy-keymap base-map)))
|
||||
(define-key map [up] 'org-move-subtree-up)
|
||||
(define-key map [down] 'org-move-subtree-down)
|
||||
(define-key map [left] 'org-do-promote)
|
||||
(define-key map [right] 'org-do-demote)
|
||||
(define-key map [(shift left)] 'org-promote-subtree)
|
||||
(define-key map [(shift right)] 'org-demote-subtree)
|
||||
(orgpan-insert-field
|
||||
"Restructure" map
|
||||
(concat U "/" D ": "
|
||||
(propertize "Move" 'face 'font-lock-warning-face)
|
||||
", " L "/" R ": "
|
||||
(propertize "Level (w S: Subtree Level)" 'face 'font-lock-warning-face))))
|
||||
(insert " ")
|
||||
(let ((map (copy-keymap base-map)))
|
||||
(define-key map [up] 'org-priority-up)
|
||||
(define-key map [down] 'org-priority-down)
|
||||
(define-key map [right] 'org-todo)
|
||||
(orgpan-insert-field "TODO/priority" map
|
||||
(concat R ": TODO, " U "/" D ": Priority")))
|
||||
)
|
||||
(insert " ? for help, q quit\n")
|
||||
(orgpan-display-bindings-help)
|
||||
(setq orgpan-ovl-help (make-overlay (point) (point)))
|
||||
))
|
||||
|
||||
(defun orgpan-make-panel-buffer ()
|
||||
"Make the panel buffer."
|
||||
(let* ((buf-name "*Org Panel*"))
|
||||
(when orgpan-panel-buffer (kill-buffer orgpan-panel-buffer))
|
||||
(setq orgpan-panel-buffer (get-buffer-create buf-name))
|
||||
(if orgpan-panel-buttons
|
||||
(orgpan-make-panel-with-buttons orgpan-panel-buffer)
|
||||
(orgpan-make-panel-without-buttons orgpan-panel-buffer))
|
||||
(with-current-buffer orgpan-panel-buffer
|
||||
(orgpan-mode)
|
||||
(goto-char (point-min)))
|
||||
orgpan-panel-buffer))
|
||||
|
||||
(defun orgpan-help ()
|
||||
(interactive)
|
||||
(set-keymap-parent orgpan-with-keymap nil)
|
||||
(set-keymap-parent orgpan-without-keymap nil)
|
||||
(describe-function 'orgpan-panel)
|
||||
(set-keymap-parent orgpan-with-keymap org-mode-map)
|
||||
(set-keymap-parent orgpan-without-keymap org-mode-map)
|
||||
(message "Use 'l' to remove help window")
|
||||
)
|
||||
|
||||
(defun orgpan-panel ()
|
||||
"Create a control panel for current `org-mode' buffer.
|
||||
The control panel may be used to quickly move around and change
|
||||
the headings. The idea is that when you want to to a lot of this
|
||||
kind of editing you should be able to do that with few
|
||||
keystrokes (and without having to remember the complicated
|
||||
keystrokes). A typical situation when this perhaps can be useful
|
||||
is when you are looking at your notes file \(usually ~/.notes,
|
||||
see `remember-data-file') where you have saved quick notes with
|
||||
`remember'.
|
||||
|
||||
The keys below are defined in the panel. Note that the commands
|
||||
are carried out in the `org-mode' buffer that belongs to the
|
||||
panel.
|
||||
|
||||
\\{orgpan-mode-map}
|
||||
|
||||
In addition to the keys above most of the keys in `org-mode' can
|
||||
also be used from the panel.
|
||||
|
||||
Note: There are two forms of the control panel, one with buttons
|
||||
and one without. The default is without, see
|
||||
`orgpan-panel-buttons'. If buttons are used choosing a different
|
||||
button changes the binding of the arrow keys."
|
||||
(interactive)
|
||||
(unless (derived-mode-p 'org-mode)
|
||||
(error "Buffer is not in org-mode"))
|
||||
(orgpan-delete-panel)
|
||||
(unless orgpan-org-mode-commands
|
||||
(map-keymap (lambda (ev def)
|
||||
(when (and def
|
||||
(symbolp def)
|
||||
(fboundp def))
|
||||
(setq orgpan-org-mode-commands
|
||||
(cons def orgpan-org-mode-commands))))
|
||||
org-mode-map))
|
||||
;;(org-back-to-heading)
|
||||
;;(remove-hook 'window-configuration-change-hook 'orgpan-window-config-change)
|
||||
(setq orgpan-org-window (selected-window))
|
||||
(setq orgpan-panel-window (split-window nil -4 'below))
|
||||
(select-window orgpan-panel-window)
|
||||
(set-window-buffer (selected-window) (orgpan-make-panel-buffer))
|
||||
;;(set-window-dedicated-p (selected-window) t)
|
||||
;; The minor mode version starts here:
|
||||
(when orgpan-minor-mode-version
|
||||
(select-window orgpan-org-window)
|
||||
(orgpan-panel-minor-mode 1)
|
||||
(add-hook 'post-command-hook 'orgpan-minor-post-command t)))
|
||||
|
||||
(defun orgpan-minor-post-command ()
|
||||
(unless (and
|
||||
;; Check org window and buffer
|
||||
(windowp orgpan-org-window)
|
||||
(window-live-p orgpan-org-window)
|
||||
(eq orgpan-org-window (selected-window))
|
||||
(derived-mode-p 'org-mode)
|
||||
;; Check panel window and buffer
|
||||
(windowp orgpan-panel-window)
|
||||
(window-live-p orgpan-panel-window)
|
||||
(bufferp orgpan-panel-buffer)
|
||||
(buffer-live-p orgpan-panel-buffer)
|
||||
(eq (window-buffer orgpan-panel-window) orgpan-panel-buffer)
|
||||
;; Check minor mode
|
||||
orgpan-panel-minor-mode)
|
||||
(orgpan-delete-panel)))
|
||||
|
||||
(define-minor-mode orgpan-panel-minor-mode
|
||||
"Minor mode used in `org-mode' buffer when showing panel."
|
||||
:keymap orgpan-mode-map
|
||||
:lighter " PANEL"
|
||||
:group 'orgpan
|
||||
)
|
||||
|
||||
|
||||
(provide 'org-panel)
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;;; org-panel.el ends here
|
||||
385
lisp/org-contrib/org-passwords.el
Normal file
385
lisp/org-contrib/org-passwords.el
Normal file
@@ -0,0 +1,385 @@
|
||||
;;; org-passwords.el --- org derived mode for managing passwords
|
||||
|
||||
;; Author: Jorge A. Alfaro-Murillo <jorge.alfaro-murillo@yale.edu>
|
||||
;; Created: December 26, 2012
|
||||
;; Homepage: https://github.com/alfaromurillo/org-passwords.el
|
||||
;; Keywords: passwords, password
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; This program is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;;; Commentary:
|
||||
|
||||
;; This file contains the code for managing your passwords with
|
||||
;; Org-mode. It is part of org/contrib (see https://orgmode.org/). If
|
||||
;; you want to contribute with development, or have a problem, do it
|
||||
;; here: https://bitbucket.org/alfaromurillo/org-passwords.el
|
||||
|
||||
;; A basic setup needs to indicate a passwords file, and a dictionary
|
||||
;; for the random words:
|
||||
|
||||
;; (require 'org-passwords)
|
||||
;; (setq org-passwords-file "~/documents/passwords.gpg")
|
||||
;; (setq org-passwords-random-words-dictionary "/etc/dictionaries-common/words")
|
||||
|
||||
;; Basic usage:
|
||||
|
||||
;; `M-x org-passwords' opens the passwords file in
|
||||
;; `org-passwords-mode'.
|
||||
|
||||
;; `M-x org-passwords-generate-password' generates a random string
|
||||
;; of numbers, lowercase letters and uppercase letters.
|
||||
|
||||
;; `C-u M-x org-passwords-generate-password' generates a random
|
||||
;; string of numbers, lowercase letters, uppercase letters and
|
||||
;; symbols.
|
||||
|
||||
;; `M-x org-passwords-random-words' concatenates random words from
|
||||
;; the dictionary defined by `org-passwords-random-words-dictionary'
|
||||
;; into a string, each word separated by the string defined in
|
||||
;; `org-passwords-random-words-separator'.
|
||||
|
||||
;; `C-u M-x org-passwords-random-words' does the same as above, and
|
||||
;; also makes substitutions according to
|
||||
;; `org-passwords-random-words-substitutions'.
|
||||
|
||||
;; It is also useful to set up keybindings for the functions
|
||||
;; `org-passwords-copy-username', `org-passwords-copy-password' and
|
||||
;; `org-passwords-open-url' in the `org-passwords-mode', to easily
|
||||
;; make the passwords and usernames available to the facility for
|
||||
;; pasting text of the window system (clipboard on X and MS-Windows,
|
||||
;; pasteboard on Nextstep/Mac OS, etc.), without inserting them in the
|
||||
;; kill-ring. You can set for example:
|
||||
|
||||
;; (eval-after-load "org-passwords"
|
||||
;; '(progn
|
||||
;; (define-key org-passwords-mode-map
|
||||
;; (kbd "C-c u")
|
||||
;; 'org-passwords-copy-username)
|
||||
;; (define-key org-passwords-mode-map
|
||||
;; (kbd "C-c p")
|
||||
;; 'org-passwords-copy-password)
|
||||
;; (kbd "C-c o")
|
||||
;; 'org-passwords-open-url)))
|
||||
|
||||
;; Finally, to enter new passwords, you can use `org-capture' and a
|
||||
;; minimal template like:
|
||||
|
||||
;; ("p" "password" entry (file "~/documents/passwords.gpg")
|
||||
;; "* %^{Title}\n %^{URL}p %^{USERNAME}p %^{PASSWORD}p")
|
||||
|
||||
;; When asked for the password you can then call either
|
||||
;; `org-passwords-generate-password' or `org-passwords-random-words'.
|
||||
;; Be sure to enable recursive minibuffers to call those functions
|
||||
;; from the minibuffer:
|
||||
|
||||
;; (setq enable-recursive-minibuffers t)
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'org)
|
||||
|
||||
;;;###autoload
|
||||
(define-derived-mode org-passwords-mode org-mode
|
||||
"org-passwords-mode"
|
||||
"Mode for storing passwords"
|
||||
nil)
|
||||
|
||||
(defgroup org-passwords nil
|
||||
"Options for password management."
|
||||
:group 'org)
|
||||
|
||||
(defcustom org-passwords-password-property "PASSWORD"
|
||||
"Name of the property for password entry."
|
||||
:type 'string
|
||||
:group 'org-passwords)
|
||||
|
||||
(defcustom org-passwords-username-property "USERNAME"
|
||||
"Name of the property for user name entry."
|
||||
:type 'string
|
||||
:group 'org-passwords)
|
||||
|
||||
(defcustom org-passwords-url-property "URL"
|
||||
"Name of the property for URL entry."
|
||||
:type 'string
|
||||
:group 'org-passwords)
|
||||
|
||||
(defcustom org-passwords-file nil
|
||||
"Default file name for the file that contains the passwords."
|
||||
:type 'file
|
||||
:group 'org-passwords)
|
||||
|
||||
(defcustom org-passwords-time-opened "1 min"
|
||||
"Time that the password file will remain open. It has to be a
|
||||
string, a number followed by units."
|
||||
:type 'str
|
||||
:group 'org-passwords)
|
||||
|
||||
(defcustom org-passwords-default-password-size "20"
|
||||
"Default number of characters to use in
|
||||
org-passwords-generate-password. It has to be a string."
|
||||
:type 'str
|
||||
:group 'org-passwords)
|
||||
|
||||
(defcustom org-passwords-random-words-dictionary nil
|
||||
"Default file name for the file that contains a dictionary of
|
||||
words for `org-passwords-random-words'. Each non-empty line in
|
||||
the file is considered a word."
|
||||
:type 'file
|
||||
:group 'org-passwords)
|
||||
|
||||
(defcustom org-passwords-default-random-words-number "5"
|
||||
"Default number of words to use in org-passwords-random-words.
|
||||
It has to be a string."
|
||||
:type 'str
|
||||
:group 'org-passwords)
|
||||
|
||||
(defvar org-passwords-random-words-separator "-"
|
||||
"A string to separate words in `org-passwords-random-words'.")
|
||||
|
||||
(defvar org-passwords-random-words-substitutions
|
||||
'(("a" . "@")
|
||||
("e" . "3")
|
||||
("o" . "0"))
|
||||
"A list of substitutions to be made with
|
||||
`org-passwords-random-words' if it is called with
|
||||
`universal-argument'. Each element is pair of
|
||||
strings (SUBSTITUTE-THIS . BY-THIS).")
|
||||
|
||||
(defun org-passwords-copy-password ()
|
||||
"Makes the password available to other programs. Puts the
|
||||
password of the entry at the location of the cursor in the
|
||||
facility for pasting text of the window system (clipboard on X
|
||||
and MS-Windows, pasteboard on Nextstep/Mac OS, etc.), without
|
||||
putting it in the kill ring."
|
||||
(interactive)
|
||||
(funcall interprogram-cut-function
|
||||
(org-entry-get (point)
|
||||
org-passwords-password-property)))
|
||||
|
||||
(defun org-passwords-copy-username ()
|
||||
"Makes the password available to other programs. Puts the
|
||||
username of the entry at the location of the cursor in the
|
||||
facility for pasting text of the window system (clipboard on X
|
||||
and MS-Windows, pasteboard on Nextstep/Mac OS, etc.), without
|
||||
putting it in the kill ring."
|
||||
(interactive)
|
||||
(funcall interprogram-cut-function
|
||||
(org-entry-get (point)
|
||||
org-passwords-username-property
|
||||
t)))
|
||||
|
||||
(defun org-passwords-open-url ()
|
||||
"Browse the URL associated with the entry at the location of
|
||||
the cursor."
|
||||
(interactive)
|
||||
(browse-url (org-entry-get (point)
|
||||
org-passwords-url-property
|
||||
t)))
|
||||
|
||||
;;;###autoload
|
||||
(defun org-passwords (&optional arg)
|
||||
"Open the password file. Open the password file defined by the
|
||||
variable `org-password-file' in read-only mode and kill that
|
||||
buffer later according to the value of the variable
|
||||
`org-passwords-time-opened'. It also adds the `org-password-file'
|
||||
to the auto-mode-alist so that it is opened with its mode being
|
||||
`org-passwords-mode'.
|
||||
|
||||
With prefix arg ARG, the command does not set up a timer to kill the buffer.
|
||||
|
||||
With a double prefix arg \\[universal-argument] \\[universal-argument], open the file for editing.
|
||||
"
|
||||
(interactive "P")
|
||||
(if org-passwords-file
|
||||
(progn
|
||||
(add-to-list 'auto-mode-alist
|
||||
(cons
|
||||
(regexp-quote
|
||||
(expand-file-name org-passwords-file))
|
||||
'org-passwords-mode))
|
||||
(if (equal arg '(4))
|
||||
(find-file-read-only org-passwords-file)
|
||||
(if (equal arg '(16))
|
||||
(find-file org-passwords-file)
|
||||
(progn
|
||||
(find-file-read-only org-passwords-file)
|
||||
(org-passwords-set-up-kill-password-buffer)))))
|
||||
(minibuffer-message "No default password file defined. Set the variable `org-password-file'.")))
|
||||
|
||||
(defun org-passwords-set-up-kill-password-buffer ()
|
||||
(run-at-time org-passwords-time-opened
|
||||
nil
|
||||
'(lambda ()
|
||||
(if (get-file-buffer org-passwords-file)
|
||||
(kill-buffer
|
||||
(get-file-buffer org-passwords-file))))))
|
||||
|
||||
;;; Password generator
|
||||
|
||||
;; Set random number seed from current time and pid. Otherwise
|
||||
;; `random' gives the same results every time emacs restarts.
|
||||
(random t)
|
||||
|
||||
(defun org-passwords-generate-password (arg)
|
||||
"Ask a number of characters and insert a password of that size.
|
||||
Password has a random string of numbers, lowercase letters, and
|
||||
uppercase letters. Argument ARG include symbols."
|
||||
(interactive "P")
|
||||
(let ((number-of-chars
|
||||
(read-from-minibuffer
|
||||
(concat "Number of characters (default "
|
||||
org-passwords-default-password-size
|
||||
"): ")
|
||||
nil
|
||||
nil
|
||||
t
|
||||
nil
|
||||
org-passwords-default-password-size)))
|
||||
(if arg
|
||||
(insert (org-passwords-generate-password-with-symbols "" number-of-chars))
|
||||
(insert (org-passwords-generate-password-without-symbols "" number-of-chars)))))
|
||||
|
||||
(defun org-passwords-generate-password-with-symbols (previous-string nums-of-chars)
|
||||
"Return a string consisting of PREVIOUS-STRING and
|
||||
NUMS-OF-CHARS random characters."
|
||||
(if (eq nums-of-chars 0) previous-string
|
||||
(org-passwords-generate-password-with-symbols
|
||||
(concat previous-string
|
||||
(char-to-string
|
||||
;; symbols, letters, numbers are from 33 to 126
|
||||
(+ (random (- 127 33)) 33)))
|
||||
(1- nums-of-chars))))
|
||||
|
||||
(defun org-passwords-generate-password-without-symbols (previous-string nums-of-chars)
|
||||
"Return string consisting of PREVIOUS-STRING and NUMS-OF-CHARS
|
||||
random numbers, lowercase letters, and numbers."
|
||||
(if (eq nums-of-chars 0)
|
||||
previous-string
|
||||
; There are 10 numbers, 26 lowercase letters and 26 uppercase
|
||||
; letters. 10 + 26 + 26 = 62. The number characters go from 48
|
||||
; to 57, the uppercase letters from 65 to 90, and the lowercase
|
||||
; from 97 to 122. The following makes each equally likely.
|
||||
(let ((temp-value (random 62)))
|
||||
(cond ((< temp-value 10)
|
||||
; If temp-value<10, then add a number
|
||||
(org-passwords-generate-password-without-symbols
|
||||
(concat previous-string
|
||||
(char-to-string (+ 48 temp-value)))
|
||||
(1- nums-of-chars)))
|
||||
((and (> temp-value 9) (< temp-value 36))
|
||||
; If 9<temp-value<36, then add an uppercase letter
|
||||
(org-passwords-generate-password-without-symbols
|
||||
(concat previous-string
|
||||
(char-to-string (+ 65 (- temp-value 10))))
|
||||
(1- nums-of-chars)))
|
||||
((> temp-value 35)
|
||||
; If temp-value>35, then add a lowecase letter
|
||||
(org-passwords-generate-password-without-symbols
|
||||
(concat previous-string
|
||||
(char-to-string (+ 97 (- temp-value 36))))
|
||||
(1- nums-of-chars)))))))
|
||||
|
||||
;;; Random words
|
||||
|
||||
(defun org-passwords-random-words (arg)
|
||||
"Ask for a number of words and inserts a sequence of that many
|
||||
random words from the list in the file
|
||||
`org-passwords-random-words-dictionary' separated by
|
||||
`org-passwords-random-words-separator'. ARG make substitutions in
|
||||
the words as defined by
|
||||
`org-passwords-random-words-substitutions'."
|
||||
(interactive "P")
|
||||
(if org-passwords-random-words-dictionary
|
||||
(let ((number-of-words
|
||||
(read-from-minibuffer
|
||||
(concat "Number of words (default "
|
||||
org-passwords-default-random-words-number
|
||||
"): ")
|
||||
nil
|
||||
nil
|
||||
t
|
||||
nil
|
||||
org-passwords-default-random-words-number))
|
||||
(list-of-words
|
||||
(with-temp-buffer
|
||||
(insert-file-contents
|
||||
org-passwords-random-words-dictionary)
|
||||
(split-string (buffer-string) "\n" t))))
|
||||
(insert
|
||||
(org-passwords-substitute
|
||||
(org-passwords-random-words-attach-number-of-words
|
||||
(nth (random (length list-of-words))
|
||||
list-of-words)
|
||||
(1- number-of-words)
|
||||
list-of-words
|
||||
org-passwords-random-words-separator)
|
||||
(if arg
|
||||
org-passwords-random-words-substitutions
|
||||
nil))))
|
||||
(minibuffer-message
|
||||
"No default dictionary file defined. Set the variable `org-passwords-random-words-dictionary'.")))
|
||||
|
||||
(defun org-passwords-random-words-attach-number-of-words
|
||||
(previous-string number-of-words list-of-words separator)
|
||||
"Returns a string consisting of PREVIOUS-STRING followed by a
|
||||
succession of NUMBER-OF-WORDS random words from the list LIST-OF-WORDS
|
||||
separated SEPARATOR."
|
||||
(if (eq number-of-words 0)
|
||||
previous-string
|
||||
(org-passwords-random-words-attach-number-of-words
|
||||
(concat previous-string
|
||||
separator
|
||||
(nth (random (length list-of-words)) list-of-words))
|
||||
(1- number-of-words)
|
||||
list-of-words
|
||||
separator)))
|
||||
|
||||
(defun org-passwords-substitute (string-to-change list-of-substitutions)
|
||||
"Substitutes each appearance in STRING-TO-CHANGE of the `car' of
|
||||
each element of LIST-OF-SUBSTITUTIONS by the `cdr' of that
|
||||
element. For example:
|
||||
(org-passwords-substitute \"ab\" \'((\"a\" . \"b\") (\"b\" . \"c\")))
|
||||
=> \"bc\"
|
||||
Substitutions are made in order of the list, so for example:
|
||||
(org-passwords-substitute \"ab\" \'((\"ab\" . \"c\") (\"b\" . \"d\")))
|
||||
=> \"c\""
|
||||
(if list-of-substitutions
|
||||
(concat (org-passwords-concat-this-with-string
|
||||
(cdar list-of-substitutions)
|
||||
(mapcar (lambda (x)
|
||||
(org-passwords-substitute
|
||||
x
|
||||
(cdr list-of-substitutions)))
|
||||
(split-string string-to-change
|
||||
(caar list-of-substitutions)))))
|
||||
string-to-change))
|
||||
|
||||
(defun org-passwords-concat-this-with-string (this list-of-strings)
|
||||
"Put the string THIS in between every string in LIST-OF-STRINGS. For example:
|
||||
(org-passwords-concat-this-with-string \"Here\" \'(\"First\" \"Second\" \"Third\"))
|
||||
=> \"FirstHereSencondHereThird\""
|
||||
(if (cdr list-of-strings)
|
||||
(concat (car list-of-strings)
|
||||
this
|
||||
(org-passwords-concat-this-with-string
|
||||
this
|
||||
(cdr list-of-strings)))
|
||||
(car list-of-strings)))
|
||||
|
||||
(provide 'org-passwords)
|
||||
|
||||
;;; org-passwords.el ends here
|
||||
272
lisp/org-contrib/org-registry.el
Normal file
272
lisp/org-contrib/org-registry.el
Normal file
@@ -0,0 +1,272 @@
|
||||
;;; org-registry.el --- a registry for Org links
|
||||
;;
|
||||
;; Copyright 2007-2021 Free Software Foundation, Inc.
|
||||
;;
|
||||
;; Emacs Lisp Archive Entry
|
||||
;; Filename: org-registry.el
|
||||
;; Version: 0.1a
|
||||
;; Author: Bastien Guerry <bzg@gnu.org>
|
||||
;; Maintainer: Bastien Guerry <bzg@gnu.org>
|
||||
;; Keywords: org, wp, registry
|
||||
;; Description: Shows Org files where the current buffer is linked
|
||||
;; Homepage: https://git.sr.ht/~bzg/org-contrib
|
||||
;;
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 3, 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; This library add a registry to your Org setup.
|
||||
;;
|
||||
;; Org files are full of links inserted with `org-store-link'. This links
|
||||
;; point to e-mail, webpages, files, dirs, info pages, man pages, etc.
|
||||
;; Actually, they come from potentially *everywhere* since Org lets you
|
||||
;; define your own storing/following functions.
|
||||
;;
|
||||
;; So, what if you are on a e-mail, webpage or whatever and want to know if
|
||||
;; this buffer has already been linked to somewhere in your agenda files?
|
||||
;;
|
||||
;; This is were org-registry comes in handy.
|
||||
;;
|
||||
;; M-x org-registry-show will tell you the name of the file
|
||||
;; C-u M-x org-registry-show will directly jump to the file
|
||||
;;
|
||||
;; In case there are several files where the link lives in:
|
||||
;;
|
||||
;; M-x org-registry-show will display them in a new window
|
||||
;; C-u M-x org-registry-show will prompt for a file to visit
|
||||
;;
|
||||
;; Add this to your Org configuration:
|
||||
;;
|
||||
;; (require 'org-registry)
|
||||
;; (org-registry-initialize)
|
||||
;;
|
||||
;; If you want to update the registry with newly inserted links in the
|
||||
;; current buffer: M-x org-registry-update
|
||||
;;
|
||||
;; If you want this job to be done each time you save an Org buffer,
|
||||
;; hook 'org-registry-update to the local 'after-save-hook in org-mode:
|
||||
;;
|
||||
;; (org-registry-insinuate)
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile
|
||||
(require 'cl))
|
||||
|
||||
(defgroup org-registry nil
|
||||
"A registry for Org."
|
||||
:group 'org)
|
||||
|
||||
(defcustom org-registry-file
|
||||
(concat (getenv "HOME") "/.org-registry.el")
|
||||
"The Org registry file."
|
||||
:group 'org-registry
|
||||
:type 'file)
|
||||
|
||||
(defcustom org-registry-find-file 'find-file-other-window
|
||||
"How to find visit files."
|
||||
:type 'function
|
||||
:group 'org-registry)
|
||||
|
||||
(defvar org-registry-alist nil
|
||||
"An alist containing the Org registry.")
|
||||
|
||||
;;;###autoload
|
||||
(defun org-registry-show (&optional visit)
|
||||
"Show Org files where there are links pointing to the current
|
||||
buffer."
|
||||
(interactive "P")
|
||||
(org-registry-initialize)
|
||||
(let* ((blink (or (org-remember-annotation) ""))
|
||||
(link (when (string-match org-bracket-link-regexp blink)
|
||||
(match-string-no-properties 1 blink)))
|
||||
(desc (or (and (string-match org-bracket-link-regexp blink)
|
||||
(match-string-no-properties 3 blink)) "No description"))
|
||||
(files (org-registry-assoc-all link))
|
||||
file point selection tmphist)
|
||||
(cond ((and files visit)
|
||||
;; result(s) to visit
|
||||
(cond ((< 1 (length files))
|
||||
;; more than one result
|
||||
(setq tmphist (mapcar (lambda(entry)
|
||||
(format "%s (%d) [%s]"
|
||||
(nth 3 entry) ; file
|
||||
(nth 2 entry) ; point
|
||||
(nth 1 entry))) files))
|
||||
(setq selection (completing-read "File: " tmphist
|
||||
nil t nil 'tmphist))
|
||||
(string-match "\\(.+\\) (\\([0-9]+\\))" selection)
|
||||
(setq file (match-string 1 selection))
|
||||
(setq point (string-to-number (match-string 2 selection))))
|
||||
((eq 1 (length files))
|
||||
;; just one result
|
||||
(setq file (nth 3 (car files)))
|
||||
(setq point (nth 2 (car files)))))
|
||||
;; visit the (selected) file
|
||||
(funcall org-registry-find-file file)
|
||||
(goto-char point)
|
||||
(unless (org-before-first-heading-p)
|
||||
(org-show-context)))
|
||||
((and files (not visit))
|
||||
;; result(s) to display
|
||||
(cond ((eq 1 (length files))
|
||||
;; show one file
|
||||
(message "Link in file %s (%d) [%s]"
|
||||
(nth 3 (car files))
|
||||
(nth 2 (car files))
|
||||
(nth 1 (car files))))
|
||||
(t (org-registry-display-files files link))))
|
||||
(t (message "No link to this in org-agenda-files")))))
|
||||
|
||||
(defun org-registry-display-files (files link)
|
||||
"Display files in a separate window."
|
||||
(switch-to-buffer-other-window
|
||||
(get-buffer-create " *Org registry info*"))
|
||||
(erase-buffer)
|
||||
(insert (format "Files pointing to %s:\n\n" link))
|
||||
(let (file)
|
||||
(while (setq file (pop files))
|
||||
(insert (format "%s (%d) [%s]\n" (nth 3 file)
|
||||
(nth 2 file) (nth 1 file)))))
|
||||
(shrink-window-if-larger-than-buffer)
|
||||
(other-window 1))
|
||||
|
||||
(defun org-registry-assoc-all (link &optional registry)
|
||||
"Return all associated entries of LINK in the registry."
|
||||
(org-registry-find-all
|
||||
(lambda (entry) (string= link (car entry)))
|
||||
registry))
|
||||
|
||||
(defun org-registry-find-all (test &optional registry)
|
||||
"Return all entries satisfying `test' in the registry."
|
||||
(delq nil
|
||||
(mapcar
|
||||
(lambda (x) (and (funcall test x) x))
|
||||
(or registry org-registry-alist))))
|
||||
|
||||
;;;###autoload
|
||||
(defun org-registry-visit ()
|
||||
"If an Org file contains a link to the current location, visit
|
||||
this file."
|
||||
(interactive)
|
||||
(org-registry-show t))
|
||||
|
||||
;;;###autoload
|
||||
(defun org-registry-initialize (&optional from-scratch)
|
||||
"Initialize `org-registry-alist'.
|
||||
If FROM-SCRATCH is non-nil or the registry does not exist yet,
|
||||
create a new registry from scratch and eval it. If the registry
|
||||
exists, eval `org-registry-file' and make it the new value for
|
||||
`org-registry-alist'."
|
||||
(interactive "P")
|
||||
(if (or from-scratch (not (file-exists-p org-registry-file)))
|
||||
;; create a new registry
|
||||
(let ((files org-agenda-files) file)
|
||||
(while (setq file (pop files))
|
||||
(setq file (expand-file-name file))
|
||||
(mapc (lambda (entry)
|
||||
(add-to-list 'org-registry-alist entry))
|
||||
(org-registry-get-entries file)))
|
||||
(when from-scratch
|
||||
(org-registry-create org-registry-alist)))
|
||||
;; eval the registry file
|
||||
(with-temp-buffer
|
||||
(insert-file-contents org-registry-file)
|
||||
(eval-buffer))))
|
||||
|
||||
;;;###autoload
|
||||
(defun org-registry-insinuate ()
|
||||
"Call `org-registry-update' after saving in Org-mode.
|
||||
Use with caution. This could slow down things a bit."
|
||||
(interactive)
|
||||
(add-hook 'org-mode-hook
|
||||
(lambda() (add-hook 'after-save-hook
|
||||
'org-registry-update t t))))
|
||||
|
||||
(defun org-registry-get-entries (file)
|
||||
"List Org links in FILE that will be put in the registry."
|
||||
(let (bufstr result)
|
||||
(with-temp-buffer
|
||||
(insert-file-contents file)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward org-angle-link-re nil t)
|
||||
(let* ((point (match-beginning 0))
|
||||
(link (match-string-no-properties 0))
|
||||
(desc (match-string-no-properties 0)))
|
||||
(add-to-list 'result (list link desc point file))))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward org-bracket-link-regexp nil t)
|
||||
(let* ((point (match-beginning 0))
|
||||
(link (match-string-no-properties 1))
|
||||
(desc (or (match-string-no-properties 3) "No description")))
|
||||
(add-to-list 'result (list link desc point file)))))
|
||||
;; return the list of new entries
|
||||
result))
|
||||
|
||||
;;;###autoload
|
||||
(defun org-registry-update ()
|
||||
"Update the registry for the current Org file."
|
||||
(interactive)
|
||||
(unless (eq major-mode 'org-mode) (error "Not in org-mode"))
|
||||
(let* ((from-file (expand-file-name (buffer-file-name)))
|
||||
(new-entries (org-registry-get-entries from-file)))
|
||||
(with-temp-buffer
|
||||
(unless (file-exists-p org-registry-file)
|
||||
(org-registry-initialize t))
|
||||
(find-file org-registry-file)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward (concat from-file "\")$") nil t)
|
||||
(let ((end (1+ (match-end 0)))
|
||||
(beg (progn (re-search-backward "^(\"" nil t)
|
||||
(match-beginning 0))))
|
||||
(delete-region beg end)))
|
||||
(goto-char (point-min))
|
||||
(re-search-forward "^(\"" nil t)
|
||||
(goto-char (match-beginning 0))
|
||||
(mapc (lambda (elem)
|
||||
(insert (with-output-to-string (prin1 elem)) "\n"))
|
||||
new-entries)
|
||||
(save-buffer)
|
||||
(kill-buffer (current-buffer)))
|
||||
(message (format "Org registry updated for %s"
|
||||
(file-name-nondirectory from-file)))))
|
||||
|
||||
(defun org-registry-create (entries)
|
||||
"Create `org-registry-file' with ENTRIES."
|
||||
(let (entry)
|
||||
(with-temp-buffer
|
||||
(find-file org-registry-file)
|
||||
(erase-buffer)
|
||||
(insert
|
||||
(with-output-to-string
|
||||
(princ ";; -*- emacs-lisp -*-\n")
|
||||
(princ ";; Org registry\n")
|
||||
(princ ";; You shouldn't try to modify this buffer manually\n\n")
|
||||
(princ "(setq org-registry-alist\n'(\n")
|
||||
(while entries
|
||||
(when (setq entry (pop entries))
|
||||
(prin1 entry)
|
||||
(princ "\n")))
|
||||
(princ "))\n")))
|
||||
(save-buffer)
|
||||
(kill-buffer (current-buffer))))
|
||||
(message "Org registry created"))
|
||||
|
||||
(provide 'org-registry)
|
||||
|
||||
;;; User Options, Variables
|
||||
|
||||
;;; org-registry.el ends here
|
||||
105
lisp/org-contrib/org-screen.el
Normal file
105
lisp/org-contrib/org-screen.el
Normal file
@@ -0,0 +1,105 @@
|
||||
;;; org-screen.el --- Integreate Org-mode with screen.
|
||||
|
||||
;; Copyright (c) 2008-2014, 2021 Andrew Hyatt
|
||||
;;
|
||||
;; Author: Andrew Hyatt <ahyatt at gmail dot com>
|
||||
;; Maintainer: Carsten Dominik <carsten.dominik@gmail.com>
|
||||
;;
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 3, 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
;;
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; This file contains functionality to integrate screen and org-mode.
|
||||
;; When using org-mode, it is often useful to take tasks that have
|
||||
;; some command-line work associated with them, and associate them
|
||||
;; with a screen session. Screen is used rather than a direct
|
||||
;; terminal to facilitate portability of the resulting session.
|
||||
;;
|
||||
;; To use screen in org, in your .emacs file, simply put this file in
|
||||
;; a directory in your load-path and write:
|
||||
;;
|
||||
;; (require 'org-screen)
|
||||
;;
|
||||
;; When have a task and want to start some command-line activity
|
||||
;; associated with that task, go to the end of your item and type:
|
||||
;;
|
||||
;; M-x org-screen
|
||||
;;
|
||||
;; This will prompt you for a name of a screen session. Type in a
|
||||
;; name and it will insert a link into your org file at your current
|
||||
;; location.
|
||||
;;
|
||||
;; When you want to visit the link, go to the link and type C-c C-o to
|
||||
;; open the link.
|
||||
;;
|
||||
;; You may want to get rid of the constant queries about whether you
|
||||
;; really want to execute lisp code. Do so by adding to your .emacs:
|
||||
;;
|
||||
;; (setq org-confirm-elisp-link-function nil)
|
||||
|
||||
(require 'term)
|
||||
(require 'org)
|
||||
|
||||
(defcustom org-screen-program-name "/usr/bin/screen"
|
||||
"Full location of the screen executable."
|
||||
:group 'org-screen
|
||||
:type 'string)
|
||||
|
||||
(defun org-screen (name)
|
||||
"Start a screen session with name"
|
||||
(interactive "MScreen name: ")
|
||||
(save-excursion
|
||||
(org-screen-helper name "-S"))
|
||||
(insert (concat "[[screen:" name "]]")))
|
||||
|
||||
(defun org-screen-buffer-name (name)
|
||||
"Returns the buffer name corresponding to the screen name given."
|
||||
(concat "*screen " name "*"))
|
||||
|
||||
(defun org-screen-helper (name arg)
|
||||
"This method will create a screen session with a specified name
|
||||
and taking the specified screen arguments. Much of this function
|
||||
is copied from ansi-term method."
|
||||
|
||||
;; Pick the name of the new buffer.
|
||||
(let ((term-ansi-buffer-name
|
||||
(generate-new-buffer-name
|
||||
(org-screen-buffer-name name))))
|
||||
(setq term-ansi-buffer-name
|
||||
(term-ansi-make-term
|
||||
term-ansi-buffer-name org-screen-program-name nil arg name))
|
||||
(set-buffer term-ansi-buffer-name)
|
||||
(term-mode)
|
||||
(term-char-mode)
|
||||
(term-set-escape-char ?\C-x)
|
||||
term-ansi-buffer-name))
|
||||
|
||||
(defun org-screen-goto (name)
|
||||
"Open the screen with the specified name in the window"
|
||||
(interactive "MScreen name: ")
|
||||
(let ((screen-buffer-name (org-screen-buffer-name name)))
|
||||
(if (member screen-buffer-name
|
||||
(mapcar 'buffer-name (buffer-list)))
|
||||
(org-pop-to-buffer-same-window screen-buffer-name)
|
||||
(org-pop-to-buffer-same-window (org-screen-helper name "-dr")))))
|
||||
|
||||
(if org-link-abbrev-alist
|
||||
(add-to-list 'org-link-abbrev-alist
|
||||
'("screen" . "elisp:(org-screen-goto \"%s\")"))
|
||||
(setq org-link-abbrev-alist
|
||||
'(("screen" . "elisp:(org-screen-goto \"%s\")"))))
|
||||
|
||||
(provide 'org-screen)
|
||||
529
lisp/org-contrib/org-screenshot.el
Normal file
529
lisp/org-contrib/org-screenshot.el
Normal file
@@ -0,0 +1,529 @@
|
||||
;;; org-screenshot.el --- Take and manage screenshots in Org-mode files
|
||||
;;
|
||||
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
|
||||
;;
|
||||
;; Author: Max Mikhanosha <max@openchat.com>
|
||||
;; Keywords: outlines, hypermedia, calendar, wp
|
||||
;; Homepage: https://orgmode.org
|
||||
;; Version: 8.0
|
||||
;;
|
||||
;; Released under the GNU General Public License version 3
|
||||
;; see: https://www.gnu.org/licenses/gpl-3.0.html
|
||||
;;
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; This program is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; NOTE: This library requires external screenshot taking executable "scrot",
|
||||
;; which is available as a package from all major Linux distribution. If your
|
||||
;; distribution does not have it, source can be found at:
|
||||
;;
|
||||
;; http://freecode.com/projects/scrot
|
||||
;;
|
||||
;; org-screenshot.el have been tested with scrot version 0.8.
|
||||
;;
|
||||
;; Usage:
|
||||
;;
|
||||
;; (require 'org-screenshot)
|
||||
;;
|
||||
;; Available commands with default bindings
|
||||
;;
|
||||
;; `org-screenshot-take' C-c M-s M-t and C-c M-s M-s
|
||||
;;
|
||||
;; Take the screenshot, C-u argument delays 1 second, double C-u 2 seconds
|
||||
;; triple C-u 3 seconds, and subsequent C-u add 2 seconds to the delay.
|
||||
;;
|
||||
;; Screenshot area is selected with the mouse, or left-click on the window
|
||||
;; for an entire window.
|
||||
;;
|
||||
;; `org-screenshot-rotate-prev' C-c M-s M-p and C-c M-s C-p
|
||||
;;
|
||||
;; Rotate screenshot before the point to one before it (sorted by date)
|
||||
;;
|
||||
;; `org-screenshot-rotate-next' C-c M-s M-n and C-c M-s C-n
|
||||
;;
|
||||
;; Rotate screenshot before the point to one after it
|
||||
;;
|
||||
;; `org-screenshot-show-unused' C-c M-s M-u and C-c M-s u
|
||||
;;
|
||||
;; Open dired buffer with screenshots that are not used in current
|
||||
;; Org buffer marked
|
||||
;;
|
||||
;; The screenshot take and rotate commands will update the inline images
|
||||
;; if they are already shown, if you are inserting first screenshot in the Org
|
||||
;; Buffer (and there are no other images shown), you need to manually display
|
||||
;; inline images with C-c C-x C-v
|
||||
;;
|
||||
;; Screenshot take and rotate commands offer user to continue by by using single
|
||||
;; keys, in a manner similar to to "repeat-char" of keyboard macros, user can
|
||||
;; continue rotating screenshots by pressing just the last key of the binding
|
||||
;;
|
||||
;; For example: C-c M-s M-t creates the screenshot and then user can
|
||||
;; repeatedly press M-p or M-n to rotate it back and forth with
|
||||
;; previously taken ones.
|
||||
;;
|
||||
|
||||
(require 'org)
|
||||
(require 'dired)
|
||||
|
||||
(defgroup org-screenshot nil
|
||||
"Options for taking and managing screen-shots"
|
||||
:group 'org-link)
|
||||
|
||||
(defcustom org-screenshot-image-directory "./images/"
|
||||
"Directory in which screenshot image files will be stored, it
|
||||
be automatically created if it doesn't already exist."
|
||||
:type 'string
|
||||
:group 'org-screenshot)
|
||||
|
||||
(defcustom org-screenshot-file-name-format "screenshot-%2.2d.png"
|
||||
"The string used to generate screenshot file name.
|
||||
|
||||
Any %d format string recipe will be expanded with `format'
|
||||
function with the argument of a screenshot sequence number.
|
||||
|
||||
A sequence like %XXXX will be replaced with string of the same
|
||||
length as there are X's, consisting of random characters in the
|
||||
range of [A-Za-z]."
|
||||
:type 'string
|
||||
:group 'org-screenshot)
|
||||
|
||||
(defcustom org-screenshot-max-tries 200
|
||||
"Number of times we will try to generate generate filename that
|
||||
does not exist. With default `org-screenshot-name-format' its the
|
||||
limit for number of screenshots, before `org-screenshot-take' is
|
||||
unable to come up with a unique name."
|
||||
:type 'integer
|
||||
:group 'org-screenshot)
|
||||
|
||||
(defvar org-screenshot-map (make-sparse-keymap)
|
||||
"Map for OrgMode screenshot related commands")
|
||||
|
||||
;; prefix
|
||||
(org-defkey org-mode-map (kbd "C-c M-s") org-screenshot-map)
|
||||
|
||||
;; Mnemonic is Control-C Meta "Screenshot" "Take"
|
||||
(org-defkey org-screenshot-map (kbd "M-t") 'org-screenshot-take)
|
||||
(org-defkey org-screenshot-map (kbd "M-s") 'org-screenshot-take)
|
||||
|
||||
;; No reason to require meta key, since its our own keymap
|
||||
(org-defkey org-screenshot-map "s" 'org-screenshot-take)
|
||||
(org-defkey org-screenshot-map "t" 'org-screenshot-take)
|
||||
|
||||
;; Rotations, the fast rotation user hint, would prefer the modifier
|
||||
;; used by the original command that started the rotation
|
||||
(org-defkey org-screenshot-map (kbd "M-n") 'org-screenshot-rotate-next)
|
||||
(org-defkey org-screenshot-map (kbd "M-p") 'org-screenshot-rotate-prev)
|
||||
(org-defkey org-screenshot-map (kbd "C-n") 'org-screenshot-rotate-next)
|
||||
(org-defkey org-screenshot-map (kbd "C-p") 'org-screenshot-rotate-prev)
|
||||
|
||||
;; Show unused image files in Dired
|
||||
(org-defkey org-screenshot-map (kbd "M-u") 'org-screenshot-show-unused)
|
||||
(org-defkey org-screenshot-map (kbd "u") 'org-screenshot-show-unused)
|
||||
|
||||
|
||||
(random t)
|
||||
|
||||
(defun org-screenshot-random-string (length)
|
||||
"Generate a random string of LENGTH consisting of random upper
|
||||
case and lower case letters."
|
||||
(let ((name (make-string length ?x)))
|
||||
(dotimes (i length)
|
||||
(let ((n (random 52)))
|
||||
(aset name i (if (< n 26)
|
||||
(+ ?a n)
|
||||
(+ ?A n -26)))))
|
||||
name))
|
||||
|
||||
(defvar org-screenshot-process nil
|
||||
"Currently running screenshot process")
|
||||
|
||||
(defvar org-screenshot-directory-seq-numbers (make-hash-table :test 'equal))
|
||||
|
||||
(defun org-screenshot-update-seq-number (directory &optional reset)
|
||||
"Set `org-screenshot-file-name-format' sequence number for the directory.
|
||||
When RESET is NIL, increments the number stored, otherwise sets
|
||||
RESET as a new number. Intended to be called if screenshot was
|
||||
successful. Updating of sequence number is done in two steps, so
|
||||
aborted/canceled screenshot attempts don't increase the number"
|
||||
|
||||
(setq directory (file-name-as-directory directory))
|
||||
(puthash directory (if reset
|
||||
(if (numberp reset) reset 1)
|
||||
(1+ (gethash directory
|
||||
org-screenshot-directory-seq-numbers
|
||||
0)))
|
||||
org-screenshot-directory-seq-numbers))
|
||||
|
||||
(defun org-screenshot-generate-file-name (directory)
|
||||
"Use `org-screenshot-name-format' to generate new screenshot
|
||||
file name for a specific directory. Keeps re-generating name if
|
||||
it already exists, up to `org-screenshot-max-tries'
|
||||
times. Returns just the file, without directory part"
|
||||
(setq directory (file-name-as-directory directory))
|
||||
(when (file-exists-p directory)
|
||||
(let ((tries 0)
|
||||
name
|
||||
had-seq
|
||||
(case-fold-search nil))
|
||||
(while (and (< tries org-screenshot-max-tries)
|
||||
(not name))
|
||||
(incf tries)
|
||||
(let ((tmp org-screenshot-file-name-format)
|
||||
(seq-re "%[-0-9.]*d")
|
||||
(rand-re "%X+"))
|
||||
(when (string-match seq-re tmp)
|
||||
(let ((seq (gethash
|
||||
directory
|
||||
org-screenshot-directory-seq-numbers 1)))
|
||||
(setq tmp
|
||||
(replace-regexp-in-string
|
||||
seq-re (format (match-string 0 tmp) seq)
|
||||
tmp)
|
||||
had-seq t)))
|
||||
(when (string-match rand-re tmp)
|
||||
(setq tmp
|
||||
(replace-regexp-in-string
|
||||
rand-re (org-screenshot-random-string
|
||||
(1- (length (match-string 0 tmp))))
|
||||
tmp t)))
|
||||
(let ((fullname (concat directory tmp)))
|
||||
(if (file-exists-p fullname)
|
||||
(when had-seq (org-screenshot-update-seq-number directory))
|
||||
(setq name tmp)))))
|
||||
name)))
|
||||
|
||||
(defun org-screenshot-image-directory ()
|
||||
"Return the `org-screenshot-image-directory', ensuring there is
|
||||
trailing slash, and that it exists"
|
||||
(let ((dir (file-name-as-directory org-screenshot-image-directory)))
|
||||
(if (file-exists-p dir)
|
||||
dir
|
||||
(make-directory dir t)
|
||||
dir)))
|
||||
|
||||
(defvar org-screenshot-last-file nil
|
||||
"File name of the last taken or rotated screenshot file,
|
||||
without directory")
|
||||
|
||||
(defun org-screenshot-process-done (process event file
|
||||
orig-buffer
|
||||
orig-delay
|
||||
orig-event)
|
||||
"Called when \"scrot\" process exits. PROCESS and EVENT are
|
||||
same arguments as in `set-process-sentinel'. ORIG-BUFFER,
|
||||
ORIG-DELAY and ORIG-EVENT are Org Buffer, the screenshot delay
|
||||
used, and LAST-INPUT-EVENT values from when screenshot was
|
||||
initiated.
|
||||
"
|
||||
(setq org-screenshot-process nil)
|
||||
(with-current-buffer (process-buffer process)
|
||||
(if (not (equal event "finished\n"))
|
||||
(progn
|
||||
(insert event)
|
||||
(cond ((save-excursion
|
||||
(goto-char (point-min))
|
||||
(re-search-forward "Key was pressed" nil t))
|
||||
(ding)
|
||||
(message "Key was pressed, screenshot aborted"))
|
||||
(t
|
||||
(display-buffer (process-buffer process))
|
||||
(message "Error running \"scrot\" program")
|
||||
(ding))))
|
||||
(with-current-buffer orig-buffer
|
||||
(let ((link (format "[[file:%s]]" file)))
|
||||
(setq org-screenshot-last-file (file-name-nondirectory file))
|
||||
(let ((beg (point)))
|
||||
(insert link)
|
||||
(when org-inline-image-overlays
|
||||
(org-display-inline-images nil t beg (point))))
|
||||
(unless (< orig-delay 3)
|
||||
(ding))
|
||||
(org-screenshot-rotate-continue t orig-event))))))
|
||||
|
||||
|
||||
;;;###autoload
|
||||
(defun org-screenshot-take (&optional delay)
|
||||
"Take a screenshot and insert link to it at point, if image
|
||||
display is already on (see \\[org-toggle-inline-images])
|
||||
screenshot will be displayed as an image
|
||||
|
||||
Screen area for the screenshot is selected with the mouse, left
|
||||
click on a window screenshots that window, while left click and
|
||||
drag selects a region. Pressing any key cancels the screen shot
|
||||
|
||||
With `C-u' universal argument waits one second after target is
|
||||
selected before taking the screenshot. With double `C-u' wait two
|
||||
seconds.
|
||||
|
||||
With triple `C-u' wait 3 seconds, and also rings the bell when
|
||||
screenshot is done, any more `C-u' after that increases delay by
|
||||
2 seconds
|
||||
"
|
||||
(interactive "P")
|
||||
|
||||
;; probably easier way to count number of C-u C-u out there
|
||||
(setq delay
|
||||
(cond ((null delay) 0)
|
||||
((integerp delay) delay)
|
||||
((and (consp delay)
|
||||
(integerp (car delay))
|
||||
(plusp (car delay)))
|
||||
(let ((num 1)
|
||||
(limit (car delay))
|
||||
(cnt 0))
|
||||
(while (< num limit)
|
||||
(setq num (* num 4)
|
||||
cnt (+ cnt (if (< cnt 3) 1 2))))
|
||||
cnt))
|
||||
(t (error "Invalid delay"))))
|
||||
(when (and org-screenshot-process
|
||||
(member (process-status org-screenshot-process)
|
||||
'(run stop)))
|
||||
(error "scrot process is still running"))
|
||||
(let* ((name (org-screenshot-generate-file-name (org-screenshot-image-directory)))
|
||||
(file (format "%s%s" (org-screenshot-image-directory)
|
||||
name))
|
||||
(path (expand-file-name file)))
|
||||
(when (get-buffer "*scrot*")
|
||||
(with-current-buffer (get-buffer "*scrot*")
|
||||
(erase-buffer)))
|
||||
(setq org-screenshot-process
|
||||
(or
|
||||
(apply 'start-process
|
||||
(append
|
||||
(list "scrot" "*scrot*" "scrot" "-s" path)
|
||||
(when (plusp delay)
|
||||
(list "-d" (format "%d" delay)))))
|
||||
(error "Unable to start scrot process")))
|
||||
(when org-screenshot-process
|
||||
(if (plusp delay)
|
||||
(message "Click on a window, or select a rectangle (delay is %d sec)..."
|
||||
delay)
|
||||
(message "Click on a window, or select a rectangle..."))
|
||||
(set-process-sentinel
|
||||
org-screenshot-process
|
||||
`(lambda (process event)
|
||||
(org-screenshot-process-done
|
||||
process event ,file ,(current-buffer) ,delay ',last-input-event))))))
|
||||
|
||||
(defvar org-screenshot-file-list nil
|
||||
"List of files in `org-screenshot-image-directory' used by
|
||||
`org-screenshot-rotate-prev' and `org-screenshot-rotate-next'")
|
||||
|
||||
(defvar org-screenshot-rotation-index -1)
|
||||
|
||||
(make-variable-buffer-local 'org-screenshot-file-list)
|
||||
(make-variable-buffer-local 'org-screenshot-rotation-index)
|
||||
|
||||
(defun org-screenshot-rotation-init (lastfile)
|
||||
"Initialize variable `org-screenshot-file-list' variable with
|
||||
the list of PNG files in `org-screenshot-image-directory' sorted
|
||||
by most recent first"
|
||||
(setq
|
||||
org-screenshot-rotation-index -1
|
||||
org-screenshot-file-list
|
||||
(let ((files (directory-files org-screenshot-image-directory
|
||||
t (image-file-name-regexp) t)))
|
||||
(mapcar 'file-name-nondirectory
|
||||
(sort files
|
||||
(lambda (file1 file2)
|
||||
(let ((mtime1 (nth 5 (file-attributes file1)))
|
||||
(mtime2 (nth 5 (file-attributes file2))))
|
||||
(setq mtime1 (+ (ash (first mtime1) 16)
|
||||
(second mtime1)))
|
||||
(setq mtime2 (+ (ash (first mtime2) 16)
|
||||
(second mtime2)))
|
||||
(> mtime1 mtime2)))))))
|
||||
(let ((n -1) (list org-screenshot-file-list))
|
||||
(while (and list (not (equal (pop list) lastfile)))
|
||||
(incf n))
|
||||
(setq org-screenshot-rotation-index n)))
|
||||
|
||||
(defun org-screenshot-do-rotate (dir from-continue-rotating)
|
||||
"Rotate last screenshot with one of the previously taken
|
||||
screenshots from the same directory. If DIR is negative, in the
|
||||
other direction"
|
||||
(setq org-screenshot-last-file nil)
|
||||
(let* ((ourdir (file-name-as-directory (org-screenshot-image-directory)))
|
||||
done
|
||||
(link-re
|
||||
;; taken from `org-display-inline-images'
|
||||
(concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?"
|
||||
(substring (image-file-name-regexp) 0 -2)
|
||||
"\\)\\]"))
|
||||
newfile oldfile)
|
||||
(save-excursion
|
||||
;; Search for link to image file in the same directory before the point
|
||||
(while (not done)
|
||||
(if (not (re-search-backward link-re (point-min) t))
|
||||
(error "Unable to find link to image from %S directory before point" ourdir)
|
||||
(let ((file (concat (or (match-string 3) "") (match-string 4))))
|
||||
(when (equal (file-name-directory file)
|
||||
ourdir)
|
||||
(setq done t
|
||||
oldfile (file-name-nondirectory file))))))
|
||||
(when (or (null org-screenshot-file-list)
|
||||
(and (not from-continue-rotating)
|
||||
(not (member last-command
|
||||
'(org-screenshot-rotate-prev
|
||||
org-screenshot-rotate-next)))))
|
||||
(org-screenshot-rotation-init oldfile))
|
||||
(unless (> (length org-screenshot-file-list) 1)
|
||||
(error "Can't rotate a single image file"))
|
||||
(replace-match "" nil nil nil 1)
|
||||
|
||||
(setq org-screenshot-rotation-index
|
||||
(mod (+ org-screenshot-rotation-index dir)
|
||||
(length org-screenshot-file-list))
|
||||
newfile (nth org-screenshot-rotation-index
|
||||
org-screenshot-file-list))
|
||||
;; in case we started rotating from the file we just inserted,
|
||||
;; advance one more time
|
||||
(when (equal oldfile newfile)
|
||||
(setq org-screenshot-rotation-index
|
||||
(mod (+ org-screenshot-rotation-index (if (plusp dir) 1 -1))
|
||||
(length org-screenshot-file-list))
|
||||
newfile (nth org-screenshot-rotation-index
|
||||
org-screenshot-file-list)))
|
||||
(replace-match (concat "file:" ourdir
|
||||
newfile)
|
||||
t t nil 4))
|
||||
;; out of save-excursion
|
||||
(setq org-screenshot-last-file newfile)
|
||||
(when org-inline-image-overlays
|
||||
(org-display-inline-images nil t (match-beginning 0) (point)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun org-screenshot-rotate-prev (dir)
|
||||
"Rotate last screenshot with one of the previously taken
|
||||
screenshots from the same directory. If DIR is negative, rotate
|
||||
in the other direction"
|
||||
(interactive "p")
|
||||
(org-screenshot-do-rotate dir nil)
|
||||
(when org-screenshot-last-file
|
||||
(org-screenshot-rotate-continue nil nil)))
|
||||
|
||||
;;;###autoload
|
||||
(defun org-screenshot-rotate-next (dir)
|
||||
"Rotate last screenshot with one of the previously taken
|
||||
screenshots from the same directory. If DIR is negative, rotate
|
||||
in the other direction"
|
||||
(interactive "p")
|
||||
(org-screenshot-do-rotate (- dir) nil)
|
||||
(when org-screenshot-last-file
|
||||
(org-screenshot-rotate-continue nil nil)))
|
||||
|
||||
(defun org-screenshot-prefer-same-modifiers (list event)
|
||||
(if (not (eventp nil)) (car list)
|
||||
(let (ret (keys list))
|
||||
(while (and (null ret) keys)
|
||||
(let ((key (car keys)))
|
||||
(if (and (= 1 (length key))
|
||||
(equal (event-modifiers event)
|
||||
(event-modifiers (elt key 0))))
|
||||
(setq ret (car keys))
|
||||
(setq keys (cdr keys)))))
|
||||
(or ret (car list)))))
|
||||
|
||||
(defun org-screenshot-rotate-continue (from-take-screenshot orig-event)
|
||||
"Display the message with the name of the last changed
|
||||
image-file and inform user that they can rotate by pressing keys
|
||||
bound to `org-screenshot-rotate-next' and
|
||||
`org-screenshot-rotate-prev' in `org-screenshot-map'
|
||||
|
||||
This works similarly to `kmacro-end-or-call-macro' so that user
|
||||
can press a long key sequence to invoke the first command, and
|
||||
then uses single keys to rotate, until unregognized key is
|
||||
entered, at which point event will be unread"
|
||||
|
||||
(let* ((event (if from-take-screenshot orig-event
|
||||
last-input-event))
|
||||
done
|
||||
(prev-key
|
||||
(org-screenshot-prefer-same-modifiers
|
||||
(where-is-internal 'org-screenshot-rotate-prev
|
||||
org-screenshot-map nil)
|
||||
event))
|
||||
(next-key
|
||||
(org-screenshot-prefer-same-modifiers
|
||||
(where-is-internal 'org-screenshot-rotate-next
|
||||
org-screenshot-map nil)
|
||||
event))
|
||||
prev-key-str next-key-str)
|
||||
(when (and (= (length prev-key) 1)
|
||||
(= (length next-key) 1))
|
||||
(setq
|
||||
prev-key-str (format-kbd-macro prev-key nil)
|
||||
next-key-str (format-kbd-macro next-key nil)
|
||||
prev-key (elt prev-key 0)
|
||||
next-key (elt next-key 0))
|
||||
(while (not done)
|
||||
(message "%S - '%s' and '%s' to rotate"
|
||||
org-screenshot-last-file prev-key-str next-key-str)
|
||||
(setq event (read-event))
|
||||
(cond ((equal event prev-key)
|
||||
(clear-this-command-keys t)
|
||||
(org-screenshot-do-rotate 1 t)
|
||||
(setq last-input-event nil))
|
||||
((equal event next-key)
|
||||
(clear-this-command-keys t)
|
||||
(org-screenshot-do-rotate -1 t)
|
||||
(setq last-input-event nil))
|
||||
(t (setq done t))))
|
||||
(when last-input-event
|
||||
(clear-this-command-keys t)
|
||||
(setq unread-command-events (list last-input-event))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun org-screenshot-show-unused ()
|
||||
"Open A Dired buffer with unused screenshots marked"
|
||||
(interactive)
|
||||
(let ((files-in-buffer)
|
||||
dired-buffer
|
||||
had-any
|
||||
(image-re (image-file-name-regexp))
|
||||
beg end)
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(widen)
|
||||
(setq beg (or beg (point-min)) end (or end (point-max)))
|
||||
(goto-char beg)
|
||||
(let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?"
|
||||
(substring (image-file-name-regexp) 0 -2)
|
||||
"\\)\\]"))
|
||||
(case-fold-search t)
|
||||
old file ov img type attrwidth width)
|
||||
(while (re-search-forward re end t)
|
||||
(setq file (concat (or (match-string 3) "") (match-string 4)))
|
||||
(when (and (file-exists-p file)
|
||||
(equal (file-name-directory file)
|
||||
(org-screenshot-image-directory)))
|
||||
(push (file-name-nondirectory file)
|
||||
files-in-buffer))))))
|
||||
(setq dired-buffer (dired-noselect (org-screenshot-image-directory)))
|
||||
(with-current-buffer dired-buffer
|
||||
(dired-unmark-all-files ?\r)
|
||||
(dired-mark-if
|
||||
(let ((file (dired-get-filename 'no-dir t)))
|
||||
(and file (string-match image-re file)
|
||||
(not (member file files-in-buffer))
|
||||
(setq had-any t)))
|
||||
"Unused screenshot"))
|
||||
(when had-any (pop-to-buffer dired-buffer))))
|
||||
|
||||
(provide 'org-screenshot)
|
||||
229
lisp/org-contrib/org-secretary.el
Normal file
229
lisp/org-contrib/org-secretary.el
Normal file
@@ -0,0 +1,229 @@
|
||||
;;; org-secretary.el --- Team management with org-mode
|
||||
;; Copyright (C) 2010-2014, 2021 Juan Reyero
|
||||
;;
|
||||
;; Author: Juan Reyero <juan _at_ juanreyero _dot_ com>
|
||||
;; Keywords: outlines, tasks, team, management
|
||||
;; Homepage: http://juanreyero.com/article/emacs/org-teams.html
|
||||
;; Version: 0.02
|
||||
;;
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; This file 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, or (at your option)
|
||||
;; any later version.
|
||||
|
||||
;; THis file is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
;;
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; This module implements helper functions for team management. It
|
||||
;; makes it easy to keep track of the work of several people. It
|
||||
;; keeps context (with whom and where you are) and allows you to use
|
||||
;; it to metadata to your notes, and to query the tasks associated
|
||||
;; with the people you are with and the place.
|
||||
;;
|
||||
;; See http://juanreyero.com/article/emacs/org-teams.html for a full
|
||||
;; explanation and configuration instructions.
|
||||
;;
|
||||
;;; Configuration
|
||||
;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;; In short; your todos use the TODO keyword, your team's use TASK.
|
||||
;; Your org-todo-keywords should look something like this:
|
||||
;;
|
||||
;; (setq org-todo-keywords
|
||||
;; '((sequence "TODO(t)" "|" "DONE(d)" "CANCELLED(c)")
|
||||
;; (sequence "TASK(f)" "|" "DONE(d)")
|
||||
;; (sequence "MAYBE(m)" "|" "CANCELLED(c)")))
|
||||
;;
|
||||
;; It helps to distinguish them by color, like this:
|
||||
;;
|
||||
;; (setq org-todo-keyword-faces
|
||||
;; '(("TODO" . (:foreground "DarkOrange1" :weight bold))
|
||||
;; ("MAYBE" . (:foreground "sea green"))
|
||||
;; ("DONE" . (:foreground "light sea green"))
|
||||
;; ("CANCELLED" . (:foreground "forest green"))
|
||||
;; ("TASK" . (:foreground "blue"))))
|
||||
;;
|
||||
;; If you want to keep track of stuck projects you should tag your
|
||||
;; projects with :prj:, and define:
|
||||
;;
|
||||
;; (setq org-tags-exclude-from-inheritance '("prj")
|
||||
;; org-stuck-projects '("+prj/-MAYBE-DONE"
|
||||
;; ("TODO" "TASK") ()))
|
||||
;;
|
||||
;; Define a tag that marks TASK entries as yours:
|
||||
;;
|
||||
;; (setq org-sec-me "juanre")
|
||||
;;
|
||||
;; Finally, you add the special views to your org-agenda-custom-commands:
|
||||
;;
|
||||
;; (setq org-agenda-custom-commands
|
||||
;; '(("h" "Work todos" tags-todo
|
||||
;; "-personal-doat={.+}-dowith={.+}/!-TASK"
|
||||
;; ((org-agenda-todo-ignore-scheduled t)))
|
||||
;; ("H" "All work todos" tags-todo "-personal/!-TASK-MAYBE"
|
||||
;; ((org-agenda-todo-ignore-scheduled nil)))
|
||||
;; ("A" "Work todos with doat or dowith" tags-todo
|
||||
;; "-personal+doat={.+}|dowith={.+}/!-TASK"
|
||||
;; ((org-agenda-todo-ignore-scheduled nil)))
|
||||
;; ("j" "TODO dowith and TASK with"
|
||||
;; ((org-sec-with-view "TODO dowith")
|
||||
;; (org-sec-where-view "TODO doat")
|
||||
;; (org-sec-assigned-with-view "TASK with")
|
||||
;; (org-sec-stuck-with-view "STUCK with")))
|
||||
;; ("J" "Interactive TODO dowith and TASK with"
|
||||
;; ((org-sec-who-view "TODO dowith")))))
|
||||
;;
|
||||
;;; Usage
|
||||
;;;;;;;;;
|
||||
;;
|
||||
;; Do C-c w to say with whom you are meeting (a space-separated list
|
||||
;; of names). Maybe do also C-c W to say where you are. Then do C-c a
|
||||
;; j to see:
|
||||
;; - Todo items defined with TODO (ie, mine) in which the
|
||||
;; =dowith= property matches any of the people with me.
|
||||
;; - Todo items defined with TODO in which the =doat= property
|
||||
;; matches my current location.
|
||||
;; - Todo items defined with TASK that are tagged with the name
|
||||
;; of any of the people with me (this is, assigned to them).
|
||||
;; - Stuck projects tagged with the name of the people with me.
|
||||
;;
|
||||
;; Use C-c j to add meta-data with the people with me, the
|
||||
;; location and the time to entries.
|
||||
|
||||
(require 'org)
|
||||
|
||||
(defvar org-sec-me nil
|
||||
"Tag that defines TASK todo entries associated to me")
|
||||
|
||||
(defvar org-sec-with nil
|
||||
"Value of the :with: property when doing an
|
||||
org-sec-tag-entry. Change it with org-sec-set-with,
|
||||
set to C-c w. Defaults to org-sec-me")
|
||||
|
||||
(defvar org-sec-where ""
|
||||
"Value of the :at: property when doing an
|
||||
org-sec-tag-entry. Change it with org-sec-set-with,
|
||||
set to C-c W")
|
||||
|
||||
(defvar org-sec-with-history '()
|
||||
"History list of :with: properties")
|
||||
|
||||
(defvar org-sec-where-history '()
|
||||
"History list of :where: properties")
|
||||
|
||||
(defun org-sec-set-with ()
|
||||
"Changes the value of the org-sec-with variable for use in the
|
||||
next call of org-sec-tag-entry. Leave it empty to default to
|
||||
org-sec-me (you)."
|
||||
(interactive)
|
||||
(setq org-sec-with (let ((w (read-string "With: " nil
|
||||
'org-sec-with-history "")))
|
||||
(if (string= w "")
|
||||
nil
|
||||
w))))
|
||||
(global-set-key "\C-cw" 'org-sec-set-with)
|
||||
|
||||
(defun org-sec-set-where ()
|
||||
"Changes the value of the org-sec-where variable for use
|
||||
in the next call of org-sec-tag-entry."
|
||||
(interactive)
|
||||
(setq org-sec-where
|
||||
(read-string "Where: " nil
|
||||
'org-sec-where-history "")))
|
||||
(global-set-key "\C-cW" 'org-sec-set-where)
|
||||
|
||||
(defun org-sec-set-dowith ()
|
||||
"Sets the value of the dowith property."
|
||||
(interactive)
|
||||
(let ((do-with
|
||||
(read-string "Do with: "
|
||||
nil 'org-sec-dowith-history "")))
|
||||
(unless (string= do-with "")
|
||||
(org-entry-put nil "dowith" do-with))))
|
||||
(global-set-key "\C-cd" 'org-sec-set-dowith)
|
||||
|
||||
(defun org-sec-set-doat ()
|
||||
"Sets the value of the doat property."
|
||||
(interactive)
|
||||
(let ((do-at (read-string "Do at: "
|
||||
nil 'org-sec-doat-history "")))
|
||||
(unless (string= do-at "")
|
||||
(org-entry-put nil "doat" do-at))))
|
||||
(global-set-key "\C-cD" 'org-sec-set-doat)
|
||||
|
||||
(defun org-sec-tag-entry ()
|
||||
"Adds a :with: property with the value of org-sec-with if
|
||||
defined, an :at: property with the value of org-sec-where
|
||||
if defined, and an :on: property with the current time."
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(org-entry-put nil "on" (format-time-string
|
||||
(org-time-stamp-format 'long)
|
||||
(current-time)))
|
||||
(unless (string= org-sec-where "")
|
||||
(org-entry-put nil "at" org-sec-where))
|
||||
(if org-sec-with
|
||||
(org-entry-put nil "with" org-sec-with))))
|
||||
(global-set-key "\C-cj" 'org-sec-tag-entry)
|
||||
|
||||
(defun join (lst sep &optional pre post)
|
||||
(mapconcat (lambda (x) (concat pre x post)) lst sep))
|
||||
|
||||
(defun org-sec-get-with ()
|
||||
(if org-sec-with
|
||||
org-sec-with
|
||||
org-sec-me))
|
||||
|
||||
(defun org-sec-with-view (par &optional who)
|
||||
"Select tasks marked as dowith=who, where who
|
||||
defaults to the value of org-sec-with."
|
||||
(org-tags-view '(4) (join (split-string (if who
|
||||
who
|
||||
(org-sec-get-with)))
|
||||
"|" "dowith=\"" "\"")))
|
||||
|
||||
(defun org-sec-where-view (par)
|
||||
"Select tasks marked as doat=org-sec-where."
|
||||
(org-tags-view '(4) (concat "doat={" org-sec-where "}")))
|
||||
|
||||
(defun org-sec-assigned-with-view (par &optional who)
|
||||
"Select tasks assigned to who, by default org-sec-with."
|
||||
(org-tags-view '(4)
|
||||
(concat (join (split-string (if who
|
||||
who
|
||||
(org-sec-get-with)))
|
||||
"|")
|
||||
"/TASK")))
|
||||
|
||||
(defun org-sec-stuck-with-view (par &optional who)
|
||||
"Select stuck projects assigned to who, by default
|
||||
org-sec-with."
|
||||
(let ((org-stuck-projects
|
||||
`(,(concat "+prj+"
|
||||
(join (split-string (if who
|
||||
who
|
||||
(org-sec-get-with))) "|")
|
||||
"/-MAYBE-DONE")
|
||||
("TODO" "TASK") ())))
|
||||
(org-agenda-list-stuck-projects)))
|
||||
|
||||
(defun org-sec-who-view (par)
|
||||
"Builds agenda for a given user. Queried. "
|
||||
(let ((who (read-string "Build todo for user/tag: "
|
||||
"" "" "")))
|
||||
(org-sec-with-view "TODO dowith" who)
|
||||
(org-sec-assigned-with-view "TASK with" who)
|
||||
(org-sec-stuck-with-view "STUCK with" who)))
|
||||
|
||||
(provide 'org-secretary)
|
||||
|
||||
;;; org-secretary.el ends here
|
||||
188
lisp/org-contrib/org-static-mathjax.el
Normal file
188
lisp/org-contrib/org-static-mathjax.el
Normal file
@@ -0,0 +1,188 @@
|
||||
;;; org-static-mathjax.el --- Muse-like tags in Org-mode
|
||||
;;
|
||||
;; Author: Jan Böker <jan dot boecker at jboecker dot de>
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; This elisp code integrates Static MathJax into the
|
||||
;; HTML export process of Org-mode.
|
||||
;;
|
||||
;; The supporting files for this package are in contrib/scripts/staticmathjax
|
||||
;; Please read the README.org file in that directory for more information.
|
||||
|
||||
;; To use it, evaluate it on startup, add the following to your .emacs:
|
||||
|
||||
;; (require 'org-static-mathjax)
|
||||
;;
|
||||
;; You will then have to customize the following two variables:
|
||||
;; - org-static-mathjax-app-ini-path
|
||||
;; - org-static-mathjax-local-mathjax-path
|
||||
;;
|
||||
;; If xulrunner is not in your $PATH, you will also need to customize
|
||||
;; org-static-mathjax-xulrunner-path.
|
||||
;;
|
||||
;; If everything is setup correctly, you can trigger Static MathJax on
|
||||
;; export to HTML by adding the following line to your Org file:
|
||||
;; #+StaticMathJax: embed-fonts:nil output-file-name:"embedded-math.html"
|
||||
;;
|
||||
;; You can omit either argument.
|
||||
;; embed-fonts defaults to nil. If you do not specify output-file-name,
|
||||
;; the exported file is overwritten with the static version.
|
||||
;;
|
||||
;; If embed-fonts is non-nil, the fonts are embedded directly into the
|
||||
;; output file using data: URIs.
|
||||
;;
|
||||
;; output-file-name specifies the file name of the static version. You
|
||||
;; can use any arbitrary lisp form here, for example:
|
||||
;; output-file-name:(concat (file-name-sans-extension buffer-file-name) "-static.html")
|
||||
;;
|
||||
;; The StaticMathJax XULRunner application expects a UTF-8 encoded
|
||||
;; input file. If the static version displays random characters instead
|
||||
;; of your math, add the following line at the top of your Org file:
|
||||
;; -*- coding: utf-8; -*-
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(defcustom org-static-mathjax-app-ini-path
|
||||
(or (expand-file-name
|
||||
"../scripts/staticmatchjax/application.ini"
|
||||
(file-name-directory (or load-file-name buffer-file-name)))
|
||||
"")
|
||||
"Path to \"application.ini\" of the Static MathJax XULRunner application.
|
||||
If you have extracted StaticMathJax to e.g. ~/.local/staticmathjax, set
|
||||
this to ~/.local/staticmathjax/application.ini"
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-static-mathjax-xulrunner-path
|
||||
"xulrunner"
|
||||
"Path to your xulrunner binary"
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-static-mathjax-local-mathjax-path
|
||||
""
|
||||
"Extract the MathJax zip file somewhere on your local
|
||||
hard drive and specify the path here.
|
||||
|
||||
The directory has to be writeable, as org-static-mathjax
|
||||
creates a temporary file there during export."
|
||||
:type 'string)
|
||||
|
||||
(defvar org-static-mathjax-debug
|
||||
nil
|
||||
"If non-nil, org-static-mathjax will print some debug messages")
|
||||
|
||||
(defun org-static-mathjax-hook-installer ()
|
||||
"Installs org-static-mathjax-process in after-save-hook.
|
||||
|
||||
Sets the following buffer-local variables for org-static-mathjax-process to pick up:
|
||||
org-static-mathjax-mathjax-path: The path to MathJax.js as used by Org HTML export
|
||||
org-static-mathjax-options: The string given with #+STATICMATHJAX: in the file"
|
||||
(let ((static-mathjax-option-string (plist-get opt-plist :static-mathjax)))
|
||||
(if static-mathjax-option-string
|
||||
(progn (set (make-local-variable 'org-static-mathjax-options) static-mathjax-option-string)
|
||||
(set (make-local-variable 'org-static-mathjax-mathjax-path)
|
||||
(nth 1 (assq 'path org-export-html-mathjax-options)))
|
||||
(let ((mathjax-options (plist-get opt-plist :mathjax)))
|
||||
(if mathjax-options
|
||||
(if (string-match "\\<path:" mathjax-options)
|
||||
(set 'org-static-mathjax-mathjax-path
|
||||
(car (read-from-string
|
||||
(substring mathjax-options (match-end 0))))))))
|
||||
(add-hook 'after-save-hook
|
||||
'org-static-mathjax-process
|
||||
nil t)))))
|
||||
|
||||
|
||||
(defun org-static-mathjax-process ()
|
||||
(save-excursion
|
||||
; some sanity checking
|
||||
(if (or (string= org-static-mathjax-app-ini-path "")
|
||||
(not (file-exists-p org-static-mathjax-app-ini-path)))
|
||||
(error "Static MathJax: You must customize org-static-mathjax-app-ini-path!"))
|
||||
(if (or (string= org-static-mathjax-local-mathjax-path "")
|
||||
(not (file-exists-p org-static-mathjax-local-mathjax-path)))
|
||||
(error "Static MathJax: You must customize org-static-mathjax-local-mathjax-path!"))
|
||||
|
||||
; define variables
|
||||
(let* ((options org-static-mathjax-options)
|
||||
(output-file-name buffer-file-name)
|
||||
(input-file-name (let ((temporary-file-directory (file-name-directory org-static-mathjax-local-mathjax-path)))
|
||||
(make-temp-file "org-static-mathjax-" nil ".html")))
|
||||
(html-code (buffer-string))
|
||||
(mathjax-oldpath (concat "src=\"" org-static-mathjax-mathjax-path))
|
||||
(mathjax-newpath (concat "src=\"" org-static-mathjax-local-mathjax-path))
|
||||
embed-fonts)
|
||||
; read file-local options
|
||||
(mapc
|
||||
(lambda (symbol)
|
||||
(if (string-match (concat "\\<" (symbol-name symbol) ":") options)
|
||||
(set symbol (eval (car (read-from-string
|
||||
(substring options (match-end 0))))))))
|
||||
'(embed-fonts output-file-name))
|
||||
|
||||
; debug
|
||||
(when org-static-mathjax-debug
|
||||
(message "output file name, embed-fonts")
|
||||
(print output-file-name)
|
||||
(print embed-fonts))
|
||||
|
||||
; open (temporary) input file, copy contents there, replace MathJax path with local installation
|
||||
(with-temp-buffer
|
||||
(insert html-code)
|
||||
(goto-char 1)
|
||||
(replace-regexp mathjax-oldpath mathjax-newpath)
|
||||
(write-file input-file-name))
|
||||
|
||||
; prepare argument list for call-process
|
||||
(let ((call-process-args (list org-static-mathjax-xulrunner-path
|
||||
nil nil nil
|
||||
org-static-mathjax-app-ini-path
|
||||
input-file-name
|
||||
output-file-name)))
|
||||
; if fonts are embedded, just append the --embed-fonts flag
|
||||
(if embed-fonts
|
||||
(add-to-list 'call-process-args "--embed-fonts" t))
|
||||
; if fonts are not embedded, the XULRunner app must replace all references
|
||||
; to the font files with the real location (Firefox inserts file:// URLs there,
|
||||
; because we are using a local MathJax installation here)
|
||||
(if (not embed-fonts)
|
||||
(progn
|
||||
(add-to-list 'call-process-args "--final-mathjax-url" t)
|
||||
(add-to-list 'call-process-args
|
||||
(file-name-directory org-static-mathjax-mathjax-path)
|
||||
t)))
|
||||
|
||||
; debug
|
||||
(when org-static-mathjax-debug
|
||||
(print call-process-args))
|
||||
; call it
|
||||
(apply 'call-process call-process-args)
|
||||
; delete our temporary input file
|
||||
(kill-buffer)
|
||||
(delete-file input-file-name)
|
||||
(let ((backup-file (concat input-file-name "~")))
|
||||
(if (file-exists-p backup-file)
|
||||
(delete-file backup-file)))))))
|
||||
|
||||
(add-to-list 'org-export-inbuffer-options-extra
|
||||
'("STATICMATHJAX" :static-mathjax))
|
||||
|
||||
(add-hook 'org-export-html-final-hook 'org-static-mathjax-hook-installer)
|
||||
|
||||
|
||||
(provide 'org-static-mathjax)
|
||||
287
lisp/org-contrib/org-sudoku.el
Normal file
287
lisp/org-contrib/org-sudoku.el
Normal file
@@ -0,0 +1,287 @@
|
||||
;;; org-sudoku.el --- Create and solve SUDOKU games in Org tables
|
||||
|
||||
;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
|
||||
;;
|
||||
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
|
||||
;; Keywords: outlines, hypermedia, calendar, wp, games
|
||||
;; Homepage: https://orgmode.org
|
||||
;; Version: 0.01
|
||||
;;
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 3, 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
;;
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; This is a quick hack to create and solve SUDOKU games in org tables.
|
||||
;;
|
||||
;; Commands:
|
||||
;;
|
||||
;; org-sudoku-create Create a new SUDOKU game
|
||||
;; org-sudoku-solve-field Solve the field at point in a SUDOKU game
|
||||
;; (this is for cheeting when you are stuck)
|
||||
;; org-sudoku-solve Solve the entire game
|
||||
;;
|
||||
|
||||
;;; Code
|
||||
|
||||
(require 'org)
|
||||
(require 'org-table)
|
||||
|
||||
;;; Customization
|
||||
|
||||
(defvar org-sudoku-size 9
|
||||
"The size of the sudoku game, 9 for a 9x9 game and 4 for a 4x4 game.
|
||||
Larger games do not seem to work because of limited resources - even though
|
||||
the algorithm is general.")
|
||||
|
||||
(defvar org-sudoku-timeout 2.0
|
||||
"Timeout for finding a solution when creating a new game.
|
||||
After this timeout, the program starts over from scratch to create
|
||||
a game.")
|
||||
|
||||
;;; Interactive commands
|
||||
|
||||
(defun org-sudoku-create (nfilled)
|
||||
"Create a sudoku game."
|
||||
(interactive "nNumber of pre-filled fields: ")
|
||||
(let ((sizesq org-sudoku-size)
|
||||
game)
|
||||
(loop for i from 1 to org-sudoku-size do
|
||||
(loop for j from 1 to org-sudoku-size do
|
||||
(push (list (cons i j) 0) game)))
|
||||
(setq game (nreverse game))
|
||||
(random t)
|
||||
(setq game (org-sudoku-build-allowed game))
|
||||
(setq game (org-sudoku-set-field game (cons 1 1)
|
||||
(1+ (random org-sudoku-size))))
|
||||
(catch 'solved
|
||||
(let ((cnt 0))
|
||||
(while t
|
||||
(catch 'abort
|
||||
(message "Attempt %d to create a game" (setq cnt (1+ cnt)))
|
||||
(setq game1 (org-sudoku-deep-copy game))
|
||||
(setq game1 (org-sudoku-solve-game
|
||||
game1 'random (+ (float-time) org-sudoku-timeout)))
|
||||
(when game1
|
||||
(setq game game1)
|
||||
(throw 'solved t))))))
|
||||
(let ((sqrtsize (floor (sqrt org-sudoku-size))))
|
||||
(loop for i from 1 to org-sudoku-size do
|
||||
(insert "| |\n")
|
||||
(if (and (= (mod i sqrtsize) 0) (< i org-sudoku-size))
|
||||
(insert "|-\n")))
|
||||
(backward-char 5)
|
||||
(org-table-align))
|
||||
(while (> (length game) nfilled)
|
||||
(setq game (delete (nth (1+ (random (length game))) game) game)))
|
||||
(mapc (lambda (e)
|
||||
(org-table-put (caar e) (cdar e) (int-to-string (nth 1 e))))
|
||||
game)
|
||||
(org-table-align)
|
||||
(org-table-goto-line 1)
|
||||
(org-table-goto-column 1)
|
||||
(message "Enjoy!")))
|
||||
|
||||
(defun org-sudoku-solve ()
|
||||
"Solve the sudoku game in the table at point."
|
||||
(interactive)
|
||||
(unless (org-at-table-p)
|
||||
(error "not at a table"))
|
||||
(let (game)
|
||||
(setq game (org-sudoku-get-game))
|
||||
(setq game (org-sudoku-build-allowed game))
|
||||
(setq game (org-sudoku-solve-game game))
|
||||
;; Insert the values
|
||||
(mapc (lambda (e)
|
||||
(org-table-put (caar e) (cdar e) (int-to-string (nth 1 e))))
|
||||
game)
|
||||
(org-table-align)))
|
||||
|
||||
(defun org-sudoku-solve-field ()
|
||||
"Just solve the field at point.
|
||||
This works by solving the whole game, then inserting only the single field."
|
||||
(interactive)
|
||||
(unless (org-at-table-p)
|
||||
(error "Not at a table"))
|
||||
(org-table-check-inside-data-field)
|
||||
(let ((i (org-table-current-dline))
|
||||
(j (org-table-current-column))
|
||||
game)
|
||||
(setq game (org-sudoku-get-game))
|
||||
(setq game (org-sudoku-build-allowed game))
|
||||
(setq game (org-sudoku-solve-game game))
|
||||
(if game
|
||||
(progn
|
||||
(org-table-put i j (number-to-string
|
||||
(nth 1 (assoc (cons i j) game)))
|
||||
'align)
|
||||
(org-table-goto-line i)
|
||||
(org-table-goto-column j))
|
||||
(error "No solution"))))
|
||||
|
||||
;;; Internal functions
|
||||
|
||||
(defun org-sudoku-get-game ()
|
||||
"Interpret table at point as sudoku game and read it.
|
||||
A game structure is returned."
|
||||
(let (b e g i j game)
|
||||
|
||||
(org-table-goto-line 1)
|
||||
(org-table-goto-column 1)
|
||||
(setq b (point))
|
||||
(org-table-goto-line org-sudoku-size)
|
||||
(org-table-goto-column org-sudoku-size)
|
||||
(setq e (point))
|
||||
(setq g (org-table-copy-region b e))
|
||||
(setq i 0 j 0)
|
||||
(mapc (lambda (c)
|
||||
(setq i (1+ i) j 0)
|
||||
(mapc
|
||||
(lambda (v)
|
||||
(setq j (1+ j))
|
||||
(push (list (cons i j)
|
||||
(string-to-number v))
|
||||
game))
|
||||
c))
|
||||
g)
|
||||
(nreverse game)))
|
||||
|
||||
(defun org-sudoku-build-allowed (game)
|
||||
(let (i j v numbers)
|
||||
(loop for i from 1 to org-sudoku-size do
|
||||
(push i numbers))
|
||||
(setq numbers (nreverse numbers))
|
||||
;; add the lists of allowed values for each entry
|
||||
(setq game (mapcar
|
||||
(lambda (e)
|
||||
(list (car e) (nth 1 e)
|
||||
(if (= (nth 1 e) 0)
|
||||
(copy-sequence numbers)
|
||||
nil)))
|
||||
game))
|
||||
;; remove the known values from the list of allowed values
|
||||
(mapc
|
||||
(lambda (e)
|
||||
(setq i (caar e) j (cdar e) v (cadr e))
|
||||
(when (> v 0)
|
||||
;; We do have a value here
|
||||
(mapc
|
||||
(lambda (f)
|
||||
(setq a (assoc f game))
|
||||
(setf (nth 2 a) (delete v (nth 2 a))))
|
||||
(cons (cons i j) (org-sudoku-rel-fields i j)))))
|
||||
game)
|
||||
game))
|
||||
|
||||
(defun org-sudoku-find-next-constrained-field (game)
|
||||
(setq game (mapcar (lambda (e) (if (nth 2 e) e nil)) game))
|
||||
(setq game (delq nil game))
|
||||
(let (va vb la lb)
|
||||
(setq game
|
||||
(sort game (lambda (a b)
|
||||
(setq va (nth 1 a) vb (nth 1 b)
|
||||
la (length (nth 2 a)) lb (length (nth 2 b)))
|
||||
(cond
|
||||
((and (= va 0) (> vb 0)) t)
|
||||
((and (> va 0) (= vb 0)) nil)
|
||||
((not (= (* va vb) 0)) nil)
|
||||
(t (< la lb))))))
|
||||
(if (or (not game) (> 0 (nth 1 (car game))))
|
||||
nil
|
||||
(caar game))))
|
||||
|
||||
(defun org-sudoku-solve-game (game &optional random stop-at)
|
||||
"Solve GAME.
|
||||
If RANDOM is non-nit, select candidates randomly from a fields option.
|
||||
If RANDOM is nil, always start with the first allowed value and try
|
||||
solving from there.
|
||||
STOP-AT can be a float time, the solver will abort at that time because
|
||||
it is probably stuck."
|
||||
(let (e v v1 allowed next g)
|
||||
(when (and stop-at
|
||||
(> (float-time) stop-at))
|
||||
(setq game nil)
|
||||
(throw 'abort nil))
|
||||
(while (setq next (org-sudoku-find-next-constrained-field game))
|
||||
(setq e (assoc next game)
|
||||
v (nth 1 e)
|
||||
allowed (nth 2 e))
|
||||
(catch 'solved
|
||||
(if (= (length allowed) 1)
|
||||
(setq game (org-sudoku-set-field game next (car allowed)))
|
||||
(while allowed
|
||||
(setq g (org-sudoku-deep-copy game))
|
||||
(if (not random)
|
||||
(setq v1 (car allowed))
|
||||
(setq v1 (nth (random (length allowed)) allowed)))
|
||||
(setq g (org-sudoku-set-field g next v1))
|
||||
(setq g (org-sudoku-solve-game g random stop-at))
|
||||
(when g
|
||||
(setq game g)
|
||||
(throw 'solved g)))
|
||||
(setq game nil))))
|
||||
(if (or (not game)
|
||||
(org-sudoku-unknown-field-p game))
|
||||
nil
|
||||
game)))
|
||||
|
||||
(defun org-sudoku-unknown-field-p (game)
|
||||
"Are there still unknown fields in the game?"
|
||||
(delq nil (mapcar (lambda (e) (if (> (nth 1 e) 0) nil t)) game)))
|
||||
|
||||
(defun org-sudoku-deep-copy (game)
|
||||
"Make a copy of the game so that manipulating the copy does not change the parent."
|
||||
(mapcar (lambda(e)
|
||||
(list (car e) (nth 1 e) (copy-sequence (nth 2 e))))
|
||||
game))
|
||||
|
||||
(defun org-sudoku-set-field (game field value)
|
||||
"Put VALUE into FIELD, and tell related fields that they cannot be VALUE."
|
||||
(let (i j)
|
||||
(setq i (car field) j (cdr field))
|
||||
(setq a (assoc field game))
|
||||
(setf (nth 1 a) value)
|
||||
(setf (nth 2 a) nil)
|
||||
|
||||
;; Remove value from all related fields
|
||||
(mapc
|
||||
(lambda (f)
|
||||
(setq a (assoc f game))
|
||||
(setf (nth 2 a) (delete value (nth 2 a))))
|
||||
(org-sudoku-rel-fields i j))
|
||||
game))
|
||||
|
||||
(defun org-sudoku-rel-fields (i j)
|
||||
"Compute the list of related fields for field (i j)."
|
||||
(let ((sqrtsize (floor (sqrt org-sudoku-size)))
|
||||
ll imin imax jmin jmax f)
|
||||
(setq f (cons i j))
|
||||
(loop for ii from 1 to org-sudoku-size do
|
||||
(or (= ii i) (push (cons ii j) ll)))
|
||||
(loop for jj from 1 to org-sudoku-size do
|
||||
(or (= jj j) (push (cons i jj) ll)))
|
||||
(setq imin (1+ (* sqrtsize (/ (1- i) sqrtsize)))
|
||||
imax (+ imin sqrtsize -1))
|
||||
(setq jmin (1+ (* sqrtsize (/ (1- j) sqrtsize)))
|
||||
jmax (+ jmin sqrtsize -1))
|
||||
(loop for ii from imin to imax do
|
||||
(loop for jj from jmin to jmax do
|
||||
(setq ff (cons ii jj))
|
||||
(or (equal ff f)
|
||||
(member ff ll)
|
||||
(push ff ll))))
|
||||
ll))
|
||||
|
||||
;;; org-sudoku ends here
|
||||
508
lisp/org-contrib/org-toc.el
Normal file
508
lisp/org-contrib/org-toc.el
Normal file
@@ -0,0 +1,508 @@
|
||||
;;; org-toc.el --- Table of contents for Org-mode buffer
|
||||
|
||||
;; Copyright 2007-2021 Free Software Foundation, Inc.
|
||||
;;
|
||||
;; Author: Bastien Guerry <bzg@gnu.org>
|
||||
;; Keywords: org, toc
|
||||
;; Homepage: https://git.sr.ht/~bzg/org-contrib
|
||||
;; Version: 0.8
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 3, 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This library implements a browsable table of contents for Org files.
|
||||
|
||||
;; Put this file into your load-path and the following into your ~/.emacs:
|
||||
;; (require 'org-toc)
|
||||
|
||||
;;; Code:
|
||||
|
||||
(provide 'org-toc)
|
||||
(eval-when-compile
|
||||
(require 'cl))
|
||||
|
||||
;;; Custom variables:
|
||||
(defvar org-toc-base-buffer nil)
|
||||
(defvar org-toc-columns-shown nil)
|
||||
(defvar org-toc-odd-levels-only nil)
|
||||
(defvar org-toc-config-alist nil)
|
||||
(defvar org-toc-cycle-global-status nil)
|
||||
(defalias 'org-show-table-of-contents 'org-toc-show)
|
||||
|
||||
(defgroup org-toc nil
|
||||
"Options concerning the browsable table of contents of Org-mode."
|
||||
:tag "Org TOC"
|
||||
:group 'org)
|
||||
|
||||
(defcustom org-toc-default-depth 1
|
||||
"Default depth when invoking `org-toc-show' without argument."
|
||||
:group 'org-toc
|
||||
:type '(choice
|
||||
(const :tag "same as base buffer" nil)
|
||||
(integer :tag "level")))
|
||||
|
||||
(defcustom org-toc-follow-mode nil
|
||||
"Non-nil means navigating through the table of contents will
|
||||
move the point in the Org buffer accordingly."
|
||||
:group 'org-toc
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom org-toc-info-mode nil
|
||||
"Non-nil means navigating through the table of contents will
|
||||
show the properties for the current headline in the echo-area."
|
||||
:group 'org-toc
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom org-toc-show-subtree-mode nil
|
||||
"Non-nil means show subtree when going to headline or following
|
||||
it while browsing the table of contents."
|
||||
:group 'org-toc
|
||||
:type '(choice
|
||||
(const :tag "show subtree" t)
|
||||
(const :tag "show entry" nil)))
|
||||
|
||||
(defcustom org-toc-recenter-mode t
|
||||
"Non-nil means recenter the Org buffer when following the
|
||||
headlines in the TOC buffer."
|
||||
:group 'org-toc
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom org-toc-recenter 0
|
||||
"Where to recenter the Org buffer when unfolding a subtree.
|
||||
This variable is only used when `org-toc-recenter-mode' is set to
|
||||
'custom. A value >=1000 will call recenter with no arg."
|
||||
:group 'org-toc
|
||||
:type 'integer)
|
||||
|
||||
(defcustom org-toc-info-exclude '("ALLTAGS")
|
||||
"A list of excluded properties when displaying info in the
|
||||
echo-area. The COLUMNS property is always excluded."
|
||||
:group 'org-toc
|
||||
:type 'lits)
|
||||
|
||||
;;; Org TOC mode:
|
||||
(defvar org-toc-mode-map (make-sparse-keymap)
|
||||
"Keymap for `org-toc-mode'.")
|
||||
|
||||
(defun org-toc-mode ()
|
||||
"A major mode for browsing the table of contents of an Org buffer.
|
||||
|
||||
\\{org-toc-mode-map}"
|
||||
(interactive)
|
||||
(kill-all-local-variables)
|
||||
(use-local-map org-toc-mode-map)
|
||||
(setq mode-name "Org TOC")
|
||||
(setq major-mode 'org-toc-mode))
|
||||
|
||||
;; toggle modes
|
||||
(define-key org-toc-mode-map "F" 'org-toc-follow-mode)
|
||||
(define-key org-toc-mode-map "S" 'org-toc-show-subtree-mode)
|
||||
(define-key org-toc-mode-map "s" 'org-toc-store-config)
|
||||
(define-key org-toc-mode-map "g" 'org-toc-restore-config)
|
||||
(define-key org-toc-mode-map "i" 'org-toc-info-mode)
|
||||
(define-key org-toc-mode-map "r" 'org-toc-recenter-mode)
|
||||
|
||||
;; navigation keys
|
||||
(define-key org-toc-mode-map "p" 'org-toc-previous)
|
||||
(define-key org-toc-mode-map "n" 'org-toc-next)
|
||||
(define-key org-toc-mode-map "f" 'org-toc-forward)
|
||||
(define-key org-toc-mode-map "b" 'org-toc-back)
|
||||
(define-key org-toc-mode-map [(left)] 'org-toc-back)
|
||||
(define-key org-toc-mode-map [(right)] 'org-toc-forward)
|
||||
(define-key org-toc-mode-map [(up)] 'org-toc-previous)
|
||||
(define-key org-toc-mode-map [(down)] 'org-toc-next)
|
||||
(define-key org-toc-mode-map "1" (lambda() (interactive) (org-toc-show 1 (point))))
|
||||
(define-key org-toc-mode-map "2" (lambda() (interactive) (org-toc-show 2 (point))))
|
||||
(define-key org-toc-mode-map "3" (lambda() (interactive) (org-toc-show 3 (point))))
|
||||
(define-key org-toc-mode-map "4" (lambda() (interactive) (org-toc-show 4 (point))))
|
||||
(define-key org-toc-mode-map " " 'org-toc-goto)
|
||||
(define-key org-toc-mode-map "q" 'org-toc-quit)
|
||||
(define-key org-toc-mode-map "x" 'org-toc-quit)
|
||||
;; go to the location and stay in the base buffer
|
||||
(define-key org-toc-mode-map [(tab)] 'org-toc-jump)
|
||||
(define-key org-toc-mode-map "v" 'org-toc-jump)
|
||||
;; go to the location and delete other windows
|
||||
(define-key org-toc-mode-map [(return)]
|
||||
(lambda() (interactive) (org-toc-jump t)))
|
||||
|
||||
;; special keys
|
||||
(define-key org-toc-mode-map "c" 'org-toc-columns)
|
||||
(define-key org-toc-mode-map "?" 'org-toc-help)
|
||||
(define-key org-toc-mode-map ":" 'org-toc-cycle-subtree)
|
||||
(define-key org-toc-mode-map "\C-c\C-o" 'org-open-at-point)
|
||||
;; global cycling in the base buffer
|
||||
(define-key org-toc-mode-map (kbd "C-S-<iso-lefttab>")
|
||||
'org-toc-cycle-base-buffer)
|
||||
;; subtree cycling in the base buffer
|
||||
(define-key org-toc-mode-map [(control tab)]
|
||||
(lambda() (interactive) (org-toc-goto nil t)))
|
||||
|
||||
;;; Toggle functions:
|
||||
(defun org-toc-follow-mode ()
|
||||
"Toggle follow mode in a `org-toc-mode' buffer."
|
||||
(interactive)
|
||||
(setq org-toc-follow-mode (not org-toc-follow-mode))
|
||||
(message "Follow mode is %s"
|
||||
(if org-toc-follow-mode "on" "off")))
|
||||
|
||||
(defun org-toc-info-mode ()
|
||||
"Toggle info mode in a `org-toc-mode' buffer."
|
||||
(interactive)
|
||||
(setq org-toc-info-mode (not org-toc-info-mode))
|
||||
(message "Info mode is %s"
|
||||
(if org-toc-info-mode "on" "off")))
|
||||
|
||||
(defun org-toc-show-subtree-mode ()
|
||||
"Toggle show subtree mode in a `org-toc-mode' buffer."
|
||||
(interactive)
|
||||
(setq org-toc-show-subtree-mode (not org-toc-show-subtree-mode))
|
||||
(message "Show subtree mode is %s"
|
||||
(if org-toc-show-subtree-mode "on" "off")))
|
||||
|
||||
(defun org-toc-recenter-mode (&optional line)
|
||||
"Toggle recenter mode in a `org-toc-mode' buffer. If LINE is
|
||||
specified, then make `org-toc-recenter' use this value."
|
||||
(interactive "P")
|
||||
(setq org-toc-recenter-mode (not org-toc-recenter-mode))
|
||||
(when (numberp line)
|
||||
(setq org-toc-recenter-mode t)
|
||||
(setq org-toc-recenter line))
|
||||
(message "Recenter mode is %s"
|
||||
(if org-toc-recenter-mode
|
||||
(format "on, line %d" org-toc-recenter) "off")))
|
||||
|
||||
(defun org-toc-cycle-subtree ()
|
||||
"Locally cycle a headline through two states: 'children and
|
||||
'folded"
|
||||
(interactive)
|
||||
(let ((beg (point))
|
||||
(end (save-excursion (end-of-line) (point)))
|
||||
(ov (car (overlays-at (point))))
|
||||
status)
|
||||
(if ov (setq status (overlay-get ov 'status))
|
||||
(setq ov (make-overlay beg end)))
|
||||
;; change the folding status of this headline
|
||||
(cond ((or (null status) (eq status 'folded))
|
||||
(org-show-children)
|
||||
(message "CHILDREN")
|
||||
(overlay-put ov 'status 'children))
|
||||
((eq status 'children)
|
||||
(show-branches)
|
||||
(message "BRANCHES")
|
||||
(overlay-put ov 'status 'branches))
|
||||
(t (hide-subtree)
|
||||
(message "FOLDED")
|
||||
(overlay-put ov 'status 'folded)))))
|
||||
|
||||
;;; Main show function:
|
||||
;; FIXME name this org-before-first-heading-p?
|
||||
(defun org-toc-before-first-heading-p ()
|
||||
"Before first heading?"
|
||||
(save-excursion
|
||||
(null (re-search-backward org-outline-regexp-bol nil t))))
|
||||
|
||||
;;;###autoload
|
||||
(defun org-toc-show (&optional depth position)
|
||||
"Show the table of contents of the current Org-mode buffer."
|
||||
(interactive "P")
|
||||
(if (eq major-mode 'org-mode)
|
||||
(progn (setq org-toc-base-buffer (current-buffer))
|
||||
(setq org-toc-odd-levels-only org-odd-levels-only))
|
||||
(if (eq major-mode 'org-toc-mode)
|
||||
(org-pop-to-buffer-same-window org-toc-base-buffer)
|
||||
(error "Not in an Org buffer")))
|
||||
;; create the new window display
|
||||
(let ((pos (or position
|
||||
(save-excursion
|
||||
(if (org-toc-before-first-heading-p)
|
||||
(progn (re-search-forward org-outline-regexp-bol nil t)
|
||||
(match-beginning 0))
|
||||
(point))))))
|
||||
(setq org-toc-cycle-global-status org-cycle-global-status)
|
||||
(delete-other-windows)
|
||||
(and (get-buffer "*org-toc*") (kill-buffer "*org-toc*"))
|
||||
(switch-to-buffer-other-window
|
||||
(make-indirect-buffer org-toc-base-buffer "*org-toc*"))
|
||||
;; make content before 1st headline invisible
|
||||
(goto-char (point-min))
|
||||
(let* ((beg (point-min))
|
||||
(end (and (re-search-forward "^\\*" nil t)
|
||||
(1- (match-beginning 0))))
|
||||
(ov (make-overlay beg end))
|
||||
(help (format "Table of contents for %s (press ? for a quick help):\n"
|
||||
(buffer-name org-toc-base-buffer))))
|
||||
(overlay-put ov 'invisible t)
|
||||
(overlay-put ov 'before-string help))
|
||||
;; build the browsable TOC
|
||||
(cond (depth
|
||||
(let* ((dpth (if org-toc-odd-levels-only
|
||||
(1- (* depth 2)) depth)))
|
||||
(org-content dpth)
|
||||
(setq org-toc-cycle-global-status
|
||||
`(org-content ,dpth))))
|
||||
((null org-toc-default-depth)
|
||||
(if (eq org-toc-cycle-global-status 'overview)
|
||||
(progn (org-overview)
|
||||
(setq org-cycle-global-status 'overview)
|
||||
(run-hook-with-args 'org-cycle-hook 'overview))
|
||||
(progn (org-overview)
|
||||
;; FIXME org-content to show only headlines?
|
||||
(org-content)
|
||||
(setq org-cycle-global-status 'contents)
|
||||
(run-hook-with-args 'org-cycle-hook 'contents))))
|
||||
(t (let* ((dpth0 org-toc-default-depth)
|
||||
(dpth (if org-toc-odd-levels-only
|
||||
(1- (* dpth0 2)) dpth0)))
|
||||
(org-content dpth)
|
||||
(setq org-toc-cycle-global-status
|
||||
`(org-content ,dpth)))))
|
||||
(goto-char pos))
|
||||
(move-beginning-of-line nil)
|
||||
(org-toc-mode)
|
||||
(shrink-window-if-larger-than-buffer)
|
||||
(setq buffer-read-only t))
|
||||
|
||||
;;; Navigation functions:
|
||||
(defun org-toc-goto (&optional jump cycle)
|
||||
"From Org TOC buffer, follow the targeted subtree in the Org window.
|
||||
If JUMP is non-nil, go to the base buffer.
|
||||
If JUMP is 'delete, go to the base buffer and delete other windows.
|
||||
If CYCLE is non-nil, cycle the targeted subtree in the Org window."
|
||||
(interactive)
|
||||
(let ((pos (point))
|
||||
(toc-buf (current-buffer)))
|
||||
(switch-to-buffer-other-window org-toc-base-buffer)
|
||||
(goto-char pos)
|
||||
(if cycle (org-cycle)
|
||||
(progn (org-overview)
|
||||
(if org-toc-show-subtree-mode
|
||||
(org-show-subtree)
|
||||
(org-show-entry))
|
||||
(org-show-context)))
|
||||
(if org-toc-recenter-mode
|
||||
(if (>= org-toc-recenter 1000) (recenter)
|
||||
(recenter org-toc-recenter)))
|
||||
(cond ((null jump)
|
||||
(switch-to-buffer-other-window toc-buf))
|
||||
((eq jump 'delete)
|
||||
(delete-other-windows)))))
|
||||
|
||||
(defun org-toc-cycle-base-buffer ()
|
||||
"Call `org-cycle' with a prefix argument in the base buffer."
|
||||
(interactive)
|
||||
(switch-to-buffer-other-window org-toc-base-buffer)
|
||||
(org-cycle t)
|
||||
(other-window 1))
|
||||
|
||||
(defun org-toc-jump (&optional delete)
|
||||
"From Org TOC buffer, jump to the targeted subtree in the Org window.
|
||||
If DELETE is non-nil, delete other windows when in the Org buffer."
|
||||
(interactive "P")
|
||||
(if delete (org-toc-goto 'delete)
|
||||
(org-toc-goto t)))
|
||||
|
||||
(defun org-toc-previous ()
|
||||
"Go to the previous headline of the TOC."
|
||||
(interactive)
|
||||
(if (save-excursion
|
||||
(beginning-of-line)
|
||||
(re-search-backward "^\\*" nil t))
|
||||
(outline-previous-visible-heading 1)
|
||||
(message "No previous heading"))
|
||||
(if org-toc-info-mode (org-toc-info))
|
||||
(if org-toc-follow-mode (org-toc-goto)))
|
||||
|
||||
(defun org-toc-next ()
|
||||
"Go to the next headline of the TOC."
|
||||
(interactive)
|
||||
(outline-next-visible-heading 1)
|
||||
(if org-toc-info-mode (org-toc-info))
|
||||
(if org-toc-follow-mode (org-toc-goto)))
|
||||
|
||||
(defun org-toc-forward ()
|
||||
"Go to the next headline at the same level in the TOC."
|
||||
(interactive)
|
||||
(condition-case nil
|
||||
(outline-forward-same-level 1)
|
||||
(error (message "No next headline at this level")))
|
||||
(if org-toc-info-mode (org-toc-info))
|
||||
(if org-toc-follow-mode (org-toc-goto)))
|
||||
|
||||
(defun org-toc-back ()
|
||||
"Go to the previous headline at the same level in the TOC."
|
||||
(interactive)
|
||||
(condition-case nil
|
||||
(outline-backward-same-level 1)
|
||||
(error (message "No previous headline at this level")))
|
||||
(if org-toc-info-mode (org-toc-info))
|
||||
(if org-toc-follow-mode (org-toc-goto)))
|
||||
|
||||
(defun org-toc-quit ()
|
||||
"Quit the current Org TOC buffer."
|
||||
(interactive)
|
||||
(kill-buffer)
|
||||
(other-window 1)
|
||||
(delete-other-windows))
|
||||
|
||||
;;; Special functions:
|
||||
(defun org-toc-columns ()
|
||||
"Toggle columns view in the Org buffer from Org TOC."
|
||||
(interactive)
|
||||
(let ((indirect-buffer (current-buffer)))
|
||||
(org-pop-to-buffer-same-window org-toc-base-buffer)
|
||||
(if (not org-toc-columns-shown)
|
||||
(progn (org-columns)
|
||||
(setq org-toc-columns-shown t))
|
||||
(progn (org-columns-remove-overlays)
|
||||
(setq org-toc-columns-shown nil)))
|
||||
(org-pop-to-buffer-same-window indirect-buffer)))
|
||||
|
||||
(defun org-toc-info ()
|
||||
"Show properties of current subtree in the echo-area."
|
||||
(interactive)
|
||||
(let ((pos (point))
|
||||
(indirect-buffer (current-buffer))
|
||||
props prop msg)
|
||||
(org-pop-to-buffer-same-window org-toc-base-buffer)
|
||||
(goto-char pos)
|
||||
(setq props (org-entry-properties))
|
||||
(while (setq prop (pop props))
|
||||
(unless (or (equal (car prop) "COLUMNS")
|
||||
(member (car prop) org-toc-info-exclude))
|
||||
(let ((p (car prop))
|
||||
(v (cdr prop)))
|
||||
(if (equal p "TAGS")
|
||||
(setq v (mapconcat 'identity (split-string v ":" t) " ")))
|
||||
(setq p (concat p ":"))
|
||||
(add-text-properties 0 (length p) '(face org-special-keyword) p)
|
||||
(setq msg (concat msg p " " v " ")))))
|
||||
(org-pop-to-buffer-same-window indirect-buffer)
|
||||
(message msg)))
|
||||
|
||||
;;; Store and restore TOC configuration:
|
||||
(defun org-toc-store-config ()
|
||||
"Store the current status of the tables of contents in
|
||||
`org-toc-config-alist'."
|
||||
(interactive)
|
||||
(let ((file (buffer-file-name org-toc-base-buffer))
|
||||
(pos (point))
|
||||
(hlcfg (org-toc-get-headlines-status)))
|
||||
(setq org-toc-config-alist
|
||||
(delete (assoc file org-toc-config-alist)
|
||||
org-toc-config-alist))
|
||||
(add-to-list 'org-toc-config-alist
|
||||
`(,file ,pos ,org-toc-cycle-global-status ,hlcfg))
|
||||
(message "TOC configuration saved: (%s)"
|
||||
(if (listp org-toc-cycle-global-status)
|
||||
(concat "org-content "
|
||||
(number-to-string
|
||||
(cadr org-toc-cycle-global-status)))
|
||||
(symbol-name org-toc-cycle-global-status)))))
|
||||
|
||||
(defun org-toc-restore-config ()
|
||||
"Get the stored status in `org-toc-config-alist' and set the
|
||||
current table of contents to it."
|
||||
(interactive)
|
||||
(let* ((file (buffer-file-name org-toc-base-buffer))
|
||||
(conf (cdr (assoc file org-toc-config-alist)))
|
||||
(pos (car conf))
|
||||
(status (cadr conf))
|
||||
(hlcfg (caddr conf)) hlcfg0 ov)
|
||||
(cond ((listp status)
|
||||
(org-toc-show (cadr status) (point)))
|
||||
((eq status 'overview)
|
||||
(org-overview)
|
||||
(setq org-cycle-global-status 'overview)
|
||||
(run-hook-with-args 'org-cycle-hook 'overview))
|
||||
(t
|
||||
(org-overview)
|
||||
(org-content)
|
||||
(setq org-cycle-global-status 'contents)
|
||||
(run-hook-with-args 'org-cycle-hook 'contents)))
|
||||
(while (setq hlcfg0 (pop hlcfg))
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(when (search-forward (car hlcfg0) nil t)
|
||||
(unless (overlays-at (match-beginning 0))
|
||||
(setq ov (make-overlay (match-beginning 0)
|
||||
(match-end 0))))
|
||||
(cond ((eq (cdr hlcfg0) 'children)
|
||||
(org-show-children)
|
||||
(message "CHILDREN")
|
||||
(overlay-put ov 'status 'children))
|
||||
((eq (cdr hlcfg0) 'branches)
|
||||
(show-branches)
|
||||
(message "BRANCHES")
|
||||
(overlay-put ov 'status 'branches))))))
|
||||
(goto-char pos)
|
||||
(if org-toc-follow-mode (org-toc-goto))
|
||||
(message "Last TOC configuration restored")
|
||||
(sit-for 1)
|
||||
(if org-toc-info-mode (org-toc-info))))
|
||||
|
||||
(defun org-toc-get-headlines-status ()
|
||||
"Return an alist of headlines and their associated folding
|
||||
status."
|
||||
(let (output ovs)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (and (not (eobp))
|
||||
(goto-char (next-overlay-change (point))))
|
||||
(when (looking-at org-outline-regexp-bol)
|
||||
(add-to-list
|
||||
'output
|
||||
(cons (buffer-substring-no-properties
|
||||
(match-beginning 0)
|
||||
(save-excursion
|
||||
(end-of-line) (point)))
|
||||
(overlay-get
|
||||
(car (overlays-at (point))) 'status))))))
|
||||
;; return an alist like (("* Headline" . 'status))
|
||||
output))
|
||||
|
||||
;; In Org TOC buffer, hide headlines below the first level.
|
||||
(defun org-toc-help ()
|
||||
"Display a quick help message in the echo-area for `org-toc-mode'."
|
||||
(interactive)
|
||||
(let ((st-start 0)
|
||||
(help-message
|
||||
"\[space\] show heading \[1-4\] hide headlines below this level
|
||||
\[TAB\] jump to heading \[F\] toggle follow mode (currently %s)
|
||||
\[return\] jump and delete others windows \[i\] toggle info mode (currently %s)
|
||||
\[S-TAB\] cycle subtree (in Org) \[S\] toggle show subtree mode (currently %s)
|
||||
\[C-S-TAB\] global cycle (in Org) \[r\] toggle recenter mode (currently %s)
|
||||
\[:\] cycle subtree (in TOC) \[c\] toggle column view (currently %s)
|
||||
\[n/p\] next/previous heading \[s\] save TOC configuration
|
||||
\[f/b\] next/previous heading of same level
|
||||
\[q\] quit the TOC \[g\] restore last TOC configuration"))
|
||||
(while (string-match "\\[[^]]+\\]" help-message st-start)
|
||||
(add-text-properties (match-beginning 0)
|
||||
(match-end 0) '(face bold) help-message)
|
||||
(setq st-start (match-end 0)))
|
||||
(message help-message
|
||||
(if org-toc-follow-mode "on" "off")
|
||||
(if org-toc-info-mode "on" "off")
|
||||
(if org-toc-show-subtree-mode "on" "off")
|
||||
(if org-toc-recenter-mode (format "on, line %s" org-toc-recenter) "off")
|
||||
(if org-toc-columns-shown "on" "off"))))
|
||||
|
||||
|
||||
;;;;##########################################################################
|
||||
;;;; User Options, Variables
|
||||
;;;;##########################################################################
|
||||
|
||||
;;; org-toc.el ends here
|
||||
210
lisp/org-contrib/org-track.el
Normal file
210
lisp/org-contrib/org-track.el
Normal file
@@ -0,0 +1,210 @@
|
||||
;;; org-track.el --- Track the most recent Org-mode version available.
|
||||
;;
|
||||
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
|
||||
;;
|
||||
;; Author: Bastien Guerry <bzg@gnu.org>
|
||||
;; Eric S Fraga <e.fraga at ucl.ac dot uk>
|
||||
;; Sebastian Rose <sebastian_rose at gmx dot de>
|
||||
;; The Worg people https://orgmode.org/worg/
|
||||
;; Keywords: outlines, hypermedia, calendar, wp
|
||||
;; Homepage: https://git.sr.ht/~bzg/org-contrib
|
||||
;; Version: 6.29a
|
||||
;;
|
||||
;; Released under the GNU General Public License version 3
|
||||
;; see: https://www.gnu.org/licenses/gpl-3.0.html
|
||||
;;
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; This program is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
;;
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; WARNING: This library is obsolete, you should use the make targets
|
||||
;; to keep track of Org latest developments.
|
||||
;;
|
||||
;; Download the latest development tarball, unpack and optionally compile it
|
||||
;;
|
||||
;; Usage:
|
||||
;;
|
||||
;; (require 'org-track)
|
||||
;;
|
||||
;; ;; ... somewhere in your setup (use customize):
|
||||
;;
|
||||
;; (setq org-track-directory "~/test/")
|
||||
;; (setq org-track-compile-sources nil)
|
||||
;; (setq org-track-remove-package t)
|
||||
;;
|
||||
;; M-x org-track-update RET
|
||||
|
||||
(require 'url-parse)
|
||||
(require 'url-handlers)
|
||||
(autoload 'url-file-local-copy "url-handlers")
|
||||
(autoload 'url-generic-parse-url "url-parse")
|
||||
|
||||
|
||||
|
||||
;;; Variables:
|
||||
|
||||
(defgroup org-track nil
|
||||
"Track the most recent Org-mode version available.
|
||||
|
||||
To use org-track, adjust `org-track-directory'.
|
||||
Org will download the archived latest git version for you,
|
||||
unpack it into that directory (i.e. a subdirectory
|
||||
`org-mode/' is added), create the autoloads file
|
||||
`org-loaddefs.el' for you and, optionally, compile the
|
||||
sources.
|
||||
All you'll have to do is call `M-x org-track-update' from
|
||||
time to time."
|
||||
:group 'org)
|
||||
|
||||
(defcustom org-track-directory (concat user-emacs-directory "org/lisp")
|
||||
"Directory where your org-mode/ directory lives.
|
||||
If that directory does not exist, it will be created."
|
||||
:type 'directory)
|
||||
|
||||
(defcustom org-track-compile-sources t
|
||||
"If `nil', never compile org-sources.
|
||||
Org will only create the autoloads file `org-loaddefs.el' for
|
||||
you then. If `t', compile the sources, too.
|
||||
Note, that emacs preferes compiled elisp files over
|
||||
non-compiled ones."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom org-track-org-url "https://orgmode.org/"
|
||||
"The URL where the package to download can be found.
|
||||
Please append a slash."
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-track-org-package "org-latest.tar.gz"
|
||||
"The basename of the package you use.
|
||||
Defaults to the development version of Org-mode.
|
||||
This should be a *.tar.gz package, since emacs provides all
|
||||
you need to unpack it."
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-track-remove-package nil
|
||||
"Remove org-latest.tar.gz after updates?"
|
||||
:type 'boolean)
|
||||
|
||||
|
||||
|
||||
;;; Frontend
|
||||
|
||||
(defun org-track-update ()
|
||||
"Update to current Org-mode version.
|
||||
Also, generate autoloads and evtl. compile the sources."
|
||||
(interactive)
|
||||
(let* ((base (file-truename org-track-directory))
|
||||
(org-exists (file-exists-p
|
||||
(file-truename
|
||||
(concat base "/org-mode/lisp/org.el"))))
|
||||
(nobase (not (file-directory-p
|
||||
(file-truename org-track-directory)))))
|
||||
(if nobase
|
||||
(when (y-or-n-p
|
||||
(format "Directory %s does not exist. Create it?" base))
|
||||
(make-directory base t)
|
||||
(setq nobase nil)))
|
||||
(if nobase
|
||||
(message "Not creating %s - giving up." org-track-directory)
|
||||
(condition-case err
|
||||
(progn
|
||||
(org-track-fetch-package)
|
||||
(org-track-compile-org))
|
||||
(error (message "%s" (error-message-string err)))))))
|
||||
|
||||
|
||||
|
||||
;;; tar related functions
|
||||
|
||||
;; `url-retrieve-synchronously' fetches files synchronously. How can we ensure
|
||||
;; that? If the maintainers of that package decide, that an assynchronous
|
||||
;; download might be better??? (used by `url-file-local-copy')
|
||||
|
||||
;;;###autoload
|
||||
(defun org-track-fetch-package (&optional directory)
|
||||
"Fetch Org package depending on `org-track-fetch-package-extension'.
|
||||
If DIRECTORY is defined, unpack the package there, i.e. add the
|
||||
subdirectory org-mode/ to DIRECTORY."
|
||||
(interactive "Dorg-track directory: ")
|
||||
(let* ((pack (concat
|
||||
(if (string-match "/$" org-track-org-url)
|
||||
org-track-org-url
|
||||
(concat org-track-org-url "/"))
|
||||
org-track-org-package))
|
||||
(base (file-truename
|
||||
(or directory org-track-directory)))
|
||||
(target (file-truename
|
||||
(concat base "/" org-track-org-package)))
|
||||
url download tarbuff)
|
||||
(message "Fetching to %s - this might take some time..." base)
|
||||
(setq url (url-generic-parse-url pack))
|
||||
(setq download (url-file-local-copy url)) ;; errors if fail
|
||||
(copy-file download target t)
|
||||
(delete-file download)
|
||||
;; (tar-mode) leads to dubious errors. We use the auto-mode-alist to
|
||||
;; ensure tar-mode is used:
|
||||
(add-to-list 'auto-mode-alist '("org-latest\\.tar\\.gz\\'" . tar-mode))
|
||||
(setq tarbuff (find-file target))
|
||||
(with-current-buffer tarbuff ;; with-temp-buffer does not work with tar-mode??
|
||||
(tar-untar-buffer))
|
||||
(kill-buffer tarbuff)
|
||||
(if org-track-remove-package
|
||||
(delete-file target))))
|
||||
|
||||
|
||||
|
||||
;;; Compile Org-mode sources
|
||||
|
||||
|
||||
;;;###autoload
|
||||
(defun org-track-compile-org (&optional directory)
|
||||
"Compile all *.el files that come with org-mode.
|
||||
Generate the autoloads file `org-loaddefs.el'.
|
||||
|
||||
DIRECTORY is where the directory org-mode/ lives (i.e. the
|
||||
parent directory of your local repo."
|
||||
(interactive)
|
||||
;; file-truename expands the filename and removes double slash, if exists:
|
||||
(setq directory (file-truename
|
||||
(concat
|
||||
(or directory
|
||||
(file-truename (concat org-track-directory "/org-mode/lisp")))
|
||||
"/")))
|
||||
(add-to-list 'load-path directory)
|
||||
(let ((list-of-org-files (file-expand-wildcards (concat directory "*.el"))))
|
||||
;; create the org-loaddefs file
|
||||
(require 'autoload)
|
||||
(setq esf/org-install-file (concat directory "org-loaddefs.el"))
|
||||
(find-file esf/org-install-file)
|
||||
(erase-buffer)
|
||||
(mapc (lambda (x)
|
||||
(generate-file-autoloads x))
|
||||
list-of-org-files)
|
||||
(insert "\n(provide (quote org-loaddefs))\n")
|
||||
(save-buffer)
|
||||
(kill-buffer)
|
||||
(byte-compile-file esf/org-install-file t)
|
||||
|
||||
(mapc (lambda (f)
|
||||
(if (file-exists-p (concat f "c"))
|
||||
(delete-file (concat f "c"))))
|
||||
list-of-org-files)
|
||||
(if org-track-compile-sources
|
||||
(mapc (lambda (f) (byte-compile-file f)) list-of-org-files))))
|
||||
|
||||
(provide 'org-track)
|
||||
|
||||
;;; org-track.el ends here
|
||||
823
lisp/org-contrib/org-velocity.el
Normal file
823
lisp/org-contrib/org-velocity.el
Normal file
@@ -0,0 +1,823 @@
|
||||
;;; org-velocity.el --- something like Notational Velocity for Org. -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2010-2014, 2021 Paul M. Rodriguez
|
||||
|
||||
;; Author: Paul M. Rodriguez <paulmrodriguez@gmail.com>
|
||||
;; Maintainer: Paul M. Rodriguez <paulmrodriguez@gmail.com>
|
||||
;; Homepage: https://github.com/ruricolist/org-velocity
|
||||
;; Created: 2010-05-05
|
||||
;; Version: 4.1
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; This program is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; Org-Velocity.el is an interface for Org inspired by the minimalist
|
||||
;; notetaking program Notational Velocity. The idea is to let you
|
||||
;; amass and access brief notes on many subjects with minimal fuss.
|
||||
;; Each note is an entry in an ordinary Org file.
|
||||
|
||||
;; Org-Velocity can be used in two ways: when called outside Org, to
|
||||
;; store and access notes in a designated bucket file; or, when called
|
||||
;; inside Org, as a method for navigating any Org file. (Setting the
|
||||
;; option `org-velocity-always-use-bucket' disables navigation inside
|
||||
;; Org files by default, although you can still force this behavior by
|
||||
;; calling `org-velocity-read' with an argument.)
|
||||
|
||||
;; Org-Velocity prompts for search terms in the minibuffer. A list of
|
||||
;; headings of entries whose text matches your search is updated as
|
||||
;; you type; you can end the search and visit an entry at any time by
|
||||
;; clicking on its heading.
|
||||
|
||||
;; RET displays the results. If there are no matches, Org-Velocity
|
||||
;; offers to create a new entry with your search string as its
|
||||
;; heading. If there are matches, it displays a list of results where
|
||||
;; the heading of each matching entry is hinted with a number or
|
||||
;; letter; clicking a result, or typing the matching hint, opens the
|
||||
;; entry for editing in an indirect buffer. 0 forces a new entry; RET
|
||||
;; reopens the search for editing.
|
||||
|
||||
;; You can customize every step in this process, including the search
|
||||
;; method, completion for search terms, and templates for creating new
|
||||
;; entries; M-x customize-group RET org-velocity RET to see all the
|
||||
;; options.
|
||||
|
||||
;; Thanks to Richard Riley, Carsten Dominik, Bastien Guerry, and Jeff
|
||||
;; Horn for their suggestions.
|
||||
|
||||
;;; Usage:
|
||||
;; (require 'org-velocity)
|
||||
;; (setq org-velocity-bucket (expand-file-name "bucket.org" org-directory))
|
||||
;; (global-set-key (kbd "C-c v") 'org-velocity)
|
||||
|
||||
;;; Code:
|
||||
(require 'org)
|
||||
(require 'button)
|
||||
(require 'electric)
|
||||
(require 'dabbrev)
|
||||
(require 'cl-lib)
|
||||
|
||||
(defgroup org-velocity nil
|
||||
"Notational Velocity-style interface for Org."
|
||||
:tag "Org-Velocity"
|
||||
:group 'outlines
|
||||
:group 'hypermedia
|
||||
:group 'org)
|
||||
|
||||
(defcustom org-velocity-bucket ""
|
||||
"Where is the bucket file?"
|
||||
:group 'org-velocity
|
||||
:type 'file)
|
||||
|
||||
(defcustom org-velocity-show-previews t
|
||||
"Show previews of the text of each heading?"
|
||||
:group 'velocity
|
||||
:type 'boolean
|
||||
:safe 'booleanp)
|
||||
|
||||
(defcustom org-velocity-exit-on-match nil
|
||||
"When searching incrementally, exit on a single match?"
|
||||
:group 'org-velocity
|
||||
:type 'boolean
|
||||
:safe 'booleanp)
|
||||
|
||||
(defcustom org-velocity-force-new nil
|
||||
"Should exiting the minibuffer with C-j force a new entry?"
|
||||
:group 'org-velocity
|
||||
:type 'boolean
|
||||
:safe 'booleanp)
|
||||
|
||||
(defcustom org-velocity-use-search-ring t
|
||||
"Push search to `search-ring' when visiting an entry?
|
||||
|
||||
This means that C-s C-s will take you directly to the first
|
||||
instance of the search string."
|
||||
:group 'org-velocity
|
||||
:type 'boolean
|
||||
:safe 'booleanp)
|
||||
|
||||
(defcustom org-velocity-always-use-bucket nil
|
||||
"Use bucket file even when called from an Org buffer?"
|
||||
:group 'org-velocity
|
||||
:type 'boolean
|
||||
:safe 'booleanp)
|
||||
|
||||
(defcustom org-velocity-use-completion nil
|
||||
"Use completion?
|
||||
|
||||
Notwithstanding the value of this option, calling
|
||||
`dabbrev-expand' always completes against the text of the bucket
|
||||
file."
|
||||
:group 'org-velocity
|
||||
:type '(choice
|
||||
(const :tag "Do not use completion" nil)
|
||||
(const :tag "Use completion" t))
|
||||
:safe 'booleanp)
|
||||
|
||||
(defcustom org-velocity-search-method 'phrase
|
||||
"Match on whole phrase, any word, or all words?"
|
||||
:group 'org-velocity
|
||||
:type '(choice
|
||||
(const :tag "Match whole phrase" phrase)
|
||||
(const :tag "Match any word" any)
|
||||
(const :tag "Match all words" all)
|
||||
(const :tag "Match a regular expression" regexp))
|
||||
:safe (lambda (v) (memq v '(phrase any all regexp))))
|
||||
|
||||
(defcustom org-velocity-capture-templates
|
||||
'(("v"
|
||||
"Velocity entry"
|
||||
entry
|
||||
(file "")
|
||||
"* %:search\n\n%i%?"))
|
||||
"Use these template with `org-capture'.
|
||||
Meanwhile `org-default-notes-file' is bound to `org-velocity-bucket-file'.
|
||||
The keyword :search inserts the current search.
|
||||
See the documentation for `org-capture-templates'."
|
||||
:group 'org-velocity
|
||||
:type (or (get 'org-capture-templates 'custom-type) 'list))
|
||||
|
||||
(defcustom org-velocity-heading-level 1
|
||||
"Only match headings at this level or higher.
|
||||
0 means to match headings at any level."
|
||||
:group 'org-velocity
|
||||
:type 'integer
|
||||
:safe (lambda (x)
|
||||
(and (integerp x)
|
||||
(>= x 0))))
|
||||
|
||||
(defvar crm-separator) ;Ensure dynamic binding.
|
||||
|
||||
(defsubst org-velocity-grab-preview ()
|
||||
"Grab preview of a subtree.
|
||||
The length of the preview is determined by `window-width'.
|
||||
|
||||
Replace all contiguous whitespace with single spaces."
|
||||
(let* ((start (progn
|
||||
(forward-line 1)
|
||||
(if (looking-at org-property-start-re)
|
||||
(re-search-forward org-property-end-re)
|
||||
(1- (point)))))
|
||||
(string+props (buffer-substring
|
||||
start
|
||||
(min
|
||||
(+ start (window-width))
|
||||
(point-max)))))
|
||||
;; We want to preserve the text properties so that, for example,
|
||||
;; we don't end up with the raw text of links in the preview.
|
||||
(with-temp-buffer
|
||||
(insert string+props)
|
||||
(goto-char (point-min))
|
||||
(save-match-data
|
||||
(while (re-search-forward split-string-default-separators
|
||||
(point-max)
|
||||
t)
|
||||
(replace-match " ")))
|
||||
(buffer-string))))
|
||||
|
||||
(cl-defstruct org-velocity-heading buffer position name level preview)
|
||||
|
||||
(defsubst org-velocity-nearest-heading (position)
|
||||
"Return last heading at POSITION.
|
||||
If there is no last heading, return nil."
|
||||
(save-excursion
|
||||
(goto-char position)
|
||||
(re-search-backward (org-velocity-heading-regexp))
|
||||
(let ((components (org-heading-components)))
|
||||
(make-org-velocity-heading
|
||||
:buffer (current-buffer)
|
||||
:position (point)
|
||||
:name (nth 4 components)
|
||||
:level (nth 0 components)
|
||||
:preview (if org-velocity-show-previews
|
||||
(org-velocity-grab-preview))))))
|
||||
|
||||
(defconst org-velocity-index
|
||||
(eval-when-compile
|
||||
(nconc (number-sequence 49 57) ;numbers
|
||||
(number-sequence 97 122) ;lowercase letters
|
||||
(number-sequence 65 90))) ;uppercase letters
|
||||
"List of chars for indexing results.")
|
||||
|
||||
(defconst org-velocity-match-buffer-name "*Velocity matches*")
|
||||
|
||||
(cl-defun org-velocity-heading-regexp (&optional (level org-velocity-heading-level))
|
||||
"Regexp to match headings at LEVEL or deeper."
|
||||
(if (zerop level)
|
||||
"^\\*+ "
|
||||
(format "^\\*\\{1,%d\\} " level)))
|
||||
|
||||
(defvar org-velocity-search nil
|
||||
"Variable to bind to current search.")
|
||||
|
||||
(defun org-velocity-buffer-file-name (&optional buffer)
|
||||
"Return the name of the file BUFFER saves to.
|
||||
Same as function `buffer-file-name' unless BUFFER is an indirect
|
||||
buffer or a minibuffer. In the former case, return the file name
|
||||
of the base buffer; in the latter, return the file name of
|
||||
`minibuffer-selected-window' (or its base buffer)."
|
||||
(let ((buffer (if (minibufferp buffer)
|
||||
(window-buffer (minibuffer-selected-window))
|
||||
buffer)))
|
||||
(buffer-file-name
|
||||
(or (buffer-base-buffer buffer)
|
||||
buffer))))
|
||||
|
||||
(defun org-velocity-minibuffer-contents ()
|
||||
"Return the contents of the minibuffer when it is active."
|
||||
(when (active-minibuffer-window)
|
||||
(with-current-buffer (window-buffer (active-minibuffer-window))
|
||||
(minibuffer-contents))))
|
||||
|
||||
(defun org-velocity-nix-minibuffer ()
|
||||
"Return the contents of the minibuffer and clear it."
|
||||
(when (active-minibuffer-window)
|
||||
(with-current-buffer (window-buffer (active-minibuffer-window))
|
||||
(prog1 (minibuffer-contents)
|
||||
(delete-minibuffer-contents)))))
|
||||
|
||||
(defun org-velocity-bucket-file ()
|
||||
"Return the proper file for Org-Velocity to search.
|
||||
If `org-velocity-always-use-bucket' is t, use bucket file;
|
||||
complain if missing. Otherwise, if an Org file is current, then
|
||||
use it."
|
||||
(let ((org-velocity-bucket
|
||||
(when org-velocity-bucket (expand-file-name org-velocity-bucket)))
|
||||
(buffer
|
||||
(let ((buffer-file (org-velocity-buffer-file-name)))
|
||||
(when buffer-file
|
||||
;; Use the target in capture buffers.
|
||||
(org-find-base-buffer-visiting buffer-file)))))
|
||||
(if org-velocity-always-use-bucket
|
||||
(or org-velocity-bucket (error "Bucket required but not defined"))
|
||||
(if (and (eq (buffer-local-value 'major-mode (or buffer (current-buffer)))
|
||||
'org-mode)
|
||||
(org-velocity-buffer-file-name))
|
||||
(org-velocity-buffer-file-name)
|
||||
(or org-velocity-bucket
|
||||
(error "No bucket and not an Org file"))))))
|
||||
|
||||
(defvar org-velocity-bucket-buffer nil)
|
||||
(defvar org-velocity-navigating nil)
|
||||
|
||||
(defsubst org-velocity-bucket-buffer ()
|
||||
(or org-velocity-bucket-buffer
|
||||
(find-file-noselect (org-velocity-bucket-file))))
|
||||
|
||||
(defsubst org-velocity-match-buffer ()
|
||||
"Return the proper buffer for Org-Velocity to display in."
|
||||
(get-buffer-create org-velocity-match-buffer-name))
|
||||
|
||||
(defsubst org-velocity-match-window ()
|
||||
(get-buffer-window (org-velocity-match-buffer)))
|
||||
|
||||
(defun org-velocity-beginning-of-headings ()
|
||||
"Goto the start of the first heading."
|
||||
(goto-char (point-min))
|
||||
;; If we are before the first heading we could still be at the
|
||||
;; first heading.
|
||||
(or (looking-at (org-velocity-heading-regexp))
|
||||
(re-search-forward (org-velocity-heading-regexp))))
|
||||
|
||||
(defun org-velocity-make-indirect-buffer (heading)
|
||||
"Make or switch to an indirect buffer visiting HEADING."
|
||||
(let* ((bucket (org-velocity-heading-buffer heading))
|
||||
(name (org-velocity-heading-name heading))
|
||||
(existing (get-buffer name)))
|
||||
(if (and existing (buffer-base-buffer existing)
|
||||
(equal (buffer-base-buffer existing) bucket))
|
||||
existing
|
||||
(make-indirect-buffer
|
||||
bucket
|
||||
(generate-new-buffer-name (org-velocity-heading-name heading))
|
||||
t))))
|
||||
|
||||
(defun org-velocity-capture ()
|
||||
"Record a note with `org-capture'."
|
||||
(let ((org-capture-templates
|
||||
org-velocity-capture-templates))
|
||||
(org-capture nil
|
||||
;; This is no longer automatically selected.
|
||||
(when (null (cdr org-capture-templates))
|
||||
(caar org-capture-templates)))
|
||||
(when org-capture-mode
|
||||
(rename-buffer org-velocity-search t))))
|
||||
|
||||
(defvar org-velocity-saved-winconf nil)
|
||||
(make-variable-buffer-local 'org-velocity-saved-winconf)
|
||||
|
||||
(defun org-velocity-edit-entry (heading)
|
||||
(if org-velocity-navigating
|
||||
(org-velocity-edit-entry/inline heading)
|
||||
(org-velocity-edit-entry/indirect heading)))
|
||||
|
||||
(cl-defun org-velocity-goto-entry (heading &key narrow)
|
||||
(goto-char (org-velocity-heading-position heading))
|
||||
(save-excursion
|
||||
(when narrow
|
||||
(org-narrow-to-subtree))
|
||||
(outline-show-all)))
|
||||
|
||||
(defun org-velocity-edit-entry/inline (heading)
|
||||
"Edit entry at HEADING in the original buffer."
|
||||
(let ((buffer (org-velocity-heading-buffer heading)))
|
||||
(pop-to-buffer buffer)
|
||||
(with-current-buffer buffer
|
||||
(org-velocity-goto-entry heading))))
|
||||
|
||||
(defun org-velocity-format-header-line (control-string &rest args)
|
||||
(set (make-local-variable 'header-line-format)
|
||||
(apply #'format control-string args)))
|
||||
|
||||
(defun org-velocity-edit-entry/indirect (heading)
|
||||
"Edit entry at HEADING in an indirect buffer."
|
||||
(let ((winconf (current-window-configuration))
|
||||
(dd default-directory)
|
||||
(buffer (org-velocity-make-indirect-buffer heading))
|
||||
(inhibit-point-motion-hooks t)
|
||||
(inhibit-field-text-motion t))
|
||||
(with-current-buffer buffer
|
||||
(setq default-directory dd) ;Inherit default directory.
|
||||
(setq org-velocity-saved-winconf winconf)
|
||||
(org-velocity-goto-entry heading :narrow t)
|
||||
(goto-char (point-max))
|
||||
(add-hook 'org-ctrl-c-ctrl-c-hook 'org-velocity-dismiss nil t))
|
||||
(pop-to-buffer buffer)
|
||||
(org-velocity-format-header-line
|
||||
"%s Use C-c C-c to finish."
|
||||
(abbreviate-file-name
|
||||
(buffer-file-name
|
||||
(org-velocity-heading-buffer heading))))))
|
||||
|
||||
(defun org-velocity-dismiss ()
|
||||
"Save current entry and close indirect buffer."
|
||||
(let ((winconf org-velocity-saved-winconf))
|
||||
(prog1 t ;Tell hook we're done.
|
||||
(save-buffer)
|
||||
(kill-buffer)
|
||||
(when (window-configuration-p winconf)
|
||||
(set-window-configuration winconf)))))
|
||||
|
||||
(defun org-velocity-visit-button (button)
|
||||
(run-hooks 'mouse-leave-buffer-hook)
|
||||
(when org-velocity-use-search-ring
|
||||
(add-to-history 'search-ring
|
||||
(button-get button 'search)
|
||||
search-ring-max))
|
||||
(let ((match (button-get button 'match)))
|
||||
(throw 'org-velocity-done match)))
|
||||
|
||||
(define-button-type 'org-velocity-button
|
||||
'action #'org-velocity-visit-button
|
||||
'follow-link 'mouse-face)
|
||||
|
||||
(defsubst org-velocity-buttonize (heading)
|
||||
"Insert HEADING as a text button with no hints."
|
||||
(insert-text-button
|
||||
(propertize (org-velocity-heading-name heading) 'face 'link)
|
||||
:type 'org-velocity-button
|
||||
'match heading
|
||||
'search org-velocity-search))
|
||||
|
||||
(defsubst org-velocity-insert-preview (heading)
|
||||
(when org-velocity-show-previews
|
||||
(insert-char ?\ 1)
|
||||
(insert
|
||||
(propertize
|
||||
(org-velocity-heading-preview heading)
|
||||
'face 'shadow))))
|
||||
|
||||
(defvar org-velocity-recursive-headings nil)
|
||||
(defvar org-velocity-recursive-search nil)
|
||||
|
||||
(cl-defun org-velocity-search-with (fun style search
|
||||
&key (headings org-velocity-recursive-headings))
|
||||
(if headings
|
||||
(save-restriction
|
||||
(dolist (heading headings)
|
||||
(widen)
|
||||
(let ((start (org-velocity-heading-position heading)))
|
||||
(goto-char start)
|
||||
(let ((end (save-excursion
|
||||
(org-end-of-subtree)
|
||||
(point))))
|
||||
(narrow-to-region start end)
|
||||
(org-velocity-search-with fun style search
|
||||
:headings nil)))))
|
||||
(cl-ecase style
|
||||
((phrase any regexp)
|
||||
(cl-block nil
|
||||
(while (re-search-forward search nil t)
|
||||
(let ((match (org-velocity-nearest-heading (point))))
|
||||
(funcall fun match))
|
||||
;; Skip to the next heading.
|
||||
(unless (re-search-forward (org-velocity-heading-regexp) nil t)
|
||||
(cl-return)))))
|
||||
((all)
|
||||
(let ((keywords
|
||||
(cl-loop for word in (split-string search)
|
||||
collect (concat "\\<" (regexp-quote word) "\\>"))))
|
||||
(org-map-entries
|
||||
(lambda ()
|
||||
;; Only search the subtree once.
|
||||
(setq org-map-continue-from
|
||||
(save-excursion
|
||||
(org-end-of-subtree)
|
||||
(point)))
|
||||
(when (cl-loop for word in keywords
|
||||
always (save-excursion
|
||||
(re-search-forward word org-map-continue-from t)))
|
||||
(let ((match (org-velocity-nearest-heading (match-end 0))))
|
||||
(funcall fun match))))))))))
|
||||
|
||||
(defun org-velocity-all-results (style search)
|
||||
(with-current-buffer (org-velocity-bucket-buffer)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(let (matches)
|
||||
(org-velocity-search-with (lambda (match)
|
||||
(push match matches))
|
||||
style
|
||||
search)
|
||||
(nreverse matches)))))
|
||||
|
||||
(defsubst org-velocity-present-match (hint match)
|
||||
(with-current-buffer (org-velocity-match-buffer)
|
||||
(when hint (insert "#" hint " "))
|
||||
(org-velocity-buttonize match)
|
||||
(org-velocity-insert-preview match)
|
||||
(newline)))
|
||||
|
||||
(defun org-velocity-present-search (style search hide-hints)
|
||||
(let ((hints org-velocity-index) matches)
|
||||
(cl-block nil
|
||||
(org-velocity-search-with (lambda (match)
|
||||
(unless hints
|
||||
(cl-return))
|
||||
(let ((hint (if hide-hints
|
||||
nil
|
||||
(car hints))))
|
||||
(org-velocity-present-match hint match))
|
||||
(pop hints)
|
||||
(push match matches))
|
||||
style
|
||||
search))
|
||||
(nreverse matches)))
|
||||
|
||||
(defun org-velocity-restrict-search ()
|
||||
(interactive)
|
||||
(let ((search (org-velocity-nix-minibuffer)))
|
||||
(when (equal search "")
|
||||
(error "No search to restrict to"))
|
||||
(push search org-velocity-recursive-search)
|
||||
(setq org-velocity-recursive-headings
|
||||
(org-velocity-all-results
|
||||
org-velocity-search-method
|
||||
search))
|
||||
;; TODO We could extend the current search instead of starting
|
||||
;; over.
|
||||
(org-velocity-update-match-header)
|
||||
(minibuffer-message "Restricting search to %s" search)))
|
||||
|
||||
(cl-defun org-velocity-update-match-header (&key (match-buffer (org-velocity-match-buffer))
|
||||
(bucket-buffer (org-velocity-bucket-buffer))
|
||||
(search-method org-velocity-search-method))
|
||||
(let ((navigating? org-velocity-navigating)
|
||||
(recursive? org-velocity-recursive-search))
|
||||
(with-current-buffer match-buffer
|
||||
(org-velocity-format-header-line
|
||||
"%s search in %s%s (%s mode)"
|
||||
(capitalize (symbol-name search-method))
|
||||
(abbreviate-file-name (buffer-file-name bucket-buffer))
|
||||
(if (not recursive?)
|
||||
""
|
||||
(let ((sep " > "))
|
||||
(concat sep (string-join (reverse recursive?) sep))))
|
||||
(if navigating? "nav" "notes")))))
|
||||
|
||||
(cl-defun org-velocity-present (search &key hide-hints)
|
||||
"Buttonize matches for SEARCH in `org-velocity-match-buffer'.
|
||||
If HIDE-HINTS is non-nil, display entries without indices. SEARCH
|
||||
binds `org-velocity-search'.
|
||||
|
||||
Return matches."
|
||||
(let ((match-buffer (org-velocity-match-buffer))
|
||||
(bucket-buffer (org-velocity-bucket-buffer))
|
||||
(search-method org-velocity-search-method))
|
||||
(if (and (stringp search) (not (string= "" search)))
|
||||
;; Fold case when the search string is all lowercase.
|
||||
(let ((case-fold-search (equal search (downcase search)))
|
||||
(truncate-partial-width-windows t))
|
||||
(with-current-buffer match-buffer
|
||||
(erase-buffer)
|
||||
;; Permanent locals.
|
||||
(setq cursor-type nil
|
||||
truncate-lines t)
|
||||
(org-velocity-update-match-header
|
||||
:match-buffer match-buffer
|
||||
:bucket-buffer bucket-buffer
|
||||
:search-method search-method))
|
||||
(prog1
|
||||
(with-current-buffer bucket-buffer
|
||||
(widen)
|
||||
(let* ((inhibit-point-motion-hooks t)
|
||||
(inhibit-field-text-motion t)
|
||||
(anchored? (string-match-p "^\\s-" search))
|
||||
(search
|
||||
(cl-ecase search-method
|
||||
(all search)
|
||||
(phrase
|
||||
(if anchored?
|
||||
(regexp-quote search)
|
||||
;; Anchor the search to the start of a word.
|
||||
(concat "\\<" (regexp-quote search))))
|
||||
(any
|
||||
(concat "\\<" (regexp-opt (split-string search))))
|
||||
(regexp search))))
|
||||
(save-excursion
|
||||
(org-velocity-beginning-of-headings)
|
||||
(condition-case lossage
|
||||
(org-velocity-present-search search-method search hide-hints)
|
||||
(invalid-regexp
|
||||
(minibuffer-message "%s" lossage))))))
|
||||
(with-current-buffer match-buffer
|
||||
(goto-char (point-min)))))
|
||||
(with-current-buffer match-buffer
|
||||
(erase-buffer)))))
|
||||
|
||||
(defun org-velocity-store-link ()
|
||||
"Function for `org-store-link-functions'."
|
||||
(if org-velocity-search
|
||||
(org-store-link-props
|
||||
:search org-velocity-search)))
|
||||
|
||||
(add-hook 'org-store-link-functions 'org-velocity-store-link)
|
||||
|
||||
(cl-defun org-velocity-create (search &key ask)
|
||||
"Create new heading named SEARCH.
|
||||
If ASK is non-nil, ask first."
|
||||
(when (or (null ask) (y-or-n-p "No match found, create? "))
|
||||
(let ((org-velocity-search search)
|
||||
(org-default-notes-file (org-velocity-bucket-file))
|
||||
;; save a stored link
|
||||
org-store-link-plist)
|
||||
(org-velocity-capture))
|
||||
search))
|
||||
|
||||
(defun org-velocity-engine (search)
|
||||
"Display a list of headings where SEARCH occurs."
|
||||
(let ((org-velocity-search search))
|
||||
(unless (or
|
||||
(not (stringp search))
|
||||
(string= "" search)) ;exit on empty string
|
||||
(cl-case
|
||||
(if (and org-velocity-force-new (eq last-command-event ?\C-j))
|
||||
:force
|
||||
(let* ((org-velocity-index (org-velocity-adjust-index))
|
||||
(matches (org-velocity-present search)))
|
||||
(cond ((null matches) :new)
|
||||
((null (cdr matches)) :follow)
|
||||
(t :prompt))))
|
||||
(:prompt (progn
|
||||
(pop-to-buffer (org-velocity-match-buffer))
|
||||
(let ((hint (org-velocity-electric-read-hint)))
|
||||
(when hint (cl-case hint
|
||||
(:edit (org-velocity-read nil search))
|
||||
(:force (org-velocity-create search))
|
||||
(otherwise (org-velocity-activate-button hint)))))))
|
||||
(:new (unless (org-velocity-create search :ask t)
|
||||
(org-velocity-read nil search)))
|
||||
(:force (org-velocity-create search))
|
||||
(:follow (if (y-or-n-p "One match, follow? ")
|
||||
(progn
|
||||
(set-buffer (org-velocity-match-buffer))
|
||||
(goto-char (point-min))
|
||||
(button-activate (next-button (point))))
|
||||
(org-velocity-read nil search)))))))
|
||||
|
||||
(defun org-velocity-activate-button (char)
|
||||
"Go to button on line number associated with CHAR in `org-velocity-index'."
|
||||
(goto-char (point-min))
|
||||
(forward-line (cl-position char org-velocity-index))
|
||||
(goto-char
|
||||
(button-start
|
||||
(next-button (point))))
|
||||
(message "%s" (button-label (button-at (point))))
|
||||
(button-activate (button-at (point))))
|
||||
|
||||
(defun org-velocity-electric-undefined ()
|
||||
"Complain about an undefined key."
|
||||
(interactive)
|
||||
(message "%s"
|
||||
(substitute-command-keys
|
||||
"\\[org-velocity-electric-new] for new entry,
|
||||
\\[org-velocity-electric-edit] to edit search,
|
||||
\\[scroll-up] to scroll up,
|
||||
\\[scroll-down] to scroll down,
|
||||
\\[keyboard-quit] to quit."))
|
||||
(sit-for 4))
|
||||
|
||||
(defun org-velocity-electric-follow (ev)
|
||||
"Follow a hint indexed by keyboard event EV."
|
||||
(interactive (list last-command-event))
|
||||
(if (not (> (cl-position ev org-velocity-index)
|
||||
(1- (count-lines (point-min) (point-max)))))
|
||||
(throw 'org-velocity-select ev)
|
||||
(call-interactively 'org-velocity-electric-undefined)))
|
||||
|
||||
(defun org-velocity-electric-edit ()
|
||||
"Edit the search string."
|
||||
(interactive)
|
||||
(throw 'org-velocity-select :edit))
|
||||
|
||||
(defun org-velocity-electric-new ()
|
||||
"Force a new entry."
|
||||
(interactive)
|
||||
(throw 'org-velocity-select :force))
|
||||
|
||||
(defvar org-velocity-electric-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map [t] 'org-velocity-electric-undefined)
|
||||
(dolist (c org-velocity-index)
|
||||
(define-key map (char-to-string c)
|
||||
'org-velocity-electric-follow))
|
||||
(define-key map "0" 'org-velocity-electric-new)
|
||||
(define-key map "\C-v" 'scroll-up)
|
||||
(define-key map "\M-v" 'scroll-down)
|
||||
(define-key map (kbd "RET") 'org-velocity-electric-edit)
|
||||
(define-key map [mouse-1] nil)
|
||||
(define-key map [mouse-2] nil)
|
||||
(define-key map [escape] 'keyboard-quit)
|
||||
(define-key map "\C-h" 'help-command)
|
||||
map))
|
||||
|
||||
(defun org-velocity-electric-read-hint ()
|
||||
"Read index of button electrically."
|
||||
(with-current-buffer (org-velocity-match-buffer)
|
||||
(when (featurep 'evil)
|
||||
;; NB Idempotent.
|
||||
(evil-make-overriding-map org-velocity-electric-map))
|
||||
(use-local-map org-velocity-electric-map)
|
||||
(catch 'org-velocity-select
|
||||
(Electric-command-loop 'org-velocity-select "Follow: "))))
|
||||
|
||||
(defvar org-velocity-incremental-keymap
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map "\C-v" 'scroll-up)
|
||||
(define-key map "\M-v" 'scroll-down)
|
||||
map))
|
||||
|
||||
(defun org-velocity-displaying-completions-p ()
|
||||
"Is there a *Completions* buffer showing?"
|
||||
(get-window-with-predicate
|
||||
(lambda (w)
|
||||
(eq (buffer-local-value 'major-mode (window-buffer w))
|
||||
'completion-list-mode))))
|
||||
|
||||
(defun org-velocity-update ()
|
||||
"Display results of search without hinting."
|
||||
(unless (org-velocity-displaying-completions-p)
|
||||
(let* ((search (org-velocity-minibuffer-contents))
|
||||
(matches (org-velocity-present search :hide-hints t)))
|
||||
(cond ((null matches)
|
||||
(select-window (active-minibuffer-window))
|
||||
(unless (or (null search) (= (length search) 0))
|
||||
(minibuffer-message "No match; RET to create")))
|
||||
((and (null (cdr matches))
|
||||
org-velocity-exit-on-match)
|
||||
(throw 'click search))
|
||||
(t
|
||||
(with-current-buffer (org-velocity-match-buffer)
|
||||
(use-local-map org-velocity-incremental-keymap)))))))
|
||||
|
||||
(defvar dabbrev--last-abbreviation)
|
||||
|
||||
(defun org-velocity-dabbrev-completion-list (abbrev)
|
||||
"Return all dabbrev completions for ABBREV."
|
||||
;; This is based on `dabbrev-completion'.
|
||||
(dabbrev--reset-global-variables)
|
||||
(setq dabbrev--last-abbreviation abbrev)
|
||||
(dabbrev--find-all-expansions abbrev case-fold-search))
|
||||
|
||||
(defvar org-velocity-local-completion-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map minibuffer-local-completion-map)
|
||||
(define-key map " " 'self-insert-command)
|
||||
(define-key map "?" 'self-insert-command)
|
||||
(define-key map [remap minibuffer-complete] 'minibuffer-complete-word)
|
||||
(define-key map [(control ?@)] 'org-velocity-restrict-search)
|
||||
(define-key map [(control ?\s)] 'org-velocity-restrict-search)
|
||||
map)
|
||||
"Keymap for completion with `completing-read'.")
|
||||
|
||||
(defun org-velocity-read-with-completion (prompt)
|
||||
"Completing read with PROMPT."
|
||||
(let ((minibuffer-local-completion-map
|
||||
org-velocity-local-completion-map)
|
||||
(completion-no-auto-exit t)
|
||||
(crm-separator " "))
|
||||
(completing-read prompt
|
||||
(completion-table-dynamic
|
||||
'org-velocity-dabbrev-completion-list))))
|
||||
|
||||
(cl-defun org-velocity-adjust-index
|
||||
(&optional (match-window (org-velocity-match-window)))
|
||||
"Truncate or extend `org-velocity-index' to the lines in
|
||||
MATCH-WINDOW."
|
||||
(with-selected-window match-window
|
||||
(let ((lines (window-height))
|
||||
(hints (length org-velocity-index)))
|
||||
(cond ((= lines hints)
|
||||
org-velocity-index)
|
||||
;; Truncate the index to the size of
|
||||
;; the buffer to be displayed.
|
||||
((< lines hints)
|
||||
(cl-subseq org-velocity-index 0 lines))
|
||||
;; If the window is so tall we run out of indices, at
|
||||
;; least make the additional results clickable.
|
||||
((> lines hints)
|
||||
(append org-velocity-index
|
||||
(make-list (- lines hints) nil)))))))
|
||||
|
||||
(defun org-velocity-incremental-read (prompt)
|
||||
"Read string with PROMPT and display results incrementally.
|
||||
Stop searching once there are more matches than can be
|
||||
displayed."
|
||||
(let ((res
|
||||
(unwind-protect
|
||||
(let* ((match-window (display-buffer (org-velocity-match-buffer)))
|
||||
(org-velocity-index (org-velocity-adjust-index match-window)))
|
||||
(catch 'click
|
||||
(add-hook 'post-command-hook 'org-velocity-update)
|
||||
(cond ((eq org-velocity-search-method 'regexp)
|
||||
(read-regexp prompt))
|
||||
(org-velocity-use-completion
|
||||
(org-velocity-read-with-completion prompt))
|
||||
(t (read-string prompt)))))
|
||||
(remove-hook 'post-command-hook 'org-velocity-update))))
|
||||
(if (bufferp res) (org-pop-to-buffer-same-window res) res)))
|
||||
|
||||
(defun org-velocity (arg &optional search)
|
||||
"Read a search string SEARCH for Org-Velocity interface.
|
||||
This means that a buffer will display all headings where SEARCH
|
||||
occurs, where one can be selected by a mouse click or by typing
|
||||
its index. If SEARCH does not occur, then a new heading may be
|
||||
created named SEARCH.
|
||||
|
||||
If `org-velocity-bucket' is defined and
|
||||
`org-velocity-always-use-bucket' is non-nil, then the bucket file
|
||||
will be used; otherwise, this will work when called in any Org
|
||||
file.
|
||||
|
||||
Calling with ARG reverses which file – the current file or the
|
||||
bucket file – to use. If the bucket file would have been used,
|
||||
then the current file is used instead, and vice versa."
|
||||
(interactive "P")
|
||||
(let ((org-velocity-always-use-bucket
|
||||
(if org-velocity-always-use-bucket
|
||||
(not arg)
|
||||
arg)))
|
||||
;; complain if inappropriate
|
||||
(cl-assert (org-velocity-bucket-file))
|
||||
(let* ((starting-buffer (current-buffer))
|
||||
(org-velocity-bucket-buffer
|
||||
(find-file-noselect (org-velocity-bucket-file)))
|
||||
(org-velocity-navigating
|
||||
(eq starting-buffer org-velocity-bucket-buffer))
|
||||
(org-velocity-recursive-headings '())
|
||||
(org-velocity-recursive-search '())
|
||||
(org-velocity-heading-level
|
||||
(if org-velocity-navigating
|
||||
0
|
||||
org-velocity-heading-level))
|
||||
(dabbrev-search-these-buffers-only
|
||||
(list org-velocity-bucket-buffer)))
|
||||
(unwind-protect
|
||||
(let ((match
|
||||
(catch 'org-velocity-done
|
||||
(org-velocity-engine
|
||||
(or search
|
||||
(org-velocity-incremental-read "Velocity search: ")))
|
||||
nil)))
|
||||
(when (org-velocity-heading-p match)
|
||||
(org-velocity-edit-entry match)))
|
||||
(kill-buffer (org-velocity-match-buffer))))))
|
||||
|
||||
(defalias 'org-velocity-read 'org-velocity)
|
||||
|
||||
(provide 'org-velocity)
|
||||
|
||||
;;; org-velocity.el ends here
|
||||
326
lisp/org-contrib/org-wikinodes.el
Normal file
326
lisp/org-contrib/org-wikinodes.el
Normal file
@@ -0,0 +1,326 @@
|
||||
;;; org-wikinodes.el --- Wiki-like CamelCase links to outline nodes
|
||||
|
||||
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
|
||||
;; Keywords: outlines, hypermedia, calendar, wp
|
||||
;; Homepage: https://orgmode.org
|
||||
;; Version: 7.01trans
|
||||
;;
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; This program is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
(require 'org)
|
||||
(eval-when-compile
|
||||
(require 'cl))
|
||||
|
||||
(defgroup org-wikinodes nil
|
||||
"Wiki-like CamelCase links words to outline nodes in Org mode."
|
||||
:tag "Org WikiNodes"
|
||||
:group 'org)
|
||||
|
||||
(defconst org-wikinodes-camel-regexp "\\<[A-Z]+[a-z]+[A-Z]+[a-z]+[a-zA-Z]*\\>"
|
||||
"Regular expression matching CamelCase words.")
|
||||
|
||||
(defcustom org-wikinodes-active t
|
||||
"Should CamelCase links be active in the current file?"
|
||||
:group 'org-wikinodes
|
||||
:type 'boolean)
|
||||
(put 'org-wikinodes-active 'safe-local-variable 'booleanp)
|
||||
|
||||
(defcustom org-wikinodes-scope 'file
|
||||
"The scope of searches for wiki targets.
|
||||
Allowed values are:
|
||||
|
||||
file Search for targets in the current file only
|
||||
directory Search for targets in all org files in the current directory"
|
||||
:group 'org-wikinodes
|
||||
:type '(choice
|
||||
(const :tag "Find targets in current file" file)
|
||||
(const :tag "Find targets in current directory" directory)))
|
||||
|
||||
(defcustom org-wikinodes-create-targets 'query
|
||||
"Non-nil means create Wiki target when following a wiki link fails.
|
||||
Allowed values are:
|
||||
|
||||
nil never create node, just throw an error if the target does not exist
|
||||
query ask the user what to do
|
||||
t create the node in the current buffer
|
||||
\"file.org\" create the node in the file \"file.org\", in the same directory
|
||||
|
||||
If you are using wiki links across files, you need to set `org-wikinodes-scope'
|
||||
to `directory'."
|
||||
:group 'org-wikinodes
|
||||
:type '(choice
|
||||
(const :tag "Never automatically create node" nil)
|
||||
(const :tag "In current file" t)
|
||||
(file :tag "In one special file\n")
|
||||
(const :tag "Query the user" query)))
|
||||
|
||||
;;; Link activation
|
||||
|
||||
(defun org-wikinodes-activate-links (limit)
|
||||
"Activate CamelCase words as links to Wiki targets."
|
||||
(when org-wikinodes-active
|
||||
(let (case-fold-search)
|
||||
(if (re-search-forward org-wikinodes-camel-regexp limit t)
|
||||
(if (equal (char-after (point-at-bol)) ?*)
|
||||
(progn
|
||||
;; in heading - deactivate flyspell
|
||||
(org-remove-flyspell-overlays-in (match-beginning 0)
|
||||
(match-end 0))
|
||||
t)
|
||||
;; this is a wiki link
|
||||
(org-remove-flyspell-overlays-in (match-beginning 0)
|
||||
(match-end 0))
|
||||
(add-text-properties (match-beginning 0) (match-end 0)
|
||||
(list 'mouse-face 'highlight
|
||||
'face 'org-link
|
||||
'keymap org-mouse-map
|
||||
'help-echo "Wiki Link"))
|
||||
t)))))
|
||||
|
||||
;;; Following links and creating non-existing target nodes
|
||||
|
||||
(defun org-wikinodes-open-at-point ()
|
||||
"Check if the cursor is on a Wiki link and follow the link.
|
||||
|
||||
This function goes into `org-open-at-point-functions'."
|
||||
(and org-wikinodes-active
|
||||
(not (org-at-heading-p))
|
||||
(let (case-fold-search) (org-in-regexp org-wikinodes-camel-regexp))
|
||||
(progn (org-wikinodes-follow-link (match-string 0)) t)))
|
||||
|
||||
(defun org-wikinodes-follow-link (target)
|
||||
"Follow a wiki link to TARGET.
|
||||
|
||||
This need to be found as an exact headline match, either in the current
|
||||
buffer, or in any .org file in the current directory, depending on the
|
||||
variable `org-wikinodes-scope'.
|
||||
|
||||
If a target headline is not found, it may be created according to the
|
||||
setting of `org-wikinodes-create-targets'."
|
||||
(if current-prefix-arg (org-wikinodes-clear-directory-targets-cache))
|
||||
(let ((create org-wikinodes-create-targets)
|
||||
visiting buffer m pos file rpl)
|
||||
(setq pos
|
||||
(or (org-find-exact-headline-in-buffer target (current-buffer))
|
||||
(and (eq org-wikinodes-scope 'directory)
|
||||
(setq file (org-wikinodes-which-file
|
||||
target (file-name-directory (buffer-file-name))))
|
||||
(org-find-exact-headline-in-buffer
|
||||
target (or (get-file-buffer file)
|
||||
(find-file-noselect file))))))
|
||||
(if pos
|
||||
(progn
|
||||
(org-mark-ring-push (point))
|
||||
(org-goto-marker-or-bmk pos)
|
||||
(move-marker pos nil))
|
||||
(when (eq create 'query)
|
||||
(if (eq org-wikinodes-scope 'directory)
|
||||
(progn
|
||||
(message "Node \"%s\" does not exist. Should it be created?
|
||||
\[RET] in this buffer [TAB] in another file [q]uit" target)
|
||||
(setq rpl (read-char-exclusive))
|
||||
(cond
|
||||
((member rpl '(?\C-g ?q)) (error "Abort"))
|
||||
((equal rpl ?\C-m) (setq create t))
|
||||
((equal rpl ?\C-i)
|
||||
(setq create (file-name-nondirectory
|
||||
(read-file-name "Create in file: "))))
|
||||
(t (error "Invalid selection"))))
|
||||
(if (y-or-n-p (format "Create new node \"%s\" in current buffer? "
|
||||
target))
|
||||
(setq create t)
|
||||
(error "Abort"))))
|
||||
|
||||
(cond
|
||||
((not create)
|
||||
;; We are not allowed to create the new node
|
||||
(error "No match for link to \"%s\"" target))
|
||||
((stringp create)
|
||||
;; Make new node in another file
|
||||
(org-mark-ring-push (point))
|
||||
(org-pop-to-buffer-same-window (find-file-noselect create))
|
||||
(goto-char (point-max))
|
||||
(or (bolp) (newline))
|
||||
(insert "\n* " target "\n")
|
||||
(backward-char 1)
|
||||
(org-wikinodes-add-target-to-cache target)
|
||||
(message "New Wiki target `%s' created in file \"%s\""
|
||||
target create))
|
||||
(t
|
||||
;; Make new node in current buffer
|
||||
(org-mark-ring-push (point))
|
||||
(goto-char (point-max))
|
||||
(or (bolp) (newline))
|
||||
(insert "* " target "\n")
|
||||
(backward-char 1)
|
||||
(org-wikinodes-add-target-to-cache target)
|
||||
(message "New Wiki target `%s' created in current buffer"
|
||||
target))))))
|
||||
|
||||
;;; The target cache
|
||||
|
||||
(defvar org-wikinodes-directory-targets-cache nil)
|
||||
|
||||
(defun org-wikinodes-clear-cache-when-on-target ()
|
||||
"When on a headline that is a Wiki target, clear the cache."
|
||||
(when (and (org-at-heading-p)
|
||||
(org-in-regexp (format org-complex-heading-regexp-format
|
||||
org-wikinodes-camel-regexp))
|
||||
(org-in-regexp org-wikinodes-camel-regexp))
|
||||
(org-wikinodes-clear-directory-targets-cache)
|
||||
t))
|
||||
|
||||
(defun org-wikinodes-clear-directory-targets-cache ()
|
||||
"Clear the cache where to find wiki targets."
|
||||
(interactive)
|
||||
(setq org-wikinodes-directory-targets-cache nil)
|
||||
(message "Wiki target cache cleared, so that it will update when used again"))
|
||||
|
||||
(defun org-wikinodes-get-targets ()
|
||||
"Return a list of all wiki targets in the current buffer."
|
||||
(let ((re (format org-complex-heading-regexp-format
|
||||
org-wikinodes-camel-regexp))
|
||||
(case-fold-search nil)
|
||||
targets)
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(widen)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward re nil t)
|
||||
(push (match-string-no-properties 4) targets))))
|
||||
(nreverse targets)))
|
||||
|
||||
(defun org-wikinodes-get-links-for-directory (dir)
|
||||
"Return an alist that connects wiki links to files in directory DIR."
|
||||
(let ((files (directory-files dir nil "\\`[^.#].*\\.org\\'"))
|
||||
(org-inhibit-startup t)
|
||||
target-file-alist file visiting m buffer)
|
||||
(while (setq file (pop files))
|
||||
(setq visiting (org-find-base-buffer-visiting file))
|
||||
(setq buffer (or visiting (find-file-noselect file)))
|
||||
(with-current-buffer buffer
|
||||
(mapc
|
||||
(lambda (target)
|
||||
(setq target-file-alist (cons (cons target file) target-file-alist)))
|
||||
(org-wikinodes-get-targets)))
|
||||
(or visiting (kill-buffer buffer)))
|
||||
target-file-alist))
|
||||
|
||||
(defun org-wikinodes-add-target-to-cache (target &optional file)
|
||||
(setq file (or file buffer-file-name (error "No file for new wiki target")))
|
||||
(set-text-properties 0 (length target) nil target)
|
||||
(let ((dir (file-name-directory (expand-file-name file)))
|
||||
a)
|
||||
(setq a (assoc dir org-wikinodes-directory-targets-cache))
|
||||
(if a
|
||||
;; Push the new target onto the existing list
|
||||
(push (cons target (expand-file-name file)) (cdr a))
|
||||
;; Call org-wikinodes-which-file so that the cache will be filled
|
||||
(org-wikinodes-which-file target dir))))
|
||||
|
||||
(defun org-wikinodes-which-file (target &optional directory)
|
||||
"Return the file for wiki headline TARGET DIRECTORY.
|
||||
If there is no such wiki target, return nil."
|
||||
(let* ((directory (expand-file-name (or directory default-directory)))
|
||||
(founddir (assoc directory org-wikinodes-directory-targets-cache))
|
||||
(foundfile (cdr (assoc target (cdr founddir)))))
|
||||
(or foundfile
|
||||
(and (push (cons directory (org-wikinodes-get-links-for-directory directory))
|
||||
org-wikinodes-directory-targets-cache)
|
||||
(cdr (assoc target (cdr (assoc directory
|
||||
org-wikinodes-directory-targets-cache))))))))
|
||||
|
||||
;;; Exporting Wiki links
|
||||
|
||||
(defvar target)
|
||||
(defvar target-alist)
|
||||
(defvar last-section-target)
|
||||
(defvar org-export-target-aliases)
|
||||
(defun org-wikinodes-set-wiki-targets-during-export (_)
|
||||
(let ((line (buffer-substring (point-at-bol) (point-at-eol)))
|
||||
(case-fold-search nil)
|
||||
wtarget a)
|
||||
(when (string-match (format org-complex-heading-regexp-format
|
||||
org-wikinodes-camel-regexp)
|
||||
line)
|
||||
(setq wtarget (match-string 4 line))
|
||||
(push (cons wtarget target) target-alist)
|
||||
(setq a (or (assoc last-section-target org-export-target-aliases)
|
||||
(progn
|
||||
(push (list last-section-target)
|
||||
org-export-target-aliases)
|
||||
(car org-export-target-aliases))))
|
||||
(push (caar target-alist) (cdr a)))))
|
||||
|
||||
(defun org-wikinodes-process-links-for-export (_)
|
||||
"Process Wiki links in the export preprocess buffer.
|
||||
Try to find target matches in the wiki scope and replace CamelCase words
|
||||
with working links."
|
||||
(let ((re org-wikinodes-camel-regexp)
|
||||
(case-fold-search nil)
|
||||
link file)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward re nil t)
|
||||
(unless (save-match-data
|
||||
(or (org-at-heading-p)
|
||||
(org-in-regexp org-bracket-link-regexp)
|
||||
(org-in-regexp org-plain-link-re)
|
||||
(org-in-regexp "<<[^<>]+>>")))
|
||||
(setq link (match-string 0))
|
||||
(delete-region (match-beginning 0) (match-end 0))
|
||||
(save-match-data
|
||||
(cond
|
||||
((org-find-exact-headline-in-buffer link (current-buffer))
|
||||
;; Found in current buffer
|
||||
(insert (format "[[*%s][%s]]" link link)))
|
||||
((eq org-wikinodes-scope 'file)
|
||||
;; No match in file, and other files are not allowed
|
||||
(insert (format "%s" link)))
|
||||
(t ;; No match for this link
|
||||
(insert (format "%s" link)))))))))
|
||||
|
||||
;;; Hook the WikiNode mechanism into Org
|
||||
|
||||
;; `C-c C-o' should follow wiki links
|
||||
(add-hook 'org-open-at-point-functions 'org-wikinodes-open-at-point)
|
||||
|
||||
;; `C-c C-c' should clear the cache
|
||||
(add-hook 'org-ctrl-c-ctrl-c-hook 'org-wikinodes-clear-cache-when-on-target)
|
||||
|
||||
;; Make Wiki haeding create additional link names for headlines
|
||||
(add-hook 'org-export-before-parsing-hook
|
||||
'org-wikinodes-set-wiki-targets-during-export)
|
||||
|
||||
;; Turn Wiki links into links the exporter will treat correctly
|
||||
(add-hook 'org-export-before-parsing-hook
|
||||
'org-wikinodes-process-links-for-export)
|
||||
|
||||
;; Activate CamelCase words as part of Org mode font lock
|
||||
|
||||
(defun org-wikinodes-add-to-font-lock-keywords ()
|
||||
"Add wikinode CamelCase highlighting to `org-font-lock-extra-keywords'."
|
||||
(let ((m (member '(org-activate-links) org-font-lock-extra-keywords)))
|
||||
(if m (push '(org-wikinodes-activate-links) (cdr m))
|
||||
(message "Failed to add wikinodes to `org-font-lock-extra-keywords'."))))
|
||||
|
||||
(add-hook 'org-font-lock-set-keywords-hook
|
||||
'org-wikinodes-add-to-font-lock-keywords)
|
||||
|
||||
(provide 'org-wikinodes)
|
||||
|
||||
;;; org-wikinodes.el ends here
|
||||
118
lisp/org-contrib/orgtbl-sqlinsert.el
Normal file
118
lisp/org-contrib/orgtbl-sqlinsert.el
Normal file
@@ -0,0 +1,118 @@
|
||||
;;; orgtbl-sqlinsert.el --- orgtbl to SQL insert statements.
|
||||
|
||||
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Jason Riedy <jason@acm.org>
|
||||
;; Keywords: org, tables, sql
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Converts an orgtbl to a sequence of SQL insertion commands.
|
||||
;; Table cells are quoted and escaped very conservatively.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defun orgtbl-to-sqlinsert (table params)
|
||||
"Convert the orgtbl-mode TABLE to SQL insert statements.
|
||||
TABLE is a list, each entry either the symbol `hline' for a horizontal
|
||||
separator line, or a list of fields for that line.
|
||||
PARAMS is a property list of parameters that can influence the conversion.
|
||||
|
||||
Names and strings are modified slightly by default. Single-ticks
|
||||
are doubled as per SQL's standard mechanism. Backslashes and
|
||||
dollar signs are deleted. And tildes are changed to spaces.
|
||||
These modifications were chosen for use with TeX. See
|
||||
ORGTBL-SQL-STRIP-AND-QUOTE.
|
||||
|
||||
Supports all parameters from ORGTBL-TO-GENERIC. New to this function
|
||||
are:
|
||||
|
||||
:sqlname The name of the database table; defaults to the name of the
|
||||
target region.
|
||||
|
||||
:nowebname If not nil, used as a wrapping noweb fragment name.
|
||||
|
||||
The most important parameters of ORGTBL-TO-GENERIC for SQL are:
|
||||
|
||||
:splice When set to t, return only insert statements, don't wrap
|
||||
them in a transaction. Default is nil.
|
||||
|
||||
:tstart, :tend
|
||||
The strings used to begin and commit the transaction.
|
||||
|
||||
:hfmt A function that gathers the quoted header names into a
|
||||
dynamically scoped variable HDRLIST. Probably should
|
||||
not be changed by the user.
|
||||
|
||||
The general parameters :skip and :skipcols have already been applied when
|
||||
this function is called."
|
||||
(let* (hdrlist
|
||||
(alignment (mapconcat (lambda (x) (if x "r" "l"))
|
||||
org-table-last-alignment ""))
|
||||
(nowebname (plist-get params :nowebname))
|
||||
(breakvals (plist-get params :breakvals))
|
||||
(firstheader t)
|
||||
(*orgtbl-default-fmt* 'orgtbl-sql-strip-and-quote)
|
||||
(params2
|
||||
(list
|
||||
:sqlname (plist-get params :sqlname)
|
||||
:tstart (lambda () (concat (if nowebname
|
||||
(format "<<%s>>= \n" nowebname)
|
||||
"")
|
||||
"BEGIN TRANSACTION;"))
|
||||
:tend (lambda () (concat "COMMIT;" (if nowebname "\n@ " "")))
|
||||
:hfmt (lambda (f) (progn (if firstheader (push f hdrlist) "")))
|
||||
:hlfmt (lambda (&rest cells) (setq firstheader nil))
|
||||
:lstart (lambda () (concat "INSERT INTO "
|
||||
sqlname "( "
|
||||
(mapconcat 'identity (reverse hdrlist)
|
||||
", ")
|
||||
" )" (if breakvals "\n" " ")
|
||||
"VALUES ( "))
|
||||
:lend " );"
|
||||
:sep " , "
|
||||
:hline nil
|
||||
:remove-nil-lines t))
|
||||
(params (org-combine-plists params2 params))
|
||||
(sqlname (plist-get params :sqlname)))
|
||||
(orgtbl-to-generic table params)))
|
||||
|
||||
(defun orgtbl-sql-quote (str)
|
||||
"Convert single ticks to doubled single ticks and wrap in single ticks."
|
||||
(concat "'" (mapconcat 'identity (split-string str "'") "''") "'"))
|
||||
|
||||
(defun orgtbl-sql-strip-dollars-escapes-tildes (str)
|
||||
"Strip dollarsigns and backslash escapes, replace tildes with spaces."
|
||||
(mapconcat 'identity
|
||||
(split-string (mapconcat 'identity
|
||||
(split-string str "\\$\\|\\\\")
|
||||
"")
|
||||
"~")
|
||||
" "))
|
||||
|
||||
(defun orgtbl-sql-strip-and-quote (str)
|
||||
"Apply ORGBTL-SQL-QUOTE and ORGTBL-SQL-STRIP-DOLLARS-ESCAPES-TILDES
|
||||
to sanitize STR for use in SQL statements."
|
||||
(cond ((stringp str)
|
||||
(orgtbl-sql-quote (orgtbl-sql-strip-dollars-escapes-tildes str)))
|
||||
((sequencep str) (mapcar 'orgtbl-sql-strip-and-quote str))
|
||||
(t nil)))
|
||||
|
||||
(provide 'orgtbl-sqlinsert)
|
||||
|
||||
;;; orgtbl-sqlinsert.el ends here
|
||||
430
lisp/org-contrib/ox-bibtex.el
Normal file
430
lisp/org-contrib/ox-bibtex.el
Normal file
@@ -0,0 +1,430 @@
|
||||
;;; ox-bibtex.el --- Export bibtex fragments
|
||||
|
||||
;; Copyright (C) 2009-2014, 2021 Taru Karttunen
|
||||
|
||||
;; Author: Taru Karttunen <taruti@taruti.net>
|
||||
;; Nicolas Goaziou <n dot goaziou at gmail dot com>
|
||||
;; This file is not currently part of GNU Emacs.
|
||||
|
||||
;; This program is free software; you can redistribute it and/or
|
||||
;; modify it under the terms of the GNU General Public License as
|
||||
;; published by the Free Software Foundation; either version 3, 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 ; see the file COPYING. If not, write to
|
||||
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||||
;; Boston, MA 02111-1307, USA.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; This is an utility to handle BibTeX export to LaTeX, html and ascii
|
||||
;; exports. For HTML and ascii it uses the bibtex2html software from:
|
||||
;;
|
||||
;; https://www.lri.fr/~filliatr/bibtex2html/
|
||||
;;
|
||||
;; For ascii it uses the pandoc software from:
|
||||
;;
|
||||
;; https://pandoc.org/
|
||||
;;
|
||||
;; It also introduces "cite" syntax for Org links.
|
||||
;;
|
||||
;; The usage is as follows:
|
||||
;;
|
||||
;; #+BIBLIOGRAPHY: bibfilename stylename optional-options
|
||||
;;
|
||||
;; e.g. given foo.bib and using style plain:
|
||||
;;
|
||||
;; #+BIBLIOGRAPHY: foo plain option:-d
|
||||
;;
|
||||
;; "stylename" can also be "nil", in which case no style will be used.
|
||||
;;
|
||||
;; Full filepaths are also possible:
|
||||
;;
|
||||
;; #+BIBLIOGRAPHY: /home/user/Literature/foo.bib plain option:-d
|
||||
;;
|
||||
;; Optional options are of the form:
|
||||
;;
|
||||
;; option:-foobar pass '-foobar' to bibtex2html
|
||||
;;
|
||||
;; e.g.,
|
||||
;;
|
||||
;; option:-d sort by date
|
||||
;; option:-a sort as BibTeX (usually by author) *default*
|
||||
;; option:-u unsorted i.e. same order as in .bib file
|
||||
;; option:-r reverse the sort
|
||||
;;
|
||||
;; See the bibtex2html man page for more. Multiple options can be
|
||||
;; combined like:
|
||||
;;
|
||||
;; option:-d option:-r
|
||||
;;
|
||||
;; Limiting to only the entries cited in the document:
|
||||
;;
|
||||
;; limit:t
|
||||
;;
|
||||
;; For LaTeX export this simply inserts the lines
|
||||
;;
|
||||
;; \bibliographystyle{plain}
|
||||
;; \bibliography{foo}
|
||||
;;
|
||||
;; into the TeX file when exporting.
|
||||
;;
|
||||
;; For HTML export it:
|
||||
;; 1) converts all \cite{foo} and [[cite:foo]] to links to the
|
||||
;; bibliography,
|
||||
;; 2) creates a foo.html and foo_bib.html,
|
||||
;; 3) includes the contents of foo.html in the exported HTML file.
|
||||
;;
|
||||
;; For ascii export it:
|
||||
;; 1) converts all \cite{foo} and [[cite:foo]] to links to the
|
||||
;; bibliography,
|
||||
;; 2) creates a foo.txt and foo_bib.html,
|
||||
;; 3) includes the contents of foo.txt in the exported ascii file.
|
||||
;;
|
||||
;; For LaTeX export it:
|
||||
;; 1) converts all [[cite:foo]] to \cite{foo}.
|
||||
|
||||
;; Initialization
|
||||
|
||||
(require 'cl-lib)
|
||||
|
||||
;;; Internal Functions
|
||||
|
||||
(defun org-bibtex-get-file (keyword)
|
||||
"Return bibliography file as a string.
|
||||
KEYWORD is a \"BIBLIOGRAPHY\" keyword. If no file is found,
|
||||
return nil instead."
|
||||
(let ((value (org-element-property :value keyword)))
|
||||
(and value
|
||||
(string-match "\\(\\S-+\\)[ \t]+\\(\\S-+\\)\\(.*\\)" value)
|
||||
(match-string 1 value))))
|
||||
|
||||
(defun org-bibtex-get-style (keyword)
|
||||
"Return bibliography style as a string.
|
||||
KEYWORD is a \"BIBLIOGRAPHY\" keyword. If no style is found,
|
||||
return nil instead."
|
||||
(let ((value (org-element-property :value keyword)))
|
||||
(and value
|
||||
(string-match "\\(\\S-+\\)[ \t]+\\(\\S-+\\)\\(.*\\)" value)
|
||||
(match-string 2 value))))
|
||||
|
||||
(defun org-bibtex-get-arguments (keyword)
|
||||
"Return \"bibtex2html\" arguments specified by the user.
|
||||
KEYWORD is a \"BIBLIOGRAPHY\" keyword. Return value is a plist
|
||||
containing `:options' and `:limit' properties. The former
|
||||
contains a list of strings to be passed as options to
|
||||
\"bibtex2html\" process. The latter contains a boolean."
|
||||
(let ((value (org-element-property :value keyword)))
|
||||
(and value
|
||||
(string-match "\\(\\S-+\\)[ \t]+\\(\\S-+\\)\\(.*\\)" value)
|
||||
(let (options limit)
|
||||
(dolist (arg (split-string (match-string 3 value))
|
||||
;; Return value.
|
||||
(list :options (nreverse options) :limit limit))
|
||||
(let* ((s (split-string arg ":"))
|
||||
(key (car s))
|
||||
(value (nth 1 s)))
|
||||
(cond ((equal "limit" key)
|
||||
(setq limit (not (equal "nil" value))))
|
||||
((equal "option" key) (push value options)))))))))
|
||||
|
||||
(defun org-bibtex-citation-p (object)
|
||||
"Non-nil when OBJECT is a citation."
|
||||
(cl-case (org-element-type object)
|
||||
(link (equal (org-element-property :type object) "cite"))
|
||||
(latex-fragment
|
||||
(string-match "\\`\\\\cite{" (org-element-property :value object)))))
|
||||
|
||||
(defun org-bibtex-get-citation-key (citation)
|
||||
"Return key for a given citation, as a string.
|
||||
CITATION is a `latex-fragment' or `link' type object satisfying
|
||||
to `org-bibtex-citation-p' predicate."
|
||||
(if (eq (org-element-type citation) 'link)
|
||||
(org-element-property :path citation)
|
||||
(let ((value (org-element-property :value citation)))
|
||||
(and (string-match "\\`\\\\cite{" value)
|
||||
(substring value (match-end 0) -1)))))
|
||||
|
||||
|
||||
;;; Follow cite: links
|
||||
|
||||
(defvar org-bibtex-file nil
|
||||
"Org file of BibTeX entries.")
|
||||
|
||||
(defun org-bibtex-goto-citation (&optional citation)
|
||||
"Visit a citation given its ID."
|
||||
(interactive)
|
||||
(let ((citation (or citation (completing-read "Citation: " (obe-citations)))))
|
||||
(find-file (or org-bibtex-file
|
||||
(error "`org-bibtex-file' has not been configured")))
|
||||
(let ((position (org-find-property "CUSTOM_ID" citation)))
|
||||
(and position (progn (goto-char position) t)))))
|
||||
|
||||
(let ((jump-fn (car (cl-remove-if-not #'fboundp '(ebib org-bibtex-goto-citation)))))
|
||||
(org-add-link-type "cite" jump-fn))
|
||||
|
||||
|
||||
|
||||
;;; Filters
|
||||
|
||||
(defun org-bibtex-process-bib-files (tree backend info)
|
||||
"Send each bibliography in parse tree to \"bibtex2html\" process.
|
||||
Return new parse tree."
|
||||
(when (org-export-derived-backend-p backend 'ascii 'html)
|
||||
;; Initialize dynamically scoped variables. The first one
|
||||
;; contain an alist between keyword objects and their HTML
|
||||
;; translation. The second one will contain an alist between
|
||||
;; citation keys and names in the output (according to style).
|
||||
(setq org-bibtex-html-entries-alist nil
|
||||
org-bibtex-html-keywords-alist nil)
|
||||
(org-element-map tree 'keyword
|
||||
(lambda (keyword)
|
||||
(when (equal (org-element-property :key keyword) "BIBLIOGRAPHY")
|
||||
(let ((arguments (org-bibtex-get-arguments keyword))
|
||||
(file (org-bibtex-get-file keyword))
|
||||
temp-file
|
||||
out-file)
|
||||
;; Test if filename is given with .bib-extension and strip
|
||||
;; it off. Filenames with another extensions will be
|
||||
;; untouched and will finally rise an error in bibtex2html.
|
||||
(setq file (if (equal (file-name-extension file) "bib")
|
||||
(file-name-sans-extension file) file))
|
||||
;; Outpufiles of bibtex2html will be put into current working directory
|
||||
;; so define a variable for this.
|
||||
(setq out-file (file-name-sans-extension
|
||||
(file-name-nondirectory file)))
|
||||
;; limit is set: collect citations throughout the document
|
||||
;; in TEMP-FILE and pass it to "bibtex2html" as "-citefile"
|
||||
;; argument.
|
||||
(when (plist-get arguments :limit)
|
||||
(let ((citations
|
||||
(org-element-map tree '(latex-fragment link)
|
||||
(lambda (object)
|
||||
(and (org-bibtex-citation-p object)
|
||||
(org-bibtex-get-citation-key object))))))
|
||||
(with-temp-file (setq temp-file (make-temp-file "ox-bibtex"))
|
||||
(insert (mapconcat 'identity citations "\n")))
|
||||
(setq arguments
|
||||
(plist-put arguments
|
||||
:options
|
||||
(append (plist-get arguments :options)
|
||||
(list "-citefile" temp-file))))))
|
||||
;; Call "bibtex2html" on specified file.
|
||||
(unless (eq 0 (apply
|
||||
'call-process
|
||||
(append '("bibtex2html" nil nil nil)
|
||||
'("-a" "-nodoc" "-noheader" "-nofooter")
|
||||
(let ((style
|
||||
(org-not-nil
|
||||
(org-bibtex-get-style keyword))))
|
||||
(and style (list "--style" style)))
|
||||
(plist-get arguments :options)
|
||||
(list (concat file ".bib")))))
|
||||
(error "Executing bibtex2html failed"))
|
||||
(and temp-file (delete-file temp-file))
|
||||
;; Open produced HTML file, and collect Bibtex key names
|
||||
(with-temp-buffer
|
||||
(insert-file-contents (concat out-file ".html"))
|
||||
;; Update `org-bibtex-html-entries-alist'.
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward
|
||||
"a name=\"\\([-_a-zA-Z0-9:]+\\)\">\\([^<]+\\)" nil t)
|
||||
(push (cons (match-string 1) (match-string 2))
|
||||
org-bibtex-html-entries-alist)))
|
||||
;; Open produced HTML file, wrap references within a block and
|
||||
;; return it.
|
||||
(with-temp-buffer
|
||||
(cond
|
||||
((org-export-derived-backend-p backend 'html)
|
||||
(insert (format "<div id=\"bibliography\">\n<h2>%s</h2>\n"
|
||||
(org-export-translate "References" :html info)))
|
||||
(insert-file-contents (concat out-file ".html"))
|
||||
(goto-char (point-max))
|
||||
(insert "\n</div>"))
|
||||
((org-export-derived-backend-p backend 'ascii)
|
||||
;; convert HTML references to text w/pandoc
|
||||
(unless (eq 0 (call-process "pandoc" nil nil nil
|
||||
(concat out-file ".html")
|
||||
"-o"
|
||||
(concat out-file ".txt")))
|
||||
(error "Executing pandoc failed"))
|
||||
(insert
|
||||
(format
|
||||
"%s\n==========\n\n"
|
||||
(org-export-translate
|
||||
"References"
|
||||
(intern (format ":%s" (plist-get info :ascii-charset)))
|
||||
info)))
|
||||
(insert-file-contents (concat out-file ".txt"))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward
|
||||
"\\[ \\[bib\\][^ ]+ \\(\\]\\||[\n\r]\\)" nil t)
|
||||
(replace-match ""))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "\\( \\]\\| \\]\\| |\\)" nil t)
|
||||
(replace-match ""))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "[\n\r]\\([\n\r][\n\r]\\)" nil t)
|
||||
(replace-match "\\1"))))
|
||||
;; Update `org-bibtex-html-keywords-alist'.
|
||||
(push (cons keyword (buffer-string))
|
||||
org-bibtex-html-keywords-alist)))))))
|
||||
;; Return parse tree unchanged.
|
||||
tree)
|
||||
|
||||
(defun org-bibtex-merge-contiguous-citations (tree backend info)
|
||||
"Merge all contiguous citation in parse tree.
|
||||
As a side effect, this filter will also turn all \"cite\" links
|
||||
into \"\\cite{...}\" LaTeX fragments and will extract options.
|
||||
Cite options are placed into square brackets at the beginning of
|
||||
the \"\\cite\" command for the LaTeX backend, and are removed for
|
||||
the HTML and ASCII backends."
|
||||
(when (org-export-derived-backend-p backend 'html 'latex 'ascii)
|
||||
(org-element-map tree '(link latex-fragment)
|
||||
(lambda (object)
|
||||
(when (org-bibtex-citation-p object)
|
||||
(let ((new-citation (list 'latex-fragment
|
||||
(list :value ""
|
||||
:post-blank (org-element-property
|
||||
:post-blank object))))
|
||||
option)
|
||||
;; Insert NEW-CITATION right before OBJECT.
|
||||
(org-element-insert-before new-citation object)
|
||||
;; Remove all subsequent contiguous citations from parse
|
||||
;; tree, keeping only their citation key.
|
||||
(let ((keys (list (org-bibtex-get-citation-key object)))
|
||||
next)
|
||||
(while (and (setq next (org-export-get-next-element object info))
|
||||
(or (and (stringp next)
|
||||
(not (string-match-p "\\S-" next)))
|
||||
(org-bibtex-citation-p next)))
|
||||
(unless (stringp next)
|
||||
(push (org-bibtex-get-citation-key next) keys))
|
||||
(org-element-extract-element object)
|
||||
(setq object next))
|
||||
;; Find any options in keys, e.g., "(Chapter 2)key" has
|
||||
;; the option "Chapter 2".
|
||||
(setq keys
|
||||
(mapcar
|
||||
(lambda (k)
|
||||
(if (string-match "^(\\([^)]\+\\))\\(.*\\)" k)
|
||||
(progn
|
||||
(when (org-export-derived-backend-p backend 'latex)
|
||||
(setq option (format "[%s]" (match-string 1 k))))
|
||||
(match-string 2 k))
|
||||
k))
|
||||
keys))
|
||||
(org-element-extract-element object)
|
||||
;; Eventually merge all keys within NEW-CITATION. Also
|
||||
;; ensure NEW-CITATION has the same :post-blank property
|
||||
;; as the last citation removed.
|
||||
(org-element-put-property
|
||||
new-citation
|
||||
:post-blank (org-element-property :post-blank object))
|
||||
(org-element-put-property
|
||||
new-citation
|
||||
:value (format "\\cite%s{%s}"
|
||||
(or option "")
|
||||
(mapconcat 'identity (nreverse keys) ",")))))))))
|
||||
tree)
|
||||
|
||||
(eval-after-load 'ox
|
||||
'(progn (add-to-list 'org-export-filter-parse-tree-functions
|
||||
'org-bibtex-process-bib-files)
|
||||
(add-to-list 'org-export-filter-parse-tree-functions
|
||||
'org-bibtex-merge-contiguous-citations)))
|
||||
|
||||
|
||||
|
||||
;;; LaTeX Part
|
||||
|
||||
(defadvice org-latex-keyword (around bibtex-keyword)
|
||||
"Translate \"BIBLIOGRAPHY\" keywords into LaTeX syntax.
|
||||
Fallback to `latex' back-end for other keywords."
|
||||
(let ((keyword (ad-get-arg 0)))
|
||||
(if (not (equal (org-element-property :key keyword) "BIBLIOGRAPHY"))
|
||||
ad-do-it
|
||||
(let ((file (org-bibtex-get-file keyword))
|
||||
(style (org-not-nil (org-bibtex-get-style keyword))))
|
||||
(setq ad-return-value
|
||||
(when file
|
||||
(concat (and style (format "\\bibliographystyle{%s}\n" style))
|
||||
(format "\\bibliography{%s}" file))))))))
|
||||
|
||||
(ad-activate 'org-latex-keyword)
|
||||
|
||||
|
||||
|
||||
;;; HTML Part
|
||||
|
||||
(defvar org-bibtex-html-entries-alist nil) ; Dynamically scoped.
|
||||
(defvar org-bibtex-html-keywords-alist nil) ; Dynamically scoped.
|
||||
|
||||
|
||||
;;;; Advices
|
||||
|
||||
(defadvice org-html-keyword (around bibtex-keyword)
|
||||
"Translate \"BIBLIOGRAPHY\" keywords into HTML syntax.
|
||||
Fallback to `html' back-end for other keywords."
|
||||
(let ((keyword (ad-get-arg 0)))
|
||||
(if (not (equal (org-element-property :key keyword) "BIBLIOGRAPHY"))
|
||||
ad-do-it
|
||||
(setq ad-return-value
|
||||
(cdr (assq keyword org-bibtex-html-keywords-alist))))))
|
||||
|
||||
(defadvice org-html-latex-fragment (around bibtex-citation)
|
||||
"Translate \"\\cite\" LaTeX fragments into HTML syntax.
|
||||
Fallback to `html' back-end for other keywords."
|
||||
(let ((fragment (ad-get-arg 0)))
|
||||
(if (not (org-bibtex-citation-p fragment)) ad-do-it
|
||||
(setq ad-return-value
|
||||
(format "[%s]"
|
||||
(mapconcat
|
||||
(lambda (key)
|
||||
(format "<a href=\"#%s\">%s</a>"
|
||||
key
|
||||
(or (cdr (assoc key org-bibtex-html-entries-alist))
|
||||
key)))
|
||||
(org-split-string
|
||||
(org-bibtex-get-citation-key fragment) ",") ","))))))
|
||||
|
||||
(ad-activate 'org-html-keyword)
|
||||
(ad-activate 'org-html-latex-fragment)
|
||||
|
||||
|
||||
;;; Ascii Part
|
||||
(defadvice org-ascii-keyword (around bibtex-keyword)
|
||||
"Translate \"BIBLIOGRAPHY\" keywords into ascii syntax.
|
||||
Fallback to `ascii' back-end for other keywords."
|
||||
(let ((keyword (ad-get-arg 0)))
|
||||
(if (not (equal (org-element-property :key keyword) "BIBLIOGRAPHY"))
|
||||
ad-do-it
|
||||
(setq ad-return-value
|
||||
(cdr (assq keyword org-bibtex-html-keywords-alist))))))
|
||||
|
||||
(defadvice org-ascii-latex-fragment (around bibtex-citation)
|
||||
"Translate \"\\cite\" LaTeX fragments into ascii syntax.
|
||||
Fallback to `ascii' back-end for other keywords."
|
||||
(let ((fragment (ad-get-arg 0)))
|
||||
(if (not (org-bibtex-citation-p fragment)) ad-do-it
|
||||
(setq ad-return-value
|
||||
(format "[%s]"
|
||||
(mapconcat
|
||||
(lambda (key)
|
||||
(or (cdr (assoc key org-bibtex-html-entries-alist))
|
||||
key))
|
||||
(org-split-string
|
||||
(org-bibtex-get-citation-key fragment) ",") ","))))))
|
||||
|
||||
(ad-activate 'org-ascii-keyword)
|
||||
(ad-activate 'org-ascii-latex-fragment)
|
||||
|
||||
(provide 'ox-bibtex)
|
||||
|
||||
;;; ox-bibtex.el ends here
|
||||
258
lisp/org-contrib/ox-confluence.el
Normal file
258
lisp/org-contrib/ox-confluence.el
Normal file
@@ -0,0 +1,258 @@
|
||||
;;; ox-confluence --- Confluence Wiki Back-End for Org Export Engine
|
||||
|
||||
;; Copyright (C) 2012-2021 Sébastien Delafond
|
||||
|
||||
;; Author: Sébastien Delafond <sdelafond@gmail.com>
|
||||
;; Keywords: outlines, confluence, wiki
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; This program is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; ox-confluence.el lets you convert Org files to confluence files
|
||||
;; using the ox.el export engine.
|
||||
;;
|
||||
;; Put this file into your load-path and the following into your ~/.emacs:
|
||||
;; (require 'ox-confluence)
|
||||
;;
|
||||
;; Export Org files to confluence:
|
||||
;; M-x org-confluence-export-as-confluence RET
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(require 'ox)
|
||||
(require 'ox-ascii)
|
||||
|
||||
;; Define the backend itself
|
||||
(org-export-define-derived-backend 'confluence 'ascii
|
||||
:translate-alist '((bold . org-confluence-bold)
|
||||
(code . org-confluence-code)
|
||||
(example-block . org-confluence-example-block)
|
||||
(fixed-width . org-confluence-fixed-width)
|
||||
(footnote-definition . org-confluence-empty)
|
||||
(footnote-reference . org-confluence-empty)
|
||||
(headline . org-confluence-headline)
|
||||
(italic . org-confluence-italic)
|
||||
(item . org-confluence-item)
|
||||
(link . org-confluence-link)
|
||||
(paragraph . org-confluence-paragraph)
|
||||
(property-drawer . org-confluence-property-drawer)
|
||||
(quote-block . org-confluence-quote-block)
|
||||
(section . org-confluence-section)
|
||||
(src-block . org-confluence-src-block)
|
||||
(strike-through . org-confluence-strike-through)
|
||||
(table . org-confluence-table)
|
||||
(table-cell . org-confluence-table-cell)
|
||||
(table-row . org-confluence-table-row)
|
||||
(template . org-confluence-template)
|
||||
(timestamp . org-confluence-timestamp)
|
||||
(underline . org-confluence-underline)
|
||||
(verbatim . org-confluence-verbatim))
|
||||
:menu-entry
|
||||
'(?f "Export to Confluence"
|
||||
((?f "As Confluence buffer" org-confluence-export-as-confluence))))
|
||||
|
||||
(defcustom org-confluence-lang-alist
|
||||
'(("sh" . "bash"))
|
||||
"Map from org-babel language name to confluence wiki language name"
|
||||
:type '(alist :key-type string :value-type string))
|
||||
|
||||
;; All the functions we use
|
||||
(defun org-confluence-bold (bold contents info)
|
||||
(format "*%s*" contents))
|
||||
|
||||
(defun org-confluence-empty (empty contents info)
|
||||
"")
|
||||
|
||||
(defun org-confluence-example-block (example-block contents info)
|
||||
;; FIXME: provide a user-controlled variable for theme
|
||||
(let ((content (org-export-format-code-default example-block info)))
|
||||
(org-confluence--block "none" "Confluence" content)))
|
||||
|
||||
(defun org-confluence-italic (italic contents info)
|
||||
(format "_%s_" contents))
|
||||
|
||||
(defun org-confluence-item (item contents info)
|
||||
(let ((list-type (org-element-property :type (org-export-get-parent item))))
|
||||
(concat
|
||||
(make-string (1+ (org-confluence--li-depth item))
|
||||
(if (eq list-type 'ordered) ?\# ?\-))
|
||||
" "
|
||||
(pcase (org-element-property :checkbox item)
|
||||
(`on "*{{(X)}}* ")
|
||||
(`off "*{{( )}}* ")
|
||||
(`trans "*{{(\\-)}}* "))
|
||||
(when (eq list-type 'descriptive)
|
||||
(concat "*"
|
||||
(org-export-data (org-element-property :tag item) info)
|
||||
"* - "))
|
||||
(org-trim contents))))
|
||||
|
||||
(defun org-confluence-fixed-width (fixed-width contents info)
|
||||
(org-confluence--block
|
||||
"none"
|
||||
"Confluence"
|
||||
(org-trim (org-element-property :value fixed-width))))
|
||||
|
||||
(defun org-confluence-verbatim (verbatim contents info)
|
||||
(format "\{\{%s\}\}" (org-element-property :value verbatim)))
|
||||
|
||||
(defun org-confluence-code (code contents info)
|
||||
(format "\{\{%s\}\}" (org-element-property :value code)))
|
||||
|
||||
(defun org-confluence-headline (headline contents info)
|
||||
(let* ((low-level-rank (org-export-low-level-p headline info))
|
||||
(text (org-export-data (org-element-property :title headline)
|
||||
info))
|
||||
(todo (org-export-data (org-element-property :todo-keyword headline)
|
||||
info))
|
||||
(level (org-export-get-relative-level headline info))
|
||||
(todo-text (if (or (not (plist-get info :with-todo-keywords))
|
||||
(string= todo ""))
|
||||
""
|
||||
(format "*{{%s}}* " todo))))
|
||||
(format "h%s. %s%s\n%s" level todo-text text
|
||||
(if (org-string-nw-p contents) contents ""))))
|
||||
|
||||
(defun org-confluence-link (link desc info)
|
||||
(if (string= "radio" (org-element-property :type link))
|
||||
desc
|
||||
(let ((raw-link (org-element-property :raw-link link)))
|
||||
(concat "["
|
||||
(when (org-string-nw-p desc) (format "%s|" desc))
|
||||
(cond
|
||||
((string-match "^confluence:" raw-link)
|
||||
(replace-regexp-in-string "^confluence:" "" raw-link))
|
||||
(t
|
||||
raw-link))
|
||||
"]"))))
|
||||
|
||||
(defun org-confluence-paragraph (paragraph contents info)
|
||||
"Transcode PARAGRAPH element for Confluence.
|
||||
CONTENTS is the paragraph contents. INFO is a plist used as
|
||||
a communication channel."
|
||||
contents)
|
||||
|
||||
(defun org-confluence-property-drawer (property-drawer contents info)
|
||||
(and (org-string-nw-p contents)
|
||||
(format "\{\{%s\}\}" contents)))
|
||||
|
||||
(defun org-confluence-quote-block (quote-block contents info)
|
||||
(format "{quote}\n%s{quote}" contents))
|
||||
|
||||
(defun org-confluence-section (section contents info)
|
||||
contents)
|
||||
|
||||
(defun org-confluence-src-block (src-block contents info)
|
||||
;; FIXME: provide a user-controlled variable for theme
|
||||
(let* ((lang (org-element-property :language src-block))
|
||||
(language (or (cdr (assoc lang org-confluence-lang-alist)) lang))
|
||||
(content (org-export-format-code-default src-block info)))
|
||||
(org-confluence--block language "Emacs" content)))
|
||||
|
||||
(defun org-confluence-strike-through (strike-through contents info)
|
||||
(format "-%s-" contents))
|
||||
|
||||
(defun org-confluence-table (table contents info)
|
||||
contents)
|
||||
|
||||
(defun org-confluence-table-row (table-row contents info)
|
||||
(concat
|
||||
(if (org-string-nw-p contents) (format "|%s" contents)
|
||||
"")
|
||||
(when (org-export-table-row-ends-header-p table-row info)
|
||||
"|")))
|
||||
|
||||
(defun org-confluence-table-cell (table-cell contents info)
|
||||
(let ((table-row (org-export-get-parent table-cell)))
|
||||
(concat (and (org-export-table-row-starts-header-p table-row info) "|")
|
||||
(if (= (length contents) 0) " " contents)
|
||||
"|")))
|
||||
|
||||
(defun org-confluence-template (contents info)
|
||||
(let ((depth (plist-get info :with-toc)))
|
||||
(concat (when depth "\{toc\}\n\n") contents)))
|
||||
|
||||
(defun org-confluence-timestamp (timestamp _contents _info)
|
||||
"Transcode a TIMESTAMP object from Org to Confluence.
|
||||
CONTENTS and INFO are ignored."
|
||||
(let ((translated (org-trim (org-timestamp-translate timestamp))))
|
||||
(if (string-prefix-p "[" translated)
|
||||
(concat "(" (substring translated 1 -1) ")")
|
||||
translated)))
|
||||
|
||||
(defun org-confluence-underline (underline contents info)
|
||||
(format "+%s+" contents))
|
||||
|
||||
(defun org-confluence--block (language theme contents)
|
||||
(concat "\{code:theme=" theme
|
||||
(when language (format "|language=%s" language))
|
||||
"}\n"
|
||||
contents
|
||||
"\{code\}\n"))
|
||||
|
||||
(defun org-confluence--li-depth (item)
|
||||
"Return depth of a list item; -1 means not a list item"
|
||||
;; FIXME check whether it's worth it to cache depth
|
||||
;; (it gets recalculated quite a few times while
|
||||
;; traversing a list)
|
||||
(let ((depth -1)
|
||||
(tag))
|
||||
(while (and item
|
||||
(setq tag (car item))
|
||||
(or (eq tag 'item) ; list items interleave with plain-list
|
||||
(eq tag 'plain-list)))
|
||||
(when (eq tag 'item)
|
||||
(cl-incf depth))
|
||||
(setq item (org-export-get-parent item)))
|
||||
depth))
|
||||
|
||||
;; main interactive entrypoint
|
||||
(defun org-confluence-export-as-confluence
|
||||
(&optional async subtreep visible-only body-only ext-plist)
|
||||
"Export current buffer to a text buffer.
|
||||
|
||||
If narrowing is active in the current buffer, only export its
|
||||
narrowed part.
|
||||
|
||||
If a region is active, export that region.
|
||||
|
||||
A non-nil optional argument ASYNC means the process should happen
|
||||
asynchronously. The resulting buffer should be accessible
|
||||
through the `org-export-stack' interface.
|
||||
|
||||
When optional argument SUBTREEP is non-nil, export the sub-tree
|
||||
at point, extracting information from the headline properties
|
||||
first.
|
||||
|
||||
When optional argument VISIBLE-ONLY is non-nil, don't export
|
||||
contents of hidden elements.
|
||||
|
||||
When optional argument BODY-ONLY is non-nil, strip title, table
|
||||
of contents and footnote definitions from output.
|
||||
|
||||
EXT-PLIST, when provided, is a property list with external
|
||||
parameters overriding Org default settings, but still inferior to
|
||||
file-local settings.
|
||||
|
||||
Export is done in a buffer named \"*Org CONFLUENCE Export*\", which
|
||||
will be displayed when `org-export-show-temporary-export-buffer'
|
||||
is non-nil."
|
||||
(interactive)
|
||||
(org-export-to-buffer 'confluence "*org CONFLUENCE Export*"
|
||||
async subtreep visible-only body-only ext-plist (lambda () (text-mode))))
|
||||
|
||||
(provide 'ox-confluence)
|
||||
585
lisp/org-contrib/ox-deck.el
Normal file
585
lisp/org-contrib/ox-deck.el
Normal file
@@ -0,0 +1,585 @@
|
||||
;;; ox-deck.el --- deck.js Presentation Back-End for Org Export Engine
|
||||
|
||||
;; Copyright (C) 2013, 2014, 2021 Rick Frankel
|
||||
|
||||
;; Author: Rick Frankel <emacs at rickster dot com>
|
||||
;; Keywords: outlines, hypermedia, slideshow
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This library implements a deck.js presentation back-end for the Org
|
||||
;; generic exporter.
|
||||
|
||||
;; Installation
|
||||
;; -------------
|
||||
;; Get a copy of deck.js from http://imakewebthings.com/deck.js/ or
|
||||
;; the gitub repository at https://github.com/imakewebthings/deck.js.
|
||||
;;
|
||||
;; Add the path to the extracted code to the variable
|
||||
;; `org-deck-directories' There are a number of customization in the
|
||||
;; org-export-deck group, most of which can be overridden with buffer
|
||||
;; local customization (starting with DECK_.)
|
||||
|
||||
;; See ox.el and ox-html.el for more details on how this exporter
|
||||
;; works (it is derived from ox-html.)
|
||||
|
||||
;; TODOs
|
||||
;; ------
|
||||
;; The title page is formatted using format-spec. This is error prone
|
||||
;; when details are missing and may insert empty tags, like <h2></h2>,
|
||||
;; for missing values.
|
||||
|
||||
(require 'ox-html)
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(org-export-define-derived-backend 'deck 'html
|
||||
:menu-entry
|
||||
'(?d "Export to deck.js HTML Presentation"
|
||||
((?H "To temporary buffer" org-deck-export-as-html)
|
||||
(?h "To file" org-deck-export-to-html)
|
||||
(?o "To file and open"
|
||||
(lambda (a s v b)
|
||||
(if a (org-deck-export-to-html t s v b)
|
||||
(org-open-file (org-deck-export-to-html nil s v b)))))))
|
||||
:options-alist
|
||||
'((:description "DESCRIPTION" nil nil newline)
|
||||
(:keywords "KEYWORDS" nil nil space)
|
||||
(:html-link-home "HTML_LINK_HOME" nil nil)
|
||||
(:html-link-up "HTML_LINK_UP" nil nil)
|
||||
(:deck-postamble "DECK_POSTAMBLE" nil org-deck-postamble newline)
|
||||
(:deck-preamble "DECK_PREAMBLE" nil org-deck-preamble newline)
|
||||
(:html-head-include-default-style "HTML_INCLUDE_DEFAULT_STYLE" "html-style" nil)
|
||||
(:html-head-include-scripts "HTML_INCLUDE_SCRIPTS" nil nil)
|
||||
(:deck-base-url "DECK_BASE_URL" nil org-deck-base-url)
|
||||
(:deck-theme "DECK_THEME" nil org-deck-theme)
|
||||
(:deck-transition "DECK_TRANSITION" nil org-deck-transition)
|
||||
(:deck-include-extensions "DECK_INCLUDE_EXTENSIONS" nil
|
||||
org-deck-include-extensions split)
|
||||
(:deck-exclude-extensions "DECK_EXCLUDE_EXTENSIONS" nil
|
||||
org-deck-exclude-extensions split))
|
||||
:translate-alist
|
||||
'((headline . org-deck-headline)
|
||||
(inner-template . org-deck-inner-template)
|
||||
(item . org-deck-item)
|
||||
(link . org-deck-link)
|
||||
(template . org-deck-template)))
|
||||
|
||||
(defgroup org-export-deck nil
|
||||
"Options for exporting Org mode files to deck.js HTML Presentations."
|
||||
:tag "Org Export DECK"
|
||||
:group 'org-export-html)
|
||||
|
||||
(defcustom org-deck-directories '("./deck.js")
|
||||
"Directories to search for deck.js components (jquery,
|
||||
modernizr; core, extensions and themes directories.)"
|
||||
:group 'org-export-deck
|
||||
:type '(repeat (string :tag "Directory")))
|
||||
|
||||
(defun org-deck--cleanup-components (components)
|
||||
(remove-duplicates
|
||||
(car (remove 'nil components))
|
||||
:test (lambda (x y)
|
||||
(string= (file-name-nondirectory x)
|
||||
(file-name-nondirectory y)))))
|
||||
|
||||
(defun org-deck--find-extensions ()
|
||||
"Returns a unique list of all extensions found in
|
||||
in the extensions directories under `org-deck-directories'"
|
||||
(org-deck--cleanup-components
|
||||
(mapcar ; extensions under existing dirs
|
||||
(lambda (dir)
|
||||
(when (file-directory-p dir) (directory-files dir t "^[^.]")))
|
||||
(mapcar ; possible extension directories
|
||||
(lambda (x) (expand-file-name "extensions" x))
|
||||
org-deck-directories))))
|
||||
|
||||
(defun org-deck--find-css (type)
|
||||
"Return a unique list of all the css stylesheets in the themes/TYPE
|
||||
directories under `org-deck-directories'."
|
||||
(org-deck--cleanup-components
|
||||
(mapcar
|
||||
(lambda (dir)
|
||||
(let ((css-dir (expand-file-name
|
||||
(concat (file-name-as-directory "themes") type) dir)))
|
||||
(when (file-directory-p css-dir)
|
||||
(directory-files css-dir t "\\.css$"))))
|
||||
org-deck-directories)))
|
||||
|
||||
(defun org-deck-list-components ()
|
||||
"List all available deck extensions, styles and
|
||||
transitions (with full paths) to a temporary buffer."
|
||||
(interactive)
|
||||
(let ((outbuf (get-buffer-create "*deck.js Extensions*")))
|
||||
(with-current-buffer outbuf
|
||||
(erase-buffer)
|
||||
(insert "Extensions\n----------\n")
|
||||
(insert (mapconcat 'identity (org-deck--find-extensions) "\n"))
|
||||
(insert "\n\nStyles\n------\n")
|
||||
(insert (mapconcat 'identity (org-deck--find-css "style") "\n"))
|
||||
(insert "\n\nTransitions\n----------\n")
|
||||
(insert (mapconcat 'identity (org-deck--find-css "transition") "\n")))
|
||||
(switch-to-buffer-other-window outbuf)))
|
||||
|
||||
(defcustom org-deck-include-extensions nil
|
||||
"If non-nil, list of extensions to include instead of all available.
|
||||
Can be overridden or set with the DECK_INCLUDE_EXTENSIONS property.
|
||||
During output generation, the extensions found by
|
||||
`org-deck--find-extensions' are searched for the appropriate
|
||||
files (scripts and/or stylesheets) to include in the generated
|
||||
html. The href/src attributes are created relative to `org-deck-base-url'."
|
||||
:group 'org-export-deck
|
||||
:type '(repeat (string :tag "Extension")))
|
||||
|
||||
(defcustom org-deck-exclude-extensions nil
|
||||
"If non-nil, list of extensions to exclude.
|
||||
Can be overridden or set with the DECK_EXCLUDE_EXTENSIONS property."
|
||||
:group 'org-export-deck
|
||||
:type '(repeat (string :tag "Extension")))
|
||||
|
||||
(defcustom org-deck-theme "swiss.css"
|
||||
"deck.js theme. Can be overridden with the DECK_THEME property.
|
||||
If this value contains a path component (\"/\"), it is used as a
|
||||
literal path (url). Otherwise it is prepended with
|
||||
`org-deck-base-url'/themes/style/."
|
||||
:group 'org-export-deck
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-deck-transition "fade.css"
|
||||
"deck.js transition theme. Can be overridden with the
|
||||
DECK_TRANSITION property.
|
||||
If this value contains a path component (\"/\"), it is used as a
|
||||
literal path (url). Otherwise it is prepended with
|
||||
`org-deck-base-url'/themes/transition/."
|
||||
:group 'org-export-deck
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-deck-base-url "deck.js"
|
||||
"Url prefix to deck.js base directory containing the core, extensions
|
||||
and themes directories.
|
||||
Can be overridden with the DECK_BASE_URL property."
|
||||
:group 'org-export-deck
|
||||
:type 'string)
|
||||
|
||||
(defvar org-deck-pre/postamble-styles
|
||||
`((both "left: 5px; width: 100%;")
|
||||
(preamble "position: absolute; top: 10px;")
|
||||
(postamble ""))
|
||||
"Alist of css styles for the preamble, postamble and both respectively.
|
||||
Can be overridden in `org-deck-styles'. See also `org-html-divs'.")
|
||||
|
||||
(defcustom org-deck-postamble "<h1>%a - %t</h1>"
|
||||
"Non-nil means insert a postamble in HTML export.
|
||||
|
||||
When set to a string, use this string
|
||||
as the postamble. When t, insert a string as defined by the
|
||||
formatting string in `org-html-postamble-format'.
|
||||
|
||||
When set to a function, apply this function and insert the
|
||||
returned string. The function takes the property list of export
|
||||
options as its only argument.
|
||||
|
||||
This is included in the document at the bottom of the content
|
||||
section, and uses the postamble element and id from
|
||||
`org-html-divs'. The default places the author and presentation
|
||||
title at the bottom of each slide.
|
||||
|
||||
The css styling is controlled by `org-deck-pre/postamble-styles'.
|
||||
|
||||
Setting :deck-postamble in publishing projects will take
|
||||
precedence over this variable."
|
||||
:group 'org-export-deck
|
||||
:type '(choice (const :tag "No postamble" nil)
|
||||
(const :tag "Default formatting string" t)
|
||||
(string :tag "Custom formatting string")
|
||||
(function :tag "Function (must return a string)")))
|
||||
|
||||
(defcustom org-deck-preamble nil
|
||||
"Non-nil means insert a preamble in HTML export.
|
||||
|
||||
When set to a string, use this string
|
||||
as the preamble. When t, insert a string as defined by the
|
||||
formatting string in `org-html-preamble-format'.
|
||||
|
||||
When set to a function, apply this function and insert the
|
||||
returned string. The function takes the property list of export
|
||||
options as its only argument.
|
||||
|
||||
This is included in the document at the top of content section, and
|
||||
uses the preamble element and id from `org-html-divs'. The css
|
||||
styling is controlled by `org-deck-pre/postamble-styles'.
|
||||
|
||||
Setting :deck-preamble in publishing projects will take
|
||||
precedence over this variable."
|
||||
:group 'org-export-deck
|
||||
:type '(choice (const :tag "No preamble" nil)
|
||||
(const :tag "Default formatting string" t)
|
||||
(string :tag "Custom formatting string")
|
||||
(function :tag "Function (must return a string)")))
|
||||
|
||||
(defvar org-deck-toc-styles
|
||||
(mapconcat
|
||||
'identity
|
||||
(list
|
||||
"#table-of-contents a {color: inherit;}"
|
||||
"#table-of-contents ul {margin-bottom: 0;}"
|
||||
"#table-of-contents li {padding: 0;}") "\n")
|
||||
"Default css styles used for formatting a table of contents slide.
|
||||
Can be overridden in `org-deck-styles'.
|
||||
Note that when the headline numbering option is true, a \"list-style: none\"
|
||||
is automatically added to avoid both numbers and bullets on the toc entries.")
|
||||
|
||||
(defcustom org-deck-styles
|
||||
"
|
||||
#title-slide h1 {
|
||||
position: static; padding: 0;
|
||||
margin-top: 10%;
|
||||
-webkit-transform: none;
|
||||
-moz-transform: none;
|
||||
-ms-transform: none;
|
||||
-o-transform: none;
|
||||
transform: none;
|
||||
}
|
||||
#title-slide h2 {
|
||||
text-align: center;
|
||||
border:none;
|
||||
padding: 0;
|
||||
margin: 0;
|
||||
}"
|
||||
"Deck specific CSS styles to include in exported html.
|
||||
Defaults to styles for the title page."
|
||||
:group 'org-export-deck
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-deck-title-slide-template
|
||||
"<h1>%t</h1>
|
||||
<h2>%s</h2>
|
||||
<h2>%a</h2>
|
||||
<h2>%e</h2>
|
||||
<h2>%d</h2>"
|
||||
"Format template to specify title page section.
|
||||
See `org-html-postamble-format' for the valid elements which
|
||||
can be included.
|
||||
|
||||
It will be wrapped in the element defined in the :html-container
|
||||
property, and defaults to the value of `org-html-container-element',
|
||||
and have the id \"title-slide\"."
|
||||
:group 'org-export-deck
|
||||
:type 'string)
|
||||
|
||||
(defun org-deck-toc (depth info)
|
||||
(concat
|
||||
(format "<%s id='table-of-contents' class='slide'>\n"
|
||||
(plist-get info :html-container))
|
||||
(format "<h2>%s</h2>\n" (org-html--translate "Table of Contents" info))
|
||||
(org-html--toc-text
|
||||
(mapcar
|
||||
(lambda (headline)
|
||||
(let* ((class (org-element-property :HTML_CONTAINER_CLASS headline))
|
||||
(section-number
|
||||
(when
|
||||
(and (not (org-export-low-level-p headline info))
|
||||
(org-export-numbered-headline-p headline info))
|
||||
(concat
|
||||
(mapconcat
|
||||
'number-to-string
|
||||
(org-export-get-headline-number headline info) ".") ". ")))
|
||||
(title
|
||||
(concat
|
||||
section-number
|
||||
(replace-regexp-in-string ; remove any links in headline...
|
||||
"</?a[^>]*>" ""
|
||||
(org-export-data
|
||||
(org-element-property :title headline) info)))))
|
||||
(cons
|
||||
(if (and class (string-match-p "\\<slide\\>" class))
|
||||
(format
|
||||
"<a href='#outline-container-%s'>%s</a>"
|
||||
(or (org-element-property :CUSTOM_ID headline)
|
||||
(concat
|
||||
"sec-"
|
||||
(mapconcat
|
||||
'number-to-string
|
||||
(org-export-get-headline-number headline info) "-")))
|
||||
title)
|
||||
title)
|
||||
(org-export-get-relative-level headline info))))
|
||||
(org-export-collect-headlines info depth)))
|
||||
(format "</%s>\n" (plist-get info :html-container))))
|
||||
|
||||
(defun org-deck--get-packages (info)
|
||||
(let ((prefix (concat (plist-get info :deck-base-url) "/"))
|
||||
(theme (plist-get info :deck-theme))
|
||||
(transition (plist-get info :deck-transition))
|
||||
(include (plist-get info :deck-include-extensions))
|
||||
(exclude (plist-get info :deck-exclude-extensions))
|
||||
(scripts '()) (sheets '()) (snippets '()))
|
||||
(add-to-list 'scripts (concat prefix "jquery.min.js"))
|
||||
(add-to-list 'scripts (concat prefix "core/deck.core.js"))
|
||||
(add-to-list 'scripts (concat prefix "modernizr.custom.js"))
|
||||
(add-to-list 'sheets (concat prefix "core/deck.core.css"))
|
||||
(mapc
|
||||
(lambda (extdir)
|
||||
(let* ((name (file-name-nondirectory extdir))
|
||||
(dir (file-name-as-directory extdir))
|
||||
(path (concat prefix "extensions/" name "/"))
|
||||
(base (format "deck.%s." name)))
|
||||
(when (and (or (eq nil include) (member name include))
|
||||
(not (member name exclude)))
|
||||
(when (file-exists-p (concat dir base "js"))
|
||||
(add-to-list 'scripts (concat path base "js")))
|
||||
(when (file-exists-p (concat dir base "css"))
|
||||
(add-to-list 'sheets (concat path base "css")))
|
||||
(when (file-exists-p (concat dir base "html"))
|
||||
(add-to-list 'snippets (concat dir base "html"))))))
|
||||
(org-deck--find-extensions))
|
||||
(if (not (string-match-p "^[[:space:]]*$" theme))
|
||||
(add-to-list 'sheets
|
||||
(if (file-name-directory theme) theme
|
||||
(format "%sthemes/style/%s" prefix theme))))
|
||||
(if (not (string-match-p "^[[:space:]]*$" transition))
|
||||
(add-to-list
|
||||
'sheets
|
||||
(if (file-name-directory transition) transition
|
||||
(format "%sthemes/transition/%s" prefix transition))))
|
||||
(list :scripts (nreverse scripts) :sheets (nreverse sheets)
|
||||
:snippets snippets)))
|
||||
|
||||
(defun org-deck-inner-template (contents info)
|
||||
"Return body of document string after HTML conversion.
|
||||
CONTENTS is the transcoded contents string. INFO is a plist
|
||||
holding export options."
|
||||
(concat contents "\n"))
|
||||
|
||||
(defun org-deck-headline (headline contents info)
|
||||
(let ((org-html-toplevel-hlevel 2)
|
||||
(class (or (org-element-property :HTML_CONTAINER_CLASS headline) ""))
|
||||
(level (org-export-get-relative-level headline info)))
|
||||
(when (and (= 1 level) (not (string-match-p "\\<slide\\>" class)))
|
||||
(org-element-put-property headline :HTML_CONTAINER_CLASS (concat class " slide")))
|
||||
(org-html-headline headline contents info)))
|
||||
|
||||
(defun org-deck-item (item contents info)
|
||||
"Transcode an ITEM element from Org to HTML.
|
||||
CONTENTS holds the contents of the item. INFO is a plist holding
|
||||
contextual information.
|
||||
If the containing headline has the property :STEP, then
|
||||
the \"slide\" class will be added to the to the list element,
|
||||
which will make the list into a \"build\"."
|
||||
(let ((text (org-html-item item contents info)))
|
||||
(if (org-export-get-node-property :STEP item t)
|
||||
(progn
|
||||
(replace-regexp-in-string "^<li>" "<li class='slide'>" text)
|
||||
(replace-regexp-in-string "^<li class='checkbox'>" "<li class='checkbox slide'>" text))
|
||||
text)))
|
||||
|
||||
(defun org-deck-link (link desc info)
|
||||
(replace-regexp-in-string "href=\"#" "href=\"#outline-container-"
|
||||
(org-export-with-backend 'html link desc info)))
|
||||
|
||||
(defun org-deck-template (contents info)
|
||||
"Return complete document string after HTML conversion.
|
||||
CONTENTS is the transcoded contents string. INFO is a plist
|
||||
holding export options."
|
||||
(let ((pkg-info (org-deck--get-packages info))
|
||||
(org-html--pre/postamble-class "deck-status")
|
||||
(info (plist-put
|
||||
(plist-put info :html-preamble (plist-get info :deck-preamble))
|
||||
:html-postamble (plist-get info :deck-postamble))))
|
||||
(mapconcat
|
||||
'identity
|
||||
(list
|
||||
(org-html-doctype info)
|
||||
(let ((lang (plist-get info :language)))
|
||||
(mapconcat
|
||||
(lambda (x)
|
||||
(apply
|
||||
'format
|
||||
"<!--%s <html %s lang='%s' xmlns='http://www.w3.org/1999/xhtml'> %s<![endif]-->"
|
||||
x))
|
||||
(list `("[if lt IE 7]>" "class='no-js ie6'" ,lang "")
|
||||
`("[if IE 7]>" "class='no-js ie7'" ,lang "")
|
||||
`("[if IE 8]>" "class='no-js ie8'" ,lang "")
|
||||
`("[if gt IE 8]><!-->" "" ,lang "<!--")) "\n"))
|
||||
"<head>"
|
||||
(org-deck--build-meta-info info)
|
||||
(mapconcat
|
||||
(lambda (sheet)
|
||||
(format
|
||||
"<link rel='stylesheet' href='%s' type='text/css' />" sheet))
|
||||
(plist-get pkg-info :sheets) "\n")
|
||||
(mapconcat
|
||||
(lambda (script)
|
||||
(format
|
||||
"<script src='%s'></script>" script))
|
||||
(plist-get pkg-info :scripts) "\n")
|
||||
(org-html--build-mathjax-config info)
|
||||
"<script>"
|
||||
" $(document).ready(function () { $.deck('.slide'); });"
|
||||
"</script>"
|
||||
(org-html--build-head info)
|
||||
"<style type='text/css'>"
|
||||
org-deck-toc-styles
|
||||
(when (plist-get info :section-numbers)
|
||||
"#table-of-contents ul li {list-style-type: none;}")
|
||||
(format "#%s, #%s {%s}"
|
||||
(nth 2 (assq 'preamble org-html-divs))
|
||||
(nth 2 (assq 'postamble org-html-divs))
|
||||
(nth 1 (assq 'both org-deck-pre/postamble-styles)))
|
||||
(format "#%s {%s}"
|
||||
(nth 2 (assq 'preamble org-html-divs))
|
||||
(nth 1 (assq 'preamble org-deck-pre/postamble-styles)))
|
||||
(format "#%s {%s}"
|
||||
(nth 2 (assq 'postamble org-html-divs))
|
||||
(nth 1 (assq 'postamble org-deck-pre/postamble-styles)))
|
||||
org-deck-styles
|
||||
"</style>"
|
||||
"</head>"
|
||||
"<body>"
|
||||
(format "<%s id='%s' class='deck-container'>"
|
||||
(nth 1 (assq 'content org-html-divs))
|
||||
(nth 2 (assq 'content org-html-divs)))
|
||||
(org-html--build-pre/postamble 'preamble info)
|
||||
;; title page
|
||||
(format "<%s id='title-slide' class='slide'>"
|
||||
(plist-get info :html-container))
|
||||
(format-spec org-deck-title-slide-template (org-html-format-spec info))
|
||||
(format "</%s>" (plist-get info :html-container))
|
||||
;; toc page
|
||||
(let ((depth (plist-get info :with-toc)))
|
||||
(when depth (org-deck-toc depth info)))
|
||||
contents
|
||||
(mapconcat
|
||||
(lambda (snippet)
|
||||
(with-temp-buffer (insert-file-contents snippet)
|
||||
(buffer-string)))
|
||||
(plist-get pkg-info :snippets) "\n")
|
||||
(org-html--build-pre/postamble 'postamble info)
|
||||
(format "</%s>" (nth 1 (assq 'content org-html-divs)))
|
||||
"</body>"
|
||||
"</html>\n") "\n")))
|
||||
|
||||
(defun org-deck--build-meta-info (info)
|
||||
"Return meta tags for exported document.
|
||||
INFO is a plist used as a communication channel."
|
||||
(let* ((title (org-export-data (plist-get info :title) info))
|
||||
(author (and (plist-get info :with-author)
|
||||
(let ((auth (plist-get info :author)))
|
||||
(and auth (org-export-data auth info)))))
|
||||
(date (and (plist-get info :with-date)
|
||||
(let ((date (org-export-get-date info)))
|
||||
(and date (org-export-data date info)))))
|
||||
(description (plist-get info :description))
|
||||
(keywords (plist-get info :keywords)))
|
||||
(mapconcat
|
||||
'identity
|
||||
(list
|
||||
(format "<title>%s</title>" title)
|
||||
(format "<meta http-equiv='Content-Type' content='text/html; charset=%s'/>"
|
||||
(or (and org-html-coding-system
|
||||
(fboundp 'coding-system-get)
|
||||
(coding-system-get
|
||||
org-html-coding-system 'mime-charset))
|
||||
"iso-8859-1"))
|
||||
(mapconcat
|
||||
(lambda (attr)
|
||||
(when (< 0 (length (car attr)))
|
||||
(format "<meta name='%s' content='%s'/>\n"
|
||||
(nth 1 attr) (car attr))))
|
||||
(list '("Org-mode" "generator")
|
||||
`(,author "author")
|
||||
`(,description "description")
|
||||
`(,keywords "keywords")) "")) "\n")))
|
||||
(defun org-deck-export-as-html
|
||||
(&optional async subtreep visible-only body-only ext-plist)
|
||||
"Export current buffer to an HTML buffer.
|
||||
|
||||
If narrowing is active in the current buffer, only export its
|
||||
narrowed part.
|
||||
|
||||
If a region is active, export that region.
|
||||
|
||||
A non-nil optional argument ASYNC means the process should happen
|
||||
asynchronously. The resulting buffer should be accessible
|
||||
through the `org-export-stack' interface.
|
||||
|
||||
When optional argument SUBTREEP is non-nil, export the sub-tree
|
||||
at point, extracting information from the headline properties
|
||||
first.
|
||||
|
||||
When optional argument VISIBLE-ONLY is non-nil, don't export
|
||||
contents of hidden elements.
|
||||
|
||||
When optional argument BODY-ONLY is non-nil, only write code
|
||||
between \"<body>\" and \"</body>\" tags.
|
||||
|
||||
EXT-PLIST, when provided, is a property list with external
|
||||
parameters overriding Org default settings, but still inferior to
|
||||
file-local settings.
|
||||
|
||||
Export is done in a buffer named \"*Org deck.js Export*\", which
|
||||
will be displayed when `org-export-show-temporary-export-buffer'
|
||||
is non-nil."
|
||||
(interactive)
|
||||
(org-export-to-buffer 'deck "*Org deck.js Export*"
|
||||
async subtreep visible-only body-only ext-plist (lambda () (nxml-mode))))
|
||||
|
||||
(defun org-deck-export-to-html
|
||||
(&optional async subtreep visible-only body-only ext-plist)
|
||||
"Export current buffer to a deck.js HTML file.
|
||||
|
||||
If narrowing is active in the current buffer, only export its
|
||||
narrowed part.
|
||||
|
||||
If a region is active, export that region.
|
||||
|
||||
A non-nil optional argument ASYNC means the process should happen
|
||||
asynchronously. The resulting file should be accessible through
|
||||
the `org-export-stack' interface.
|
||||
|
||||
When optional argument SUBTREEP is non-nil, export the sub-tree
|
||||
at point, extracting information from the headline properties
|
||||
first.
|
||||
|
||||
When optional argument VISIBLE-ONLY is non-nil, don't export
|
||||
contents of hidden elements.
|
||||
|
||||
When optional argument BODY-ONLY is non-nil, only write code
|
||||
between \"<body>\" and \"</body>\" tags.
|
||||
|
||||
EXT-PLIST, when provided, is a property list with external
|
||||
parameters overriding Org default settings, but still inferior to
|
||||
file-local settings.
|
||||
|
||||
Return output file's name."
|
||||
(interactive)
|
||||
(let* ((extension (concat "." org-html-extension))
|
||||
(file (org-export-output-file-name extension subtreep))
|
||||
(org-export-coding-system org-html-coding-system))
|
||||
(org-export-to-file 'deck file
|
||||
async subtreep visible-only body-only ext-plist)))
|
||||
|
||||
(defun org-deck-publish-to-html (plist filename pub-dir)
|
||||
"Publish an org file to deck.js HTML Presentation.
|
||||
FILENAME is the filename of the Org file to be published. PLIST
|
||||
is the property list for the given project. PUB-DIR is the
|
||||
publishing directory. Returns output file name."
|
||||
(org-publish-org-to 'deck filename ".html" plist pub-dir))
|
||||
|
||||
(provide 'ox-deck)
|
||||
|
||||
;;; ox-deck.el ends here
|
||||
211
lisp/org-contrib/ox-extra.el
Normal file
211
lisp/org-contrib/ox-extra.el
Normal file
@@ -0,0 +1,211 @@
|
||||
;;; ox-extra.el --- Convenience functions for org export
|
||||
|
||||
;; Copyright (C) 2014, 2021 Aaron Ecay
|
||||
|
||||
;; Author: Aaron Ecay <aaronecay@gmail.com>
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file contains some convenience functions for org export, which
|
||||
;; are not part of org's core. Call `ox-extras-activate' passing a
|
||||
;; list of symbols naming extras, which will be installed globally in
|
||||
;; your org session.
|
||||
;;
|
||||
;; For example, you could include the following in your .emacs file:
|
||||
;;
|
||||
;; (require 'ox-extra)
|
||||
;; (ox-extras-activate '(latex-header-blocks ignore-headlines))
|
||||
;;
|
||||
|
||||
;; Currently available extras:
|
||||
|
||||
;; - `latex-header-blocks' -- allow the use of latex blocks, the
|
||||
;; contents of which which will be interpreted as #+latex_header lines
|
||||
;; for export. These blocks should be tagged with #+header: :header
|
||||
;; yes. For example:
|
||||
;; #+header: :header yes
|
||||
;; #+begin_export latex
|
||||
;; ...
|
||||
;; #+end_export
|
||||
|
||||
;; - `ignore-headlines' -- allow a headline (but not its children) to
|
||||
;; be ignored. Any headline tagged with the 'ignore' tag will be
|
||||
;; ignored (i.e. will not be included in the export), but any child
|
||||
;; headlines will not be ignored (unless explicitly tagged to be
|
||||
;; ignored), and will instead have their levels promoted by one.
|
||||
|
||||
;; TODO:
|
||||
;; - add a function to org-mode-hook that looks for a ox-extras local
|
||||
;; variable and activates the specified extras buffer-locally
|
||||
;; - allow specification of desired extras to be activated via
|
||||
;; customize
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ox)
|
||||
(require 'cl-lib)
|
||||
|
||||
(defun org-latex-header-blocks-filter (backend)
|
||||
(when (org-export-derived-backend-p backend 'latex)
|
||||
(let ((positions
|
||||
(org-element-map (org-element-parse-buffer 'greater-element nil) 'export-block
|
||||
(lambda (block)
|
||||
(when (and (string= (org-element-property :type block) "LATEX")
|
||||
(string= (org-export-read-attribute
|
||||
:header block :header)
|
||||
"yes"))
|
||||
(list (org-element-property :begin block)
|
||||
(org-element-property :end block)
|
||||
(org-element-property :post-affiliated block)))))))
|
||||
(mapc (lambda (pos)
|
||||
(goto-char (nth 2 pos))
|
||||
(cl-destructuring-bind
|
||||
(beg end &rest ignore)
|
||||
;; FIXME: `org-edit-src-find-region-and-lang' was
|
||||
;; removed in 9c06f8cce (2014-11-11).
|
||||
(org-edit-src-find-region-and-lang)
|
||||
(let ((contents-lines (split-string
|
||||
(buffer-substring-no-properties beg end)
|
||||
"\n")))
|
||||
(delete-region (nth 0 pos) (nth 1 pos))
|
||||
(dolist (line contents-lines)
|
||||
(insert (concat "#+latex_header: "
|
||||
(replace-regexp-in-string "\\` *" "" line)
|
||||
"\n"))))))
|
||||
;; go in reverse, to avoid wrecking the numeric positions
|
||||
;; earlier in the file
|
||||
(reverse positions)))))
|
||||
|
||||
|
||||
;; During export headlines which have the "ignore" tag are removed
|
||||
;; from the parse tree. Their contents are retained (leading to a
|
||||
;; possibly invalid parse tree, which nevertheless appears to function
|
||||
;; correctly with most export backends) all children headlines are
|
||||
;; retained and are promoted to the level of the ignored parent
|
||||
;; headline.
|
||||
;;
|
||||
;; This makes it possible to add structure to the original Org-mode
|
||||
;; document which does not effect the exported version, such as in the
|
||||
;; following examples.
|
||||
;;
|
||||
;; Wrapping an abstract in a headline
|
||||
;;
|
||||
;; * Abstract :ignore:
|
||||
;; #+LaTeX: \begin{abstract}
|
||||
;; #+HTML: <div id="abstract">
|
||||
;;
|
||||
;; ...
|
||||
;;
|
||||
;; #+HTML: </div>
|
||||
;; #+LaTeX: \end{abstract}
|
||||
;;
|
||||
;; Placing References under a headline (using ox-bibtex in contrib)
|
||||
;;
|
||||
;; * References :ignore:
|
||||
;; #+BIBLIOGRAPHY: dissertation plain
|
||||
;;
|
||||
;; Inserting an appendix for LaTeX using the appendix package.
|
||||
;;
|
||||
;; * Appendix :ignore:
|
||||
;; #+LaTeX: \begin{appendices}
|
||||
;; ** Reproduction
|
||||
;; ...
|
||||
;; ** Definitions
|
||||
;; #+LaTeX: \end{appendices}
|
||||
;;
|
||||
(defun org-export-ignore-headlines (data backend info)
|
||||
"Remove headlines tagged \"ignore\" retaining contents and promoting children.
|
||||
Each headline tagged \"ignore\" will be removed retaining its
|
||||
contents and promoting any children headlines to the level of the
|
||||
parent."
|
||||
(org-element-map data 'headline
|
||||
(lambda (object)
|
||||
(when (member "ignore" (org-element-property :tags object))
|
||||
(let ((level-top (org-element-property :level object))
|
||||
level-diff)
|
||||
(mapc (lambda (el)
|
||||
;; recursively promote all nested headlines
|
||||
(org-element-map el 'headline
|
||||
(lambda (el)
|
||||
(when (equal 'headline (org-element-type el))
|
||||
(unless level-diff
|
||||
(setq level-diff (- (org-element-property :level el)
|
||||
level-top)))
|
||||
(org-element-put-property el
|
||||
:level (- (org-element-property :level el)
|
||||
level-diff)))))
|
||||
;; insert back into parse tree
|
||||
(org-element-insert-before el object))
|
||||
(org-element-contents object)))
|
||||
(org-element-extract-element object)))
|
||||
info nil)
|
||||
(org-extra--merge-sections data backend info)
|
||||
data)
|
||||
|
||||
(defun org-extra--merge-sections (data _backend info)
|
||||
(org-element-map data 'headline
|
||||
(lambda (hl)
|
||||
(let ((sections
|
||||
(cl-loop
|
||||
for el in (org-element-map (org-element-contents hl)
|
||||
'(headline section) #'identity info)
|
||||
until (eq (org-element-type el) 'headline)
|
||||
collect el)))
|
||||
(when (and sections
|
||||
(> (length sections) 1))
|
||||
(apply #'org-element-adopt-elements
|
||||
(car sections)
|
||||
(cl-mapcan (lambda (s) (org-element-contents s))
|
||||
(cdr sections)))
|
||||
(mapc #'org-element-extract-element (cdr sections)))))
|
||||
info))
|
||||
|
||||
(defconst ox-extras
|
||||
'((latex-header-blocks org-latex-header-blocks-filter org-export-before-parsing-hook)
|
||||
(ignore-headlines org-export-ignore-headlines org-export-filter-parse-tree-functions))
|
||||
"A list of org export extras that can be enabled.
|
||||
|
||||
Should be a list of items of the form (NAME FN HOOK). NAME is a
|
||||
symbol, which can be passed to `ox-extras-activate'. FN is a
|
||||
function which will be added to HOOK.")
|
||||
|
||||
(defun ox-extras-activate (extras)
|
||||
"Activate certain org export extras.
|
||||
|
||||
EXTRAS should be a list of extras (defined in `ox-extras') which
|
||||
should be activated."
|
||||
(dolist (extra extras)
|
||||
(let* ((lst (assq extra ox-extras))
|
||||
(fn (nth 1 lst))
|
||||
(hook (nth 2 lst)))
|
||||
(when (and fn hook)
|
||||
(add-hook hook fn)))))
|
||||
|
||||
(defun ox-extras-deactivate (extras)
|
||||
"Deactivate certain org export extras.
|
||||
|
||||
This function is the opposite of `ox-extras-activate'. EXTRAS
|
||||
should be a list of extras (defined in `ox-extras') which should
|
||||
be activated."
|
||||
(dolist (extra extras)
|
||||
(let* ((lst (assq extra ox-extras))
|
||||
(fn (nth 1 lst))
|
||||
(hook (nth 2 lst)))
|
||||
(when (and fn hook)
|
||||
(remove-hook hook fn)))))
|
||||
|
||||
(provide 'ox-extra)
|
||||
;;; ox-extra.el ends here
|
||||
527
lisp/org-contrib/ox-freemind.el
Normal file
527
lisp/org-contrib/ox-freemind.el
Normal file
@@ -0,0 +1,527 @@
|
||||
;;; ox-freemind.el --- Freemind Mindmap Back-End for Org Export Engine
|
||||
|
||||
;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Jambunathan K <kjambunathan at gmail dot com>
|
||||
;; Keywords: outlines, hypermedia, calendar, wp
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; This program is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This library implements a Freemind Mindmap back-end for Org generic
|
||||
;; exporter.
|
||||
|
||||
;; To test it, run:
|
||||
;;
|
||||
;; M-x org-freemind-export-to-freemind
|
||||
;;
|
||||
;; in an Org mode buffer. See ox.el for more details on how this
|
||||
;; exporter works.
|
||||
|
||||
;;; Code:
|
||||
|
||||
;;; Dependencies
|
||||
|
||||
(require 'ox-html)
|
||||
|
||||
|
||||
|
||||
;;; Define Back-End
|
||||
|
||||
(org-export-define-derived-backend 'freemind 'html
|
||||
:menu-entry
|
||||
'(?f "Export to Freemind Mindmap"
|
||||
((?f "As Freemind Mindmap file" org-freemind-export-to-freemind)
|
||||
(?o "As Freemind Mindmap file and open"
|
||||
(lambda (a s v b)
|
||||
(if a (org-freemind-export-to-freemind t s v b)
|
||||
(org-open-file (org-freemind-export-to-freemind nil s v b)))))))
|
||||
:translate-alist '((headline . org-freemind-headline)
|
||||
(template . org-freemind-template)
|
||||
(inner-template . org-freemind-inner-template)
|
||||
(section . org-freemind-section)
|
||||
(entity . org-freemind-entity))
|
||||
:filters-alist '((:filter-options . org-freemind-options-function)
|
||||
(:filter-final-output . org-freemind-final-function)))
|
||||
|
||||
|
||||
|
||||
;;; User Configuration Variables
|
||||
|
||||
(defgroup org-export-freemind nil
|
||||
"Options for exporting Org mode files to Freemind Mindmap."
|
||||
:tag "Org Export Freemind Mindmap"
|
||||
:group 'org-export)
|
||||
|
||||
(defcustom org-freemind-styles
|
||||
'((default . "<node>\n</node>")
|
||||
(0 . "<node COLOR=\"#000000\">\n<font NAME=\"SansSerif\" SIZE=\"20\"/>\n</node>")
|
||||
(1 . "<node COLOR=\"#0033ff\">\n<edge STYLE=\"sharp_bezier\" WIDTH=\"8\"/>\n<font NAME=\"SansSerif\" SIZE=\"18\"/>\n</node>")
|
||||
(2 . "<node COLOR=\"#00b439\">\n<edge STYLE=\"bezier\" WIDTH=\"thin\"/>\n<font NAME=\"SansSerif\" SIZE=\"16\"/>\n</node>")
|
||||
(3 . "<node COLOR=\"#990000\" FOLDED=\"true\">\n<font NAME=\"SansSerif\" SIZE=\"14\"/>\n</node>")
|
||||
(4 . "<node COLOR=\"#111111\">\n</node>"))
|
||||
"List of Freemind node styles.
|
||||
Each entry is of the form (STYLE-NAME . STYLE-SPEC). STYLE-NAME
|
||||
can be one of an integer (signifying an outline level), a string
|
||||
or the symbol `default'. STYLE-SPEC, a string, is a Freemind
|
||||
node style."
|
||||
:type '(alist :options (default 0 1 2 3)
|
||||
:key-type (choice :tag "Style tag"
|
||||
(integer :tag "Outline level")
|
||||
(const :tag "Default value" default)
|
||||
(string :tag "Node style"))
|
||||
:value-type (string :tag "Style spec"))
|
||||
:group 'org-export-freemind)
|
||||
|
||||
(defcustom org-freemind-style-map-function 'org-freemind-style-map--automatic
|
||||
"Function to map an Org element to it's node style.
|
||||
The mapping function takes two arguments an Org ELEMENT and INFO.
|
||||
ELEMENT can be one of the following types - `org-data',
|
||||
`headline' or `section'. INFO is a plist holding contextual
|
||||
information during export. The function must return a STYLE-SPEC
|
||||
to be applied to ELEMENT.
|
||||
|
||||
See `org-freemind-style-map--automatic' for a sample style
|
||||
function. See `org-freemind-styles' for a list of named styles."
|
||||
:type '(radio
|
||||
(function-item org-freemind-style-map--automatic)
|
||||
(function-item org-freemind-style-map--default)
|
||||
function)
|
||||
:group 'org-export-freemind)
|
||||
|
||||
(defcustom org-freemind-section-format 'note
|
||||
"Specify how outline sections are to be formatted.
|
||||
If `inline', append it to the contents of it's heading node. If
|
||||
`note', attach it as a note to it's heading node. If `node',
|
||||
attach it as a separate node to it's heading node.
|
||||
|
||||
Use `note', if the input Org file contains large sections. Use
|
||||
`node', if the Org file contains mid-sized sections that need to
|
||||
stand apart. Otherwise, use `inline'."
|
||||
:type '(choice
|
||||
(const :tag "Append to outline title" inline)
|
||||
(const :tag "Attach as a note" note)
|
||||
(const :tag "Create a separate node" node))
|
||||
:group 'org-export-freemind)
|
||||
|
||||
;;;; Debugging
|
||||
|
||||
(defcustom org-freemind-pretty-output nil
|
||||
"Enable this to generate pretty Freemind Mindmap."
|
||||
:type 'boolean
|
||||
:group 'org-export-freemind)
|
||||
|
||||
|
||||
;;; Internal Functions
|
||||
|
||||
;;;; XML Manipulation
|
||||
|
||||
(defun org-freemind--serialize (parsed-xml &optional contents)
|
||||
"Convert PARSED-XML in to XML string.
|
||||
PARSED-XML is a parse tree as returned by
|
||||
`libxml-parse-xml-region'. CONTENTS is an optional string.
|
||||
|
||||
Ignore CONTENTS, if PARSED-XML is not a sole XML element.
|
||||
Otherwise, append CONTENTS to the contents of top-level element
|
||||
in PARSED-XML.
|
||||
|
||||
This is an inverse function of `libxml-parse-xml-region'.
|
||||
|
||||
For purposes of Freemind export, PARSED-XML is a node style
|
||||
specification - \"<node ...>...</node>\" - as a parse tree."
|
||||
(when contents
|
||||
(assert (symbolp (car parsed-xml))))
|
||||
(cond
|
||||
((null parsed-xml) "")
|
||||
((stringp parsed-xml) parsed-xml)
|
||||
((symbolp (car parsed-xml))
|
||||
(let ((attributes (mapconcat
|
||||
(lambda (av)
|
||||
(format "%s=\"%s\"" (car av) (cdr av)))
|
||||
(cadr parsed-xml) " ")))
|
||||
(if (or (cddr parsed-xml) contents)
|
||||
(format "\n<%s%s>%s\n</%s>"
|
||||
(car parsed-xml)
|
||||
(if (string= attributes "") "" (concat " " attributes))
|
||||
(concat (org-freemind--serialize (cddr parsed-xml))
|
||||
contents )
|
||||
(car parsed-xml))
|
||||
(format "\n<%s%s/>"
|
||||
(car parsed-xml)
|
||||
(if (string= attributes "") "" (concat " " attributes))))))
|
||||
(t (mapconcat #'org-freemind--serialize parsed-xml ""))))
|
||||
|
||||
(defun org-freemind--parse-xml (xml-string)
|
||||
"Return parse tree for XML-STRING using `libxml-parse-xml-region'.
|
||||
For purposes of Freemind export, XML-STRING is a node style
|
||||
specification - \"<node ...>...</node>\" - as a string."
|
||||
(with-temp-buffer
|
||||
(insert (or xml-string ""))
|
||||
(libxml-parse-xml-region (point-min) (point-max))))
|
||||
|
||||
|
||||
;;;; Style mappers :: Default and Automatic layout
|
||||
|
||||
(defun org-freemind-style-map--automatic (element info)
|
||||
"Return a node style corresponding to relative outline level of ELEMENT.
|
||||
ELEMENT can be any of the following types - `org-data',
|
||||
`headline' or `section'. See `org-freemind-styles' for style
|
||||
mappings of different outline levels."
|
||||
(let ((style-name
|
||||
(case (org-element-type element)
|
||||
(headline
|
||||
(org-export-get-relative-level element info))
|
||||
(section
|
||||
(let ((parent (org-export-get-parent-headline element)))
|
||||
(if (not parent) 1
|
||||
(1+ (org-export-get-relative-level parent info)))))
|
||||
(t 0))))
|
||||
(or (assoc-default style-name org-freemind-styles)
|
||||
(assoc-default 'default org-freemind-styles)
|
||||
"<node></node>")))
|
||||
|
||||
(defun org-freemind-style-map--default (element info)
|
||||
"Return the default style for all ELEMENTs.
|
||||
ELEMENT can be any of the following types - `org-data',
|
||||
`headline' or `section'. See `org-freemind-styles' for current
|
||||
value of default style."
|
||||
(or (assoc-default 'default org-freemind-styles)
|
||||
"<node></node>"))
|
||||
|
||||
|
||||
;;;; Helpers :: Retrieve, apply Freemind styles
|
||||
|
||||
(defun org-freemind--get-node-style (element info)
|
||||
"Return Freemind node style applicable for HEADLINE.
|
||||
ELEMENT is an Org element of type `org-data', `headline' or
|
||||
`section'. INFO is a plist holding contextual information."
|
||||
(unless (fboundp org-freemind-style-map-function)
|
||||
(setq org-freemind-style-map-function 'org-freemind-style-map--default))
|
||||
(let ((style (funcall org-freemind-style-map-function element info)))
|
||||
;; Sanitize node style.
|
||||
|
||||
;; Loop through the attributes of node element and purge those
|
||||
;; attributes that look suspicious. This is an extra bit of work
|
||||
;; that allows one to copy verbatim node styles from an existing
|
||||
;; Freemind Mindmap file without messing with the exported data.
|
||||
(let* ((data (org-freemind--parse-xml style))
|
||||
(attributes (cadr data))
|
||||
(ignored-attrs '(POSITION FOLDED TEXT CREATED ID
|
||||
MODIFIED)))
|
||||
(let (attr)
|
||||
(while (setq attr (pop ignored-attrs))
|
||||
(setq attributes (assq-delete-all attr attributes))))
|
||||
(when data (setcar (cdr data) attributes))
|
||||
(org-freemind--serialize data))))
|
||||
|
||||
(defun org-freemind--build-stylized-node (style-1 style-2 &optional contents)
|
||||
"Build a Freemind node with style STYLE-1 + STYLE-2 and add CONTENTS to it.
|
||||
STYLE-1 and STYLE-2 are Freemind node styles as a string.
|
||||
STYLE-1 is the base node style and STYLE-2 is the overriding
|
||||
style that takes precedence over STYLE-1. CONTENTS is a string.
|
||||
|
||||
Return value is a Freemind node with following properties:
|
||||
|
||||
1. The attributes of \"<node ...> </node>\" element is the union
|
||||
of corresponding attributes of STYLE-1 and STYLE-2. When
|
||||
STYLE-1 and STYLE-2 specify values for the same attribute
|
||||
name, choose the attribute value from STYLE-2.
|
||||
|
||||
2. The children of \"<node ...> </node>\" element is the union of
|
||||
top-level children of STYLE-1 and STYLE-2 with CONTENTS
|
||||
appended to it. When STYLE-1 and STYLE-2 share a child
|
||||
element of same type, the value chosen is that from STYLE-2.
|
||||
|
||||
For example, merging with following parameters
|
||||
|
||||
STYLE-1 =>
|
||||
<node COLOR=\"#00b439\" STYLE=\"Bubble\">
|
||||
<edge STYLE=\"bezier\" WIDTH=\"thin\"/>
|
||||
<font NAME=\"SansSerif\" SIZE=\"16\"/>
|
||||
</node>
|
||||
|
||||
STYLE-2 =>
|
||||
<node COLOR=\"#990000\" FOLDED=\"true\">
|
||||
<font NAME=\"SansSerif\" SIZE=\"14\"/>
|
||||
</node>
|
||||
|
||||
CONTENTS =>
|
||||
<attribute NAME=\"ORGTAG\" VALUE=\"@home\"/>
|
||||
|
||||
will result in following node:
|
||||
|
||||
RETURN =>
|
||||
<node STYLE=\"Bubble\" COLOR=\"#990000\" FOLDED=\"true\">
|
||||
<edge STYLE=\"bezier\" WIDTH=\"thin\"/>
|
||||
<font NAME=\"SansSerif\" SIZE=\"14\"/>
|
||||
<attribute NAME=\"ORGTAG\" VALUE=\"@home\"/>
|
||||
</node>."
|
||||
(let* ((data1 (org-freemind--parse-xml (or style-1 "")))
|
||||
(data2 (org-freemind--parse-xml (or style-2 "")))
|
||||
(attr1 (cadr data1))
|
||||
(attr2 (cadr data2))
|
||||
(merged-attr attr2)
|
||||
(children1 (cddr data1))
|
||||
(children2 (cddr data2))
|
||||
(merged-children children2))
|
||||
(let (attr)
|
||||
(while (setq attr (pop attr1))
|
||||
(unless (assq (car attr) merged-attr)
|
||||
(push attr merged-attr))))
|
||||
(let (child)
|
||||
(while (setq child (pop children1))
|
||||
(when (or (stringp child) (not (assq (car child) merged-children)))
|
||||
(push child merged-children))))
|
||||
(let ((merged-data (nconc (list 'node merged-attr) merged-children)))
|
||||
(org-freemind--serialize merged-data contents))))
|
||||
|
||||
|
||||
;;;; Helpers :: Node contents
|
||||
|
||||
(defun org-freemind--richcontent (type contents &optional css-style)
|
||||
(let* ((type (case type
|
||||
(note "NOTE")
|
||||
(node "NODE")
|
||||
(t "NODE")))
|
||||
(contents (org-trim contents)))
|
||||
(if (string= (org-trim contents) "") ""
|
||||
(format "\n<richcontent TYPE=\"%s\">%s\n</richcontent>"
|
||||
type
|
||||
(format "\n<html>\n<head>%s\n</head>\n%s\n</html>"
|
||||
(or css-style "")
|
||||
(format "<body>\n%s\n</body>" contents))))))
|
||||
|
||||
(defun org-freemind--build-node-contents (element contents info)
|
||||
(let* ((title (case (org-element-type element)
|
||||
(headline
|
||||
(org-element-property :title element))
|
||||
(org-data
|
||||
(plist-get info :title))
|
||||
(t (error "Shouldn't come here"))))
|
||||
(element-contents (org-element-contents element))
|
||||
(section (assq 'section element-contents))
|
||||
(section-contents
|
||||
(let ((backend (org-export-create-backend
|
||||
:parent (org-export-backend-name
|
||||
(plist-get info :back-end))
|
||||
:transcoders '((section . (lambda (e c i) c))))))
|
||||
(org-export-data-with-backend section backend info)))
|
||||
(itemized-contents-p (let ((first-child-headline
|
||||
(org-element-map element-contents
|
||||
'headline 'identity info t)))
|
||||
(when first-child-headline
|
||||
(org-export-low-level-p first-child-headline
|
||||
info))))
|
||||
(node-contents (concat section-contents
|
||||
(when itemized-contents-p
|
||||
contents))))
|
||||
(concat (let ((title (org-export-data title info)))
|
||||
(case org-freemind-section-format
|
||||
(inline
|
||||
(org-freemind--richcontent
|
||||
'node (concat (format "\n<h2>%s</h2>" title)
|
||||
node-contents) ))
|
||||
(note
|
||||
(concat (org-freemind--richcontent
|
||||
'node (format "\n<p>%s\n</p>" title))
|
||||
(org-freemind--richcontent
|
||||
'note node-contents)))
|
||||
(node
|
||||
(concat
|
||||
(org-freemind--richcontent
|
||||
'node (format "\n<p>%s\n</p>" title))
|
||||
(when section
|
||||
(org-freemind--build-stylized-node
|
||||
(org-freemind--get-node-style section info) nil
|
||||
(org-freemind--richcontent 'node node-contents)))))))
|
||||
(unless itemized-contents-p
|
||||
contents))))
|
||||
|
||||
|
||||
|
||||
;;; Template
|
||||
|
||||
(defun org-freemind-template (contents info)
|
||||
"Return complete document string after Freemind Mindmap conversion.
|
||||
CONTENTS is the transcoded contents string. RAW-DATA is the
|
||||
original parsed data. INFO is a plist holding export options."
|
||||
(format
|
||||
"<map version=\"0.9.0\">\n%s\n</map>"
|
||||
(org-freemind--build-stylized-node
|
||||
(org-freemind--get-node-style nil info) nil
|
||||
(let ((org-data (plist-get info :parse-tree)))
|
||||
(org-freemind--build-node-contents org-data contents info)))))
|
||||
|
||||
(defun org-freemind-inner-template (contents info)
|
||||
"Return body of document string after Freemind Mindmap conversion.
|
||||
CONTENTS is the transcoded contents string. INFO is a plist
|
||||
holding export options."
|
||||
contents)
|
||||
|
||||
;;;; Tags
|
||||
|
||||
(defun org-freemind--tags (tags)
|
||||
(mapconcat (lambda (tag)
|
||||
(format "\n<attribute NAME=\"%s\" VALUE=\"%s\"/>" tag ""))
|
||||
tags "\n"))
|
||||
|
||||
|
||||
|
||||
;;; Transcode Functions
|
||||
|
||||
;;;; Entity
|
||||
|
||||
(defun org-freemind-entity (entity contents info)
|
||||
"Transcode an ENTITY object from Org to Freemind Mindmap.
|
||||
CONTENTS are the definition itself. INFO is a plist holding
|
||||
contextual information."
|
||||
(org-element-property :utf-8 entity))
|
||||
|
||||
;;;; Headline
|
||||
|
||||
(defun org-freemind-headline (headline contents info)
|
||||
"Transcode a HEADLINE element from Org to Freemind Mindmap.
|
||||
CONTENTS holds the contents of the headline. INFO is a plist
|
||||
holding contextual information."
|
||||
;; Empty contents?
|
||||
(setq contents (or contents ""))
|
||||
(let* ((numberedp (org-export-numbered-headline-p headline info))
|
||||
(level (org-export-get-relative-level headline info))
|
||||
(text (org-export-data (org-element-property :title headline) info))
|
||||
(todo (and (plist-get info :with-todo-keywords)
|
||||
(let ((todo (org-element-property :todo-keyword headline)))
|
||||
(and todo (org-export-data todo info)))))
|
||||
(todo-type (and todo (org-element-property :todo-type headline)))
|
||||
(tags (and (plist-get info :with-tags)
|
||||
(org-export-get-tags headline info)))
|
||||
(priority (and (plist-get info :with-priority)
|
||||
(org-element-property :priority headline)))
|
||||
(section-number (and (not (org-export-low-level-p headline info))
|
||||
(org-export-numbered-headline-p headline info)
|
||||
(mapconcat 'number-to-string
|
||||
(org-export-get-headline-number
|
||||
headline info) ".")))
|
||||
;; Create the headline text.
|
||||
(full-text (org-export-data (org-element-property :title headline)
|
||||
info))
|
||||
;; Headline order (i.e, first digit of the section number)
|
||||
(headline-order (car (org-export-get-headline-number headline info))))
|
||||
(cond
|
||||
;; Case 1: This is a footnote section: ignore it.
|
||||
((org-element-property :footnote-section-p headline) nil)
|
||||
;; Case 2. This is a deep sub-tree, export it as a list item.
|
||||
;; Delegate the actual export to `html' backend.
|
||||
((org-export-low-level-p headline info)
|
||||
(org-html-headline headline contents info))
|
||||
;; Case 3. Standard headline. Export it as a section.
|
||||
(t
|
||||
(let* ((section-number (mapconcat 'number-to-string
|
||||
(org-export-get-headline-number
|
||||
headline info) "-"))
|
||||
(ids (remove 'nil
|
||||
(list (org-element-property :CUSTOM_ID headline)
|
||||
(concat "sec-" section-number)
|
||||
(org-element-property :ID headline))))
|
||||
(preferred-id (car ids))
|
||||
(extra-ids (cdr ids))
|
||||
(left-p (zerop (% headline-order 2))))
|
||||
(org-freemind--build-stylized-node
|
||||
(org-freemind--get-node-style headline info)
|
||||
(format "<node ID=\"%s\" POSITION=\"%s\" FOLDED=\"%s\">\n</node>"
|
||||
preferred-id
|
||||
(if left-p "left" "right")
|
||||
(if (= level 1) "true" "false"))
|
||||
(concat (org-freemind--build-node-contents headline contents info)
|
||||
(org-freemind--tags tags))))))))
|
||||
|
||||
|
||||
;;;; Section
|
||||
|
||||
(defun org-freemind-section (section contents info)
|
||||
"Transcode a SECTION element from Org to Freemind Mindmap.
|
||||
CONTENTS holds the contents of the section. INFO is a plist
|
||||
holding contextual information."
|
||||
(let ((parent (org-export-get-parent-headline section)))
|
||||
(when (and parent (org-export-low-level-p parent info))
|
||||
contents)))
|
||||
|
||||
|
||||
|
||||
;;; Filter Functions
|
||||
|
||||
(defun org-freemind-final-function (contents backend info)
|
||||
"Return CONTENTS as pretty XML using `indent-region'."
|
||||
(if (not org-freemind-pretty-output) contents
|
||||
(with-temp-buffer
|
||||
(nxml-mode)
|
||||
(insert contents)
|
||||
(indent-region (point-min) (point-max))
|
||||
(buffer-substring-no-properties (point-min) (point-max)))))
|
||||
|
||||
(defun org-freemind-options-function (info backend)
|
||||
"Install script in export options when appropriate.
|
||||
EXP-PLIST is a plist containing export options. BACKEND is the
|
||||
export back-end currently used."
|
||||
;; Freemind/Freeplane doesn't seem to like named html entities in
|
||||
;; richcontent. For now, turn off smart quote processing so that
|
||||
;; entities like "’" & friends are avoided in the exported
|
||||
;; output.
|
||||
(plist-put info :with-smart-quotes nil))
|
||||
|
||||
|
||||
|
||||
;;; End-user functions
|
||||
|
||||
;;;###autoload
|
||||
(defun org-freemind-export-to-freemind
|
||||
(&optional async subtreep visible-only body-only ext-plist)
|
||||
"Export current buffer to a Freemind Mindmap file.
|
||||
|
||||
If narrowing is active in the current buffer, only export its
|
||||
narrowed part.
|
||||
|
||||
If a region is active, export that region.
|
||||
|
||||
A non-nil optional argument ASYNC means the process should happen
|
||||
asynchronously. The resulting file should be accessible through
|
||||
the `org-export-stack' interface.
|
||||
|
||||
When optional argument SUBTREEP is non-nil, export the sub-tree
|
||||
at point, extracting information from the headline properties
|
||||
first.
|
||||
|
||||
When optional argument VISIBLE-ONLY is non-nil, don't export
|
||||
contents of hidden elements.
|
||||
|
||||
When optional argument BODY-ONLY is non-nil, only write code
|
||||
between \"<body>\" and \"</body>\" tags.
|
||||
|
||||
EXT-PLIST, when provided, is a property list with external
|
||||
parameters overriding Org default settings, but still inferior to
|
||||
file-local settings.
|
||||
|
||||
Return output file's name."
|
||||
(interactive)
|
||||
(let* ((extension (concat ".mm" ))
|
||||
(file (org-export-output-file-name extension subtreep))
|
||||
(org-export-coding-system 'utf-8))
|
||||
(org-export-to-file 'freemind file
|
||||
async subtreep visible-only body-only ext-plist)))
|
||||
|
||||
(provide 'ox-freemind)
|
||||
|
||||
;;; ox-freemind.el ends here
|
||||
1960
lisp/org-contrib/ox-groff.el
Normal file
1960
lisp/org-contrib/ox-groff.el
Normal file
File diff suppressed because it is too large
Load Diff
421
lisp/org-contrib/ox-rss.el
Normal file
421
lisp/org-contrib/ox-rss.el
Normal file
@@ -0,0 +1,421 @@
|
||||
;;; ox-rss.el --- RSS 2.0 Back-End for Org Export Engine
|
||||
|
||||
;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Bastien Guerry <bzg@gnu.org>
|
||||
;; Maintainer: Bastien Guerry <bzg@gnu.org>
|
||||
;; Keywords: org, wp, blog, feed, rss
|
||||
;; Homepage: https://gitlab.com/nsavage/ox-rss
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; This program is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This library implements an RSS 2.0 back-end for Org exporter, based
|
||||
;; on the `html' back-end.
|
||||
;;
|
||||
;; It requires Emacs 24.1 at least.
|
||||
;;
|
||||
;; It provides two commands for export, depending on the desired output:
|
||||
;; `org-rss-export-as-rss' (temporary buffer) and `org-rss-export-to-rss'
|
||||
;; (as a ".xml" file).
|
||||
;;
|
||||
;; This backend understands three new option keywords:
|
||||
;;
|
||||
;; #+RSS_EXTENSION: xml
|
||||
;; #+RSS_IMAGE_URL: https://myblog.org/mypicture.jpg
|
||||
;; #+RSS_FEED_URL: https://myblog.org/feeds/blog.xml
|
||||
;;
|
||||
;; It uses #+HTML_LINK_HOME: to set the base url of the feed.
|
||||
;;
|
||||
;; Exporting an Org file to RSS modifies each top-level entry by adding a
|
||||
;; PUBDATE property. If `org-rss-use-entry-url-as-guid', it will also add
|
||||
;; an ID property, later used as the guid for the feed's item.
|
||||
;;
|
||||
;; The top-level headline is used as the title of each RSS item unless
|
||||
;; an RSS_TITLE property is set on the headline.
|
||||
;;
|
||||
;; You typically want to use it within a publishing project like this:
|
||||
;;
|
||||
;; (add-to-list
|
||||
;; 'org-publish-project-alist
|
||||
;; '("homepage_rss"
|
||||
;; :base-directory "~/myhomepage/"
|
||||
;; :base-extension "org"
|
||||
;; :rss-image-url "http://lumiere.ens.fr/~guerry/images/faces/15.png"
|
||||
;; :html-link-home "http://lumiere.ens.fr/~guerry/"
|
||||
;; :html-link-use-abs-url t
|
||||
;; :rss-extension "xml"
|
||||
;; :publishing-directory "/home/guerry/public_html/"
|
||||
;; :publishing-function (org-rss-publish-to-rss)
|
||||
;; :section-numbers nil
|
||||
;; :exclude ".*" ;; To exclude all files...
|
||||
;; :include ("index.org") ;; ... except index.org.
|
||||
;; :table-of-contents nil))
|
||||
;;
|
||||
;; ... then rsync /home/guerry/public_html/ with your server.
|
||||
;;
|
||||
;; By default, the permalink for a blog entry points to the headline.
|
||||
;; You can specify a different one by using the :RSS_PERMALINK:
|
||||
;; property within an entry.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ox-html)
|
||||
(declare-function url-encode-url "url-util" (url))
|
||||
|
||||
;;; Variables and options
|
||||
|
||||
(defgroup org-export-rss nil
|
||||
"Options specific to RSS export back-end."
|
||||
:tag "Org RSS"
|
||||
:group 'org-export
|
||||
:version "24.4"
|
||||
:package-version '(Org . "8.0"))
|
||||
|
||||
(defcustom org-rss-image-url "https://orgmode.org/img/org-mode-unicorn-logo.png"
|
||||
"The URL of the image for the RSS feed."
|
||||
:group 'org-export-rss
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-rss-extension "xml"
|
||||
"File extension for the RSS 2.0 feed."
|
||||
:group 'org-export-rss
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-rss-categories 'from-tags
|
||||
"Where to extract items category information from.
|
||||
The default is to extract categories from the tags of the
|
||||
headlines. When set to another value, extract the category
|
||||
from the :CATEGORY: property of the entry."
|
||||
:group 'org-export-rss
|
||||
:type '(choice
|
||||
(const :tag "From tags" from-tags)
|
||||
(const :tag "From the category property" from-category)))
|
||||
|
||||
(defcustom org-rss-use-entry-url-as-guid t
|
||||
"Use the URL for the <guid> metatag?
|
||||
When nil, Org will create ids using `org-icalendar-create-uid'."
|
||||
:group 'org-export-rss
|
||||
:type 'boolean)
|
||||
|
||||
;;; Define backend
|
||||
|
||||
(org-export-define-derived-backend 'rss 'html
|
||||
:menu-entry
|
||||
'(?r "Export to RSS"
|
||||
((?R "As RSS buffer"
|
||||
(lambda (a s v b) (org-rss-export-as-rss a s v)))
|
||||
(?r "As RSS file" (lambda (a s v b) (org-rss-export-to-rss a s v)))
|
||||
(?o "As RSS file and open"
|
||||
(lambda (a s v b)
|
||||
(if a (org-rss-export-to-rss t s v)
|
||||
(org-open-file (org-rss-export-to-rss nil s v)))))))
|
||||
:options-alist
|
||||
'((:description "DESCRIPTION" nil nil newline)
|
||||
(:keywords "KEYWORDS" nil nil space)
|
||||
(:with-toc nil nil nil) ;; Never include HTML's toc
|
||||
(:rss-extension "RSS_EXTENSION" nil org-rss-extension)
|
||||
(:rss-image-url "RSS_IMAGE_URL" nil org-rss-image-url)
|
||||
(:rss-feed-url "RSS_FEED_URL" nil nil t)
|
||||
(:rss-categories nil nil org-rss-categories))
|
||||
:filters-alist '((:filter-final-output . org-rss-final-function))
|
||||
:translate-alist '((headline . org-rss-headline)
|
||||
(comment . (lambda (&rest args) ""))
|
||||
(comment-block . (lambda (&rest args) ""))
|
||||
(timestamp . (lambda (&rest args) ""))
|
||||
(plain-text . org-rss-plain-text)
|
||||
(section . org-rss-section)
|
||||
(template . org-rss-template)))
|
||||
|
||||
;;; Export functions
|
||||
|
||||
;;;###autoload
|
||||
(defun org-rss-export-as-rss (&optional async subtreep visible-only)
|
||||
"Export current buffer to an RSS buffer.
|
||||
|
||||
If narrowing is active in the current buffer, only export its
|
||||
narrowed part.
|
||||
|
||||
If a region is active, export that region.
|
||||
|
||||
A non-nil optional argument ASYNC means the process should happen
|
||||
asynchronously. The resulting buffer should be accessible
|
||||
through the `org-export-stack' interface.
|
||||
|
||||
When optional argument SUBTREEP is non-nil, export the sub-tree
|
||||
at point, extracting information from the headline properties
|
||||
first.
|
||||
|
||||
When optional argument VISIBLE-ONLY is non-nil, don't export
|
||||
contents of hidden elements.
|
||||
|
||||
Export is done in a buffer named \"*Org RSS Export*\", which will
|
||||
be displayed when `org-export-show-temporary-export-buffer' is
|
||||
non-nil."
|
||||
(interactive)
|
||||
(let ((file (buffer-file-name (buffer-base-buffer))))
|
||||
(org-icalendar-create-uid file 'warn-user)
|
||||
(org-rss-add-pubdate-property))
|
||||
(org-export-to-buffer 'rss "*Org RSS Export*"
|
||||
async subtreep visible-only nil nil (lambda () (text-mode))))
|
||||
|
||||
;;;###autoload
|
||||
(defun org-rss-export-to-rss (&optional async subtreep visible-only)
|
||||
"Export current buffer to an RSS file.
|
||||
|
||||
If narrowing is active in the current buffer, only export its
|
||||
narrowed part.
|
||||
|
||||
If a region is active, export that region.
|
||||
|
||||
A non-nil optional argument ASYNC means the process should happen
|
||||
asynchronously. The resulting file should be accessible through
|
||||
the `org-export-stack' interface.
|
||||
|
||||
When optional argument SUBTREEP is non-nil, export the sub-tree
|
||||
at point, extracting information from the headline properties
|
||||
first.
|
||||
|
||||
When optional argument VISIBLE-ONLY is non-nil, don't export
|
||||
contents of hidden elements.
|
||||
|
||||
Return output file's name."
|
||||
(interactive)
|
||||
(let ((file (buffer-file-name (buffer-base-buffer))))
|
||||
(org-icalendar-create-uid file 'warn-user)
|
||||
(org-rss-add-pubdate-property))
|
||||
(let ((outfile (org-export-output-file-name
|
||||
(concat "." org-rss-extension) subtreep)))
|
||||
(org-export-to-file 'rss outfile async subtreep visible-only)))
|
||||
|
||||
;;;###autoload
|
||||
(defun org-rss-publish-to-rss (plist filename pub-dir)
|
||||
"Publish an org file to RSS.
|
||||
|
||||
FILENAME is the filename of the Org file to be published. PLIST
|
||||
is the property list for the given project. PUB-DIR is the
|
||||
publishing directory.
|
||||
|
||||
Return output file name."
|
||||
(let ((bf (get-file-buffer filename)))
|
||||
(if bf
|
||||
(with-current-buffer bf
|
||||
(org-icalendar-create-uid filename 'warn-user)
|
||||
(org-rss-add-pubdate-property)
|
||||
(write-file filename))
|
||||
(find-file filename)
|
||||
(org-icalendar-create-uid filename 'warn-user)
|
||||
(org-rss-add-pubdate-property)
|
||||
(write-file filename) (kill-buffer)))
|
||||
(org-publish-org-to
|
||||
'rss filename (concat "." org-rss-extension) plist pub-dir))
|
||||
|
||||
;;; Main transcoding functions
|
||||
|
||||
(defun org-rss-headline (headline contents info)
|
||||
"Transcode HEADLINE element into RSS format.
|
||||
CONTENTS is the headline contents. INFO is a plist used as a
|
||||
communication channel."
|
||||
(if (> (org-export-get-relative-level headline info) 1)
|
||||
(org-export-data-with-backend headline 'html info)
|
||||
(unless (org-element-property :footnote-section-p headline)
|
||||
(let* ((email (org-export-data (plist-get info :email) info))
|
||||
(author (and (plist-get info :with-author)
|
||||
(let ((auth (plist-get info :author)))
|
||||
(and auth (org-export-data auth info)))))
|
||||
(htmlext (plist-get info :html-extension))
|
||||
(hl-number (org-export-get-headline-number headline info))
|
||||
(hl-home (file-name-as-directory (plist-get info :html-link-home)))
|
||||
(hl-pdir (plist-get info :publishing-directory))
|
||||
(hl-perm (org-element-property :RSS_PERMALINK headline))
|
||||
(anchor (org-export-get-reference headline info))
|
||||
(category (org-rss-plain-text
|
||||
(or (org-element-property :CATEGORY headline) "") info))
|
||||
(pubdate0 (org-element-property :PUBDATE headline))
|
||||
(pubdate (let ((system-time-locale "C"))
|
||||
(if (and pubdate0 (not (string-empty-p pubdate0)))
|
||||
(format-time-string
|
||||
"%a, %d %b %Y %H:%M:%S %z"
|
||||
(org-time-string-to-time pubdate0)))))
|
||||
(title (org-rss-plain-text
|
||||
(or (org-element-property :RSS_TITLE headline)
|
||||
(replace-regexp-in-string
|
||||
org-bracket-link-regexp
|
||||
(lambda (m) (or (match-string 3 m)
|
||||
(match-string 1 m)))
|
||||
(org-element-property :raw-value headline))) info))
|
||||
(publink
|
||||
(or (and hl-perm (concat (or hl-home hl-pdir) hl-perm))
|
||||
(concat
|
||||
(or hl-home hl-pdir)
|
||||
(file-name-nondirectory
|
||||
(file-name-sans-extension
|
||||
(plist-get info :input-file))) "." htmlext "#" anchor)))
|
||||
(guid (if org-rss-use-entry-url-as-guid
|
||||
publink
|
||||
(org-rss-plain-text
|
||||
(or (org-element-property :ID headline)
|
||||
(org-element-property :CUSTOM_ID headline)
|
||||
publink)
|
||||
info))))
|
||||
(if (not pubdate) "" ;; Skip entries with no PUBDATE prop
|
||||
(format
|
||||
(concat
|
||||
"<item>\n"
|
||||
"<title>%s</title>\n"
|
||||
"<link>%s</link>\n"
|
||||
"<author>%s (%s)</author>\n"
|
||||
"<guid isPermaLink=\"false\">%s</guid>\n"
|
||||
"<pubDate>%s</pubDate>\n"
|
||||
(org-rss-build-categories headline info) "\n"
|
||||
"<description><![CDATA[%s]]></description>\n"
|
||||
"</item>\n")
|
||||
title publink email author guid pubdate contents))))))
|
||||
|
||||
(defun org-rss-build-categories (headline info)
|
||||
"Build categories for the RSS item."
|
||||
(if (eq (plist-get info :rss-categories) 'from-tags)
|
||||
(mapconcat
|
||||
(lambda (c) (format "<category><![CDATA[%s]]></category>" c))
|
||||
(org-element-property :tags headline)
|
||||
"\n")
|
||||
(let ((c (org-element-property :CATEGORY headline)))
|
||||
(format "<category><![CDATA[%s]]></category>" c))))
|
||||
|
||||
(defun org-rss-template (contents info)
|
||||
"Return complete document string after RSS conversion.
|
||||
CONTENTS is the transcoded contents string. INFO is a plist used
|
||||
as a communication channel."
|
||||
(concat
|
||||
(format "<?xml version=\"1.0\" encoding=\"%s\"?>"
|
||||
(symbol-name org-html-coding-system))
|
||||
"\n<rss version=\"2.0\"
|
||||
xmlns:content=\"http://purl.org/rss/1.0/modules/content/\"
|
||||
xmlns:wfw=\"http://wellformedweb.org/CommentAPI/\"
|
||||
xmlns:dc=\"http://purl.org/dc/elements/1.1/\"
|
||||
xmlns:atom=\"http://www.w3.org/2005/Atom\"
|
||||
xmlns:sy=\"http://purl.org/rss/1.0/modules/syndication/\"
|
||||
xmlns:slash=\"http://purl.org/rss/1.0/modules/slash/\"
|
||||
xmlns:georss=\"http://www.georss.org/georss\"
|
||||
xmlns:geo=\"http://www.w3.org/2003/01/geo/wgs84_pos#\"
|
||||
xmlns:media=\"http://search.yahoo.com/mrss/\">"
|
||||
"<channel>"
|
||||
(org-rss-build-channel-info info) "\n"
|
||||
contents
|
||||
"</channel>\n"
|
||||
"</rss>"))
|
||||
|
||||
(defun org-rss-build-channel-info (info)
|
||||
"Build the RSS channel information."
|
||||
(let* ((system-time-locale "C")
|
||||
(title (org-export-data (plist-get info :title) info))
|
||||
(email (org-export-data (plist-get info :email) info))
|
||||
(author (and (plist-get info :with-author)
|
||||
(let ((auth (plist-get info :author)))
|
||||
(and auth (org-export-data auth info)))))
|
||||
(date (format-time-string "%a, %d %b %Y %H:%M:%S %z")) ;; RFC 882
|
||||
(description (org-export-data (plist-get info :description) info))
|
||||
(lang (plist-get info :language))
|
||||
(keywords (plist-get info :keywords))
|
||||
(rssext (plist-get info :rss-extension))
|
||||
(blogurl (or (plist-get info :html-link-home)
|
||||
(plist-get info :publishing-directory)))
|
||||
(image (url-encode-url (plist-get info :rss-image-url)))
|
||||
(ifile (plist-get info :input-file))
|
||||
(publink
|
||||
(or (plist-get info :rss-feed-url)
|
||||
(concat (file-name-as-directory blogurl)
|
||||
(file-name-nondirectory
|
||||
(file-name-sans-extension ifile))
|
||||
"." rssext))))
|
||||
(format
|
||||
"\n<title>%s</title>
|
||||
<atom:link href=\"%s\" rel=\"self\" type=\"application/rss+xml\" />
|
||||
<link>%s</link>
|
||||
<description><![CDATA[%s]]></description>
|
||||
<language>%s</language>
|
||||
<pubDate>%s</pubDate>
|
||||
<lastBuildDate>%s</lastBuildDate>
|
||||
<generator>%s</generator>
|
||||
<webMaster>%s (%s)</webMaster>
|
||||
<image>
|
||||
<url>%s</url>
|
||||
<title>%s</title>
|
||||
<link>%s</link>
|
||||
</image>
|
||||
"
|
||||
title publink blogurl description lang date date
|
||||
(concat (format "Emacs %d.%d"
|
||||
emacs-major-version
|
||||
emacs-minor-version)
|
||||
" Org-mode " (org-version))
|
||||
email author image title blogurl)))
|
||||
|
||||
(defun org-rss-section (section contents info)
|
||||
"Transcode SECTION element into RSS format.
|
||||
CONTENTS is the section contents. INFO is a plist used as
|
||||
a communication channel."
|
||||
contents)
|
||||
|
||||
(defun org-rss-timestamp (timestamp contents info)
|
||||
"Transcode a TIMESTAMP object from Org to RSS.
|
||||
CONTENTS is nil. INFO is a plist holding contextual
|
||||
information."
|
||||
(org-html-encode-plain-text
|
||||
(org-timestamp-translate timestamp)))
|
||||
|
||||
(defun org-rss-plain-text (contents info)
|
||||
"Convert plain text into RSS encoded text."
|
||||
(let (output)
|
||||
(setq output (org-html-encode-plain-text contents)
|
||||
output (org-export-activate-smart-quotes
|
||||
output :html info))))
|
||||
|
||||
;;; Filters
|
||||
|
||||
(defun org-rss-final-function (contents backend info)
|
||||
"Prettify the RSS output."
|
||||
(with-temp-buffer
|
||||
(xml-mode)
|
||||
(insert contents)
|
||||
(indent-region (point-min) (point-max))
|
||||
(buffer-substring-no-properties (point-min) (point-max))))
|
||||
|
||||
;;; Miscellaneous
|
||||
|
||||
(defun org-rss-add-pubdate-property ()
|
||||
"Set the PUBDATE property for top-level headlines."
|
||||
(let (msg)
|
||||
(org-map-entries
|
||||
(lambda ()
|
||||
(let* ((entry (org-element-at-point))
|
||||
(level (org-element-property :level entry)))
|
||||
(when (= level 1)
|
||||
(unless (org-entry-get (point) "PUBDATE")
|
||||
(setq msg t)
|
||||
(org-set-property
|
||||
"PUBDATE" (format-time-string
|
||||
(cdr org-time-stamp-formats)))))))
|
||||
nil nil 'comment 'archive)
|
||||
(when msg
|
||||
(message "Property PUBDATE added to top-level entries in %s"
|
||||
(buffer-file-name))
|
||||
(sit-for 2))))
|
||||
|
||||
(provide 'ox-rss)
|
||||
|
||||
;;; ox-rss.el ends here
|
||||
433
lisp/org-contrib/ox-s5.el
Normal file
433
lisp/org-contrib/ox-s5.el
Normal file
@@ -0,0 +1,433 @@
|
||||
;;; ox-s5.el --- S5 Presentation Back-End for Org Export Engine
|
||||
|
||||
;; Copyright (C) 2011-2014, 2021 Rick Frankel
|
||||
|
||||
;; Author: Rick Frankel <emacs at rickster dot com>
|
||||
;; Keywords: outlines, hypermedia, S5, wp
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This library implements an S5 Presentation back-end for the Org
|
||||
;; generic exporter.
|
||||
|
||||
;; Installation
|
||||
;; ------------
|
||||
;; Get the s5 scripts from
|
||||
;; https://meyerweb.com/eric/tools/s5/
|
||||
;; (Note that the default s5 version is set for using the alpha, 1.2a2.
|
||||
;; Copy the ui dir to somewhere reachable from your published presentation
|
||||
;; The default (`org-s5-ui-url') is set to "ui" (e.g., in the
|
||||
;; same directory as the html file).
|
||||
|
||||
;; Usage
|
||||
;; -----
|
||||
;; Follow the general instructions at the above website. To generate
|
||||
;; incremental builds, you can set the HTML_CONTAINER_CLASS on an
|
||||
;; object to "incremental" to make it build. If you want an outline to
|
||||
;; build, set the :INCREMENTAL property on the parent headline.
|
||||
|
||||
;; To test it, run:
|
||||
;;
|
||||
;; M-x org-s5-export-as-html
|
||||
;;
|
||||
;; in an Org mode buffer. See ox.el and ox-html.el for more details
|
||||
;; on how this exporter works.
|
||||
|
||||
;; TODOs
|
||||
;; ------
|
||||
;; The title page is formatted using format-spec. This is error prone
|
||||
;; when details are missing and may insert empty tags, like <h2></h2>,
|
||||
;; for missing values.
|
||||
|
||||
(require 'ox-html)
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(org-export-define-derived-backend 's5 'html
|
||||
:menu-entry
|
||||
'(?s "Export to S5 HTML Presentation"
|
||||
((?H "To temporary buffer" org-s5-export-as-html)
|
||||
(?h "To file" org-s5-export-to-html)
|
||||
(?o "To file and open"
|
||||
(lambda (a s v b)
|
||||
(if a (org-s5-export-to-html t s v b)
|
||||
(org-open-file (org-s5-export-to-html nil s v b)))))))
|
||||
:options-alist
|
||||
'((:html-link-home "HTML_LINK_HOME" nil nil)
|
||||
(:html-link-up "HTML_LINK_UP" nil nil)
|
||||
(:s5-postamble "S5_POSTAMBLE" nil org-s5-postamble newline)
|
||||
(:s5-preamble "S5_PREAMBLE" nil org-s5-preamble newline)
|
||||
(:html-head-include-default-style "HTML_INCLUDE_DEFAULT_STYLE" nil nil)
|
||||
(:html-head-include-scripts "HTML_INCLUDE_SCRIPTS" nil nil)
|
||||
(:s5-version "S5_VERSION" nil org-s5-version)
|
||||
(:s5-theme-file "S5_THEME_FILE" nil org-s5-theme-file)
|
||||
(:s5-ui-url "S5_UI_URL" nil org-s5-ui-url)
|
||||
(:s5-default-view "S5_DEFAULT_VIEW" nil org-s5-default-view)
|
||||
(:s5-control-visibility "S5_CONTROL_VISIBILITY" nil
|
||||
org-s5-control-visibility))
|
||||
:translate-alist
|
||||
'((headline . org-s5-headline)
|
||||
(plain-list . org-s5-plain-list)
|
||||
(inner-template . org-s5-inner-template)
|
||||
(template . org-s5-template)))
|
||||
|
||||
(defgroup org-export-s5 nil
|
||||
"Options for exporting Org mode files to S5 HTML Presentations."
|
||||
:tag "Org Export S5"
|
||||
:group 'org-export-html)
|
||||
|
||||
(defcustom org-s5-version "1.2a2"
|
||||
"Version of s5 being used (for version metadata.) Defaults to
|
||||
s5 v2 alpha 2.
|
||||
Can be overridden with S5_VERSION."
|
||||
:group 'org-export-s5
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-s5-theme-file nil
|
||||
"Url to S5 theme (slides.css) file. Can be overridden with the
|
||||
S5_THEME_FILE property. If nil, defaults to
|
||||
`org-s5-ui-url'/default/slides.css. If it starts with anything but
|
||||
\"http\" or \"/\", it is used as-is. Otherwise the link in generated
|
||||
relative to `org-s5-ui-url'.
|
||||
The links for all other required stylesheets and scripts will be
|
||||
generated relative to `org-s5-ui-url'/default."
|
||||
:group 'org-export-s5
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-s5-ui-url "ui"
|
||||
"Base url to directory containing S5 \"default\" subdirectory
|
||||
and the \"s5-notes.html\" file.
|
||||
Can be overridden with the S5_UI_URL property."
|
||||
:group 'org-export-s5
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-s5-default-view 'slideshow
|
||||
"Setting for \"defaultView\" meta info."
|
||||
:group 'org-export-s5
|
||||
:type '(choice (const slideshow) (const outline)))
|
||||
|
||||
(defcustom org-s5-control-visibility 'hidden
|
||||
"Setting for \"controlVis\" meta info."
|
||||
:group 'org-export-s5
|
||||
:type '(choice (const hidden) (const visibile)))
|
||||
|
||||
(defvar org-s5--divs
|
||||
'((preamble "div" "header")
|
||||
(content "div" "content")
|
||||
(postamble "div" "footer"))
|
||||
"Alist of the three section elements for HTML export.
|
||||
The car of each entry is one of 'preamble, 'content or 'postamble.
|
||||
The cdrs of each entry are the ELEMENT_TYPE and ID for each
|
||||
section of the exported document.
|
||||
|
||||
If you set `org-html-container-element' to \"li\", \"ol\" will be
|
||||
uses as the content ELEMENT_TYPE, generating an XOXO format
|
||||
slideshow.
|
||||
|
||||
Note that changing the preamble or postamble will break the
|
||||
core S5 stylesheets.")
|
||||
|
||||
(defcustom org-s5-postamble "<h1>%a - %t</h1>"
|
||||
"Preamble inserted into the S5 layout section.
|
||||
When set to a string, use this string as the postamble.
|
||||
|
||||
When set to a function, apply this function and insert the
|
||||
returned string. The function takes the property list of export
|
||||
options as its only argument.
|
||||
|
||||
Setting the S5_POSTAMBLE option -- or the :s5-postamble in publishing
|
||||
projects -- will take precedence over this variable.
|
||||
|
||||
Note that the default css styling will break if this is set to nil
|
||||
or an empty string."
|
||||
:group 'org-export-s5
|
||||
:type '(choice (const :tag "No postamble" " ")
|
||||
(string :tag "Custom formatting string")
|
||||
(function :tag "Function (must return a string)")))
|
||||
|
||||
(defcustom org-s5-preamble " "
|
||||
"Peamble inserted into the S5 layout section.
|
||||
|
||||
When set to a string, use this string as the preamble.
|
||||
|
||||
When set to a function, apply this function and insert the
|
||||
returned string. The function takes the property list of export
|
||||
options as its only argument.
|
||||
|
||||
Setting S5_PREAMBLE option -- or the :s5-preamble in publishing
|
||||
projects -- will take precedence over this variable.
|
||||
|
||||
Note that the default css styling will break if this is set to nil
|
||||
or an empty string."
|
||||
:group 'org-export-s5
|
||||
:type '(choice (const :tag "No preamble" " ")
|
||||
(string :tag "Custom formatting string")
|
||||
(function :tag "Function (must return a string)")))
|
||||
|
||||
(defcustom org-s5-title-slide-template
|
||||
"<h1>%t</h1>
|
||||
<h2>%s</h2>
|
||||
<h2>%a</h2>
|
||||
<h3>%e</h3>
|
||||
<h4>%d</h4>"
|
||||
"Format template to specify title page section.
|
||||
See `org-html-postamble-format' for the valid elements which
|
||||
can be included.
|
||||
|
||||
It will be wrapped in the element defined in the :html-container
|
||||
property, and defaults to the value of `org-html-container-element',
|
||||
and have the id \"title-slide\"."
|
||||
:group 'org-export-s5
|
||||
:type 'string)
|
||||
|
||||
(defun org-s5--format-toc-headline (headline info)
|
||||
"Return an appropriate table of contents entry for HEADLINE.
|
||||
Note that (currently) the S5 exporter does not support deep links,
|
||||
so the table of contents is not \"active\".
|
||||
INFO is a plist used as a communication channel."
|
||||
(let* ((headline-number (org-export-get-headline-number headline info))
|
||||
(section-number
|
||||
(and (not (org-export-low-level-p headline info))
|
||||
(org-export-numbered-headline-p headline info)
|
||||
(concat (mapconcat 'number-to-string headline-number ".") ". ")))
|
||||
(tags (and (eq (plist-get info :with-tags) t)
|
||||
(org-export-get-tags headline info))))
|
||||
(concat section-number
|
||||
(org-export-data
|
||||
(org-export-get-alt-title headline info) info)
|
||||
(and tags " ") (org-html--tags tags info))))
|
||||
|
||||
(defun org-s5-toc (depth info)
|
||||
(let* ((headlines (org-export-collect-headlines info depth))
|
||||
(toc-entries
|
||||
(mapcar (lambda (headline)
|
||||
(cons (org-s5--format-toc-headline headline info)
|
||||
(org-export-get-relative-level headline info)))
|
||||
(org-export-collect-headlines info depth))))
|
||||
(when toc-entries
|
||||
(concat
|
||||
(format "<%s id='table-of-contents' class='slide'>\n"
|
||||
(plist-get info :html-container))
|
||||
(format "<h1>%s</h1>\n"
|
||||
(org-html--translate "Table of Contents" info))
|
||||
"<div id=\"text-table-of-contents\">"
|
||||
(org-html--toc-text toc-entries)
|
||||
"</div>\n"
|
||||
(format "</%s>\n" (plist-get info :html-container))))))
|
||||
|
||||
(defun org-s5--build-head (info)
|
||||
(let* ((dir (plist-get info :s5-ui-url))
|
||||
(theme (or (plist-get info :s5-theme-file) "default/slides.css")))
|
||||
(mapconcat
|
||||
'identity
|
||||
(list
|
||||
"<!-- style sheet links -->"
|
||||
(mapconcat
|
||||
(lambda (list)
|
||||
(format
|
||||
(concat
|
||||
"<link rel='stylesheet' href='%s/default/%s' type='text/css'"
|
||||
" media='%s' id='%s' />")
|
||||
dir (nth 0 list) (nth 1 list) (nth 2 list)))
|
||||
(list
|
||||
'("outline.css" "screen" "outlineStyle")
|
||||
'("print.css" "print" "slidePrint")
|
||||
'("opera.css" "projection" "operaFix")) "\n")
|
||||
(format (concat
|
||||
"<link rel='stylesheet' href='%s' type='text/css'"
|
||||
" media='screen' id='slideProj' />")
|
||||
(if (string-match-p "^\\(http\\|/\\)" theme) theme
|
||||
(concat dir "/" theme)))
|
||||
"<!-- S5 JS -->"
|
||||
(concat
|
||||
"<script src='" dir
|
||||
"/default/slides.js'></script>")) "\n")))
|
||||
|
||||
(defun org-s5--build-meta-info (info)
|
||||
(concat
|
||||
(org-html--build-meta-info info)
|
||||
(format "<meta name=\"version\" content=\"S5 %s\" />\n"
|
||||
(plist-get info :s5-version))
|
||||
(format "<meta name='defaultView' content='%s' />\n"
|
||||
(plist-get info :s5-default-view))
|
||||
(format "<meta name='controlVis' content='%s' />"
|
||||
(plist-get info :s5-control-visibility))))
|
||||
|
||||
(defun org-s5-headline (headline contents info)
|
||||
(let ((org-html-toplevel-hlevel 1)
|
||||
(class (or (org-element-property :HTML_CONTAINER_CLASS headline) ""))
|
||||
(level (org-export-get-relative-level headline info)))
|
||||
(when (and (= 1 level) (not (string-match-p "\\<slide\\>" class)))
|
||||
(org-element-put-property headline :HTML_CONTAINER_CLASS (concat class " slide")))
|
||||
(org-html-headline headline contents info)))
|
||||
|
||||
(defun org-s5-plain-list (plain-list contents info)
|
||||
"Transcode a PLAIN-LIST element from Org to HTML.
|
||||
CONTENTS is the contents of the list. INFO is a plist holding
|
||||
contextual information.
|
||||
If a containing headline has the property :INCREMENTAL,
|
||||
then the \"incremental\" class will be added to the to the list,
|
||||
which will make the list into a \"build\"."
|
||||
(let* ((type (org-element-property :type plain-list))
|
||||
(tag (case type
|
||||
(ordered "ol")
|
||||
(unordered "ul")
|
||||
(descriptive "dl"))))
|
||||
(format "%s\n%s%s"
|
||||
(format
|
||||
"<%s class='org-%s%s'>" tag tag
|
||||
(if (org-export-get-node-property :INCREMENTAL plain-list t)
|
||||
" incremental" ""))
|
||||
contents
|
||||
(format "</%s>" tag))))
|
||||
|
||||
(defun org-s5-inner-template (contents info)
|
||||
"Return body of document string after HTML conversion.
|
||||
CONTENTS is the transcoded contents string. INFO is a plist
|
||||
holding export options."
|
||||
(concat contents "\n"))
|
||||
|
||||
(defun org-s5-template (contents info)
|
||||
"Return complete document string after HTML conversion.
|
||||
CONTENTS is the transcoded contents string. INFO is a plist
|
||||
holding export options."
|
||||
(let ((info (plist-put
|
||||
(plist-put
|
||||
(plist-put info :html-preamble (plist-get info :s5-preamble))
|
||||
:html-postamble
|
||||
(plist-get info :s5-postamble))
|
||||
:html-divs
|
||||
(if (equal "li" (plist-get info :html-container))
|
||||
(cons '(content "ol" "content") org-s5--divs)
|
||||
org-s5--divs))))
|
||||
(mapconcat
|
||||
'identity
|
||||
(list
|
||||
(org-html-doctype info)
|
||||
(format "<html xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"%s\" xml:lang=\"%s\">"
|
||||
(plist-get info :language) (plist-get info :language))
|
||||
"<head>"
|
||||
(org-s5--build-meta-info info)
|
||||
(org-s5--build-head info)
|
||||
(org-html--build-head info)
|
||||
(org-html--build-mathjax-config info)
|
||||
"</head>"
|
||||
"<body>"
|
||||
"<div class=\"layout\">"
|
||||
"<div id=\"controls\"><!-- no edit --></div>"
|
||||
"<div id=\"currentSlide\"><!-- no edit --></div>"
|
||||
(org-html--build-pre/postamble 'preamble info)
|
||||
(org-html--build-pre/postamble 'postamble info)
|
||||
"</div>"
|
||||
(format "<%s id=\"%s\" class=\"presentation\">"
|
||||
(nth 1 (assq 'content org-html-divs))
|
||||
(nth 2 (assq 'content org-html-divs)))
|
||||
;; title page
|
||||
(format "<%s id='title-slide' class='slide'>"
|
||||
(plist-get info :html-container))
|
||||
(format-spec org-s5-title-slide-template (org-html-format-spec info))
|
||||
(format "</%s>" (plist-get info :html-container))
|
||||
;; table of contents.
|
||||
(let ((depth (plist-get info :with-toc)))
|
||||
(when depth (org-s5-toc depth info)))
|
||||
contents
|
||||
(format "</%s>" (nth 1 (assq 'content org-html-divs)))
|
||||
"</body>"
|
||||
"</html>\n") "\n")))
|
||||
|
||||
(defun org-s5-export-as-html
|
||||
(&optional async subtreep visible-only body-only ext-plist)
|
||||
"Export current buffer to an HTML buffer.
|
||||
|
||||
If narrowing is active in the current buffer, only export its
|
||||
narrowed part.
|
||||
|
||||
If a region is active, export that region.
|
||||
|
||||
A non-nil optional argument ASYNC means the process should happen
|
||||
asynchronously. The resulting buffer should be accessible
|
||||
through the `org-export-stack' interface.
|
||||
|
||||
When optional argument SUBTREEP is non-nil, export the sub-tree
|
||||
at point, extracting information from the headline properties
|
||||
first.
|
||||
|
||||
When optional argument VISIBLE-ONLY is non-nil, don't export
|
||||
contents of hidden elements.
|
||||
|
||||
When optional argument BODY-ONLY is non-nil, only write code
|
||||
between \"<body>\" and \"</body>\" tags.
|
||||
|
||||
EXT-PLIST, when provided, is a property list with external
|
||||
parameters overriding Org default settings, but still inferior to
|
||||
file-local settings.
|
||||
|
||||
Export is done in a buffer named \"*Org S5 Export*\", which
|
||||
will be displayed when `org-export-show-temporary-export-buffer'
|
||||
is non-nil."
|
||||
(interactive)
|
||||
(org-export-to-buffer 's5 "*Org S5 Export*"
|
||||
async subtreep visible-only body-only ext-plist (lambda () (nxml-mode))))
|
||||
|
||||
(defun org-s5-export-to-html
|
||||
(&optional async subtreep visible-only body-only ext-plist)
|
||||
"Export current buffer to a S5 HTML file.
|
||||
|
||||
If narrowing is active in the current buffer, only export its
|
||||
narrowed part.
|
||||
|
||||
If a region is active, export that region.
|
||||
|
||||
A non-nil optional argument ASYNC means the process should happen
|
||||
asynchronously. The resulting file should be accessible through
|
||||
the `org-export-stack' interface.
|
||||
|
||||
When optional argument SUBTREEP is non-nil, export the sub-tree
|
||||
at point, extracting information from the headline properties
|
||||
first.
|
||||
|
||||
When optional argument VISIBLE-ONLY is non-nil, don't export
|
||||
contents of hidden elements.
|
||||
|
||||
When optional argument BODY-ONLY is non-nil, only write code
|
||||
between \"<body>\" and \"</body>\" tags.
|
||||
|
||||
EXT-PLIST, when provided, is a property list with external
|
||||
parameters overriding Org default settings, but still inferior to
|
||||
file-local settings.
|
||||
|
||||
Return output file's name."
|
||||
(interactive)
|
||||
(let* ((extension (concat "." org-html-extension))
|
||||
(file (org-export-output-file-name extension subtreep))
|
||||
(org-export-coding-system org-html-coding-system))
|
||||
(org-export-to-file 's5 file
|
||||
async subtreep visible-only body-only ext-plist)))
|
||||
|
||||
(defun org-s5-publish-to-html (plist filename pub-dir)
|
||||
"Publish an org file to S5 HTML Presentation.
|
||||
|
||||
FILENAME is the filename of the Org file to be published. PLIST
|
||||
is the property list for the given project. PUB-DIR is the
|
||||
publishing directory.
|
||||
|
||||
Return output file name."
|
||||
(org-publish-org-to 's5 filename ".html" plist pub-dir))
|
||||
|
||||
(provide 'ox-s5)
|
||||
|
||||
;;; ox-s5.el ends here
|
||||
1033
lisp/org-contrib/ox-taskjuggler.el
Normal file
1033
lisp/org-contrib/ox-taskjuggler.el
Normal file
File diff suppressed because it is too large
Load Diff
Reference in New Issue
Block a user