pax_global_header 0000666 0000000 0000000 00000000064 15017331127 0014512 g ustar 00root root 0000000 0000000 52 comment=f6247f0c9b8c15b19e8ddca2f600ceb2cf48beb9
mastodon.el/ 0000775 0000000 0000000 00000000000 15017331127 0013301 5 ustar 00root root 0000000 0000000 mastodon.el/.elpaignore 0000664 0000000 0000000 00000000125 15017331127 0015425 0 ustar 00root root 0000000 0000000 *.*~
.woodpecker.yml
lisp/.dir-locals.el
Cask
fixture
Makefile
stubfile.plstore
test
mastodon.el/.gitignore 0000664 0000000 0000000 00000000325 15017331127 0015271 0 ustar 00root root 0000000 0000000 # Compiled
*.elc
# Packaging
.cask
# Other
.DS_Store
stubfile.plstore
*~
dist/
/mastodon.org
# ELPA-generted files
/mastodon-pkg.el
/mastodon-autoloads.el
/lisp/mastodon-autoloads.el
# ELSA files
/lisp/.elsa/
mastodon.el/.woodpecker.yml 0000664 0000000 0000000 00000000616 15017331127 0016247 0 ustar 00root root 0000000 0000000 pipeline:
current:
image: silex/emacs:cask
commands:
- emacs --version
- cask install
- cask emacs -batch -l test/ert-helper.el -f ert-run-tests-batch-and-exit
last:
image: silex/emacs:27-ci-cask
commands:
- emacs --version
- cask install
- cask emacs -batch -l test/ert-helper.el -f ert-run-tests-batch-and-exit
branches: [ main, develop ]
mastodon.el/Cask 0000664 0000000 0000000 00000000337 15017331127 0014110 0 ustar 00root root 0000000 0000000 (source gnu)
(source melpa)
(package-file "lisp/mastodon.el")
(files "lisp/*.el")
(development
(depends-on "ert-runner")
(depends-on "el-mock")
(depends-on "ecukes")
(depends-on "package-lint")
(depends-on "async"))
mastodon.el/LICENSE 0000664 0000000 0000000 00000104512 15017331127 0014311 0 ustar 00root root 0000000 0000000 GNU GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
Copyright (C) 2007 Free Software Foundation, Inc.
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The GNU General Public License is a free, copyleft license for
software and other kinds of works.
The licenses for most software and other practical works are designed
to take away your freedom to share and change the works. By contrast,
the GNU General Public License is intended to guarantee your freedom to
share and change all versions of a program--to make sure it remains free
software for all its users. We, the Free Software Foundation, use the
GNU General Public License for most of our software; it applies also to
any other work released this way by its authors. You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
them if you wish), that you receive source code or can get it if you
want it, that you can change the software or use pieces of it in new
free programs, and that you know you can do these things.
To protect your rights, we need to prevent others from denying you
these rights or asking you to surrender the rights. Therefore, you have
certain responsibilities if you distribute copies of the software, or if
you modify it: responsibilities to respect the freedom of others.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must pass on to the recipients the same
freedoms that you received. You must make sure that they, too, receive
or can get the source code. And you must show them these terms so they
know their rights.
Developers that use the GNU GPL protect your rights with two steps:
(1) assert copyright on the software, and (2) offer you this License
giving you legal permission to copy, distribute and/or modify it.
For the developers' and authors' protection, the GPL clearly explains
that there is no warranty for this free software. For both users' and
authors' sake, the GPL requires that modified versions be marked as
changed, so that their problems will not be attributed erroneously to
authors of previous versions.
Some devices are designed to deny users access to install or run
modified versions of the software inside them, although the manufacturer
can do so. This is fundamentally incompatible with the aim of
protecting users' freedom to change the software. The systematic
pattern of such abuse occurs in the area of products for individuals to
use, which is precisely where it is most unacceptable. Therefore, we
have designed this version of the GPL to prohibit the practice for those
products. If such problems arise substantially in other domains, we
stand ready to extend this provision to those domains in future versions
of the GPL, as needed to protect the freedom of users.
Finally, every program is threatened constantly by software patents.
States should not allow patents to restrict development and use of
software on general-purpose computers, but in those that do, we wish to
avoid the special danger that patents applied to a free program could
make it effectively proprietary. To prevent this, the GPL assures that
patents cannot be used to render the program non-free.
The precise terms and conditions for copying, distribution and
modification follow.
TERMS AND CONDITIONS
0. Definitions.
"This License" refers to version 3 of the GNU General Public License.
"Copyright" also means copyright-like laws that apply to other kinds of
works, such as semiconductor masks.
"The Program" refers to any copyrightable work licensed under this
License. Each licensee is addressed as "you". "Licensees" and
"recipients" may be individuals or organizations.
To "modify" a work means to copy from or adapt all or part of the work
in a fashion requiring copyright permission, other than the making of an
exact copy. The resulting work is called a "modified version" of the
earlier work or a work "based on" the earlier work.
A "covered work" means either the unmodified Program or a work based
on the Program.
To "propagate" a work means to do anything with it that, without
permission, would make you directly or secondarily liable for
infringement under applicable copyright law, except executing it on a
computer or modifying a private copy. Propagation includes copying,
distribution (with or without modification), making available to the
public, and in some countries other activities as well.
To "convey" a work means any kind of propagation that enables other
parties to make or receive copies. Mere interaction with a user through
a computer network, with no transfer of a copy, is not conveying.
An interactive user interface displays "Appropriate Legal Notices"
to the extent that it includes a convenient and prominently visible
feature that (1) displays an appropriate copyright notice, and (2)
tells the user that there is no warranty for the work (except to the
extent that warranties are provided), that licensees may convey the
work under this License, and how to view a copy of this License. If
the interface presents a list of user commands or options, such as a
menu, a prominent item in the list meets this criterion.
1. Source Code.
The "source code" for a work means the preferred form of the work
for making modifications to it. "Object code" means any non-source
form of a work.
A "Standard Interface" means an interface that either is an official
standard defined by a recognized standards body, or, in the case of
interfaces specified for a particular programming language, one that
is widely used among developers working in that language.
The "System Libraries" of an executable work include anything, other
than the work as a whole, that (a) is included in the normal form of
packaging a Major Component, but which is not part of that Major
Component, and (b) serves only to enable use of the work with that
Major Component, or to implement a Standard Interface for which an
implementation is available to the public in source code form. A
"Major Component", in this context, means a major essential component
(kernel, window system, and so on) of the specific operating system
(if any) on which the executable work runs, or a compiler used to
produce the work, or an object code interpreter used to run it.
The "Corresponding Source" for a work in object code form means all
the source code needed to generate, install, and (for an executable
work) run the object code and to modify the work, including scripts to
control those activities. However, it does not include the work's
System Libraries, or general-purpose tools or generally available free
programs which are used unmodified in performing those activities but
which are not part of the work. For example, Corresponding Source
includes interface definition files associated with source files for
the work, and the source code for shared libraries and dynamically
linked subprograms that the work is specifically designed to require,
such as by intimate data communication or control flow between those
subprograms and other parts of the work.
The Corresponding Source need not include anything that users
can regenerate automatically from other parts of the Corresponding
Source.
The Corresponding Source for a work in source code form is that
same work.
2. Basic Permissions.
All rights granted under this License are granted for the term of
copyright on the Program, and are irrevocable provided the stated
conditions are met. This License explicitly affirms your unlimited
permission to run the unmodified Program. The output from running a
covered work is covered by this License only if the output, given its
content, constitutes a covered work. This License acknowledges your
rights of fair use or other equivalent, as provided by copyright law.
You may make, run and propagate covered works that you do not
convey, without conditions so long as your license otherwise remains
in force. You may convey covered works to others for the sole purpose
of having them make modifications exclusively for you, or provide you
with facilities for running those works, provided that you comply with
the terms of this License in conveying all material for which you do
not control copyright. Those thus making or running the covered works
for you must do so exclusively on your behalf, under your direction
and control, on terms that prohibit them from making any copies of
your copyrighted material outside their relationship with you.
Conveying under any other circumstances is permitted solely under
the conditions stated below. Sublicensing is not allowed; section 10
makes it unnecessary.
3. Protecting Users' Legal Rights From Anti-Circumvention Law.
No covered work shall be deemed part of an effective technological
measure under any applicable law fulfilling obligations under article
11 of the WIPO copyright treaty adopted on 20 December 1996, or
similar laws prohibiting or restricting circumvention of such
measures.
When you convey a covered work, you waive any legal power to forbid
circumvention of technological measures to the extent such circumvention
is effected by exercising rights under this License with respect to
the covered work, and you disclaim any intention to limit operation or
modification of the work as a means of enforcing, against the work's
users, your or third parties' legal rights to forbid circumvention of
technological measures.
4. Conveying Verbatim Copies.
You may convey verbatim copies of the Program's source code as you
receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice;
keep intact all notices stating that this License and any
non-permissive terms added in accord with section 7 apply to the code;
keep intact all notices of the absence of any warranty; and give all
recipients a copy of this License along with the Program.
You may charge any price or no price for each copy that you convey,
and you may offer support or warranty protection for a fee.
5. Conveying Modified Source Versions.
You may convey a work based on the Program, or the modifications to
produce it from the Program, in the form of source code under the
terms of section 4, provided that you also meet all of these conditions:
a) The work must carry prominent notices stating that you modified
it, and giving a relevant date.
b) The work must carry prominent notices stating that it is
released under this License and any conditions added under section
7. This requirement modifies the requirement in section 4 to
"keep intact all notices".
c) You must license the entire work, as a whole, under this
License to anyone who comes into possession of a copy. This
License will therefore apply, along with any applicable section 7
additional terms, to the whole of the work, and all its parts,
regardless of how they are packaged. This License gives no
permission to license the work in any other way, but it does not
invalidate such permission if you have separately received it.
d) If the work has interactive user interfaces, each must display
Appropriate Legal Notices; however, if the Program has interactive
interfaces that do not display Appropriate Legal Notices, your
work need not make them do so.
A compilation of a covered work with other separate and independent
works, which are not by their nature extensions of the covered work,
and which are not combined with it such as to form a larger program,
in or on a volume of a storage or distribution medium, is called an
"aggregate" if the compilation and its resulting copyright are not
used to limit the access or legal rights of the compilation's users
beyond what the individual works permit. Inclusion of a covered work
in an aggregate does not cause this License to apply to the other
parts of the aggregate.
6. Conveying Non-Source Forms.
You may convey a covered work in object code form under the terms
of sections 4 and 5, provided that you also convey the
machine-readable Corresponding Source under the terms of this License,
in one of these ways:
a) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by the
Corresponding Source fixed on a durable physical medium
customarily used for software interchange.
b) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by a
written offer, valid for at least three years and valid for as
long as you offer spare parts or customer support for that product
model, to give anyone who possesses the object code either (1) a
copy of the Corresponding Source for all the software in the
product that is covered by this License, on a durable physical
medium customarily used for software interchange, for a price no
more than your reasonable cost of physically performing this
conveying of source, or (2) access to copy the
Corresponding Source from a network server at no charge.
c) Convey individual copies of the object code with a copy of the
written offer to provide the Corresponding Source. This
alternative is allowed only occasionally and noncommercially, and
only if you received the object code with such an offer, in accord
with subsection 6b.
d) Convey the object code by offering access from a designated
place (gratis or for a charge), and offer equivalent access to the
Corresponding Source in the same way through the same place at no
further charge. You need not require recipients to copy the
Corresponding Source along with the object code. If the place to
copy the object code is a network server, the Corresponding Source
may be on a different server (operated by you or a third party)
that supports equivalent copying facilities, provided you maintain
clear directions next to the object code saying where to find the
Corresponding Source. Regardless of what server hosts the
Corresponding Source, you remain obligated to ensure that it is
available for as long as needed to satisfy these requirements.
e) Convey the object code using peer-to-peer transmission, provided
you inform other peers where the object code and Corresponding
Source of the work are being offered to the general public at no
charge under subsection 6d.
A separable portion of the object code, whose source code is excluded
from the Corresponding Source as a System Library, need not be
included in conveying the object code work.
A "User Product" is either (1) a "consumer product", which means any
tangible personal property which is normally used for personal, family,
or household purposes, or (2) anything designed or sold for incorporation
into a dwelling. In determining whether a product is a consumer product,
doubtful cases shall be resolved in favor of coverage. For a particular
product received by a particular user, "normally used" refers to a
typical or common use of that class of product, regardless of the status
of the particular user or of the way in which the particular user
actually uses, or expects or is expected to use, the product. A product
is a consumer product regardless of whether the product has substantial
commercial, industrial or non-consumer uses, unless such uses represent
the only significant mode of use of the product.
"Installation Information" for a User Product means any methods,
procedures, authorization keys, or other information required to install
and execute modified versions of a covered work in that User Product from
a modified version of its Corresponding Source. The information must
suffice to ensure that the continued functioning of the modified object
code is in no case prevented or interfered with solely because
modification has been made.
If you convey an object code work under this section in, or with, or
specifically for use in, a User Product, and the conveying occurs as
part of a transaction in which the right of possession and use of the
User Product is transferred to the recipient in perpetuity or for a
fixed term (regardless of how the transaction is characterized), the
Corresponding Source conveyed under this section must be accompanied
by the Installation Information. But this requirement does not apply
if neither you nor any third party retains the ability to install
modified object code on the User Product (for example, the work has
been installed in ROM).
The requirement to provide Installation Information does not include a
requirement to continue to provide support service, warranty, or updates
for a work that has been modified or installed by the recipient, or for
the User Product in which it has been modified or installed. Access to a
network may be denied when the modification itself materially and
adversely affects the operation of the network or violates the rules and
protocols for communication across the network.
Corresponding Source conveyed, and Installation Information provided,
in accord with this section must be in a format that is publicly
documented (and with an implementation available to the public in
source code form), and must require no special password or key for
unpacking, reading or copying.
7. Additional Terms.
"Additional permissions" are terms that supplement the terms of this
License by making exceptions from one or more of its conditions.
Additional permissions that are applicable to the entire Program shall
be treated as though they were included in this License, to the extent
that they are valid under applicable law. If additional permissions
apply only to part of the Program, that part may be used separately
under those permissions, but the entire Program remains governed by
this License without regard to the additional permissions.
When you convey a copy of a covered work, you may at your option
remove any additional permissions from that copy, or from any part of
it. (Additional permissions may be written to require their own
removal in certain cases when you modify the work.) You may place
additional permissions on material, added by you to a covered work,
for which you have or can give appropriate copyright permission.
Notwithstanding any other provision of this License, for material you
add to a covered work, you may (if authorized by the copyright holders of
that material) supplement the terms of this License with terms:
a) Disclaiming warranty or limiting liability differently from the
terms of sections 15 and 16 of this License; or
b) Requiring preservation of specified reasonable legal notices or
author attributions in that material or in the Appropriate Legal
Notices displayed by works containing it; or
c) Prohibiting misrepresentation of the origin of that material, or
requiring that modified versions of such material be marked in
reasonable ways as different from the original version; or
d) Limiting the use for publicity purposes of names of licensors or
authors of the material; or
e) Declining to grant rights under trademark law for use of some
trade names, trademarks, or service marks; or
f) Requiring indemnification of licensors and authors of that
material by anyone who conveys the material (or modified versions of
it) with contractual assumptions of liability to the recipient, for
any liability that these contractual assumptions directly impose on
those licensors and authors.
All other non-permissive additional terms are considered "further
restrictions" within the meaning of section 10. If the Program as you
received it, or any part of it, contains a notice stating that it is
governed by this License along with a term that is a further
restriction, you may remove that term. If a license document contains
a further restriction but permits relicensing or conveying under this
License, you may add to a covered work material governed by the terms
of that license document, provided that the further restriction does
not survive such relicensing or conveying.
If you add terms to a covered work in accord with this section, you
must place, in the relevant source files, a statement of the
additional terms that apply to those files, or a notice indicating
where to find the applicable terms.
Additional terms, permissive or non-permissive, may be stated in the
form of a separately written license, or stated as exceptions;
the above requirements apply either way.
8. Termination.
You may not propagate or modify a covered work except as expressly
provided under this License. Any attempt otherwise to propagate or
modify it is void, and will automatically terminate your rights under
this License (including any patent licenses granted under the third
paragraph of section 11).
However, if you cease all violation of this License, then your
license from a particular copyright holder is reinstated (a)
provisionally, unless and until the copyright holder explicitly and
finally terminates your license, and (b) permanently, if the copyright
holder fails to notify you of the violation by some reasonable means
prior to 60 days after the cessation.
Moreover, your license from a particular copyright holder is
reinstated permanently if the copyright holder notifies you of the
violation by some reasonable means, this is the first time you have
received notice of violation of this License (for any work) from that
copyright holder, and you cure the violation prior to 30 days after
your receipt of the notice.
Termination of your rights under this section does not terminate the
licenses of parties who have received copies or rights from you under
this License. If your rights have been terminated and not permanently
reinstated, you do not qualify to receive new licenses for the same
material under section 10.
9. Acceptance Not Required for Having Copies.
You are not required to accept this License in order to receive or
run a copy of the Program. Ancillary propagation of a covered work
occurring solely as a consequence of using peer-to-peer transmission
to receive a copy likewise does not require acceptance. However,
nothing other than this License grants you permission to propagate or
modify any covered work. These actions infringe copyright if you do
not accept this License. Therefore, by modifying or propagating a
covered work, you indicate your acceptance of this License to do so.
10. Automatic Licensing of Downstream Recipients.
Each time you convey a covered work, the recipient automatically
receives a license from the original licensors, to run, modify and
propagate that work, subject to this License. You are not responsible
for enforcing compliance by third parties with this License.
An "entity transaction" is a transaction transferring control of an
organization, or substantially all assets of one, or subdividing an
organization, or merging organizations. If propagation of a covered
work results from an entity transaction, each party to that
transaction who receives a copy of the work also receives whatever
licenses to the work the party's predecessor in interest had or could
give under the previous paragraph, plus a right to possession of the
Corresponding Source of the work from the predecessor in interest, if
the predecessor has it or can get it with reasonable efforts.
You may not impose any further restrictions on the exercise of the
rights granted or affirmed under this License. For example, you may
not impose a license fee, royalty, or other charge for exercise of
rights granted under this License, and you may not initiate litigation
(including a cross-claim or counterclaim in a lawsuit) alleging that
any patent claim is infringed by making, using, selling, offering for
sale, or importing the Program or any portion of it.
11. Patents.
A "contributor" is a copyright holder who authorizes use under this
License of the Program or a work on which the Program is based. The
work thus licensed is called the contributor's "contributor version".
A contributor's "essential patent claims" are all patent claims
owned or controlled by the contributor, whether already acquired or
hereafter acquired, that would be infringed by some manner, permitted
by this License, of making, using, or selling its contributor version,
but do not include claims that would be infringed only as a
consequence of further modification of the contributor version. For
purposes of this definition, "control" includes the right to grant
patent sublicenses in a manner consistent with the requirements of
this License.
Each contributor grants you a non-exclusive, worldwide, royalty-free
patent license under the contributor's essential patent claims, to
make, use, sell, offer for sale, import and otherwise run, modify and
propagate the contents of its contributor version.
In the following three paragraphs, a "patent license" is any express
agreement or commitment, however denominated, not to enforce a patent
(such as an express permission to practice a patent or covenant not to
sue for patent infringement). To "grant" such a patent license to a
party means to make such an agreement or commitment not to enforce a
patent against the party.
If you convey a covered work, knowingly relying on a patent license,
and the Corresponding Source of the work is not available for anyone
to copy, free of charge and under the terms of this License, through a
publicly available network server or other readily accessible means,
then you must either (1) cause the Corresponding Source to be so
available, or (2) arrange to deprive yourself of the benefit of the
patent license for this particular work, or (3) arrange, in a manner
consistent with the requirements of this License, to extend the patent
license to downstream recipients. "Knowingly relying" means you have
actual knowledge that, but for the patent license, your conveying the
covered work in a country, or your recipient's use of the covered work
in a country, would infringe one or more identifiable patents in that
country that you have reason to believe are valid.
If, pursuant to or in connection with a single transaction or
arrangement, you convey, or propagate by procuring conveyance of, a
covered work, and grant a patent license to some of the parties
receiving the covered work authorizing them to use, propagate, modify
or convey a specific copy of the covered work, then the patent license
you grant is automatically extended to all recipients of the covered
work and works based on it.
A patent license is "discriminatory" if it does not include within
the scope of its coverage, prohibits the exercise of, or is
conditioned on the non-exercise of one or more of the rights that are
specifically granted under this License. You may not convey a covered
work if you are a party to an arrangement with a third party that is
in the business of distributing software, under which you make payment
to the third party based on the extent of your activity of conveying
the work, and under which the third party grants, to any of the
parties who would receive the covered work from you, a discriminatory
patent license (a) in connection with copies of the covered work
conveyed by you (or copies made from those copies), or (b) primarily
for and in connection with specific products or compilations that
contain the covered work, unless you entered into that arrangement,
or that patent license was granted, prior to 28 March 2007.
Nothing in this License shall be construed as excluding or limiting
any implied license or other defenses to infringement that may
otherwise be available to you under applicable patent law.
12. No Surrender of Others' Freedom.
If conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot convey a
covered work so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you may
not convey it at all. For example, if you agree to terms that obligate you
to collect a royalty for further conveying from those to whom you convey
the Program, the only way you could satisfy both those terms and this
License would be to refrain entirely from conveying the Program.
13. Use with the GNU Affero General Public License.
Notwithstanding any other provision of this License, you have
permission to link or combine any covered work with a work licensed
under version 3 of the GNU Affero General Public License into a single
combined work, and to convey the resulting work. The terms of this
License will continue to apply to the part which is the covered work,
but the special requirements of the GNU Affero General Public License,
section 13, concerning interaction through a network will apply to the
combination as such.
14. Revised Versions of this License.
The Free Software Foundation may publish revised and/or new versions of
the GNU General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the
Program specifies that a certain numbered version of the GNU General
Public License "or any later version" applies to it, you have the
option of following the terms and conditions either of that numbered
version or of any later version published by the Free Software
Foundation. If the Program does not specify a version number of the
GNU General Public License, you may choose any version ever published
by the Free Software Foundation.
If the Program specifies that a proxy can decide which future
versions of the GNU General Public License can be used, that proxy's
public statement of acceptance of a version permanently authorizes you
to choose that version for the Program.
Later license versions may give you additional or different
permissions. However, no additional obligations are imposed on any
author or copyright holder as a result of your choosing to follow a
later version.
15. Disclaimer of Warranty.
THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
16. Limitation of Liability.
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.
17. Interpretation of Sections 15 and 16.
If the disclaimer of warranty and limitation of liability provided
above cannot be given local legal effect according to their terms,
reviewing courts shall apply local law that most closely approximates
an absolute waiver of all civil liability in connection with the
Program, unless a warranty or assumption of liability accompanies a
copy of the Program in return for a fee.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
state the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
Copyright (C)
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
Also add information on how to contact you by electronic and paper mail.
If the program does terminal interaction, make it output a short
notice like this when it starts in an interactive mode:
Copyright (C)
This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, your program's commands
might be different; for a GUI interface, you would use an "about box".
You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
.
The GNU General Public License does not permit incorporating your program
into proprietary programs. If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License. But first, please read
. mastodon.el/Makefile 0000664 0000000 0000000 00000002132 15017331127 0014737 0 ustar 00root root 0000000 0000000 PKG = mastodon
CP = cp
LN = ln
EMACS = emacs
MAKEINFO = makeinfo
INSTALL-INFO = install-info
ORG_DIR = $(word 1,$(wildcard $(HOME)/.emacs.d/elpa/org-9*))
ORG_PATH = -L $(ORG_DIR)
ORG_ARGS = --batch $(ORG_PATH) -l org -l ol-man
ORG_EVAL1 = --funcall org-texinfo-export-to-texinfo
ORG_EVAL2 = --funcall org-texinfo-export-to-info
## ################################################################
.PHONY: infoclean tests testsclean
all: $(PKG).info dir
infoclean:
rm -f $(PKG).org $(PKG).texi $(PKG).info dir
tests:
cask emacs -batch -load test/ert-helper.el -f ert-run-tests-batch-and-exit
testsclean:
rm -f stubfile.plstore~
## ################################################################
# May look at this in the future
#
# %.info: %.texi
# @printf "Generating $@\n"
# $(MAKEINFO) --no-split $< -o $@
#
# %.texi: %.org
# @printf "Generating $@\n"
# $(EMACS) $(ORG_ARGS) $@ $(ORG_EVAL1)
%.info: %.org
@printf "Generating $@\n"
$(EMACS) $(ORG_ARGS) $< $(ORG_EVAL2)
dir: $(PKG).info
printf "Generating $@\n"
echo $^ | xargs -n 1 $(INSTALL-INFO) --dir=$@
$(PKG).org: README.org
$(CP) $< $@
mastodon.el/README.org 0000664 0000000 0000000 00000066636 15017331127 0014770 0 ustar 00root root 0000000 0000000 #+title: A Mastodon client
#+export_file_name: mastodon
#+TEXINFO_DIR_CATEGORY: Emacs
#+TEXINFO_DIR_TITLE: Mastodon: (mastodon).
#+TEXINFO_DIR_DESC: Client for fediverse services using the Mastodon API.
@@html:
@@
@@html:
@@
# @@html:
@@
* README
=mastodon.el= is an Emacs client for the ActivityPub social networks that
implement the Mastodon API. For info see [[https://joinmastodon.org/][joinmastodon.org]].
NB: =mastodon.el= now ships this readme as an .info file, so if you have it
installed you should be able to browse this readme inside emacs. =C-h i= for
info, then =m masto RET= should load it for you.
** Installation
You can install =mastodon.el= from ELPA, MELPA, or directly from this repo.
It is also available as a GUIX package.
*** ELPA
You should be able to directly install with:
=M-x package-refresh-contents RET=
=M-x package-install RET mastodon RET=
*** MELPA
Add =MELPA= to your archives:
#+BEGIN_SRC emacs-lisp
(require 'package)
(add-to-list 'package-archives
'("melpa" . "http://melpa.org/packages/") t)
#+END_SRC
Update and install:
=M-x package-refresh-contents RET=
=M-x package-install RET mastodon RET=
*** Repo
Clone this repository and add the lisp directory to your load path. Then,
require it and go.
#+BEGIN_SRC emacs-lisp
(add-to-list 'load-path "/path/to/mastodon.el/lisp")
(require 'mastodon)
#+END_SRC
Or, with =use-package=:
#+BEGIN_SRC emacs-lisp
(use-package mastodon
:ensure t)
#+END_SRC
The minimum Emacs version is now 28.1. But if you are running an older
version it shouldn't be very hard to get it working.
*** Emoji
Since Emacs 28, it has builtin emoji support with =emoji.el=. If you prefer
to use [[https://github.com/iqbalansari/emacs-emojify][Emojify]], =require= it and set =mastodon-use-emojify= to non-nil to
display emoji in timelines and to use it when composing toots. =Emoji.el= is
the better option, but for now only =emojify= supports downloading and using
custom emoji from your instance. From personal experience, =emojify= also
tends to result in less TOFU.
*** Discover
=mastodon-mode= can provide a context menu for its keybindings if [[https://github.com/mickeynp/discover.el][Discover]]
is installed. It is not required.
if you have Discover, add the following to your Emacs init configuration:
#+BEGIN_SRC emacs-lisp
(require 'mastodon-discover)
(with-eval-after-load 'mastodon (mastodon-discover))
#+END_SRC
Or, with =use-package=:
#+BEGIN_SRC emacs-lisp
(use-package mastodon
:ensure t
:config
(mastodon-discover))
#+END_SRC
** Usage
*** Logging in to your instance
You need to set 2 variables in your init file to get started:
1. =mastodon-instance-url=
2. =mastodon-active-user=
(see their doc strings for details). For example If you want to post toots
as "example_user@social.instance.org", then put this in your init file:
#+BEGIN_SRC emacs-lisp
(setq mastodon-instance-url "https://social.instance.org"
mastodon-active-user "example_user")
#+END_SRC
Then *restart* Emacs and run =M-x mastodon=. Make sure you are connected to
internet before you do this. If you have multiple mastodon accounts you
can activate one at a time by changing those two variables and restarting
Emacs.
If you were using mastodon.el before 2FA was implemented and the above
steps do not work, call =(mastodon-forget-all-logins)=, restart Emacs and
follow the steps again.
**** encrypted access tokens (from 2.0.0)
By default, user access tokens are now stored in the user's auth source
file (typically =~/.authinfo.gpg=, check the value of =auth-sources=). When
you first update to 2.0.0, or if you encounter issues due to old
credentials, call =(mastodon-forget-all-logins)= to remove the old
mastodon.el plstore, and then authenticate again. If you don't want to use
the auth source file, set =mastodon-auth-use-auth-source= to nil. Entries
will instead be stored encrypted in =mastodon-client--token-file=, a plstore.
If for some reason you reauthenticate, you'll need to either remove the
entry in your auth sources file, or manually update the token in it after
doing so, as mastodon.el is unable to reliably update (or even remove)
entires.
The format for a mastodon.el auth source entry is as follows:
=machine INSTANCE login USERNAME password AUTHTOKEN=
with the token being what you copy from the browser when authenticating.
If you have =auth-source-save-behavior= set to nil, you'll also need to add
such an entry manually.
Finally, if you find you're asked for your key passphrase too often while
authenticating, consider setting =epa-file-encrypt-to= (for auth-source
encryption) and =plstore-encrypt-to= (for plstore encryption) to your
preferred key ID.
*** Timelines
=M-x mastodon=
Opens a =*mastodon-home*= buffer in the major mode and displays toots. If
your credentials are not yet saved, you will be prompted for email and
password. The app registration process will take place if your
=mastodon-token-file= does not contain =:client_id= and =:client_secret=.
**** Keybindings
For a full list of commands and variables, see [[file:mastodon-index.org][mastodon-index.org]].
|----------------+---------------------------------------------------------------------------------|
| Key | Action |
|----------------+---------------------------------------------------------------------------------|
| | *Help* |
| =?= | Show discover menu of all bindings, if =discover= is available |
|----------------+---------------------------------------------------------------------------------|
| | *Timeline actions* |
| =n= | Go to next item (toot, notification, user) |
| =p= | Go to previous item (toot, notification, user) |
| =M-n/= | Go to the next interesting thing that has an action |
| =M-p/= | Go to the previous interesting thing that has an action |
| =F= | Open federated timeline (1 prefix arg: hide-replies, 2 prefix args: media only) |
| =H= | Open home timeline (1 prefix arg: hide-replies) |
| =L= | Open local timeline (1 prefix arg: hide-replies, 2 prefix args: media only) |
| =N= | Open notifications timeline |
| =@= | Open mentions-only notifications timeline |
| =u= | Update current timeline |
| =T= | Open thread for toot at point |
| =#= | Prompt for tag and open its timeline |
| =A= | Open author profile of toot at point |
| =P= | Open profile of user attached to toot at point |
| =O= | View own profile |
| =U= | update your profile bio note |
| =;= | view instance description for toot at point |
| =:= | view followed tags and load a tag timeline |
| =C-:= | view timeline of all followed tags |
| =,= | view favouriters of toot at point |
| =.= | view boosters of toot at point |
| =/= | switch between mastodon buffers |
| =\= | prompt for an instance domain and view its local timeline (if poss) |
| =Z= | report user/toot at point to instances moderators |
|----------------+---------------------------------------------------------------------------------|
| | *Other views* |
| =s= | search (posts, users, tags) (NB: only posts you have interacted with) |
| =I=, =c=, =d= | view, create, and delete filters |
| =R=, =a=, =j= | view/accept/reject follow requests |
| =G= | view follow suggestions |
| =V= | view your favourited toots |
| =K= | view bookmarked toots |
| =X= | view/edit/create/delete lists |
| =S= | view your scheduled toots |
| =S-:= | view profile/account settings transient menu |
|----------------+---------------------------------------------------------------------------------|
| | *Toot actions* |
| =t= | Compose a new toot |
| =c= | Toggle content warning content |
| =b= | Boost toot under =point= |
| =f= | Favourite toot under =point= |
| =k= | toggle bookmark of toot at point |
| =r= | Reply to toot under =point= |
| =v= | Vote on poll at point |
| =C= | copy url of toot at point |
| =C-RET= | play video/gif at point (requires =mpv=) |
| =e= | edit your toot at point |
| =E= | view edits of toot at point |
| =i= | (un)pin your toot at point |
| =d= | delete your toot at point, and reload current timeline |
| =D= | delete and redraft toot at point, preserving reply/CW/visibility |
| =!= | toggle folding of toot at point |
| (=S-C-=) =W=, =M=, =B= | (un)follow, (un)mute, (un)block author of toot at point |
|----------------+---------------------------------------------------------------------------------|
| | *Profile view* |
| =C-c C-c= | cycle between statuses, statuses without boosts, followers, and following |
| | =mastodon-profile--add-account-to-list= (see lists view) |
|----------------+---------------------------------------------------------------------------------|
| | *Notifications view* |
| =a=, =j= | accept/reject follow request |
| =C-k= | clear notification at point |
| =C-c C-c= | cycle between notification types |
| | see =mastodon-notifications--get-*= functions for filtered views |
|----------------+---------------------------------------------------------------------------------|
| | *Quitting* |
| =q= | Quit mastodon buffer, leave window open |
| =Q= | Quit mastodon buffer and kill window |
| =C-M-q= | Quit and kill all mastodon buffers |
|----------------+---------------------------------------------------------------------------------|
**** Toot byline legend
|---------------+------------------------|
| Marker | Meaning |
|---------------+------------------------|
| =(đ)= (or =(B)=) | I boosted this toot |
| =(â)= (or =(F)=) | I favourited this toot |
| =(đ)= (or =(K)=) | I bookmarked this toot |
|---------------+------------------------|
*** Composing toots
=M-x mastodon-toot= (or =t= from a mastodon.el buffer) opens a new
buffer/window in =text-mode= and =mastodon-toot= minor mode. Enter the
contents of your toot here. =C-c C-c= sends the toot. =C-c C-k= cancels. Both
actions kill the buffer and window. Further keybindings are displayed in
the buffer, and in the following subsection.
Replies preserve visibility status/content warnings, and include boosters
by default. If the region is active when you start a reply, it will be
yanked into the compose buffer prefixed with =>= to form a rough reply
quote.
Server's max toot length, with running char count, and attachment
previews, are shown.
You can download and use your instance's custom emoji
(=mastodon-toot--download-custom-emoji=,
=mastodon-toot--enable-custom-emoji=).
If you want to view some of the toot being replied to in the compose
buffer, set =mastodon-toot-display-orig-in-reply-buffer= to non-nil.
The compose buffer uses =text-mode= so any configuration you have for that
mode will be enabled. If any of your existing config conflicts with
=mastodon-toot=, you can disable it in the =mastodon-toot-mode-hook=. For
example, the default value of that hook is as follows:
#+begin_src emacs-lisp
(add-hook 'mastodon-toot-mode-hook
(lambda ()
(auto-fill-mode -1)))
#+end_src
**** Keybindings
|---------+-------------------------------|
| Key | Action |
|---------+-------------------------------|
| =C-c C-c= | Send toot |
| =C-c C-k= | Cancel toot |
| =C-c C-w= | Add content warning |
| =C-c C-v= | Change toot visibility |
| =C-c C-n= | Add sensitive media/nsfw flag |
| =C-c C-a= | Upload attachment(s) |
| =C-c != | Remove all attachments |
| =C-c C-e= | Insert emoji |
| =C-c C-p= | Create a poll |
| =C-c C-o= | Cancel poll |
| =C-c C-l= | Set toot language |
| =C-c C-s= | Schedule toot |
|---------+-------------------------------|
**** Autocompletion of mentions, tags and emoji
Autocompletion of mentions, tags, and emojis is provided by
=completion-at-point-functions= (capf) backends.
=mastodon-toot--enable-completion= is enabled by default.
To trigger completion, type a prefix followed by a few letters, =@= for
mentions, =#= for tags, and =:= for emoji (for now this only works when using
=emojify.el=).
If you want to enable =company-mode= in the toot compose buffer, set
=mastodon-toot--use-company-for-completion= to =t=. (=mastodon.el= used to run
its own native company backends, but these have been removed in favour of
capfs.)
If you donât run =company= and want immediate, keyless completion, youâll
need to have another completion engine running that handles capfs. A
common combination is =consult= and =corfu=.
**** Draft toots
- Compose buffer text is saved as you type, kept in
=mastodon-toot-current-toot-text=.
- =mastodon-toot--save-draft=: save the current toot as a draft.
- =mastodon-toot--open-draft-toot=: Open a compose buffer and insert one of
your draft toots.
- =mastodon-toot--delete-draft-toot=: Delete a draft toot.
- =mastodon-toot--delete-all-drafts=: Delete all your drafts.
*** Other commands and account settings:
In addition to =mastodon=, the following three functions are autoloaded and
should work without first loading a =mastodon.el= buffer:
- =mastodon-toot=: Compose new toot
- =mastodon-notifications-get=: View all notifications
- =mastodon-url-lookup=: Attempt to load a URL in =mastodon.el=. URL may be at
point or provided in the minibuffer.
- =mastodon-tl--view-instance-description=: View information about the
instance that the author of the toot at point is on.
- =mastodon-tl--view-own-instance=: View information about your own
instance.
- =mastodon-search--trending-tags=: View a list of trending hashtags on your
instance.
- =mastodon-search--trending-statuses=: View a list of trending statuses on
your instance.
- =mastodon-search--trending-links=: View a list of trending links on your
instance (+ click through to a timeline of posts featuring a given link)
- =mastodon-tl--add-toot-account-at-point-to-list=: Add the account of the
toot at point to a list.
- =mastodon-tl--dm-user=: Send a direct message to one of the users at
point.
- =mastodon-profile--add-private-note-to-account=: Add a private note to
another userâs account.
- =mastodon-profile--view-account-private-note=: View a private note on a
userâs account.
- =mastodon-profile--show-familiar-followers=: Show a list of âfamiliar
followersâ for a given account. Familiar followers are accounts that you
follow, and that follow the account.
- =mastodon-tl--follow-tag=: Follow a tag (works like following a user)
- =mastodon-tl--unfollow-tag=: Unfollow a tag
- =mastodon-tl--list-followed-tags=: View a list of tags you're following.
- =mastodon-tl--followed-tags-timeline=: View a timeline of all your
followed tags.
- =mastodon-tl--some-followed-tags-timleine=: View a timeline of multiple
tags, from your followed tags or any other.
- =mastodon-switch-to-buffer=: switch between mastodon buffers.
- =mastodon-tl--get-remote-local-timeline=: View a local timeline of a
remote instance.
- =mastodon-tl--remote-tag-timeline=: View a tag timeline on a remote
instance.
- =mastodon-user-settings=: Launch a transient menu to update various
account settings.
*** Notifications
Mastodon from 4.3 supports grouped notifications. These are implemented by
=mastodon.el= but disabled by default out of consideration to users on
instances that don't support them. If you are on an instance that
implements grouped notifications, set =mastodon-group-notifications= to =t= to
enable them.
*** Customization
See =M-x customize-group RET mastodon= to view all customize options.
- Timeline options:
- Use proportional fonts
- Default number of posts displayed
- Timestamp format
- Relative timestamps
- Display user avatars
- Avatar image height
- Enable image caching
- Hide replies in timelines
- Show toot stats in byline
- Compose options:
- Completion style for mentions and tags
- Enable custom emoji
- Display toot being replied to
- Set default reply visibility
- Nofitication options:
- Display user's profile note in follow requests
- Group notifications
*** Commands and variables index
An index of all user-facing commands and custom variables is available
here: [[file:mastodon-index.org][mastodon-index.org]].
You can also hit =?= in any =mastodon.el= buffer to see the available
bindings, or run =M-X= (upper-case =X=) to view all commands in the buffer
with completion, and call one.
*** Packages related to =mastodon.el=
**** Alternative timeline layout
The incomparable Nicholas Rougier has written an alternative timeline
layout for =mastodon.el=.
The repo is at [[https://github.com/rougier/mastodon-alt][mastodon-alt]].
**** Org links, archive search
[[https://codeberg.org/chrmoe/toot-suite][toot-suite]] implements an org link type for fediverse posts, and also provides a way to browse an offline archive of your account.
**** Mastodon hydra
A user made a hydra for handling basic =mastodon.el= commands. It's
available at https://holgerschurig.github.io/en/emacs-mastodon-hydra/.
**** Narrow to timeline item
A simple code snippet to enable narrowing to current item in timelines:
http://takeonrules.com/2024/10/31/hacking-on-mastodon-emacs-package-to-narrow-viewing/
**** Sachac's config goodies
The incomparable sachac has a bunch of =mastodon.el= extensions and goodies in their literate config, available here: https://sachachua.com/dotemacs/index.html#mastodon.
*** Live-updating timelines: =mastodon-async-mode=
(code taken from [[https://github.com/alexjgriffith/mastodon-future.el][mastodon-future]].)
Works for federated, local, and home timelines and for notifications. It's
a little touchy, one thing to avoid is trying to load a timeline more than
once at a time. It can go off the rails a bit, but it's still pretty cool.
The current maintainer of =mastodon.el= is unable to debug or improve this
feature.
To enable, it, add =(require 'mastodon-async)= to your =init.el=. Then you can
view a timeline with one of the commands that begin with
=mastodon-async--stream-=.
*** Translating toots
You can translate toots with =mastodon-toot--translate-toot-text= (=a= in a
timeline). At the moment this requires [[https://codeberg.org/martianh/lingva.el][lingva.el]], a little interface I
wrote to [[https://lingva.ml][lingva.ml]], to be installed to work.
You could easily modify the simple function to use your Emacs translator
of choice (=libretrans.el= , =google-translate=, =babel=, =go-translate=, etc.),
you just need to fetch the toot's content with =(mastodon-tl--content toot)=
and pass it to your translator function as its text argument. Here's what
=mastodon-toot--translate-toot-text= looks like:
#+begin_src emacs-lisp
(defun mastodon-toot-translate-toot-text ()
"Translate text of toot at point.
Uses `lingva.el'."
(interactive)
(let* ((toot (mastodon-tl--property 'item-json)))
(if toot
(lingva-translate nil (mastodon-tl--content toot))
(message "No toot to translate?"))))
#+end_src
*** Bookmarks and =mastodon.el=
=mastodon.el= implements a basic bookmark record and handler. Currently,
this means that you can bookmark a post item and later load it in thread
view. This could be expanded to any item with an id, but probably not to
things like timeline views. If you want to be able to bookmark something,
open an issue and ask, as it's trivial to expand the bookmarking code.
** Dependencies
Hard dependencies (should all install with =mastodon.el=):
- =request= (for uploading attachments, [[https://github.com/tkf/emacs-request][emacs-request]])
- =persist= (for storing some settings across sessions, [[https://elpa.gnu.org/packages/persist.html][persist]])
- =tp.el= (for transient menus, [[https://codeberg.org/martianh/tp.el][tp.el]])
Optional dependencies (install yourself, =mastodon.el= can use them):
- =emojify= to use custom emoji (else we use builtin =emoji.el=)
- =mpv= and =mpv.el= for viewing videos and gifs
- =lingva.el= for translating toots
** Network compatibility
=mastodon.el= should work with ActivityPub servers that implement the
Mastodon API.
Apart from Mastodon itself, it is currently known to work with:
- Pleroma ([[https://pleroma.social/][pleroma.social]])
- Akkoma ([[https://akkoma.social/][akkoma.social]])
- Gotosocial ([[https://gotosocial.org/][gotosocial.org]])
- Sharkey ([[https://joinsharkey.org][joinsharkey.org]])
It does not support the non-Mastodon API servers Misskey ([[https://misskey.io/][misskey.io]]),
Firefish ([[https://joinfirefish.org/][joinfirefish.org]], formerly Calkey) and Friendica, but it should
fully support displaying and interacting with posts and users on those
platforms.
If you attempt to use =mastodon.el= with a server and run into problems,
feel free to open an issue.
** Contributing
PRs, issues, feature requests, and general feedback are very welcome!
If you prefer emailing patches to the process described below, feel free
to send them on. Ideally they'd be patches that can be applied with =git
am=, if you want to actually contribute a commit.
*** Bug reports
1. =mastodon.el= has bugs, as well as lots of room for improvement.
2. I receive very little feedback, so if I don't run into the bug it often
doesn't get fixed.
3. If you run into something that seems broken, first try running
=mastodon.el= in emacs with no init file (i.e. =emacs -q= (instructions and
code for doing this are [[https://codeberg.org/martianh/mastodon.el/issues/300][here]]) to see if it also happens independently
of your own config (it probably does).
4. Else enable debug on error (=toggle-debug-on-error=), make the bug happen
again, and copy the backtrace that appears.
5. Open an issue here and explain what is going on. Provide your emacs
version and what kind of server your account is on.
*** Fixes and features
1. Install [[https://cask.readthedocs.io/en/latest/guide/installation.html][Cask]] if you don't already have it installed
2. Create an [[https://codeberg.org/martianh/mastodon.el/issues][issue]] detailing what you'd like to do.
3. Fork the repository and create a branch off of =develop=.
4. Run the tests (with =make tests=) and ensure that your code doesn't break any of them.
5. Create a pull request (to develop) referencing the issue created in
step 2.
*** Coding style
- This library uses an unconvential double dash (=--=) between file
namespaces and function names, which contradicts normal Elisp style.
This needs to be respected until the whole library is changed.
- Use =aggressive-indent-mode= or similar to keep your code indented.
- Single spaces end sentences in docstrings.
- There's no need for a blank line after the first docstring line (one is
added automatically when documentation is displayed).
** Supporting =mastodon.el=
If you'd like to support continued development of =mastodon.el=, I accept
donations via paypal: [[https://paypal.me/martianh][paypal.me/martianh]]. If you would prefer a different
payment method, please write to me at and I
can provide IBAN or other bank account details.
I don't have a tech worker's income, so even a small tip would help out.
** Contributors
=mastodon.el= is the work of a number of people.
Some significant contributors are:
- https://github.com/jdenen [original author]
- http://atomized.org
- https://alexjgriffith.itch.io
- https://github.com/hdurer
- https://codeberg.org/Red_Starfish
** Screenshots
Here's a (federated) timeline:
[[file:screenshot-tl.png]]
Here's a notifcations view plus a compose buffer:
[[file:screenshot-notifs+compose.png]]
Here's a user settings transient (active values green, current server
values commented and, if a boolean, underlined):
[[file:screenshot-transient-1.jpg]]
Here's a user profile fields transient (changed fields green, current
server values commented):
[[file:screenshot-transient-2.jpg]]
mastodon.el/dir 0000664 0000000 0000000 00000001235 15017331127 0014003 0 ustar 00root root 0000000 0000000 This is the file .../info/dir, which contains the
topmost node of the Info hierarchy, called (dir)Top.
The first time you invoke Info you start off looking at this node.
File: dir, Node: Top This is the top of the INFO tree
This (the Directory node) gives a menu of major topics.
Typing "q" exits, "H" lists all Info commands, "d" returns here,
"h" gives a primer for first-timers,
"mEmacs" visits the Emacs manual, etc.
In Emacs, you can click mouse button 2 on a menu item or cross reference
to select it.
* Menu:
Emacs
* Mastodon: (mastodon). Client for fediverse services using the
Mastodon API.
mastodon.el/fixture/ 0000775 0000000 0000000 00000000000 15017331127 0014767 5 ustar 00root root 0000000 0000000 mastodon.el/fixture/client.plstore 0000664 0000000 0000000 00000001262 15017331127 0017660 0 ustar 00root root 0000000 0000000 ;;; public entries -*- mode: plstore -*-
(("mastodon-http://other.example" :client_id "id1" :client_secret "secret1")
("mastodon-http://mastodon.example" :client_id "id2" :client_secret "secret2")
("user-test8000@mastodon.example" :username "test8000@mastodon.example" :instance "http://mastodon.example" :client_id "id2" :client_secret "secret2" :access_token "token2")
("active-user" :username "test9000@other.example" :instance "http://other.example" :client_id "id1" :client_secret "secret1" :access_token "token1")
("user-test9000@other.example" :username "test9000@other.example" :instance "http://other.example" :client_id "id1" :client_secret "secret1" :access_token "token1"))
mastodon.el/fixture/empty.plstore 0000664 0000000 0000000 00000000137 15017331127 0017540 0 ustar 00root root 0000000 0000000 ;;; public entries -*- mode: plstore -*-
(("ignore" :client_id "id" :client_secret "secret"))
mastodon.el/lisp/ 0000775 0000000 0000000 00000000000 15017331127 0014250 5 ustar 00root root 0000000 0000000 mastodon.el/lisp/.dir-locals.el 0000664 0000000 0000000 00000000354 15017331127 0016703 0 ustar 00root root 0000000 0000000 ;;; Directory Local Variables -*- no-byte-compile: t -*-
;;; For more information see (info "(emacs) Directory Variables")
((nil . ((indent-tabs-mode . nil)))
(emacs-lisp-mode . ((package-lint-main-file . "mastodon.el"))))
mastodon.el/lisp/mastodon-async.el 0000664 0000000 0000000 00000034524 15017331127 0017541 0 ustar 00root root 0000000 0000000 ;;; mastodon-async.el --- Async streaming functions for mastodon.el -*- lexical-binding: t -*-
;; Copyright (C) 2017 Alex J. Griffith
;; Author: Alex J. Griffith
;; Maintainer: Marty Hiatt
;; Package-Requires: ((emacs "27.1"))
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
;; This file is part of mastodon.el.
;; mastodon.el 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.
;; mastodon.el 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 mastodon.el. If not, see .
;;; Commentary:
;; Rework sync code so it does not mess up the async-buffer
;;; Code:
(require 'mastodon-tl)
(require 'json)
(require 'url-http)
(defvar url-http-end-of-headers)
(autoload 'mastodon-auth--access-token "mastodon-auth")
(autoload 'mastodon-http--api "mastodon-http")
(autoload 'mastodon-http--get-json "mastodon-http")
(autoload 'mastodon-mode "mastodon")
(autoload 'mastodon-notifications--timeline "mastodon-notifications")
(autoload 'mastodon-tl--timeline "mastodon-tl")
(defgroup mastodon-async nil
"An async module for mastodon streams."
:prefix "mastodon-async-"
:group 'external)
;;;###autoload
(define-minor-mode mastodon-async-mode
"Async Mastodon."
:lighter " MasA")
(defvar mastodon-instance-url)
(defvar mastodon-tl--enable-relative-timestamps)
(defvar mastodon-tl--display-media-p)
(defvar mastodon-tl--buffer-spec)
(defvar-local mastodon-async--queue "" ;;"*mastodon-async-queue*"
"The intermediate queue buffer name.")
(defvar-local mastodon-async--buffer "" ;;"*mastodon-async-buffer*"
"User facing output buffer name.")
(defvar-local mastodon-async--http-buffer "" ;;""
"Buffer variable bound to http output.")
(defun mastodon-async--display-http ()
"Display the async HTTP input buffer."
(display-buffer mastodon-async--http-buffer))
(defun mastodon-async--display-buffer ()
"Display the async user facing buffer."
(interactive)
(display-buffer mastodon-async--buffer))
(defun mastodon-async--display-queue ()
"Display the async queue buffer."
(display-buffer mastodon-async--queue))
(defun mastodon-async--stop-http ()
"Stop the http processs and close the async and http buffer."
(interactive)
(let ((inhibit-read-only t))
(stop-process (get-buffer-process mastodon-async--http-buffer))
(delete-process (get-buffer-process mastodon-async--http-buffer))
(kill-buffer mastodon-async--http-buffer)
(setq mastodon-async--http-buffer "")
(when (not (string= "" mastodon-async--queue)) ; error handle on kill async buffer
(kill-buffer mastodon-async--queue))))
(defun mastodon-async--stream-notifications ()
"Open a stream of user notifications."
(interactive)
(mastodon-async--mastodon
"user"
"home"
"notifications"
'mastodon-async--process-queue-string-notifications))
(defun mastodon-async--stream-home ()
"Open a stream of the home timeline."
(interactive)
(mastodon-async--mastodon
"user"
"home"
"home"
'mastodon-async--process-queue-string))
(defun mastodon-async--stream-federated ()
"Open a stream of Federated."
(interactive)
(mastodon-async--mastodon
"public"
"public"
"federated"
'mastodon-async--process-queue-string))
(defun mastodon-async--stream-local ()
"Open a stream of Local."
(interactive)
;; Need to add another layer of filtering for this to work
;; apparently it the local flag does not work
(mastodon-async--mastodon
"public"
"public?local=true"
"local"
'mastodon-async--process-queue-local-string))
(defun mastodon-async--mastodon (endpoint timeline name filter)
"Make sure that the previous async process has been closed.
Then start an async stream at ENDPOINT filtering toots
using FILTER.
TIMELINE is a specific target, such as federated or home.
NAME is the center portion of the buffer name for
*mastodon-async-buffer and *mastodon-async-queue."
(ignore timeline) ;; TODO: figure out what this is meant to be used for
(let ((buffer (mastodon-async--start-process
endpoint filter name)))
(with-current-buffer buffer
(mastodon-async--display-buffer)
(goto-char (point-max))
(goto-char 1))))
(defun mastodon-async--get (url callback)
"An async GET request to URL with CALLBACK."
(let ((url-request-method "GET")
(url-request-extra-headers
`(("Authorization" .
,(concat
"Bearer "
(mastodon-auth--access-token))))))
(url-retrieve url callback)))
(defun mastodon-async--set-http-buffer (buffer http-buffer)
"Initialize for BUFFER a local variable `mastodon-async--http-buffer'.
HTTP-BUFFER is the initializing value. Use this funcion if HTTP-BUFFER
is not known when `mastodon-async--setup-buffer' is called."
(with-current-buffer (get-buffer-create buffer)
(setq mastodon-async--http-buffer http-buffer)))
(defun mastodon-async--set-local-variables (buffer
http-buffer
buffer-name
queue-name)
"Set local variables for BUFFER, HTTP-BUFFER, BUFFER-NAME, and QUEUE-NAME."
(with-current-buffer (get-buffer-create buffer)
(let ((value mastodon-instance-url))
(make-local-variable 'mastodon-instance-url)
(setq-local mastodon-instance-url value))
(setq mastodon-async--http-buffer http-buffer)
(setq mastodon-async--buffer buffer-name)
(setq mastodon-async--queue queue-name)))
(defun mastodon-async--setup-http (http-buffer name)
"Add local variables to HTTP-BUFFER.
NAME is used to generate the display buffer and the queue."
(let ((queue-name (concat " *mastodon-async-queue-" name "-"
mastodon-instance-url "*"))
(buffer-name (concat "*mastodon-async-display-" name "-"
mastodon-instance-url "*")))
(mastodon-async--set-local-variables http-buffer http-buffer
buffer-name queue-name)))
(defun mastodon-async--setup-queue (http-buffer name)
"Set up HTTP-BUFFER buffer for the async queue.
NAME is used to generate the display buffer and the queue."
(let ((queue-name (concat " *mastodon-async-queue-" name "-"
mastodon-instance-url "*"))
(buffer-name(concat "*mastodon-async-display-" name "-"
mastodon-instance-url "*")))
(mastodon-async--set-local-variables queue-name http-buffer
buffer-name queue-name)
queue-name))
(defun mastodon-async--setup-buffer (http-buffer name endpoint)
"Set up the buffer timeline like `mastodon-tl--init'.
HTTP-BUFFER the name of the http-buffer, if unknown, set to...
NAME is the name of the stream for the buffer name.
ENDPOINT is the endpoint for the stream and timeline."
(let ((queue-name (concat " *mastodon-async-queue-" name "-"
mastodon-instance-url "*"))
(buffer-name (concat "*mastodon-async-display-" name "-"
mastodon-instance-url "*"))
;; if user stream, we need "timelines/home" not "timelines/user"
;; if notifs, we need "notifications" not "timelines/notifications"
(endpoint (cond
((string= name "notifications") "notifications")
((string= name "home") "timelines/home")
(t (format "timelines/%s" endpoint)))))
(mastodon-async--set-local-variables buffer-name http-buffer
buffer-name queue-name)
;; Similar to timeline init.
(with-current-buffer (get-buffer-create buffer-name)
(setq inhibit-read-only t) ; for home timeline?
(make-local-variable 'mastodon-tl--enable-relative-timestamps)
(make-local-variable 'mastodon-tl--display-media-p)
(message (mastodon-http--api endpoint))
(if (string= name "notifications")
(mastodon-notifications--timeline
(mastodon-http--get-json
(mastodon-http--api "notifications")))
(mastodon-tl--timeline (mastodon-http--get-json
(mastodon-http--api endpoint))))
(mastodon-mode)
(mastodon-tl--set-buffer-spec buffer-name
endpoint
(if (string= name "notifications")
'mastodon-notifications--timeline
'mastodon-tl--timeline))
(setq-local mastodon-tl--enable-relative-timestamps nil)
(setq-local mastodon-tl--display-media-p t)
(current-buffer))))
(defun mastodon-async--start-process (endpoint filter &optional name)
"Start an async mastodon stream at ENDPOINT.
Filter the toots using FILTER.
NAME is used for the queue and display buffer."
(let* ((stream (concat "streaming/" endpoint))
(async-queue (mastodon-async--setup-queue "" (or name stream)))
(async-buffer (mastodon-async--setup-buffer "" (or name stream) endpoint))
(http-buffer (mastodon-async--get
(mastodon-http--api stream)
(lambda (status)
(ignore status)
(message "HTTP SOURCE CLOSED")))))
(mastodon-async--setup-http http-buffer (or name stream))
(mastodon-async--set-http-buffer async-buffer http-buffer)
(mastodon-async--set-http-buffer async-queue http-buffer)
(set-process-filter (get-buffer-process http-buffer)
(mastodon-async--http-hook filter))
http-buffer))
(defun mastodon-async--http-hook (filter)
"Return a lambda with a custom FILTER for processing toots."
(let ((filter filter))
(lambda (proc data)
(with-current-buffer (process-buffer proc)
(let* ((string
(mastodon-async--stream-filter
(mastodon-async--http-layer proc data)))
(queue-string (mastodon-async--cycle-queue string)))
(when queue-string
(mastodon-async--output-toot
(funcall filter queue-string))))))))
(defun mastodon-async--process-queue-string (string)
"Parse the output STRING of the queue buffer, returning only update events."
(let ((split-strings (split-string string "\n" t)))
(when split-strings ; do nothing if we get nothing; just postpones the error
(let ((event-type (replace-regexp-in-string
"^event: " ""
(car split-strings)))
(data (replace-regexp-in-string
"^data: " "" (cadr split-strings))))
(when (string= "update" event-type)
;; in some casses the data is not fully formed
;; for now return nil if malformed using `ignore-errors'
(ignore-errors (json-read-from-string data)))))))
(defun mastodon-async--process-queue-string-notifications (string)
"Parse the output STRING of the queue buffer, returning only notification events."
;; NB notification events in streams include follow requests
(let* ((split-strings (split-string string "\n" t))
(event-type (replace-regexp-in-string
"^event: " ""
(car split-strings)))
(data (replace-regexp-in-string
"^data: " "" (cadr split-strings))))
(when (string= "notification" event-type)
;; in some casses the data is not fully formed
;; for now return nil if malformed using `ignore-errors'
(ignore-errors (json-read-from-string data)))))
(defun mastodon-async--process-queue-local-string (string)
"Use STRING to limit the public endpoint to displaying local steams only."
(let ((json (mastodon-async--process-queue-string string)))
(when json
(when (mastodon-async--account-local-p json)
json))))
(defun mastodon-async--account-local-p (json)
"Test JSON to see if account is local."
(not (string-match-p
"@"
(alist-get 'acct (alist-get 'account json)))))
(defun mastodon-async--output-toot (toot)
"Process TOOT and prepend it to the async user-facing buffer."
(if (not (bufferp (get-buffer mastodon-async--buffer)))
(mastodon-async--stop-http)
(when toot
(with-current-buffer mastodon-async--buffer
(let* ((inhibit-read-only t)
(old-max (point-max))
(previous (point))
(mastodon-tl--enable-relative-timestamps t)
(mastodon-tl--display-media-p t))
(goto-char (point-min))
(if (equal (buffer-name)
(concat "*mastodon-async-display-notifications-"
mastodon-instance-url "*"))
(mastodon-notifications--timeline (list toot))
(mastodon-tl--timeline (list toot)))
(if (eq previous 1)
(goto-char 1)
(goto-char (+ previous (- (point-max) old-max)))))))))
(defun mastodon-async--cycle-queue (string)
"Append the most recent STRING from http buffer to queue buffer.
Then determine if a full message has been recived. If so return it.
Full messages are seperated by two newlines"
(with-current-buffer mastodon-async--queue
(goto-char (max-char))
(insert (decode-coding-string string 'utf-8))
(goto-char 0)
(let ((next (re-search-forward "\n\n" nil t)))
(when next
(let ((return-string (buffer-substring 1 next))
(inhibit-read-only t))
(delete-region 1 next)
return-string)))))
(defun mastodon-async--http-layer (proc data)
"Passes PROC and DATA to âurl-http-generic-filterâ.
It then processes its output."
(with-current-buffer (process-buffer proc)
(let ((start (max 1 (- (point-max) 2))))
(url-http-generic-filter proc data)
(when (> url-http-end-of-headers start)
(setq start url-http-end-of-headers))
(let ((end (- (point-max) 2)))
(buffer-substring start end)))))
(defun mastodon-async--stream-filter (string)
"Remove comments from STRING."
(replace-regexp-in-string "^:.*\n" "" string))
(provide 'mastodon-async)
;;; mastodon-async.el ends here
mastodon.el/lisp/mastodon-auth.el 0000664 0000000 0000000 00000031664 15017331127 0017367 0 ustar 00root root 0000000 0000000 ;;; mastodon-auth.el --- Auth functions for mastodon.el -*- lexical-binding: t -*-
;; Copyright (C) 2017-2019 Johnson Denen
;; Copyright (C) 2021 Abhiseck Paira
;; Copyright (C) 2025 Marty Hiatt
;; Author: Johnson Denen
;; Maintainer: Marty Hiatt
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
;; This file is part of mastodon.el.
;; mastodon.el 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.
;; mastodon.el 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 mastodon.el. If not, see .
;;; Commentary:
;; mastodon-auth.el supports authorizing and authenticating with Mastodon.
;;; Code:
(require 'plstore)
(require 'auth-source)
(require 'json)
(require 'url)
(eval-when-compile (require 'subr-x)) ; for if-let*
(autoload 'mastodon-client "mastodon-client")
(autoload 'mastodon-client--active-user "mastodon-client")
(autoload 'mastodon-client--form-user-from-vars "mastodon-client")
(autoload 'mastodon-client--make-user-active "mastodon-client")
(autoload 'mastodon-client--store-access-token "mastodon-client")
(autoload 'mastodon-http--api "mastodon-http")
(autoload 'mastodon-http--concat-params-to-url "mastodon-http")
(autoload 'mastodon-http--get-json "mastodon-http")
(autoload 'mastodon-http--post "mastodon-http")
(autoload 'mastodon-return-credential-account "mastodon")
(autoload 'mastodon-client--general-read "mastodon-client")
(autoload 'mastodon-client--token-file "mastodon-client")
(defvar mastodon-instance-url)
(defvar mastodon-client-scopes)
(defvar mastodon-client-redirect-uri)
(defvar mastodon-active-user)
(defgroup mastodon-auth nil
"Authenticate with Mastodon."
:prefix "mastodon-auth-"
:group 'mastodon)
(defcustom mastodon-auth-use-auth-source t
"Whether to use auth sources for user credentials.
If t, save and read user access token in the user's auth source
file (see `auth-sources'). If nil, use `mastodon-client--token-file'
instead.
If you change the value of this variable, call
`mastodon-forget-all-logins' and log in again.
If for some reason you generate a new token, you'll have to update your
auth souce file manually, or at least remove the entry and authenticate
again, as auth-source.el only provides unreliable tools for updating
entries."
:type 'boolean)
(defvar mastodon-auth-source-file nil
"This variable is obsolete.
This variable currently serves no purpose and will be removed in
the future.")
(defvar mastodon-auth--token-alist nil
"Alist of User access tokens keyed by instance url.")
(defvar mastodon-auth--acct-alist nil
"Alist of account accts (name@domain) keyed by instance url.")
(defvar mastodon-auth--user-unaware
" ** MASTODON.EL - NOTICE **
User variables not set: mastodon.el requires that you set both
`mastodon-active-user' and `mastodon-instance-url' in your init file.
Please see its documentation to understand what value it accepts
by running M-x describe-variable on it or visiting our web page:
https://codeberg.org/martianh/mastodon.el.
")
(defun mastodon-auth--get-browser-login-url ()
"Return properly formed browser login url."
(let ((client-id (plist-get (mastodon-client) :client_id)))
(if (not client-id)
(error "Failed to set up client id")
(mastodon-http--concat-params-to-url
(concat mastodon-instance-url "/oauth/authorize/")
`(("response_type" . "code")
("redirect_uri" . ,mastodon-client-redirect-uri)
("scope" . ,mastodon-client-scopes)
("client_id" . ,client-id))))))
(defvar mastodon-auth--explanation
(format
"
1. A URL has been copied to your clipboard. Open this URL in a
javascript capable browser and your browser will take you to your
Mastodon instance's login page.
2. Login to your account (%s) and authorize \"mastodon.el\".
3. After authorization you will be presented an authorization
code. Copy this code and paste it in the minibuffer prompt."
(mastodon-client--form-user-from-vars)))
(defun mastodon-auth--show-notice (notice buffer-name &optional ask)
"Display NOTICE to user.
By default NOTICE is displayed in vertical split occupying 50% of total
width. The buffer name of the buffer being displayed in the
window is BUFFER-NAME.
When optional argument ASK is given which should be a string, use
ASK as the minibuffer prompt. Return whatever user types in
response to the prompt.
When ASK is absent return nil."
(let ((buffer (get-buffer-create buffer-name))
(inhibit-read-only t)
ask-value window)
(set-buffer buffer)
(erase-buffer)
(insert notice)
(fill-region (point-min) (point-max))
(read-only-mode)
(setq window (select-window
(split-window (frame-root-window) nil 'below)
t))
(switch-to-buffer buffer t)
(when ask
(setq ask-value (read-string ask))
(kill-buffer buffer)
(delete-window window))
ask-value))
(defun mastodon-auth--request-authorization-code ()
"Ask authorization code and return it."
(let ((url (mastodon-auth--get-browser-login-url))
(select-enable-clipboard t)
authorization-code)
(kill-new url)
(message "%s" url)
(setq authorization-code
(mastodon-auth--show-notice mastodon-auth--explanation
"*mastodon-notice*"
"Authorization Code: "))
authorization-code))
(defun mastodon-auth--generate-token ()
"Generate access_token for the user. Return response buffer."
(let ((authorization-code (mastodon-auth--request-authorization-code)))
(mastodon-http--post
(concat mastodon-instance-url "/oauth/token")
`(("grant_type" . "authorization_code")
("client_secret" . ,(plist-get (mastodon-client) :client_secret))
("client_id" . ,(plist-get (mastodon-client) :client_id))
("code" . ,authorization-code)
("redirect_uri" . ,mastodon-client-redirect-uri))
nil
:unauthenticated)))
(defun mastodon-auth--get-token ()
"Make a request to generate an auth token and return JSON response."
(with-current-buffer (mastodon-auth--generate-token)
(goto-char (point-min))
(re-search-forward "^$" nil 'move)
(let ((json-object-type 'plist)
(json-key-type 'keyword)
(json-array-type 'vector)
(json-string (buffer-substring-no-properties (point) (point-max))))
(json-read-from-string json-string))))
(defun mastodon-auth--plstore-token-check (&optional auth-source)
"Signal an error if plstore contains unencrypted access-token.
If AUTH-SOURCE, and if `mastodon-auth-use-auth-source' is non-nil,
return non-nil if it contains any access token.
Used to help users switch to the new encrypted auth token flow."
;; FIXME: is it poss to move this plstore read to have one less read?
;; e.g. inside of `mastodon-client--active-user'? the issue is that
;; ideally we want to test "user-" entry, even if fetching "active-user"
;; entry, so we would have to re-do the plstore read functions.
(when
(mastodon-auth--plstore-access-token-member auth-source)
(if auth-source
(user-error "Auth source storage of tokens is enabled,\
but there is also an access token in your plstore.\
If you're seeing this message after updating,\
call `mastodon-forget-all-logins', and try again.
If you don't want to use auth sources,\
also set `mastodon-auth-use-auth-source' to nil.\
If this message is in error, contact us on the mastodon.el repo")
(user-error "Unencrypted access token in your plstore.\
If you're seeing this message after updating,\
call `mastodon-forget-all-logins', and log in again.
If this message is in error, contact us on the mastodon.el repo"))))
(defun mastodon-auth--plstore-access-token-member (&optional auth-source)
"Return non-nil if the user entry of the plstore contains :access_token.
If AUTH-SOURCE, also check if it contains :secret-access_token."
(let* ((plstore (plstore-open (mastodon-client--token-file)))
(name (concat "user-" (mastodon-client--form-user-from-vars)))
;; get alist like plstore.el does, so that keys will display with
;; ":secret-" prefix if encrypted:
(alist (assoc name (plstore--get-merged-alist plstore))))
(if (and auth-source mastodon-auth-use-auth-source)
(or (member :access_token alist)
(member :secret-access_token alist))
(member :access_token alist))))
(defun mastodon-auth--access-token ()
"Return the access token to use with `mastodon-instance-url'.
Generate/save token if none known yet."
(cond
(mastodon-auth--token-alist
;; user variables are known and initialised.
(alist-get mastodon-instance-url
mastodon-auth--token-alist nil nil #'string=))
;; if auth source enabled, but we have an access token in plstore,
;; error out and tell user to remove plstore and start over or disable
;; auth source:
((mastodon-auth--plstore-token-check))
((plist-get (mastodon-client--active-user) :access_token)
;; user variables need to be read from plstore active-user entry.
(push (cons mastodon-instance-url
(plist-get (mastodon-client--active-user) :access_token))
mastodon-auth--token-alist)
(alist-get mastodon-instance-url
mastodon-auth--token-alist nil nil #'string=))
((null mastodon-active-user)
;; user not aware of 2FA-related changes and has not set
;; `mastodon-active-user'. Make user aware and error out.
(mastodon-auth--show-notice mastodon-auth--user-unaware
"*mastodon-notice*")
(user-error "Variables not set properly"))
(t
;; user access-token needs to fetched from the server and
;; stored and variables initialised.
(mastodon-auth--handle-token-response (mastodon-auth--get-token)))))
(defun mastodon-auth--handle-token-response (response)
"Add token RESPONSE to `mastodon-auth--token-alist'.
The token is returned by `mastodon-auth--get-token'.
Handle any errors from the server."
(pcase response
((and (let token (plist-get response :access_token))
(guard token))
(mastodon-client--make-user-active
(mastodon-client--store-access-token token))
(cdar (push (cons mastodon-instance-url token)
mastodon-auth--token-alist)))
(`(:error ,class :error_description ,error)
(error "Mastodon-auth--access-token: %s: %s" class error))
(_ (error "Unknown response from mastodon-auth--get-token!"))))
(defun mastodon-auth-source-get (user host &optional token create)
"Fetch an auth source token, searching by USER and HOST.
If CREATE, use TOKEN or prompt for it, and save it if there is no such entry.
Return a list of user, password/secret, and the item's save-function."
(let* ((auth-source-creation-prompts
'((secret . "%u access token: ")))
(source
(car
(auth-source-search :host host :user user
:require '(:user :secret)
:secret (if token token nil)
;; "create" alone doesn't work here!:
:create (if create t nil)))))
(when source
(let ((creds
`(,(plist-get source :user)
,(auth-info-password source)
,(plist-get source :save-function))))
(when create ;; call save function:
(when (functionp (nth 2 creds))
(funcall (nth 2 creds))))
creds))))
(defun mastodon-auth-source-token (url handle &optional token create)
"Parse URL, search auth sources with it, user HANDLE and TOKEN.
Calls `mastodon-auth-source-get', returns only the token.
If CREATE, create an entry is none is found."
(let ((host (url-host
(url-generic-parse-url url)))
(username (car (split-string handle "@"))))
(nth 1
(mastodon-auth-source-get username host token create))))
(defun mastodon-auth--get-account-name ()
"Request user credentials and return an account name."
(alist-get 'acct
(mastodon-return-credential-account)))
(defun mastodon-auth--get-account-id ()
"Request user credentials and return an account name."
(alist-get 'id
(mastodon-return-credential-account)))
(defun mastodon-auth--user-acct ()
"Return a mastodon user acct name."
(or (cdr (assoc mastodon-instance-url mastodon-auth--acct-alist))
(let ((acct (mastodon-auth--get-account-name)))
(push (cons mastodon-instance-url acct) mastodon-auth--acct-alist)
acct)))
(provide 'mastodon-auth)
;;; mastodon-auth.el ends here
mastodon.el/lisp/mastodon-client.el 0000664 0000000 0000000 00000024506 15017331127 0017701 0 ustar 00root root 0000000 0000000 ;;; mastodon-client.el --- Client functions for mastodon.el -*- lexical-binding: t -*-
;; Copyright (C) 2017-2019 Johnson Denen
;; Copyright (C) 2021 Abhiseck Paira
;; Copyright (C) 2025 Marty Hiatt
;; Author: Johnson Denen
;; Maintainer: Marty Hiatt
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
;; This file is part of mastodon.el.
;; mastodon.el 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.
;; mastodon.el 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 mastodon.el. If not, see .
;;; Commentary:
;; mastodon-client.el supports registering the Emacs client with your Mastodon instance.
;;; Code:
(require 'plstore)
(require 'json)
(require 'url)
(defvar mastodon-instance-url)
(defvar mastodon-active-user)
(defvar mastodon-auth-use-auth-source)
(autoload 'mastodon-http--api "mastodon-http")
(autoload 'mastodon-http--post "mastodon-http")
(autoload 'mastodon-auth-source-token "mastodon-auth")
(defcustom mastodon-client--token-file
(concat user-emacs-directory "mastodon.plstore")
"File path where Mastodon access tokens are stored."
:group 'mastodon
:type 'file)
(defvar mastodon-client--client-details-alist nil
"An alist of Client id and secrets keyed by the instance url.")
(defvar mastodon-client--active-user-details-plist nil
"A plist of active user details.")
(defvar mastodon-client-scopes "read write follow"
"Scopes to pass to oauth during registration.")
(defvar mastodon-client-website "https://codeberg.org/martianh/mastodon.el"
"Website of mastodon.el.")
(defvar mastodon-client-redirect-uri "urn:ietf:wg:oauth:2.0:oob"
"Redirect_uri as required by oauth.")
(defun mastodon-client--register ()
"POST client to Mastodon."
(mastodon-http--post (mastodon-http--api "apps")
`(("client_name" . "mastodon.el")
("redirect_uris" . ,mastodon-client-redirect-uri)
("scopes" . ,mastodon-client-scopes)
("website" . ,mastodon-client-website))
nil
:unauthenticated))
(defun mastodon-client--fetch ()
"Return JSON from `mastodon-client--register' call."
(let ((buf (mastodon-client--register)))
(if (not buf)
(user-error "Client registration failed.\
Is `mastodon-instance-url' correct?")
(with-current-buffer buf
(goto-char (point-min))
(re-search-forward "^$" nil 'move)
(let* ((json-object-type 'plist)
(json-key-type 'keyword)
(json-array-type 'vector)
(json-string
(buffer-substring-no-properties (point) (point-max)))
(parsed
(json-read-from-string json-string)))
(if (eq :error (car parsed))
(error "Error: %s" (cadr parsed))
parsed))))))
(defun mastodon-client--token-file ()
"Return `mastodon-client--token-file'."
mastodon-client--token-file)
(defun mastodon-client--store ()
"Store client_id and client_secret in `mastodon-client--token-file'.
Make `mastodon-client--fetch' call to determine client values.
Return a plist of secret and non-secret key/val pairs."
(let* ((plstore (plstore-open (mastodon-client--token-file)))
(client (mastodon-client--fetch))
(secrets `( :client_id ,(plist-get client :client_id)
:client_secret ,(plist-get client :client_secret)))
(sans-secrets
(dolist (x '(:client_id :client_secret) client)
(cl-remf client x)))
;; alexgriffith reported seeing ellipses in the saved output
;; which indicate some output truncating. Nothing in
;; `plstore-save' seems to ensure this cannot happen so let's do
;; that ourselves:
(print-length nil)
(print-level nil))
(plstore-put plstore
(concat "mastodon-" mastodon-instance-url)
sans-secrets secrets)
;; FIXME: breaks tests: prompts for gpg passphrase
(plstore-save plstore)
(plstore-close plstore)
(append secrets sans-secrets)))
(defun mastodon-client--remove-key-from-plstore (plstore)
"Remove KEY from PLSTORE."
(cdr plstore))
;; Actually it returns a plist with client-details if such details are
;; already stored in mastodon.plstore
(defun mastodon-client--read ()
"Retrieve client_id and client_secret from `mastodon-client--token-file'."
(let* ((plstore (plstore-open (mastodon-client--token-file)))
(mastodon
(plstore-get plstore
(concat "mastodon-" mastodon-instance-url))))
(plstore-close plstore)
(mastodon-client--remove-key-from-plstore mastodon)))
(defun mastodon-client--general-read (key)
"Retrieve the plstore item keyed by KEY.
Return plist without the KEY."
(let* ((plstore (plstore-open (mastodon-client--token-file)))
(plstore-item (plstore-get plstore key)))
(plstore-close plstore)
(mastodon-client--remove-key-from-plstore plstore-item)))
(defun mastodon-client--make-user-details-plist ()
"Make a plist with current user details. Return it."
`( :username ,(mastodon-client--form-user-from-vars)
:instance ,mastodon-instance-url
:client_id ,(plist-get (mastodon-client) :client_id)
:client_secret ,(plist-get (mastodon-client) :client_secret)))
(defun mastodon-client--store-access-token (token)
"Save TOKEN as :access_token encrypted in the plstore.
Return the plist after the operation.
If `mastodon-auth-use-auth-source', encrypt it in auth source file."
(let* ((user-details (mastodon-client--make-user-details-plist))
(plstore (plstore-open (mastodon-client--token-file)))
(username (mastodon-client--form-user-from-vars))
(key (concat "user-" username))
(secrets `( :client_id ,(plist-get user-details :client_id)
:client_secret ,(plist-get user-details :client_secret)))
(sans-secrets
(dolist (x '(:client_id :client_secret) user-details)
(cl-remf user-details x)))
(print-length nil)
(print-level nil))
(if mastodon-auth-use-auth-source
;; auth-source:
(progn
(mastodon-auth-source-token
mastodon-instance-url username token :create)
(plstore-put plstore key sans-secrets secrets))
;; plstore encrypted:
(plstore-put plstore key sans-secrets
(append secrets `(:access_token ,token))))
(plstore-save plstore)
(plstore-close plstore)
(cdr (plstore-get plstore key))))
(defun mastodon-client--make-user-active (user-details)
"USER-DETAILS is a plist consisting of user details.
Save it to plstore under key \"active-user\".
If `mastodon-auth-use-auth-source' is non-nil, fetch the access token
from the user's auth source file and add it to the active user entry.
Return a plist of secret and non-secret key/val pairs."
(let* ((plstore (plstore-open (mastodon-client--token-file)))
(handle (plist-get user-details :username))
(token
(if mastodon-auth-use-auth-source
(mastodon-auth-source-token mastodon-instance-url handle)
(plist-get user-details :access_token)))
(secrets `( :access_token ,token
:client_id ,(plist-get user-details :client_id)
:client_secret ,(plist-get user-details :client_secret)))
(deets (copy-sequence user-details))
(sans-secrets
(dolist (x '(:client_id :client_secret :access_token) deets)
(cl-remf deets x)))
(print-length nil)
(print-level nil))
(plstore-put plstore "active-user" sans-secrets secrets)
(plstore-save plstore)
(plstore-close plstore)
(append secrets sans-secrets)))
(defun mastodon-client--form-user-from-vars ()
"Create a username from user variable. Return that username.
Username in the form user@instance.com is formed from the
variables `mastodon-instance-url' and `mastodon-active-user'."
(concat mastodon-active-user
"@"
(url-host (url-generic-parse-url mastodon-instance-url))))
(defun mastodon-client--make-current-user-active ()
"Make the user specified by user variables active user.
Return the details (plist)."
(let* ((username (mastodon-client--form-user-from-vars))
(user-plist (mastodon-client--general-read
(concat "user-" username))))
(when user-plist
(mastodon-client--make-user-active user-plist)
user-plist)))
(defun mastodon-client--current-user-active-p ()
"Return user-details if the current user is active.
Otherwise return nil."
(let ((username (mastodon-client--form-user-from-vars))
(user-details (mastodon-client--general-read "active-user")))
(when (and user-details
(string= (plist-get user-details :username) username))
user-details)))
(defun mastodon-client--active-user ()
"Return the details of the currently active user.
Details is a plist."
(or mastodon-client--active-user-details-plist
(setq mastodon-client--active-user-details-plist
(or (mastodon-client--current-user-active-p)
(mastodon-client--make-current-user-active)))))
(defun mastodon-client ()
"Return variable client secrets to use for `mastodon-instance-url'.
If `mastodon-client--client-details-alist' is nil, read plist from
`mastodon-client--token-file'.
Fetch and store plist if `mastodon-client--read' returns nil.
Return a plist."
(let ((client-details
(cdr (assoc mastodon-instance-url
mastodon-client--client-details-alist))))
(or client-details
(let ((client-details (or (mastodon-client--read)
(mastodon-client--store))))
(push (cons mastodon-instance-url client-details)
mastodon-client--client-details-alist)
client-details))))
(provide 'mastodon-client)
;;; mastodon-client.el ends here
mastodon.el/lisp/mastodon-discover.el 0000664 0000000 0000000 00000013332 15017331127 0020234 0 ustar 00root root 0000000 0000000 ;;; mastodon-discover.el --- Use Mastodon.el with discover.el -*- lexical-binding: t -*-
;; Copyright (C) 2019 Johnson Denen
;; Copyright (C) 2020-2024 Marty Hiatt
;; Author: Johnson Denen
;; Marty Hiatt
;; Maintainer: Marty Hiatt
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
;; This file is part of mastodon.el.
;; mastodon.el 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.
;; mastodon.el 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 mastodon.el. If not, see .
;;; Commentary:
;; This adds optional functionality that can be used if the dicover package
;; is present.
;;
;; See the README file for how to use this.
;;; Code:
(declare-function discover-add-context-menu "discover")
(autoload 'mastodon-kill-window "mastodon")
(defun mastodon-discover ()
"Plug Mastodon functionality into `discover'."
(interactive)
(when (require 'discover nil :noerror)
(discover-add-context-menu
:bind "?"
:mode 'mastodon-mode
:mode-hook 'mastodon-mode-hook
:context-menu
'(mastodon
(description "Mastodon feed viewer")
(actions
("Toots"
("A" "View profile of author" mastodon-profile-get-toot-author)
("b" "Boost" mastodon-toot--boost)
("f" "Favourite" mastodon-toot--favourite)
("c" "Toggle hidden text (CW)" mastodon-tl-toggle-spoiler-text-in-toot)
("k" "Bookmark toot" mastodon-toot-toggle-bookmark)
("v" "Vote on poll" mastodon-tl-poll-vote)
("n" "Next" mastodon-tl-goto-next-item)
("p" "Prev" mastodon-tl-goto-prev-item)
("TAB" "Next link item" mastodon-tl-next-tab-item)
("S-TAB" "Prev link item" mastodon-tl-previous-tab-item)
;; NB: (when (require 'mpv etc. calls don't work here
("C-RET" "Play media" mastodon-tl-mpv-play-video-at-point)
("t" "New toot" mastodon-toot)
("r" "Reply" mastodon-toot-reply)
("C" "Copy toot URL" mastodon-toot-copy-toot-url)
("o" "Open toot URL" mastodon-toot-browse-toot-url)
("d" "Delete (your) toot" mastodon-toot-delete-toot)
("D" "Delete and redraft (your) toot" mastodon-toot-delete-toot)
("e" "Edit (your) toot" mastodon-toot-edit-toot-at-point)
("E" "View edits of (your) toot" mastodon-toot-view-toot-edits)
("i" "Pin/Unpin (your) toot" mastodon-toot-pin-toot-toggle)
("P" "View user profile" mastodon-profile-show-user)
("a" "Translate toot at point" mastodon-toot-translate-toot-text)
("T" "View thread" mastodon-tl-thread)
("v" "Vote on poll" mastodon-tl-poll-vote)
("," "View toot's favouriters" mastodon-toot--list-toot-favouriters)
("." "View toot's boosters" mastodon-toot--list-toot-boosters)
("/" "Switch buffers" mastodon-switch-to-buffer))
("Views"
("h/?" "View mode help/keybindings" describe-mode)
("#" "Tag search" mastodon-tl-get-tag-timeline)
("\"" "List followed tags" mastodon-tl-list-followed-tags)
("'" "Followed tags timeline" mastodon-tl-followed-tags-timeline)
("F" "Federated" mastodon-tl-get-federated-timeline)
("H" "Home" mastodon-tl-get-home-timeline)
("L" "Local" mastodon-tl-get-local-timeline)
("N" "Notifications" mastodon-notifications-get)
("@" "Notifications with mentions" mastodon-notifications-get-mentions)
("g/u" "Update timeline" mastodon-tl-update)
("s" "Search" mastodon-search-query)
("O" "Jump to your profile" mastodon-profile-my-profile)
("U" "Update your profile note" mastodon-profile-update-user-profile-note)
("K" "View bookmarks" mastodon-profile-view-bookmarks)
("V" "View favourites" mastodon-profile-view-favourites)
("R" "View follow requests" mastodon-profile--view-follow-requests)
("G" "View follow suggestions" mastodon-tl--get-follow-suggestions)
("I" "View filters" mastodon-tl--view-filters)
("X" "View lists" mastodon-tl--view-lists)
("S" "View scheduled toots" mastodon-tl--view-scheduled-toots)
(";" "View instance description" mastodon-tl--view-instance-description))
("Users"
("W" "Follow" mastodon-tl-follow-user)
("C-S-W" "Unfollow" mastodon-tl-unfollow-user)
("M" "Mute" mastodon-tl-mute-user)
("C-S-M" "Unmute" mastodon-tl-unmute-user)
("B" "Block" mastodon-tl-block-user)
("C-S-B" "Unblock" mastodon-tl-unblock-user))
("Images"
;; RET errors here also :/
("/i" "Load full image in browser" 'shr-browse-image)
("r" "rotate" 'image-rotate)
("+" "zoom in" 'image-increase-size)
("-" "zoom out" 'image-decrease-size)
("u" "copy URL" 'shr-maybe-probe-and-copy-url))
("Profile view"
("C-c C-c" "Cycle profile views" mastodon-profile-account-view-cycle))
("Quit"
("q" "Quit mastodon and bury buffer." kill-this-buffer)
("Q" "Quit mastodon buffer and kill window." mastodon--kill-window)
("M-C-q" "Quit mastodon and kill all buffers." mastodon-kill-all-buffers)))))))
(provide 'mastodon-discover)
;;; mastodon-discover.el ends here
mastodon.el/lisp/mastodon-http.el 0000664 0000000 0000000 00000044277 15017331127 0017411 0 ustar 00root root 0000000 0000000 ;;; mastodon-http.el --- HTTP request/response functions for mastodon.el -*- lexical-binding: t -*-
;; Copyright (C) 2017-2019 Johnson Denen
;; Copyright (C) 2020-2024 Marty Hiatt
;; Author: Johnson Denen
;; Marty Hiatt
;; Maintainer: Marty Hiatt
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
;; This file is part of mastodon.el.
;; mastodon.el 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.
;; mastodon.el 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 mastodon.el. If not, see .
;;; Commentary:
;; mastodon-http.el provides HTTP request/response functions.
;;; Code:
(require 'json)
(require 'url)
(require 'url-http)
(require 'shr)
(defvar mastodon-instance-url)
(defvar mastodon-toot--media-attachment-ids)
(defvar mastodon-toot--media-attachment-filenames)
(autoload 'mastodon-auth--access-token "mastodon-auth")
(autoload 'mastodon-toot--update-status-fields "mastodon-toot")
(autoload 'url-insert "url-handlers")
(defvar mastodon-http--api-version "v1")
(defconst mastodon-http--timeout 15
"HTTP request timeout, in seconds. Has no effect on Emacs < 26.1.")
(defun mastodon-http--api (endpoint &optional version)
"Return Mastodon API URL for ENDPOINT.
Optionally specify VERSION in format vX."
(concat mastodon-instance-url "/api/"
(or version mastodon-http--api-version) "/" endpoint))
(defun mastodon-http--api-v2 (endpoint)
"Return Mastodon API v2 URL for ENDPOINT."
(mastodon-http--api endpoint "v2"))
(defun mastodon-http--url-retrieve-synchronously (url &optional silent)
"Retrieve URL asynchronously.
This is a thin abstraction over the system
`url-retrieve-synchronously'. Depending on which version of this
is available we will call it with or without a timeout.
SILENT means don't message."
(if (< (cdr (func-arity 'url-retrieve-synchronously)) 4)
(url-retrieve-synchronously url)
(url-retrieve-synchronously url (or silent nil) nil mastodon-http--timeout)))
(defun mastodon-http--triage (response success)
"Determine if RESPONSE was successful.
Call SUCCESS on RESPONSE if successful. Message status and JSON error
from RESPONSE if unsuccessful."
(let ((status (with-current-buffer response
;; FIXME: breaks tests, as url-http-end-of-headers not set
(url-http-parse-response))))
(if (and (>= 200 status)
(<= status 299))
;; (string-prefix-p "2" (number-to-string status))
(funcall success response)
(if (= 404 status)
(message "Error %s: page not found" status)
(let ((json-response (with-current-buffer response
(mastodon-http--process-json))))
(message "Error %s: %s" status (alist-get 'error json-response)))))))
(defun mastodon-http--read-file-as-string (filename &optional url)
"Read a file FILENAME as a string.
Used to generate image preview.
URL means FILENAME is a URL."
(with-temp-buffer
(if url
(url-insert-file-contents filename)
(insert-file-contents filename))
(string-to-unibyte (buffer-string))))
(defmacro mastodon-http--authorized-request (method body &optional unauthenticated-p)
"Make a METHOD type request using BODY, with Mastodon authorization.
Unless UNAUTHENTICATED-P is non-nil."
(declare (debug 'body)
(indent 1))
`(let ((url-request-method ,method)
(url-request-extra-headers
(unless ,unauthenticated-p
(list (cons "Authorization"
(concat "Bearer " (mastodon-auth--access-token)))))))
,body))
(defun mastodon-http--build-params-string (params)
"Build a request parameters string from parameters alist PARAMS."
;; (url-build-query-string args nil))
;; url-build-query-string adds 'nil' for empty params so lets stick with our
;; own:
(mapconcat (lambda (p)
(when (cdr p) ; only when value
(concat (url-hexify-string (car p))
"=" (url-hexify-string (cdr p)))))
params "&"))
(defun mastodon-http--build-array-params-alist (param-str array)
"Return parameters alist using PARAM-STR and ARRAY param values.
Used for API form data parameters that take an array."
(cl-loop for x in array
collect (cons param-str x)))
(defun mastodon-http--concat-params-to-url (url params)
"Build a query string with PARAMS and concat to URL."
(if params
(concat url "?"
(mastodon-http--build-params-string params))
url))
(defun mastodon-http--post (url
&optional params headers unauthenticated-p json)
"POST synchronously to URL, optionally with PARAMS and HEADERS.
Authorization header is included by default unless
UNAUTHENTICATED-P is non-nil.
If JSON is :json, encode PARAMS as JSON for
the request data. If it is :raw, just use the plain params."
;; NB: raw is used by `mastodon-tl-unfilter-user-languages'; not sure if
;; there's a way around it?
(mastodon-http--authorized-request "POST"
(let* ((url-request-data
(when params
(cond ((eq json :json)
(json-encode params))
((eq json :raw)
params)
(t
(mastodon-http--build-params-string params)))))
(url-request-extra-headers
(append url-request-extra-headers ; auth set in macro
(if json
'(("Content-Type" . "application/json")
("Accept" . "application/json"))
(unless (assoc "Content-Type" headers) ; pleroma compat:
'(("Content-Type" . "application/x-www-form-urlencoded"))))
headers)))
(with-temp-buffer
(mastodon-http--url-retrieve-synchronously url)))
unauthenticated-p))
(defun mastodon-http--get (url &optional params silent)
"Make synchronous GET request to URL.
PARAMS is an alist of any extra parameters to send with the request.
SILENT means don't message."
(mastodon-http--authorized-request "GET"
;; url-request-data doesn't seem to work with GET requests?:
(let ((url (mastodon-http--concat-params-to-url url params)))
(mastodon-http--url-retrieve-synchronously url silent))))
(defun mastodon-http--get-response (url &optional params no-headers silent vector)
"Make synchronous GET request to URL. Return JSON and response headers.
PARAMS is an alist of any extra parameters to send with the request.
SILENT means don't message.
NO-HEADERS means don't collect http response headers.
VECTOR means return json arrays as vectors."
(let ((buf (mastodon-http--get url params silent)))
;; --get can return nil if instance unresponsive:
(if (not buf)
(user-error "Looks like the server response borked. \
Is your instance up?")
(with-current-buffer buf
(mastodon-http--process-response no-headers vector)))))
(defun mastodon-http--get-json (url &optional params silent vector)
"Return only JSON data from URL request.
PARAMS is an alist of any extra parameters to send with the request.
SILENT means don't message.
VECTOR means return json arrays as vectors."
(car (mastodon-http--get-response url params :no-headers silent vector)))
(defun mastodon-http--process-json ()
"Return only JSON data from async URL request.
Callback to `mastodon-http--get-json-async', usually
`mastodon-tl--init*', is run on the result."
(car (mastodon-http--process-response :no-headers)))
(defun mastodon-http--render-html-err (string)
"Render STRING as HTML in a temp buffer.
STRING should be a HTML for a 404 errror."
(with-temp-buffer
(insert string)
(shr-render-buffer (current-buffer))
(view-mode))) ; for 'q' to kill buffer and window
;; (error ""))) ; stop subsequent processing
(defun mastodon-http--process-response (&optional no-headers vector)
"Process http response.
Return a cons of JSON list and http response headers.
If NO-HEADERS is non-nil, just return the JSON.
VECTOR means return json arrays as vectors.
Callback to `mastodon-http--get-response-async', usually
`mastodon-tl--init*', is run on the result."
;; view raw response:
;; (switch-to-buffer (current-buffer))
(let ((headers (unless no-headers
(mastodon-http--process-headers))))
(goto-char (point-min))
(re-search-forward "^$" nil 'move)
(let ((json-array-type (if vector 'vector 'list))
(json-string (string-trim-right
(decode-coding-string
(buffer-substring-no-properties (point) (point-max))
'utf-8))))
(kill-buffer)
(cond ((or (string-empty-p json-string) (null json-string))
nil)
;; if we get html, just render it and error:
;; ideally we should handle the status code in here rather than
;; this crappy hack?
((string-prefix-p "\n<" json-string) ; html hack
;; NB: in this case, process-response returns t!:
(mastodon-http--render-html-err json-string)
nil) ;; return nil instead of t
;; if no json or html, maybe we have a plain string error message
;; (misskey does this, but there are probably better ways to do
;; this):
((not (or (string-prefix-p "\n{" json-string)
(string-prefix-p "\n[" json-string)))
(error "%s" json-string))
(t
;; instance may return error in JSON e.g. ((error . "Record not
;; found")) for a null endpoint. but we don't error here because
;; sometimes we just want to check for such an error in an
;; if/cond.
`(,(json-read-from-string json-string) . ,headers))))))
(defun mastodon-http--process-headers ()
"Return an alist of http response headers."
(goto-char (point-min))
(let* ((head-str (buffer-substring-no-properties
(point-min)
(re-search-forward "^$" nil 'move)))
(head-list (split-string head-str "\n")))
(mapcar (lambda (x)
(let ((list (split-string x ": ")))
(cons (car list) (cadr list))))
head-list)))
(defun mastodon-http--delete (url &optional params)
"Make DELETE request to URL.
PARAMS is an alist of any extra parameters to send with the request."
;; url-request-data only works with POST requests?
(let ((url (mastodon-http--concat-params-to-url url params)))
(mastodon-http--authorized-request "DELETE"
(with-temp-buffer
(mastodon-http--url-retrieve-synchronously url)))))
(defun mastodon-http--put (url &optional params headers)
"Make PUT request to URL.
PARAMS is an alist of any extra parameters to send with the request.
HEADERS is an alist of any extra headers to send with the request."
(mastodon-http--authorized-request "PUT"
(let ((url-request-data
(when params (mastodon-http--build-params-string params)))
(url-request-extra-headers
(append url-request-extra-headers ; auth set in macro
(unless (assoc "Content-Type" headers) ; pleroma compat:
'(("Content-Type" . "application/x-www-form-urlencoded")))
headers)))
(with-temp-buffer (mastodon-http--url-retrieve-synchronously url)))))
;; profile update functions
(defun mastodon-http--patch-json (url &optional params)
"Make synchronous PATCH request to URL. Return JSON response.
Optionally specify the PARAMS to send."
(with-current-buffer (mastodon-http--patch url params)
(mastodon-http--process-json)))
(defun mastodon-http--patch (url &optional params json)
"Make synchronous PATCH request to URL.
Optionally specify the PARAMS to send.
JSON means send params as JSON data."
(mastodon-http--authorized-request "PATCH"
;; NB: unlike POST, PATCHing only works if we use query params!
;; so here, unless JSON arg, we use query params and do not set
;; `url-request-data'. this is probably an error, i don't understand it.
(let* ((url-request-data
(when (and params json)
(encode-coding-string
(json-encode params) 'utf-8)))
;; (mastodon-http--build-params-string params))))
(url (if (not json)
(mastodon-http--concat-params-to-url url params)
url))
(headers (when json
'(("Content-Type" . "application/json")
("Accept" . "application/json"))))
(url-request-extra-headers
(append url-request-extra-headers headers)))
(mastodon-http--url-retrieve-synchronously url))))
;; Asynchronous functions
(defun mastodon-http--get-async (url &optional params callback &rest cbargs)
"Make GET request to URL.
Pass response buffer to CALLBACK function with args CBARGS.
PARAMS is an alist of any extra parameters to send with the request."
(let ((url (mastodon-http--concat-params-to-url url params)))
(mastodon-http--authorized-request "GET"
(url-retrieve url callback cbargs))))
(defun mastodon-http--get-response-async (url &optional params callback &rest cbargs)
"Make GET request to URL. Call CALLBACK with http response and CBARGS.
PARAMS is an alist of any extra parameters to send with the request."
(mastodon-http--get-async
url
params
(lambda (status)
(when status ; for flakey servers
(apply callback (mastodon-http--process-response) cbargs)))))
(defun mastodon-http--get-json-async (url &optional params callback &rest cbargs)
"Make GET request to URL. Call CALLBACK with json-list and CBARGS.
PARAMS is an alist of any extra parameters to send with the request."
(mastodon-http--get-async
url
params
(lambda (status)
(when status ;; only when we actually get sth?
(apply callback (mastodon-http--process-json) cbargs)))))
(defun mastodon-http--post-async (url params _headers &optional callback &rest cbargs)
"POST asynchronously to URL with PARAMS and HEADERS.
Then run function CALLBACK with arguements CBARGS.
Authorization header is included by default unless UNAUTHENTICED-P is non-nil."
(mastodon-http--authorized-request "POST"
(let ((url-request-data (when params
(mastodon-http--build-params-string params))))
(with-temp-buffer
(url-retrieve url callback cbargs)))))
(defun mastodon-http--get-cb-data (status)
"Return data using `json-read' after a successful async request.
If STATUS includes an error, emit a message describing it and return nil."
(let* ((buf (current-buffer))
(data (with-temp-buffer
(url-insert buf)
(goto-char (point-min))
(json-read))))
(if-let* ((error-thrown (plist-get status :error)))
;; not necessarily a user error, but we want its functionality:
(user-error "%S %s" error-thrown (alist-get 'error data))
data)))
(defun mastodon-http--post-media-callback (status file caption buffer)
"Callback function called after posting FILE as an attachment with CAPTION.
The toot is being composed in BUFFER. See `url-retrieve' for STATUS."
(unwind-protect
(when-let* ((data (mastodon-http--get-cb-data status)))
(with-current-buffer buffer
(let ((id (alist-get 'id data)))
;; update ids:
(if (not mastodon-toot--media-attachment-ids)
;; add first id:
(push id mastodon-toot--media-attachment-ids)
;; add new id to end of list to preserve order:
(push id (cdr
(last mastodon-toot--media-attachment-ids))))
;; pleroma, PUT the description:
;; this is how the mangane akkoma web client does it
;; and it seems easier than the other options!
(when (and caption
(not (string= caption (alist-get 'description data))))
(let ((url (mastodon-http--api (format "media/%s" id))))
;; (message "PUTting image description")
(mastodon-http--put url `(("description" . ,caption)))))
(message "Uploading %s... (done)" file)
(mastodon-toot--update-status-fields))))
(kill-buffer (current-buffer))))
(defun mastodon-http--post-media-prep-file (filename)
"Return the request data to upload FILENAME."
(with-temp-buffer
(set-buffer-multibyte nil)
(insert-file-contents-literally filename)
(let ((boundary (buffer-hash)))
(goto-char (point-min))
(insert "--" boundary "\r\n"
(format "Content-Disposition: form-data; name=\"file\"; filename=\"%s\"\r\n\r\n"
(file-name-nondirectory filename)))
(goto-char (point-max))
(insert "\r\n" "--" boundary "--" "\r\n")
`(,boundary . ,(buffer-substring-no-properties (point-min) (point-max))))))
(defun mastodon-http--post-media-attachment (url filename caption)
"Make POST request to upload FILENAME with CAPTION to the server's media URL.
The upload is asynchronous. On succeeding,
`mastodon-toot--media-attachment-ids' is set to the id(s) of the
item uploaded, and `mastodon-toot--update-status-fields' is run."
(mastodon-http--authorized-request "POST"
(let* ((data (mastodon-http--post-media-prep-file filename))
(url-request-extra-headers
(append url-request-extra-headers ; auth set in macro
`(("Content-Type" . ,(format "multipart/form-data; boundary=%s"
(car data))))))
(url-request-data (cdr data))
(params `(("description" . ,caption)))
(url (mastodon-http--concat-params-to-url url params)))
(url-retrieve url #'mastodon-http--post-media-callback
`(,filename ,caption ,(current-buffer))))))
(provide 'mastodon-http)
;;; mastodon-http.el ends here
mastodon.el/lisp/mastodon-inspect.el 0000664 0000000 0000000 00000011052 15017331127 0020060 0 ustar 00root root 0000000 0000000 ;;; mastodon-inspect.el --- Client for Mastodon -*- lexical-binding: t -*-
;; Copyright (C) 2017-2019 Johnson Denen
;; Copyright (C) 2020-2024 Marty Hiatt
;; Author: Johnson Denen
;; Marty Hiatt
;; Maintainer: Marty Hiatt
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
;; This file is part of mastodon.el.
;; mastodon.el 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.
;; mastodon.el 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 mastodon.el. If not, see .
;;; Commentary:
;; Some tools to help inspect / debug mastodon.el
;;; Code:
(autoload 'mastodon-http--api "mastodon-http")
(autoload 'mastodon-http--get-json "mastodon-http")
(autoload 'mastodon-http--get-search-json "mastodon-http")
(autoload 'mastodon-media--inline-images "mastodon-media")
(autoload 'mastodon-mode "mastodon")
(autoload 'mastodon-tl--as-string "mastodon-tl")
(autoload 'mastodon-tl--property "mastodon-tl")
(autoload 'mastodon-tl--toot "mastodon-tl")
(defvar mastodon-instance-url)
(defgroup mastodon-inspect nil
"Tools to help inspect toots."
:prefix "mastodon-inspect-"
:group 'external)
(defun mastodon-inspect--dump-json-in-buffer (name json)
"Buffer NAME is opened and JSON in printed into it."
(switch-to-buffer-other-window name)
(erase-buffer)
(let ((print-level nil)
(print-length nil))
(insert (pp json t)))
(goto-char (point-min))
(emacs-lisp-mode)
(message "success"))
(defun mastodon-inspect--toot ()
"Find next toot and dump its meta data into new buffer."
(interactive)
(mastodon-inspect--dump-json-in-buffer
(concat "*mastodon-inspect-toot-"
(mastodon-tl--as-string (mastodon-tl--property 'item-id))
"*")
(mastodon-tl--property 'item-json)))
(defun mastodon-inspect--download-single-toot (item-id)
"Download the toot/status represented by ITEM-ID."
(mastodon-http--get-json
(mastodon-http--api (concat "statuses/" item-id))))
(defun mastodon-inspect--view-single-toot (item-id)
"View the toot/status represented by ITEM-ID."
(interactive "s Toot ID: ")
(let ((buffer (get-buffer-create (concat "*mastodon-status-" item-id "*"))))
(with-current-buffer buffer
(let ((toot (mastodon-inspect--download-single-toot item-id )))
(mastodon-tl--toot toot)
(goto-char (point-min))
(while (search-forward "\n\n\n | " nil t)
(replace-match "\n | "))
(mastodon-media--inline-images (point-min) (point-max))))
(switch-to-buffer-other-window buffer)
(mastodon-mode)))
(defun mastodon-inspect--view-single-toot-source (item-id)
"View the ess source of a toot/status represented by ITEM-ID."
(interactive "s Toot ID: ")
(mastodon-inspect--dump-json-in-buffer
(concat "*mastodon-status-raw-" item-id "*")
(mastodon-inspect--download-single-toot item-id)))
(defvar mastodon-inspect--search-query-accounts-result)
(defvar mastodon-inspect--single-account-json)
(defvar mastodon-inspect--search-query-full-result)
(defvar mastodon-inspect--search-result-tags)
(defun mastodon-inspect--get-search-result (query)
"Inspect function for a search result for QUERY."
(interactive)
(setq mastodon-inspect--search-query-full-result
(append ; convert vector to list
(mastodon-http--get-search-json
(format "%s/api/v2/search" mastodon-instance-url)
query)
nil))
(setq mastodon-inspect--search-result-tags
(append (cdr
(caddr mastodon-inspect--search-query-full-result))
nil)))
(defun mastodon-inspect--get-search-account (query)
"Return JSON for a single account after search QUERY."
(interactive)
(setq mastodon-inspect--search-query-accounts-result
(append ; convert vector to list
(mastodon-http--get-search-json
(format "%s/api/v1/accounts/search" mastodon-instance-url)
query)
nil))
(setq mastodon-inspect--single-account-json
(car mastodon-inspect--search-query-accounts-result)))
(provide 'mastodon-inspect)
;;; mastodon-inspect.el ends here
mastodon.el/lisp/mastodon-iso.el 0000664 0000000 0000000 00000014433 15017331127 0017213 0 ustar 00root root 0000000 0000000 ;;; mastodon-iso.el --- ISO language code lists for mastodon.el -*- lexical-binding: t -*-
;; Copyright (C) 2022 Marty Hiatt
;; Author: Marty Hiatt
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
;; This file is part of mastodon.el.
;; mastodon.el 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.
;; mastodon.el 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 mastodon.el. If not, see .
;;; Commentary:
;;; Code:
;; via
;; https://github.com/VyrCossont/mastodon/blob/0836f4a656d5486784cadfd7d0cd717bb67ede4c/app/helpers/languages_helper.rb
;; and
;; https://github.com/Shinmera/language-codes/blob/master/data/iso-639-3.lisp
(defvar mastodon-iso-639-1
'(("Abkhazian" . "ab")
("Afar" . "aa")
("Afrikaans" . "af")
("Akan" . "ak")
("Albanian" . "sq")
("Amharic" . "am")
("Arabic" . "ar")
("Aragonese" . "an")
("Armenian" . "hy")
("Assamese" . "as")
("Avaric" . "av")
("Avestan" . "ae")
("Aymara" . "ay")
("Azerbaijani" . "az")
("Bambara" . "bm")
("Bashkir" . "ba")
("Basque" . "eu")
("Belarusian" . "be")
("Bengali" . "bn")
("Bihari languages" . "bh")
("Bislama" . "bi")
("Bosnian" . "bs")
("Breton" . "br")
("Bulgarian" . "bg")
("Burmese" . "my")
("Central Khmer" . "km")
("Chamorro" . "ch")
("Chechen" . "ce")
("Chinese" . "zh")
("Chuvash" . "cv")
("Cornish" . "kw")
("Corsican" . "co")
("Cree" . "cr")
("Croatian" . "hr")
("Czech" . "cs")
("Danish" . "da")
("Dzongkha" . "dz")
("English" . "en")
("Esperanto" . "eo")
("Estonian" . "et")
("Ewe" . "ee")
("Faroese" . "fo")
("Fijian" . "fj")
("Finnish" . "fi")
("Dutch" . "nl")
("French" . "fr")
("Fulah" . "ff")
("Galician" . "gl")
("Ganda" . "lg")
("Georgian" . "ka")
("German" . "de")
("Greek" . "el")
("Guarani" . "gn")
("Gujarati" . "gu")
("Haitian" . "ht")
("Hausa" . "ha")
("Hebrew" . "he")
("Herero" . "hz")
("Hindi" . "hi")
("Hiri Motu" . "ho")
("Hungarian" . "hu")
("Icelandic" . "is")
("Ido" . "io")
("Igbo" . "ig")
("Indonesian" . "id")
("Interlingua" . "ia")
("Inuktitut" . "iu")
("Inupiaq" . "ik")
("Irish" . "ga")
("Italian" . "it")
("Japanese" . "ja")
("Japanese" . "jp")
("Javanese" . "jv")
("Kalaallisut" . "kl")
("Kannada" . "kn")
("Kanuri" . "kr")
("Kashmiri" . "ks")
("Kazakh" . "kk")
("Kikuyu" . "ki")
("Kinyarwanda" . "rw")
("Komi" . "kv")
("Kongo" . "kg")
("Korean" . "ko")
("Kurdish" . "ku")
("Kuanyama" . "kj")
("Kirghiz" . "ky")
("Lao" . "lo")
("Latin" . "la")
("Latvian" . "lv")
("Limburgan" . "li")
("Lingala" . "ln")
("Lithuanian" . "lt")
("Luba-Katanga" . "lu")
("Luxembourgish" . "lb")
("Macedonian" . "mk")
("Malagasy" . "mg")
("Malay" . "ms")
("Malayalam" . "ml")
("Divehi" . "dv")
("Maltese" . "mt")
("Manx" . "gv")
("Maori" . "mi")
("Marathi" . "mr")
("Marshallese" . "mh")
("Mongolian" . "mn")
("Nauru" . "na")
("Navajo" . "nv")
("Ndonga" . "ng")
("Nepali" . "ne")
("Ndebele, North" . "nd")
("Northern Sami" . "se")
("Norwegian" . "no")
("BokmĂĽl, Norwegian" . "nb")
("Chichewa" . "ny")
("Norwegian Nynorsk" . "nn")
("Interlingue" . "ie")
("Occitan" . "oc")
("Ojibwa" . "oj")
("Church Slavic" . "cu")
("Oriya" . "or")
("Oromo" . "om")
("Ossetian" . "os")
("Pali" . "pi")
("Persian" . "fa")
("Polish" . "pl")
("Portuguese" . "pt")
("Panjabi" . "pa")
("Pushto" . "ps")
("Quechua" . "qu")
("Romanian" . "ro")
("Romansh" . "rm")
("Rundi" . "rn")
("Russian" . "ru")
("Samoan" . "sm")
("Sango" . "sg")
("Sanskrit" . "sa")
("Sardinian" . "sc")
("Gaelic" . "gd")
("Serbian" . "sr")
("Shona" . "sn")
("Sichuan Yi" . "ii")
("Sindhi" . "sd")
("Sinhala" . "si")
("Slovak" . "sk")
("Slovenian" . "sl")
("Somali" . "so")
("Sotho, Southern" . "st")
("Ndebele, South" . "nr")
("Spanish" . "es")
("Sundanese" . "su")
("Swahili" . "sw")
("Swati" . "ss")
("Swedish" . "sv")
("Tagalog" . "tl")
("Tahitian" . "ty")
("Tajik" . "tg")
("Tamil" . "ta")
("Tatar" . "tt")
("Telugu" . "te")
("Thai" . "th")
("Tibetan" . "bo")
("Tigrinya" . "ti")
("Tonga (Tonga Islands)" . "to")
("Tsonga" . "ts")
("Tswana" . "tn")
("Turkish" . "tr")
("Turkmen" . "tk")
("Twi" . "tw")
("Ukrainian" . "uk")
("Urdu" . "ur")
("Uighur" . "ug")
("Uzbek" . "uz")
("Catalan" . "ca")
("Venda" . "ve")
("Vietnamese" . "vi")
("VolapĂźk" . "vo")
("Walloon" . "wa")
("Welsh" . "cy")
("Western Frisian" . "fy")
("Wolof" . "wo")
("Xhosa" . "xh")
("Yiddish" . "yi")
("Yoruba" . "yo")
("Zhuang" . "za")
("Zulu" . "zu")))
;; web UI doesn't respect these for now
(defvar mastodon-iso-639-regional
'(("es-AR" "EspaĂąol (Argentina)")
("es-MX" "EspaĂąol (MĂŠxico)")
("pt-BR" "PortuguĂŞs (Brasil)")
("pt-PT" "PortuguĂŞs (Portugal)")
("sr-Latn" "Srpski (latinica)")
("zh-CN" "çŽä˝ä¸ć")
("zh-HK" "çšéŤä¸ćďźéŚć¸Żďź")
("zh-TW" "çšéŤä¸ćďźčşçŁďź")))
(defvar mastodon-iso-639-3
'(("ast" "Asturian" "Asturianu")
("ckb" "Sorani (Kurdish)" "ŘłŰعاŮŰ")
("jbo" "Lojban" "la .lojban.")
("kab" "Kabyle" "Taqbaylit")
("kmr" "Kurmanji (Kurdish)" "KurmancĂŽ")
("ldn" "LĂĄadan" "LĂĄadan")
("lfn" "Lingua Franca Nova" "lingua franca nova")
("tok" "Toki Pona" "toki pona")
("zba" "Balaibalan" "باŮŮبŮŮ")
("zgh" "Standard Moroccan Tamazight" "âľâ´°âľâ´°âľŁâľâľâľ")))
(provide 'mastodon-iso)
;;; mastodon-iso.el ends here
mastodon.el/lisp/mastodon-media.el 0000664 0000000 0000000 00000072057 15017331127 0017506 0 ustar 00root root 0000000 0000000 ;;; mastodon-media.el --- Functions for inlining Mastodon media -*- lexical-binding: t -*-
;; Copyright (C) 2017-2019 Johnson Denen
;; Copyright (C) 2020-2024 Marty Hiatt
;; Author: Johnson Denen
;; Marty Hiatt
;; Maintainer: Marty Hiatt
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
;; This file is part of mastodon.el.
;; mastodon.el 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.
;; mastodon.el 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 mastodon.el. If not, see .
;;; Commentary:
;; mastodon-media.el provides functions for inlining media.
;; Known bug gnutls -12 when trying to access images on some systems.
;; It looks like their may be a version mismatch between the encryption
;; required by the server and client.
;;; Code:
(require 'url-cache)
(require 'mm-decode)
(require 'image-mode)
(autoload 'mastodon-tl--propertize-img-str-or-url "mastodon-tl")
(autoload 'mastodon-tl--image-trans-check "mastodon-tl")
(autoload 'mastodon-image-mode "mastodon-tl")
(defvar url-show-status)
(defvar mastodon-tl--shr-image-map-replacement)
(defgroup mastodon-media nil
"Inline Mastadon media."
:prefix "mastodon-media-"
:group 'mastodon)
(defcustom mastodon-media--avatar-height 20
"Height of the user avatar images (if shown)."
:type 'integer)
(defcustom mastodon-media--preview-max-height 250
"Max height of any media attachment preview to be shown in timelines."
:type 'integer)
(defcustom mastodon-media--enable-image-caching nil
"Whether images should be cached."
:type 'boolean)
(defcustom mastodon-media--hide-sensitive-media t
"Whether media marked as sensitive should be hidden."
:type 'boolean)
(defvar mastodon-media--generic-avatar-data
(base64-decode-string
"iVBORw0KGgoAAAANSUhEUgAAAGQAAABkCAIAAAD/gAIDAAAACXBIWXMAAAsTAAALEwEAmpwYAAAA
B3RJTUUH4QUIFCg2lVD1hwAAABZ0RVh0Q29tbWVudABHZW5lcmljIGF2YXRhcsyCnMsAAAcGSURB
VHja7dzdT1J/HAfwcw7EQzMKW0pGRMK4qdRZbdrs6aIRbt506V1b/AV1U2td9l9UXnmhW6vgwuko
SbcOD/a0RB4CCRCRg0AIR4Hz8LvgN2cKCMI5wOH7uXBuugO+eH8+fM/3HIFpmoZAVVYIIABYAAtg
ASyABbAAAcACWAALYAEsgAUIABbAAlgAC2ABLEAAsAAWwAJYAAtgAQKAxUjxm+R50DRN0zRFUf+8
kggCwzAMwwDrfyOSJGmattlsdrvd5XLlcrndnyoUir6+vpGRkZMnT/J4vIarwY26MaTAZLVap6en
fT7f9vY2QRA7Ozv/vJJ8vkgk4vP5XV1dWq1Wq9VKpdIGkjUGi6IoFEWnp6ddLlcymSRJsvzv83g8
kUikUCi0Wq1Opzt16lS7YBEE8ebNG6PRiGHYoUwHyW7cuPHo0SOlUsl9LIIgXrx4Ybfb//79e7Qj
CIXC3t7ex48fX7lyhctYBSkURTOZTC3H4fF4SqXy6dOnLHuxh0VR1PPnz2uX2uv17Nmzy5cvc21R
StP0q1ev7HZ7XaQgCCJJ0u/3T0xMBINBrmGhKGo0Go88p0p5Wa1Wg8GQSqW4g0XT9NTUFIZhdT9y
Npudn59nLVwIO7FyuVxVrRIqr1AoZDab2QkXG1hTU1PJZJKhg5MkOT8/HwqFuIBF07TP52MoVrvh
YqLHG4BlsVi2t7cZfQiSJB0OBwudyDiWzWYjCILpR1lZWeECltPp3LeXwEQFg8FoNNryWPl8noVp
ws6jgG1lgAWwuI914cIFPp/xnX6ZTCYSiVoeq7+/n4U/Q61Wy+Xylse6desWC8kaGBiQSCQtjyWR
SGQyGY/HY+4hpFJpV1cXRwa8TqdjtBOHh4fVajVHsLRarVKpZChcUqn07t27LPQgS1gSiUSn04nF
4rofGYbh4eHhgYEBTq2ztFrtyMhI3ZtRo9GMjY2xEyv2sCQSiV6vV6lUdWzGzs7O8fHxwcFBDq7g
5XL5kydPent76+LV2dmp1+vv37/P5gqe7SvSDofj5cuXteydwjAslUr1ev2DBw9YPt1pwL0ODodj
YmLCYrEcYZ8LhmGNRjM+Ps5yphqGBUFQKBQyGo0mk2l1dTWfz5MkSVFUPp8/+GSEQiEMw8eOHYNh
uLu7e2hoaGxsjM05tbfYvpkNx/FQKBSJRCAI6unpwTBsbW0tmUwWbtc6mCMEQSAIOn78+Llz586f
P9/T05PL5QKBgEKh4GyyCkZfvnwJhULhcHhzczOTyRRuYMtms/l8PpPJZDKZnZ2dvc9HIBCIxeIT
J04Uvil87ejoOH36tEwm02g0V69evXjxIkewCkZer/fr16+/f/+OxWKlrvQQBEEQxL7dYQRBhEJh
0fNwBEHEYrFMJlOpVP39/RqNhgU1prAKTDMzMy6XKxqNJhIJptY+CHLmzBmZTHbp0qXbt2+rVKpW
wtplWl5eDofDTF803Bs0tVrNKFmdsXAcn52dnZ2dDQaD7DAVJRsdHb1z507dT93rhoXj+MrKytzc
3NLSEnNNVyHZ2bNnr127NjQ0NDg4WEey+mDhOP7u3bu5ubkyI5z9iMnl8nv37o2OjgoEgmbBisVi
r1+/ttlsjQ1UmYg9fPiwo6OjwVg4jn///v3Dhw/Ly8vNEKiiXhKJpK+vT6fT1d6S/FqkUBSdnJz0
+/1QsxZFUclkEkXReDxOkuT169dr8TpisnAcN5lMb9++ZfP+11pKIBAUdgpv3rx55BGGtIMUBEG5
XM7tdhsMhoWFhb3/S8UsVitK1curaqzV1dX379+3nNQ+r42NjSPsPlaH5fP5mnyiV+Ll9XonJyfD
4XC1XkhVDTgzM/Pz50+oxSubzX779u3z58/VLneQyqUMBsOnT5+acz1V7XoiHo9//PjRZDKl0+n6
Y3k8HrPZ3Gxr9Fq81tfXl5aWAoFA5cO+IqxIJFLYSIA4VARBuN3uxcXFyoc9v5IGNJvNVquVAw14
sBktFkt3d7dUKq3k5BGpJFYLCwucacCizZhIJCoJF3JorBYXF//8+QNxtAiCKFwiqKRvkEPnOoqi
HGvAfeFKJBIVTnqkfKx+/PjBsbleKlwej6cmLI/H43A4OByr3XClUimn03louMphra2teb1eqA0q
m836fL6tra0jYkUiEb/fz8k3waLhikQiXq+3/NtiSayNjY1fv35BbVP5fN7pdG5tbR0Fy+12c360
Hxzz5a8KI6V6EMMwzo/2fZ2YTqej0WgqlSoVLqRUDwYCAajNiqKoYDBYphOLY8ViscItVG1VJEmu
r6+XeU8sjhWPxzc3N9sNiyAIDMOqS1YbDqwKx1YRrFQqxc7HJDRnpdPpUuEqgoVhWL0+i6hFz6tL
ja3iM4u1zw1qwhlfJihI0bfCNhxYe4NSqg3/A862hQAbrdtHAAAAAElFTkSuQmCC")
"The PNG data for a generic 100x100 avatar.")
(defvar mastodon-media--generic-broken-image-data
(base64-decode-string
"iVBORw0KGgoAAAANSUhEUgAAAMgAAADICAYAAACtWK6eAAAACXBIWXMAAAsTAAALEwEAmpwYAAAA
B3RJTUUH4QUIFQUVFt+0LQAAABZ0RVh0Q29tbWVudABHZW5lcmljIGF2YXRhcsyCnMsAAAdoSURB
VHja7d1NSFRrAIfx//iB6ZDSMJYVkWEk0ceYFUkkhhQlEUhEg0FlC1eBoRTUwlbRok0TgRQURZAE
FgpjJmFajpK4kggxpXHRQEGWUJZizpy7uPfC5eKiV+dD5zw/mN05jrxnnjnfcxyWZVkCMKc0SXI4
HIwEMIcUhgAgEIBAAAIBCAQgEIBAAAIBCAQgEAAEAhAIQCAAgQAEAhAIQCAAgQA2kBaNP8Jt7ViM
onErOWsQgEAAAgEIBCAQgEAAAgEIBCAQgEAAEAhAIACBAAQCEAhAIACBAAQCEAhAIAAIBCAQgEAA
AgEIBCAQgEAAAgEIBACBAAQCEAhAIACBAAQCEAhAIACBAAQCgEAAAgEIBCAQgECAxSyNIYitz58/
a3BwUIODgxoZGVEoFFIoFNK3b980NTWlX79+SZIyMzOVlZWlVatWae3atSooKJDH49HOnTvl8XiU
ksJ3WSI4LMuyHA7Hgv6IZVmM5D8mJyf1/PlzdXZ2qrOzU8FgcMF/0+126+DBg6qqqlJFRYXS0vhe
+6MP9wI/1wQSJeFwWH6/X01NTWpra9PU1FTM3isvL0/nz5/XuXPntHz5ciqIcSCy/v50L+hlV+Pj
49a1a9esdevWLXgMTV8ul8u6c+eOFYlELMwtKmNNIOa+fv1qXbp0yXI6nXEP4/+v0tJS6+PHj9RA
IIk3PT1tXb161crOzk54GP995ebmWt3d3RRBIInj9/utgoKCRRXGf18ZGRmW3++niigHwk56PHf4
Yiw9PV0dHR0qLy9nD52jWAQylxUrVmhgYEAbN24kkCgsM84+JZmJiQmdPn1akUiEweBE4eL/NsrN
zVVZWZlKSkpUWFioTZs2yeVyKTs7W7Ozs5qYmNDExITev3+v/v5+9fX1qb+/f8FjevPmTdXW1rIG
IZDFN9gbNmyQ1+uV1+uVx+MxXlAjIyNqbGzU3bt39fPnz3n9vytXrlQwGJTT6SQQThQm/ohIamqq
VVlZaXV1dUXtPT98+GCVlZXNe7n4fD6OYnGYN7GDnZ6ebtXU1FhjY2Mxed9IJGLV19fPa7kUFRUR
CIEkZrAdDod15syZmIXxf7W1tfNaNqOjowSygBdHseZh7969GhgY0IMHD5Sfnx+X97xx44Z2795t
PF93dzcLjMO88TvHcP/+ffX19WnXrl3xXVApKbp9+7bxfSFv3rxhwRFI7B07dkxDQ0Oqrq5O2P9Q
XFysffv2Gc0zOjrKwiOQ2Hv69Kny8vIS/n8cP37caPqxsTEWHoHYa//HxPfv3xk0ArGP1atXG03/
7z3vIBBbyM3NNZo+KyuLQSMQ+5icnDSaPicnh0EjEPsYHh42mp7L3gnEVnp6eoymLyoqYtAIxD4e
PXpkNP3+/fsZtAXgcvclpL29XUeOHPnj6Z1Op8bHx7Vs2TJ7fri5o9A+ZmZmdPHiRaN5vF6vbeNg
E8tmGhoaNDQ0ZPTteeHCBQaOQJLfkydPdP36daN5Tp48qc2bNzN47IMkt9evX+vw4cOanp7+43ly
cnI0PDy8KK4dYx8EMRMIBHT06FGjOCTJ5/PZPg42sZJce3u7Dh06pB8/fhjNV11dndBL8tnEYhMr
5lpaWuT1evX792+j+YqLixUIBLj+ik2s5NXc3KwTJ04Yx5Gfn69nz54RB5tYyaupqUlVVVWanZ01
ms/tdqujo4P9DgJJXg8fPtSpU6cUDoeN43j58qUKCwsZRAJJTvfu3dPZs2eNf0/X7Xarq6tL27dv
ZxAJJDn5fD7V1NQYx7FmzRq9evVK27ZtYxAJJDk1NDSorq7O+ChgQUGBent7tWXLFgYxxniecILU
1dXJ5/MZz7d161a9ePHC+N50sAZZMq5cuTKvOEpKStTT00McccSJwji7devWvJ7bceDAAbW2ttr6
cQbGH26eD7K0BAIBlZeXG5/nqKioUEtLizIyMhhEAklOX758kcfj0adPn4zXHG1tbcSRoEDYB4mT
y5cvG8exZ88etba2Egf7IMnt7du32rFjh9G5jvz8fA0MDBj/UBxYgyw5jY2NRnGkpqaqubmZOBYB
AomxmZkZPX782Gie+vr6uD9/BGxiJURvb69KS0v/ePrMzEyFQiG5XC4Gj02s5BcIBIymr6ysJA42
sezj3bt3RtObPv8DBLKkBYNBo+m5r4NAbCUUChlNv379egaNQOzD9FdJ2P8gEFsxfQQaFyMuLhzm
jfUAG45tOBw2fhY6ojP2rEGWwiqdONjEAggEIBCAQAACAUAgAIEA0cIPx8UYJ1FZgwAEAhAIAAIB
CAQgEIBAAAIBFiNOFMaY6V1tnFhkDQIQCEAgAIEABAKAQAACAQgEIBCAQAACAQgEIBCAQABIXO4e
c1y+zhoEIBCAQAAQCEAgAIEABAIQCEAgAIEABAIQCEAgAAgEIBCAQAACAQgEIBCAQAACAQgEAIEA
BAIQCEAgAIEABAIsJVH58WqHw8FIgjUIQCAACAQgEIBAAAIBCAQgEIBAAAIBCAQgEAAEAhAIQCBA
fKRJkmVZjAQwh78A6vCRWJE8K+8AAAAASUVORK5CYII=")
"The PNG data for a generic 200x200 \"broken image\" view.")
(defvar mastodon-media--sensitive-image-data
(base64-decode-string
"iVBORw0KGgoAAAANSUhEUgAAAMgAAADICAYAAACtWK6eAAAA6npUWHRSYXcgcHJvZmlsZSB0eXBl
IGV4aWYAAHjajVHbjcQwCPx3FVcCr/hRjvOSroMtfyc2Ts4rrXRIxjAQPEzC8fo9w89lkiXYknIs
MRLMihWpCDJ1W5tnsuabbaPGMx7uggBS3NrTIo4fwBGz58X7efSPQSPgimh5CrU6vs746gMlfw5y
Bsr9Zdr9Ax+k4oxsXi2WnKbV9o1my88xTRKXyMngTSilWBBnIUvQc7+InpuUNmjpgt7AyEergJMc
ykrwqtZZ6nVMK+7YvAU0skMMb9qFJ/xKUADz4g9VusX8q82j0Rf7z1rhDfqGdxgpcULlAAABhWlD
Q1BJQ0MgcHJvZmlsZQAAeJx9kT1Iw0AcxV8/tKJVBzuIOGSoTnZREd1qFYpQIdQKrTqYXPohNGlI
UlwcBdeCgx+LVQcXZ10dXAVB8APE2cFJ0UVK/F9SaBHjwXE/3t173L0D/PUyU81gHFA1y0gnE0I2
tyKEXtGJIHowgz6JmfqsKKbgOb7u4ePrXYxneZ/7c/QqeZMBPoE4znTDIl4nntq0dM77xBFWkhTi
c+Ixgy5I/Mh12eU3zkWH/TwzYmTSc8QRYqHYxnIbs5KhEk8SRxVVo3x/1mWF8xZntVxlzXvyF4bz
2vIS12kOI4kFLEKEABlVbKAMCzFaNVJMpGk/4eEfcvwiuWRybYCRYx4VqJAcP/gf/O7WLEyMu0nh
BNDxYtsfI0BoF2jUbPv72LYbJ0DgGbjSWv5KHZj+JL3W0qJHQP82cHHd0uQ94HIHGHzSJUNypABN
f6EAvJ/RN+WAgVuge9XtrbmP0wcgQ12lboCDQ2C0SNlrHu/uau/t3zPN/n4Ag31yra/8+kkAAA14
aVRYdFhNTDpjb20uYWRvYmUueG1wAAAAAAA8P3hwYWNrZXQgYmVnaW49Iu+7vyIgaWQ9Ilc1TTBN
cENlaGlIenJlU3pOVGN6a2M5ZCI/Pgo8eDp4bXBtZXRhIHhtbG5zOng9ImFkb2JlOm5zOm1ldGEv
IiB4OnhtcHRrPSJYTVAgQ29yZSA0LjQuMC1FeGl2MiI+CiA8cmRmOlJERiB4bWxuczpyZGY9Imh0
dHA6Ly93d3cudzMub3JnLzE5OTkvMDIvMjItcmRmLXN5bnRheC1ucyMiPgogIDxyZGY6RGVzY3Jp
cHRpb24gcmRmOmFib3V0PSIiCiAgICB4bWxuczp4bXBNTT0iaHR0cDovL25zLmFkb2JlLmNvbS94
YXAvMS4wL21tLyIKICAgIHhtbG5zOnN0RXZ0PSJodHRwOi8vbnMuYWRvYmUuY29tL3hhcC8xLjAv
c1R5cGUvUmVzb3VyY2VFdmVudCMiCiAgICB4bWxuczpkYz0iaHR0cDovL3B1cmwub3JnL2RjL2Vs
ZW1lbnRzLzEuMS8iCiAgICB4bWxuczpHSU1QPSJodHRwOi8vd3d3LmdpbXAub3JnL3htcC8iCiAg
ICB4bWxuczp0aWZmPSJodHRwOi8vbnMuYWRvYmUuY29tL3RpZmYvMS4wLyIKICAgIHhtbG5zOnht
cD0iaHR0cDovL25zLmFkb2JlLmNvbS94YXAvMS4wLyIKICAgeG1wTU06RG9jdW1lbnRJRD0iZ2lt
cDpkb2NpZDpnaW1wOmYyYjU4MzUwLTc3ZWMtNDAxNC1hNDVlLTE1N2QyZjljOGM5NyIKICAgeG1w
TU06SW5zdGFuY2VJRD0ieG1wLmlpZDowOTk5MzZhMi1jOGM5LTRkYTAtYTI0Yi02YTM1MmUyNmNi
NmUiCiAgIHhtcE1NOk9yaWdpbmFsRG9jdW1lbnRJRD0ieG1wLmRpZDphMDliYmZhMi03MzA2LTQ3
NWQtOGExNC05YzA3ZTE1NmFiMTYiCiAgIGRjOkZvcm1hdD0iaW1hZ2UvcG5nIgogICBHSU1QOkFQ
ST0iMi4wIgogICBHSU1QOlBsYXRmb3JtPSJMaW51eCIKICAgR0lNUDpUaW1lU3RhbXA9IjE3MTc1
MDI1MDIzNDQ1NzIiCiAgIEdJTVA6VmVyc2lvbj0iMi4xMC4zNCIKICAgdGlmZjpPcmllbnRhdGlv
bj0iMSIKICAgeG1wOkNyZWF0b3JUb29sPSJHSU1QIDIuMTAiCiAgIHhtcDpNZXRhZGF0YURhdGU9
IjIwMjQ6MDY6MDRUMTQ6MDE6NDArMDI6MDAiCiAgIHhtcDpNb2RpZnlEYXRlPSIyMDI0OjA2OjA0
VDE0OjAxOjQwKzAyOjAwIj4KICAgPHhtcE1NOkhpc3Rvcnk+CiAgICA8cmRmOlNlcT4KICAgICA8
cmRmOmxpCiAgICAgIHN0RXZ0OmFjdGlvbj0ic2F2ZWQiCiAgICAgIHN0RXZ0OmNoYW5nZWQ9Ii8i
CiAgICAgIHN0RXZ0Omluc3RhbmNlSUQ9InhtcC5paWQ6NTRmM2I5NDktOTlkMS00Mzk2LWI2NzIt
Y2ZkYjRlZWFiYTA1IgogICAgICBzdEV2dDpzb2Z0d2FyZUFnZW50PSJHaW1wIDIuMTAgKExpbnV4
KSIKICAgICAgc3RFdnQ6d2hlbj0iMjAyNC0wNi0wNFQxNDowMTo0MiswMjowMCIvPgogICAgPC9y
ZGY6U2VxPgogICA8L3htcE1NOkhpc3Rvcnk+CiAgPC9yZGY6RGVzY3JpcHRpb24+CiA8L3JkZjpS
REY+CjwveDp4bXBtZXRhPgogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
ICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAg
ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAg
ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
ICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
ICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAg
ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAg
ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
ICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
ICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
CiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAg
ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAg
ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
ICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
ICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAg
ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAg
ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
ICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
ICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAg
ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAg
ICAgICAgICAgICAgCjw/eHBhY2tldCBlbmQ9InciPz6w3d0DAAAABmJLR0QA/wD/AP+gvaeTAAAA
CXBIWXMAAC4jAAAuIwF4pT92AAAAB3RJTUUH6AYEDAEq/VtQSwAAABl0RVh0Q29tbWVudABDcmVh
dGVkIHdpdGggR0lNUFeBDhcAAAtOSURBVHja7dvbT5R3Hsfxz5xwhtOsjkgFGQZRTlFOCjJSkpVe
YFltmpZNuo3t9qLdu/4Pa/+L3jVZL9pEU2q7aGirEkUkWw+IM5SpOELxgICcUXjmsBfKBOooo2Za
3H2/Ei+EeRif74/3c5gnmj47fDgqAHGZGQFAIACBAAQCEAhAIACBAAQCEAhAIAAIBCAQgEAAAgEI
BCAQgEAAAgEIBCAQAAQCEAhAIACBAAQCEAhAIACBAAQCgEAAAgEIBCAQgEAAAgEIBCAQgEAAAgFA
IACBAAQCEAhAIACBAAQCEAhAIAAIBCAQgEAAAgEIBCAQgEAAAgEIBCAQAAQCEAhAIACBAAQCEAjw
CrIm+w0ikYiCwaB8Pp8GBweVk5OjoqIiOZ1OjY+Pq6qq6g8fwuLiov7d1qbFhQUdOHhQaampSd0O
BBLT2dmp8+fP6/3331dzc7Oi0ahu3bql1tZW7dixY00MIRqNKhQKyWyxyPQ7bAcCkSSNjY3p7Nmz
anzjDeXl5cW+7vF41NLSos7OzjUxhHXr1umvLS2/23bgHkSSNDk5+ahC65Md5uTkaMuyaID/u0BS
UlIkSd0XLmhubu6J73vr6tb8gO7fv69gMMhvyhqfV7LeN6mBZGdnKysrS1NTU2r95htNTU29Uou9
uLiojo4OhUIhfvPX8LyS+b6mzw4fjibzHz8+Pq6jx45pfGxMqamp+suBA9pWWCiTKf5tbSgU0vXr
1+X3+3Xnzh1t2bJFFRUV8ng8kqSBgQF99dVXkiTXxo36xyefaGBgQD6/X0ODg8rNzVVdXZ1ycnJW
DNDn86nv55/1YH5excXF8nq9slgsikajmpiY0PDwsPx+v5qbm5WZmamJiQmdOHlSN4NB2Ww2paWn
a252Vk1NTSovL3/qdsePH1dfX5/WrVsnm82mSCSiAwcOqKCgQF1dXeru7pbNZpNhGCoqKlJzc3NC
+53oJW0gEND1gQGNjY4qNzdXZWVlKikpic07EolocHBQgUBAwWBQVqtVnoICFW3frry8vNjrnnfO
q80rWeub6Pu+KMu+ffv+mcxAUlNTVVxUpLm5Od2+fVt+n0/z8/PavHlz7BJsiWEYOnXqlDwej6qr
q1VVVaUHDx+qtbVVm7KztdHlktPp1I4dOxQIBDQ5OSmTySSXy6Vd1dWqrKxU8OZNnTl9Wrt27Yrd
+5w5c0YOh0NvNDYqPz9f7e3tqq6ultVq1YMHD+T3+3X+/HmNjIyourpaDodDDodDmzZt0uXLl/XO
O+9o//79qq+vV3Z2tiQ9dbvCwkLl5ubqypUrcjqd+vjjj+VyuSRJW7ZsUVlZmX755Rft3r1bDQ0N
MpvNCe33avoDAXV0dKi2pkY1u3erpLRU83Nz8vv9Ki4ultVq1eLiotrb2zU8PKz6+nrt3btXZWVl
j87wra0yDENut1tms/m557zavJK1vom875q9xFqSkZGhgwcP6t1335XdbtelS5f0xRdf6N69eyte
19PTo/T0dL322muyWCxKSUlRdVWVcnJzdaKtTXNzc7JYLHK5XMrKypLNZtOePXvkdrtjw6qsqJBh
GLo3Oho7e3R3dys9I0MWi0UbN25UQ0ODotFoLOC6ujo1NDQ8eXp9fDQ1m81xw4+3ndVqVWFhocrL
y3Xv3r0V914mk0l2u102m01VVVWyWCwJ7/ezDA0N6djRo3pz/365XC6ZzWb9yenU66+/rg8++EB2
u12SdOHCBQUCATU1NWnDhg2yWCxKTU1VbW2tGhsb1d3drf/89NOjI+dzznm1eSVrfRN53zX7Me+K
Es1mFRcXKycnR6dOnZLP59OXX36pjz76SJmZmVpYWNCPP/6ocDisjo6OuD/jRjConY+fnVgsltiQ
l3M4HLEj/NLrsrOz9e3x42ppaZHb7Y77cNJifbFRPG276upqXb16VYFAQLW1tbGvDwwMaE9dXezs
9rz7/VuRSEQ//PCDamtrtWHDhqf+O2dmZnTu3DnVeb1KS0t74vuVlZU6e/asTp86pfKdO2OvSXTO
q0nW+ibb7xbI8rNJc3OzZDLJd+2aenp61NDQoKmpKYXDYR06dEhut1vRaDR2lF86SjztviXeUT8S
DscG/fbbb+vosWM6cuSIvF6v9uzZo9QkP/XevHmztm/fro6ODu0sL5fDblcoFNJPFy/qb++9F3vd
y+735OSk7t69q5plEcaz9AFJZkZG3O/b7Xbt2LlTly9d0vT0dNyInjXn1SRrfV/pj3mnp6cViUSe
+LrNZtNer1eS1HvtWuz6dPkATCaTzGZz7E8iw5MUG/ryZy8ul0t///BD7WtsVFdXl/515IhmZmaS
OliTyaSamhoZhqEbAwOxS6GqykrZbLYV1+Uvs98PHz58tJAJzmd2dvbpB6/09IT3L96cnyWZ6/vK
BjI4NPTEfcaStMeLsbQo6x5fJ48uu7Z8EeHHR5blv4ThcFh2u13eujodOnRI42Njunr1asI/MxJ9
sQ/68vLylJObq3OdnVpcXNTFixe1bdu2Fa952f1eugQZGxt75uucTuejA1Jvb+yXNd6zBEnKzMx8
oTk/a17JXN+XXac/LJBUh0NdXV1xP58ef7ygFRUVkqQN69fLnZ+vzs7OuEe5Bw8famJiYsXfw3FO
s4uLiyuOMAsLC7p0+XLs+263W6VlZU9su3SmW37aX7qJfjA/v+KsuPw18bZbvv1er1fjY2P6/vvv
lZ+fH7uGXvK8+/1b69ev1+acHHV2dsZ9znT37l3Nzs4qIyND9fX1mpmZkc/ni3updu3aNf15374V
l1eJznm1eSVrfRNdpzUZSHp6uvr6+vTtd99pZGREoVBIhmFoeHhYJ0+eVEVFhUpLS2M38fubmhQO
h/XN8eMaGRlROBxWKBTSnTt3dDMYjB0FZ2ZmNPzrrzIMY8WlkmEYGhwcjIURjUZltVp15vRp3b59
W5FIRGNjYxq8eVNFRUUrbiBHRkZig10KOjMzU66NG+Xz+zU/P6/Z2Vn19vauut1yHo9HTqdTPT09
KikpifvhRaL7HfdDAotFb+7fL5vNphMnTmh0dFSRSESGYSgYDOr+/ftKf3yW9nq9qqysVFtbm65c
uRL7JRwdHVXbiRPaXVOj2pqaFTf2ic55tXkla30TWac1+6BwYWFBP/f3y5mZqVu3bmngxg3NTE/L
4/GoqLhYWwsKYvUvL7+3t1d9fX2ypaRoa0GBSkpKlJWVJUnq6+vT119/vWKbt956S263W59//nns
5xmGIYfDoU8//VTt7e1KS0tTf3+/srKytGvXLuXm5kqSgsGg2tralJKSonA4LMMw5PF4dPDgwUeX
LuPjOt/ZqZGREe0sL1d1VZVSUlJW3W45n9+vyYkJ1dfXP/N+7Vn7vZqJiQn19vaqv79fZrNZhYWF
Ki0tfeJ5QCQS0dDQkAKBgG7cuCFJ2rp1q4qKimLPQF50ziaT6anzSub6JvK+a/ZJejIsfQKy/IYP
/ztzXkvra30VFy7RjwTxas55La0v/+UWIBCAQAACAQgEIBCAQAACAQgEIBAABAIQCEAgAIEABAIQ
CEAgAIEABAIQCAACAQgEIBCAQAACAQgEIBCAQAACAUAgAIEABAIQCEAgAIEABAIQCEAgAIEAIBCA
QAACAQgEIBCAQAACAQgEIBAABAIQCEAgAIEABAIQCEAgAIEABAIQCAACAQgEIBCAQAACAQgEIBCA
QAACAUAgAIEABAIQCEAgAIEABAIQCEAgAIEAIBCAQAACAQgEIBCAQAACAQgEIBAABAIQCEAgAIEA
BAIQCEAgAIEABAIQCAACAQgEIBCAQAACAQgEIBCAQAACAQgEAIEABAIQCEAgAIEABAIQCEAgAIEA
IBCAQICX9F8/bNVInwJ8BAAAAABJRU5ErkJggg==")
"The PNG data for a sensitive image placeholder.")
(defun mastodon-media--process-image-response
(status-plist url marker image-options region-length)
"Callback function processing the url retrieve response for URL.
STATUS-PLIST is the usual plist of status events as per `url-retrieve'.
IMAGE-OPTIONS are the precomputed options to apply to the image.
MARKER is the marker to where the response should be visible.
REGION-LENGTH is the length of the region that should be replaced
with the image."
(when (marker-buffer marker) ; if buffer hasn't been killed
(let ((url-buffer (current-buffer))
(is-error-response-p (eq :error (car status-plist))))
(let* ((data (unless is-error-response-p
(goto-char (point-min))
(and (search-forward "\n\n" nil t)
(buffer-substring (point) (point-max)))))
(image (when data
(apply #'create-image data ;; inbuilt scaling in 27.1:
(when (version< emacs-version "27.1")
(when image-options 'imagemagick))
t image-options))))
(when mastodon-media--enable-image-caching
(unless (url-is-cached url) ; cache if not already cached
(url-store-in-cache url-buffer)))
(with-current-buffer (marker-buffer marker)
;; Save narrowing in our buffer
(let ((inhibit-read-only t))
(save-restriction
(widen)
(put-text-property marker
(+ marker region-length) 'media-state 'loaded)
(when image
;; We only set the image to display if we could load
;; it; we already have set a default image when we
;; added the tag.
(mastodon-media--display-image-or-sensitive
marker region-length image))
;; We are done with the marker; release it:
(set-marker marker nil)))
(kill-buffer url-buffer))))))
(defun mastodon-media--display-image-or-sensitive (marker region-length image)
"Display image using display property, or add sensitive mask.
MARKER, REGION-LENGTH and IMAGE are from
`mastodon-media--process-image-response'.
If the image is marked sensitive, the image is stored in
image-data prop so it can be toggled."
(if (or (not (eq t (get-text-property marker 'sensitive)))
(not mastodon-media--hide-sensitive-media))
;; display image
(put-text-property marker (+ marker region-length)
'display image)
;; display sensitive placeholder and save image data as prop:
(add-text-properties marker (+ marker region-length)
`(display
;; (image :type png :data ,mastodon-media--sensitive-image-data)
,(create-image
mastodon-media--sensitive-image-data nil t)
sensitive-state hidden image-data ,image))))
(defvar mastodon-media--attachments nil
"A list attachment details for full sized image view buffer.
The first element is the URL of the image displayed, followed by plists
of details of all of a toot's attachments.")
(defun mastodon-media--process-full-sized-image-response
(status-plist url attachments &optional prev-buf)
;; FIXME: refactor this with but not into
;; `mastodon-media--process-image-response'.
"Callback function processing the `url-retrieve' response for URL.
URL is a full-sized image URL attached to a timeline image.
STATUS-PLIST is a plist of status events as per `url-retrieve'."
(if-let* ((error-response (plist-get status-plist :error)))
(user-error "error in loading image: %S" error-response)
(when mastodon-media--enable-image-caching
(unless (url-is-cached url) ;; cache if not already cached
(url-store-in-cache)))
;; thanks to rahguzar for this idea:
;; https://codeberg.org/martianh/mastodon.el/issues/540
(let* ((handle (mm-dissect-buffer t))
(image (mm-get-image handle))
(str (image-property image :data))
(buf "*masto-image*"))
(with-current-buffer (get-buffer-create buf)
(let ((inhibit-read-only t))
(erase-buffer)
(insert-image image str)
(special-mode) ; prevent image-mode loop bug
(mastodon-image-mode) ;; for our keymap
(goto-char (point-min))
(image-transform-fit-both)
;; set image metadata for view cycling:
(setq-local mastodon-media--attachments (cons url attachments))))
;; switch to buf if not already viewing it:
(unless (equal buf prev-buf)
(switch-to-buffer-other-window buf))
;; display bindings if multiple images:
(when (< 1 (length (cdr mastodon-media--attachments)))
(message (substitute-command-keys
"\\`.'/\\`>'/\\`' to cycle images"))))))
(defun mastodon-media--image-or-cached (url process-fun args)
"Fetch URL from cache or fro host.
Call PROCESS-FUN on it with ARGS, a list of callback args as
specified by `url-retrieve'."
(if (and mastodon-media--enable-image-caching
(url-is-cached url)) ;; if cached, decompress and use:
(with-current-buffer (url-fetch-from-cache url)
(set-buffer-multibyte nil)
(goto-char (point-min))
(zlib-decompress-region
(goto-char (search-forward "\n\n")) (point-max))
(apply process-fun args)) ;; no status-plist arg from cache
;; fetch as usual and process-image-response will cache it:
;; cbargs fun will be called with status-plist by url-retrieve:
(url-retrieve url process-fun (cdr args))))
(defun mastodon-media--load-image-from-url (url media-type start region-length)
"Take a URL and MEDIA-TYPE and load the image asynchronously.
MEDIA-TYPE is a symbol and either `avatar' or `media-link'.
START is the position where we start loading the image.
REGION-LENGTH is the range from start to propertize."
(let ((image-options
(when (mastodon-tl--image-trans-check)
(cond ((eq media-type 'avatar)
`(:height ,mastodon-media--avatar-height))
((eq media-type 'media-link)
`(:max-height ,mastodon-media--preview-max-height)))))
(buffer (current-buffer))
(marker (copy-marker start))
(url-show-status nil)) ; stop url.el from spamming us about connecting
(condition-case nil
;; catch errors in url-retrieve to not break our caller
(mastodon-media--image-or-cached
url
#'mastodon-media--process-image-response
(list nil url marker image-options region-length))
(error (with-current-buffer buffer
;; TODO: Add retries
(put-text-property marker (+ marker region-length)
'media-state 'loading-failed)
:loading-failed)))))
(defun mastodon-media--select-next-media-line (end-pos)
"Find coordinates of the next media to load before END-POS.
Returns the list of (`start' . `end', `media-symbol') points of
that line and string found or nil no more media links were
found."
(let ((next-pos (point)))
(while
(and
(setq next-pos (next-single-property-change next-pos 'media-state))
(or (not (eq 'needs-loading (get-text-property next-pos 'media-state)))
(null (get-text-property next-pos 'media-url))
(null (get-text-property next-pos 'media-type))))
;; do nothing - the loop will proceed
)
(when (and next-pos (< next-pos end-pos))
(let ((media-type (get-text-property next-pos 'media-type)))
(cond
((eq media-type 'avatar) ; avatars are one character
(list next-pos (+ next-pos 1) 'avatar))
((eq media-type 'media-link) ; media links are 5 characters: [img]
(list next-pos (+ next-pos 5) 'media-link)))))))
(defun mastodon-media--valid-link-p (link)
"Check if LINK is valid.
Checks to make sure the missing string has not been returned."
(and link
(> (length link) 8)
(or (string= "http://" (substring link 0 7))
(string= "https://" (substring link 0 8)))))
(defun mastodon-media--inline-images (search-start search-end)
"Find all `Media_Links:' in the range from SEARCH-START to SEARCH-END.
Replace them with the referenced image."
(save-excursion
(goto-char search-start)
(let (line-details)
(while (setq line-details
(mastodon-media--select-next-media-line search-end))
(let* ((start (car line-details))
(end (cadr line-details))
(media-type (cadr (cdr line-details)))
(type (get-text-property start 'mastodon-media-type))
(image-url (get-text-property start 'media-url)))
(if (not (mastodon-media--valid-link-p image-url))
;; mark it at least as not needing loading any more
(put-text-property start end 'media-state 'invalid-url)
;; proceed to load this image asynchronously
(put-text-property start end 'media-state 'loading)
(mastodon-media--load-image-from-url
image-url media-type start (- end start))
(when (or (string= type "gifv")
(string= type "video"))
(mastodon-media--moving-image-overlay start end))))))))
;; (defvar-local mastodon-media--overlays nil
;; "Holds a list of overlays in the buffer.")
(defun mastodon-media--moving-image-overlay (start end)
"Add play symbol overlay to moving image media items.
START and END are the beginning and end of the media item to overlay."
(let ((ov (make-overlay start end)))
(overlay-put
ov
'after-string
(propertize "ď
"
'help-echo "Video"
'face
'((:height 3.5 :inherit mastodon-toot-docs-face))))))
;; (cl-pushnew ov mastodon-media--overlays)))
(defun mastodon-media--get-avatar-rendering (avatar-url)
"Return the string to be written that renders the avatar at AVATAR-URL."
;; We use just an empty space as the textual representation.
;; This is what a user will see on a non-graphical display
;; where not showing an avatar at all is preferable.
(let ((image-options (when (mastodon-tl--image-trans-check)
`(:height ,mastodon-media--avatar-height))))
(concat
(propertize " "
'media-url avatar-url
'media-state 'needs-loading
'media-type 'avatar
'display
(apply #'create-image mastodon-media--generic-avatar-data
;; inbuilt scaling in 27.1
(when (version< emacs-version "27.1")
(when image-options 'imagemagick))
t image-options))
" ")))
(defun mastodon-media--get-media-link-rendering
(media-url &optional full-remote-url type caption sensitive)
"Return the string to be written that renders the image at MEDIA-URL.
FULL-REMOTE-URL is used for `shr-browse-image'.
TYPE is the attachment's type field on the server.
CAPTION is the image caption if provided.
SENSITIVE is a flag from the item's JSON data."
(let* ((help-echo-base
(substitute-command-keys
(concat "\\`RET': load full image or play video,\
\\`i' for image options"
(when (not (eq sensitive :json-false))
", \\`S': toggle sensitive media"))))
(help-echo (if caption
(concat help-echo-base
"\n\"" caption "\"")
help-echo-base)))
(concat
(mastodon-tl--propertize-img-str-or-url
"[img]" media-url full-remote-url type help-echo
(create-image mastodon-media--generic-broken-image-data nil t)
nil caption sensitive)
" ")))
(provide 'mastodon-media)
;;; mastodon-media.el ends here
mastodon.el/lisp/mastodon-notifications.el 0000664 0000000 0000000 00000114301 15017331127 0021265 0 ustar 00root root 0000000 0000000 ;;; mastodon-notifications.el --- Notification functions for mastodon.el -*- lexical-binding: t -*-
;; Copyright (C) 2017-2019 Johnson Denen
;; Copyright (C) 2020-2024 Marty Hiatt
;; Author: Johnson Denen
;; Marty Hiatt
;; Maintainer: Marty Hiatt
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
;; This file is part of mastodon.el.
;; mastodon.el 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.
;; mastodon.el 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 mastodon.el. If not, see .
;;; Commentary:
;; mastodon-notification.el provides notification functions for Mastodon.
;;; Code:
(require 'subr-x)
(require 'cl-lib)
(require 'mastodon-widget)
(require 'map)
(autoload 'mastodon-http--api "mastodon-http")
(autoload 'mastodon-http--get-params-async-json "mastodon-http")
(autoload 'mastodon-http--post "mastodon-http")
(autoload 'mastodon-http--triage "mastodon-http")
(autoload 'mastodon-media--inline-images "mastodon-media")
(autoload 'mastodon-tl--byline "mastodon-tl")
(autoload 'mastodon-tl--byline-author "mastodon-tl")
(autoload 'mastodon-tl--clean-tabs-and-nl "mastodon-tl")
(autoload 'mastodon-tl--content "mastodon-tl")
(autoload 'mastodon-tl--field "mastodon-tl")
(autoload 'mastodon-tl--find-property-range "mastodon-tl")
(autoload 'mastodon-tl--has-spoiler "mastodon-tl")
(autoload 'mastodon-tl--init "mastodon-tl")
(autoload 'mastodon-tl--property "mastodon-tl")
(autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl")
(autoload 'mastodon-tl--spoiler "mastodon-tl")
(autoload 'mastodon-tl--item-id "mastodon-tl")
(autoload 'mastodon-tl-update "mastodon-tl")
(autoload 'mastodon-views-view-follow-requests "mastodon-views")
(autoload 'mastodon-tl--current-filters "mastodon-views")
(autoload 'mastodon-tl--render-text "mastodon-tl")
(autoload 'mastodon-notifications-get "mastodon")
(autoload 'mastodon-tl--byline-uname-+-handle "mastodon-tl")
(autoload 'mastodon-tl--byline-handle "mastodon-tl")
(autoload 'mastodon-http--get-json "mastodon-http")
(autoload 'mastodon-media--get-avatar-rendering "mastodon-media")
(autoload 'mastodon-tl--image-trans-check "mastodon-tl")
(autoload 'mastodon-tl--symbol "mastodon-tl")
(autoload 'mastodon-tl--display-or-uname "mastodon-tl")
(autoload 'mastodon-tl-goto-next-item "mastodon-tl")
(autoload 'mastodon-tl--buffer-type-eq "mastodon-tl")
(autoload 'mastodon-tl--buffer-property "mastodon-tl")
(autoload 'mastodon-http--patch "mastodon-http")
(autoload 'mastodon-views--minor-view "mastodon-views")
(autoload 'mastodon-tl--goto-first-item "mastodon-tl")
(autoload 'mastodon-tl--init-sync "mastodon-tl")
;; notifications defcustoms moved into mastodon.el
;; as some need to be available without loading this file
(defvar mastodon-tl--shr-map-replacement)
(defvar mastodon-tl--horiz-bar)
(defvar mastodon-active-user)
(defvar mastodon-instance-url)
(defvar mastodon-tl--buffer-spec)
(defvar mastodon-tl--display-media-p)
(defvar mastodon-mode-map)
(defvar mastodon-tl--fold-toots-at-length)
(defvar mastodon-tl--show-avatars)
(defvar mastodon-profile-note-in-foll-reqs)
(defvar mastodon-profile-note-in-foll-reqs-max-length)
(defvar mastodon-group-notifications)
(defvar mastodon-notifications-grouped-names-count)
(defvar mastodon-tl--link-keymap)
(defvar mastodon-tl--update-point)
;;; VARIABLES
(defvar mastodon-notifications--map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map mastodon-mode-map)
(define-key map (kbd "a") #'mastodon-notifications-follow-request-accept)
(define-key map (kbd "j") #'mastodon-notifications-follow-request-reject)
(define-key map (kbd "C-k") #'mastodon-notifications-clear-current)
(define-key map (kbd "C-c C-c") #'mastodon-notifications-cycle-type)
map)
"Keymap for viewing notifications.")
(defvar mastodon-notifications--types
'("all" "favourite" "reblog" "mention" "poll"
"follow_request" "follow" "status" "update"
"severed_relationships" "moderation_warning")
"A list of notification types according to their name on the server, plus \"all\".")
(defvar mastodon-notifications--filter-types-alist
'(("all" . mastodon-notifications-get)
("favourite" . mastodon-notifications-get-favourites)
("reblog" . mastodon-notifications-get-boosts)
("mention" . mastodon-notifications-get-mentions)
("poll" . mastodon-notifications-get-polls)
("follow_request" . mastodon-notifications-get-follow-requests)
("follow" . mastodon-notifications-get-follows)
("status" . mastodon-notifications-get-statuses)
("update" . mastodon-notifications-get-edits))
"An alist of notification types and their corresponding load functions.
Notification types are named according to their name on the server.")
(defvar mastodon-notifications--response-alist
'(("Followed" . "you")
("Favourited" . "your post")
("Boosted" . "your post")
("Mentioned" . "you")
("Posted a poll" . "that has now ended")
("Requested to follow" . "you")
("Posted" . "a post")
("Edited" . "their post"))
"Alist of subjects for notification types.")
(defvar mastodon-notifications--action-alist
'((reblog . "Boosted")
(favourite . "Favourited")
(follow_request . "Requested to follow")
(follow . "Followed")
(mention . "Mentioned")
(status . "Posted")
(poll . "Posted a poll")
(update . "Edited")
(severed_relationships . "Relationships severed")
(moderation_warning . "Moderation warning"))
"Action strings keyed by notification type.
Types are those of the Mastodon API.")
(defvar mastodon-notifications--no-status-notif-alist
'(("moderation_warning" . moderation_warning)
("severed_relationships" . event)
("follow" . follow)
("follow_request" . follow_request)))
;;; VAR FETCHERS
(defun mastodon-notifications--action-alist-get (type)
"Return an action string for notification TYPE.
Fetch from `mastodon-notifications--action-alist'.
If no match, return empty string."
(or (alist-get type mastodon-notifications--action-alist)
""))
(defun mastodon-notifications--response-alist-get (message)
"Return a response string for MESSAGE.
Fetch from `mastodon-notifications--response-alist'.
If no match, return empty string."
(or (alist-get
message
mastodon-notifications--response-alist nil nil #'equal)
""))
;;; UTILS
(defun mastodon-notifications--api (endpoint)
"Return a notifications API ENDPOINT.
If `mastodon-group-notifications' is non-nil, use API v2."
(mastodon-http--api endpoint
(when mastodon-group-notifications "v2")))
;;; FOLL REQS
(defun mastodon-notifications--follow-request-process (&optional reject)
"Process the follow request at point.
With no argument, the request is accepted. Argument REJECT means
reject the request. Can be called in notifications view or in
follow-requests view."
(if (not (mastodon-tl--find-property-range 'item-json (point)))
(user-error "No follow request at point?")
(let* ((item-json (mastodon-tl--property 'item-json))
(f-reqs-view-p (string= "follow_requests"
(plist-get mastodon-tl--buffer-spec 'endpoint)))
(f-req-p (or (string= "follow_request"
(mastodon-tl--property 'notification-type
:no-move))
f-reqs-view-p)))
(if (not f-req-p)
(user-error "No follow request at point?")
(let-alist (or (alist-get 'account item-json) ;notifs
item-json) ;f-reqs
(if (not .id)
(user-error "No account result at point?")
(let ((response
(mastodon-http--post
(mastodon-http--api
(format "follow_requests/%s/%s"
.id (if reject "reject" "authorize"))))))
(mastodon-http--triage
response
(lambda (_)
(if f-reqs-view-p
(mastodon-views-view-follow-requests)
(mastodon-tl--reload-timeline-or-profile))
(message "Follow request of %s (@%s) %s!"
.username .acct (if reject "rejected" "accepted")))))))))))
(defun mastodon-notifications-follow-request-accept ()
"Accept a follow request.
Can be called in notifications view or in follow-requests view."
(interactive)
(mastodon-notifications--follow-request-process))
(defun mastodon-notifications-follow-request-reject ()
"Reject a follow request.
Can be called in notifications view or in follow-requests view."
(interactive)
(mastodon-notifications--follow-request-process :reject))
;;; FORMAT NON-STANDARD NOTIFS
(defun mastodon-notifications--severance-body (json)
"Return a body for a severance notification JSON."
;; https://docs.joinmastodon.org/entities/RelationshipSeveranceEvent/
(let-alist json
(concat .type ": "
.target_name
"\nRelationships affected: "
"\nFollowers: " (number-to-string .followers_count)
"\nFollowing: " (number-to-string .following_count))))
(defun mastodon-notifications--mod-warning-body (json)
"Return a body for a moderation warning notification JSON."
;; https://docs.joinmastodon.org/entities/AccountWarning/
(let-alist json
(concat .action ": \"" (string-trim .text) "\""
"\nStatuses: "
(mastodon-notifications--render-mod-status-links .status_ids)
"\nfor account: "
.target_account.acct
(if .appeal
(concat "\nYour appeal: \""
(alist-get 'text .appeal)
"\"")
"")
"\nMore info/appeal: "
(mastodon-notifications--render-mod-link .id))))
(defun mastodon-notifications--propertize-link (url help-echo)
"Render a plain URL link with HELP-ECHO."
(propertize
url
'face 'shr-link ;; mastodon-display-name-face
'keymap mastodon-tl--shr-map-replacement
'mastodon-tab-stop 'shr-url
'help-echo help-echo
'follow-link t
'mouse-face 'highlight
'shr-url url
'keymap mastodon-tl--shr-map-replacement))
(defun mastodon-notifications--render-mod-status-links (ids)
"Render moderation status IDS as URLs."
(mapconcat (lambda (id)
(let ((str (format "%s/@%s/%s"
mastodon-instance-url
mastodon-active-user id)))
(mastodon-notifications--propertize-link str "view toot")))
ids ", "))
(defun mastodon-notifications--render-mod-link (id)
"Render a moderation link for item with ID."
(let ((str (format "%s/disputes/strikes/%s"
mastodon-instance-url id)))
(mastodon-notifications--propertize-link str "View mod warning")))
;;; FORMAT/INSERT SINGLE NOTIF
(defun mastodon-notifications--format-note (note)
"Format for a NOTE, a non-grouped notification."
(let* ((type (intern (alist-get 'type note)))
(profile-note
(when (eq 'follow_request type)
(let ((str (mastodon-tl--field
'note
(mastodon-tl--field 'account note))))
(if mastodon-profile-note-in-foll-reqs-max-length
(string-limit str mastodon-profile-note-in-foll-reqs-max-length)
str))))
(status (mastodon-tl--field 'status note))
(follower (alist-get 'account note))
(follower-name (mastodon-notifications--follower-name follower))
(filtered (mastodon-tl--field 'filtered status))
(filters (when filtered
(mastodon-tl--current-filters filtered))))
(if (and filtered (assoc "hide" filters))
nil
(mastodon-notifications--insert-note
;; toot
;; should always be note, otherwise notif data not avail
;; later on:
note
;; body
(mastodon-notifications--body-arg
type filters status profile-note follower-name nil note)
;; action-byline (top)
(mastodon-notifications--action-byline
type nil nil note follower-name)
;; base toot (always provide)
status
nil nil nil type))))
(defun mastodon-notifications--format-group-note (group status accounts)
"Format for a GROUP notification.
STATUS is the status's JSON.
ACCOUNTS is data of the accounts that have reacted to the notification."
(let ((folded nil))
;; FIXME: apply/refactor filtering as per/with `mastodon-tl--toot'
(let-alist group
(let* ((type (intern .type))
(profile-note
(when (member type '(follow_request))
(let ((str (mastodon-tl--field 'note (car accounts))))
(if mastodon-profile-note-in-foll-reqs-max-length
(string-limit str mastodon-profile-note-in-foll-reqs-max-length)
str))))
(follower (when (member type '(follow follow_request))
(car accounts)))
(follower-name (mastodon-notifications--follower-name follower))
(filtered (mastodon-tl--field 'filtered status))
(filters (when filtered
(mastodon-tl--current-filters filtered))))
(unless (and filtered (assoc "hide" filters))
(mastodon-notifications--insert-note
;; toot
(if (member type '(follow follow_request))
follower
status)
;; body
(mastodon-notifications--body-arg
type filters status profile-note follower-name group)
;; action-byline
(mastodon-notifications--action-byline
type accounts group)
;; base toot (no need for update/poll/?)
(when (member type '(favourite reblog))
status)
folded group accounts))))))
(defun mastodon-notifications--follower-name (follower)
"Return display_name or username of FOLLOWER."
(if (not (string= "" (alist-get 'display_name follower)))
(alist-get 'display_name follower)
(alist-get 'username follower)))
(defun mastodon-notifications--comment-note-text (str)
"Add comment face to all text in STR with `shr-text' face only."
(with-temp-buffer
(insert str)
(goto-char (point-min))
(let (prop)
(while (setq prop (text-property-search-forward 'face 'shr-text t))
(add-text-properties (prop-match-beginning prop)
(prop-match-end prop)
'(face (mastodon-toot-docs-face shr-text)))))
(buffer-string)))
(defun mastodon-notifications--body-arg
(type &optional filters status profile-note follower-name group note)
"Prepare a notification body argument.
The string returned is passed to `mastodon-notifications--insert-note'.
TYPE is a symbol, a member of `mastodon-notifiations--types'.
FILTERS STATUS PROFILE-NOTE FOLLOWER-NAME GROUP NOTE."
(let ((body
(if-let* ((match (assoc "warn" filters)))
(mastodon-tl--spoiler status (cadr match))
(mastodon-tl--clean-tabs-and-nl
(cond ((mastodon-tl--has-spoiler status)
(mastodon-tl--spoiler status))
((eq type 'follow_request)
(mastodon-tl--render-text profile-note))
(t (mastodon-tl--content status)))))))
(cond
((not (member (symbol-name type)
mastodon-notifications--types))
"Unknown notification type.")
((eq type 'follow)
(propertize "Congratulations, you have a new follower!"
'face 'default
'item-type 'follow-request)) ;; nav
((eq type 'follow_request)
(concat
(propertize (format "You have a follow request from %s"
follower-name)
'face 'default
'item-type 'follow-request) ;; nav
(when mastodon-profile-note-in-foll-reqs
(concat
":\n"
(mastodon-notifications--comment-note-text body)))))
((eq type 'severed_relationships)
(mastodon-notifications--severance-body
(alist-get 'event (or group note))))
((eq type 'moderation_warning)
(mastodon-notifications--mod-warning-body
(alist-get 'moderation_warning (or group note))))
((member type '(favourite reblog))
(propertize
(mastodon-notifications--comment-note-text body)))
(t body))))
(defun mastodon-notifications--insert-note
(toot body action-byline
&optional base-toot unfolded group accounts type)
"Display the content and byline of timeline element TOOT.
BODY will form the section of the toot above the byline.
AUTHOR-BYLINE is an optional function for adding the author
portion of the byline that takes one variable. By default it is
`mastodon-tl--byline-author'.
ACTION-BYLINE is a string, obtained by calling
`mastodon-notifications--action-byline'.
BASE-TOOT is the JSON of the toot responded to.
UNFOLDED is a boolean meaning whether to unfold or fold item if
foldable.
GROUP is the notification group data.
ACCOUNTS is the notification accounts data.
TYPE is notification type, used for non-group notifs."
(let* ((type (if type
(symbol-name type) ;; non-group
(alist-get 'type group)))
(toot-foldable
(and mastodon-tl--fold-toots-at-length
(length> body mastodon-tl--fold-toots-at-length)))
(ts ;; types listed here use base item timestamp, else we use
;; group's latest timestamp:
(when (and group
(not
(member type '("favourite" "reblog" "edit" "poll"))))
(mastodon-tl--field 'latest_page_notification_at group))))
(insert
(propertize ;; top byline, body + byline:
(concat
(if (equal type "mention") ;; top (action) byline
""
action-byline)
(propertize body ;; body only
'toot-body t) ;; includes newlines etc. for folding
"\n"
;; actual byline:
(if (member type '("severed_relationships" "moderation_warning"))
(propertize
(concat mastodon-tl--horiz-bar "\n")
'byline t)
(mastodon-tl--byline toot nil nil base-toot group ts)))
'item-type 'toot ;; for nav, actions, etc.
'item-id (or (alist-get 'page_max_id group) ;; newest notif
(alist-get 'id toot)) ; toot id
'base-item-id (mastodon-tl--item-id
;; if status is a notif, get id from base-toot
;; (-tl--item-id toot) will not work here:
(or base-toot
toot)) ; else normal toot with reblog check
'item-json toot
'base-toot base-toot
'cursor-face 'mastodon-cursor-highlight-face
'toot-foldable toot-foldable
'toot-folded (and toot-foldable (not unfolded))
;; grouped notifs data:
'notification-type type
'notification-id (alist-get 'group_key group)
'notification-group group
'notification-accounts accounts
;; for pagination:
'notifications-min-id (alist-get 'page_min_id group)
'notifications-max-id (alist-get 'page_max_id group))
"\n")))
;;; BYLINES
(defun mastodon-notifications--action-byline
(type &optional accounts group note follower-name)
"Return an action (top) byline for notification of TYPE.
ACCOUNTS and GROUP group are used by grouped notifications.
NOTE and FOLLOWER-NAME are used for non-grouped notifs."
(let* ((str-prefix (mastodon-notifications--action-alist-get type))
(action-str
(unless (member type '(follow follow_request mention))
(downcase
(mastodon-notifications--byline-action-str
str-prefix))))
(action-symbol (if (eq type 'mention)
""
(mastodon-tl--symbol type)))
(action-authors
(cond
((not (member (symbol-name type)
mastodon-notifications--types))
"")
((member type
'(follow follow_request mention
severed_relationships moderation_warning))
"") ;; mentions are normal statuses
(group
(mastodon-notifications--byline-accounts accounts group))
(t (mastodon-tl--byline-handle note nil
follower-name
'mastodon-display-name-face)))))
(propertize
(concat action-symbol " " action-authors action-str)
'byline-top t)))
(defun mastodon-notifications--byline-action-str (message)
"Return an action (top) byline string for TOOT with MESSAGE."
(let ((resp (mastodon-notifications--response-alist-get message)))
(concat " "
(propertize message 'face 'mastodon-boosted-face)
" " resp "\n")))
(defun mastodon-notifications--alist-by-value (str field json)
"From JSON, return the alist whose FIELD value matches STR.
JSON is a list of alists."
(cl-some (lambda (y)
(when (string= str (alist-get field y))
y))
json))
(defun mastodon-notifications--group-accounts (ids json)
"For IDS, return account data in JSON."
(cl-loop
for x in ids
collect (mastodon-notifications--alist-by-value x 'id json)))
(defun mastodon-notifications--byline-accounts
(accounts group &optional avatar)
"Propertize author byline ACCOUNTS.
GROUP is the group notification data.
When AVATAR, include the account's avatar image."
(let ((total (alist-get 'notifications_count group))
(accts mastodon-notifications-grouped-names-count))
(concat
(string-trim ;; remove trailing newline
(cl-loop
for account in accounts
repeat accts
concat
(let-alist account
(concat
;; avatar insertion moved up to `mastodon-tl--byline' by
;; default to be outside 'byline propt.
(when (and avatar ; used by `mastodon-profile--format-user'
mastodon-tl--show-avatars
mastodon-tl--display-media-p
(mastodon-tl--image-trans-check))
(mastodon-media--get-avatar-rendering .avatar))
(let ((uname (mastodon-tl--display-or-uname account)))
(mastodon-tl--byline-handle account nil
uname 'mastodon-display-name-face))
", ")))
nil ", ")
(if (< accts total)
(let ((diff (- total accts)))
(propertize ;; help-echo remaining notifs authors:
(format " and %s other%s" diff (if (= 1 diff) "" "s"))
'help-echo (mapconcat (lambda (a)
(propertize (alist-get 'username a)
'face 'mastodon-display-name-face))
(cddr accounts) ;; not first two
", ")))))))
;;; LOAD TIMELINE
(defun mastodon-notifications--render (json no-group)
"Display grouped notifications in JSON.
NO-GROUP means don't render grouped notifications."
;; (setq masto-grouped-notifs json)
(let ((start-pos (point)))
(if no-group
(cl-loop for x in json
do (mastodon-notifications--format-note x))
(cl-loop
for g in (alist-get 'notification_groups json)
for accounts = (mastodon-notifications--group-accounts
(alist-get 'sample_account_ids g)
(alist-get 'accounts json))
for type = (alist-get 'type g)
for status = (mastodon-notifications--status-or-event g type json)
do (mastodon-notifications--format-group-note g status accounts)))
(when mastodon-tl--display-media-p
;; images-in-notifs custom is handeld in
;; `mastodon-tl--media-attachment', not here
(mastodon-media--inline-images start-pos (point)))))
(defun mastodon-notifications--status-or-event (group type json)
"Return a notification's status or event data.
Using GROUP data, notification TYPE, and overall notifs JSON."
(if (member type (map-keys mastodon-notifications--no-status-notif-alist))
;; notifs w no status data:
(let ((key (alist-get type mastodon-notifications--no-status-notif-alist
nil nil #'equal)))
(alist-get key group))
(mastodon-notifications--alist-by-value
(alist-get 'status_id group)
'id
(alist-get 'statuses json))))
(defun mastodon-notifications--empty-group-json-p (json)
"Non-nil if JSON is empty grouped notifs data."
(equal json '((accounts) (statuses) (notification_groups))))
(defun mastodon-notifications--timeline (json &optional type update)
"Format JSON in Emacs buffer.
Optionally specify TYPE.
UPDATE means we are updating, so skip some things."
(if (seq-empty-p json)
(user-error "Looks like you have no (more) notifications for now")
(unless update
(mastodon-widget--create
"Filter" mastodon-notifications--types
(or type "all")
(lambda (widget &rest _ignore)
(let ((value (widget-value widget)))
(mastodon-notifications-get-type value)))
:newline)
(insert "\n"))
;; filtered/requests message:
(when (mastodon-notifications--notif-requests)
(insert
(substitute-command-keys
"You have filtered notifications. \
\\[mastodon-notifications-requests] to view requests.\n\n")))
;; set update point:
(setq mastodon-tl--update-point (point))
;; render:
(mastodon-notifications--render json
(not mastodon-group-notifications))
(goto-char (point-min))
;; set last read notif ID:
(save-excursion
(mastodon-tl-goto-next-item :no-refresh)
(let ((id (mastodon-tl--property 'item-id))) ;; notif not base
(mastodon-notifications--set-last-read id)))
(unless update ;; already in tl--update
(mastodon-tl-goto-next-item))))
;;; VIEW LOADING FUNCTIONS
(defun mastodon-notifications-get-type (&optional type)
"Read a notification type and load its timeline.
Optionally specify TYPE."
(interactive)
(let ((choice (or type
(completing-read
"View notifications: "
mastodon-notifications--filter-types-alist))))
(funcall (alist-get
choice mastodon-notifications--filter-types-alist
nil nil #'equal))))
(defun mastodon-notifications-cycle-type (&optional prefix)
"Cycle the current notifications view.
With arg PREFIX, `completing-read' a type and load it."
(interactive "P")
;; FIXME: do we need a sept buffer-type result for all notifs views?
(if (not (or (mastodon-tl--buffer-type-eq 'notifications)
(mastodon-tl--buffer-type-eq 'mentions)))
(user-error "Not in a notifications view")
(let* ((choice
(if prefix
(completing-read "Notifs by type: "
mastodon-notifications--types)
(mastodon-notifications--get-next-type)))
(fun (alist-get choice mastodon-notifications--filter-types-alist
nil nil #'equal)))
(funcall fun))))
(defun mastodon-notifications--current-type ()
"Return the current notification type or nil."
(let* ((update-params (mastodon-tl--buffer-property
'update-params nil :no-error)))
(alist-get "types[]" update-params nil nil #'equal)))
(defun mastodon-notifications--get-next-type ()
"Return the next notif type based on current buffer spec."
(let* ((type (mastodon-notifications--current-type)))
(if (not type)
(cadr mastodon-notifications--types)
(or (cadr (member type mastodon-notifications--types))
(car mastodon-notifications--types)))))
(defun mastodon-notifications-get-mentions ()
"Display mention notifications in buffer."
(interactive)
(mastodon-notifications-get "mention" "mentions"))
(defun mastodon-notifications-get-favourites ()
"Display favourite notifications in buffer."
(interactive)
(mastodon-notifications-get "favourite" "favourites"))
(defun mastodon-notifications-get-boosts ()
"Display boost notifications in buffer."
(interactive)
(mastodon-notifications-get "reblog" "boosts"))
(defun mastodon-notifications-get-polls ()
"Display poll notifications in buffer."
(interactive)
(mastodon-notifications-get "poll" "polls"))
(defun mastodon-notifications-get-statuses ()
"Display status notifications in buffer.
Status notifications are created when you call
`mastodon-tl-enable-notify-user-posts'."
(interactive)
(mastodon-notifications-get "status" "statuses"))
(defun mastodon-notifications-get-follows ()
"Display follow notifications in buffer."
(interactive)
(mastodon-notifications-get "follow" "follows"))
(defun mastodon-notifications-get-follow-requests ()
"Display follow request notifications in buffer."
(interactive)
(mastodon-notifications-get "follow_request" "follow-requests"))
(defun mastodon-notifications-get-edits ()
"Display edited post notifications in buffer."
(interactive)
(mastodon-notifications-get "update" "edits"))
(defun mastodon-notifications--filter-types-list (type)
"Return a list of notification types with TYPE removed."
(remove type mastodon-notifications--types))
;;; CLEAR/DISMISS NOTIFS
(defun mastodon-notifications-clear-all ()
"Clear all notifications."
(interactive)
(when (y-or-n-p "Clear all notifications?")
(let ((response
(mastodon-http--post
(mastodon-notifications--api "notifications/clear"))))
(mastodon-http--triage
response (lambda (_)
(when mastodon-tl--buffer-spec
(mastodon-tl--reload-timeline-or-profile))
(message "All notifications cleared!"))))))
(defun mastodon-notifications-clear-current ()
"Dismiss the notification at point."
(interactive)
(let* ((id (or ;; grouping enabled
;; (*should* also work for ungrouped items):
(mastodon-tl--property 'notification-id)
;; FIXME: are these all required?
(mastodon-tl--property 'item-id)
(mastodon-tl--field
'id
(mastodon-tl--property 'item-json))))
(endpoint (mastodon-notifications--api
(format "notifications/%s/dismiss" id)))
(response (mastodon-http--post endpoint)))
(mastodon-http--triage
response (lambda (_)
(when mastodon-tl--buffer-spec
(mastodon-tl--reload-timeline-or-profile))
(message "Notification dismissed!")))))
;;; MISC
(defun mastodon-notifications--set-last-read (id)
"Set the last read notification ID on the server."
(let ((endpoint (mastodon-http--api "markers"))
(params `(("notifications[last_read_id]" . ,id))))
(mastodon-http--post endpoint params)))
(defun mastodon-notifications--get-last-read ()
"Return the last read notification ID from the server."
(let* ((params '(("timeline[]" . "notifications")))
(endpoint (mastodon-http--api "markers"))
(resp (mastodon-http--get-json endpoint params)))
(map-nested-elt resp '(notifications last_read_id))))
(defun mastodon-notifications-get-single-notif ()
"Return a single notification JSON for v2 notifs."
(interactive)
(let* ((id ;; grouped (should work for ungrouped items):
(mastodon-tl--property 'notification-id))
(endpoint (mastodon-notifications--api
(format "notifications/%s" id)))
(response (mastodon-http--get-json endpoint)))
(message "%s" (prin1-to-string response))))
(defun mastodon-notifications--get-unread-count ()
"Return the number of unread notifications for the current account."
;; params: limit - max 1000, default 100, types[], exclude_types[], account_id
(let* ((endpoint "notifications/unread_count")
(url (mastodon-http--api endpoint
(when mastodon-group-notifications "v2")))
(resp (mastodon-http--get-json url)))
(alist-get 'count resp)))
;;; NOTIFICATION REQUESTS / FILTERING / POLICY
(defvar mastodon-notifications--requests-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map mastodon-mode-map)
(define-key map (kbd "j") #'mastodon-notifications-request-reject)
(define-key map (kbd "a") #'mastodon-notifications-request-accept)
(define-key map (kbd "g") #'mastodon-notifications-requests)
map)
"Keymap for viewing follow requests.")
;; FIXME: these are only for grouped notifs, else the fields are JSON bools
(defvar mastodon-notifications-policy-vals
'("accept" "filter" "drop"))
(defun mastodon-notifications-get-policy ()
"Return the notification filtering policy."
(let ((url (mastodon-notifications--api "notifications/policy")))
(mastodon-http--get-json url)))
(defun mastodon-notifications--notif-requests ()
"Non-nil if the user currently has pending/filtered notifications.
Returns"
(let* ((policy (mastodon-notifications-get-policy))
(count (map-nested-elt policy '(summary pending_notifications_count))))
(if (and count (> count 0))
count)))
(defun mastodon-notifications--pending-p ()
"Non-nil if there are any pending requests or notifications."
(let* ((json (mastodon-notifications-get-policy))
(summary (alist-get 'summary json)))
(or (not (= 0 (alist-get 'pending_requests_count summary)))
(not (= 0 (alist-get 'pending_notifications_count summary))))))
(defun mastodon-notifications--update-policy (&optional params)
"Update notifications filtering policy.
PARAMS is an alist of parameters."
;; https://docs.joinmastodon.org/methods/notifications/#update-the-filtering-policy-for-notifications
(let ((url (mastodon-notifications--api "notifications/policy")))
(mastodon-http--patch url params)))
(defun mastodon-notifications--get-requests (&optional params)
"Get a list of notification requests data from the server.
PARAMS is an alist of parameters."
;; NB: link header pagination
(let ((url (mastodon-notifications--api "notifications/requests")))
(mastodon-http--get-json url params)))
(defun mastodon-notifications-request-accept (&optional reject)
"Accept a notification request for a user.
This will merge any filtered notifications from them into the main
notifications and accept any future notification from them.
REJECT means reject notifications instead."
;; POST /api/v1/notifications/requests/:id/accept
(interactive)
(let* ((id (mastodon-tl--property 'item-id))
(user (mastodon-tl--property 'notif-req-user))
(url (mastodon-http--api
(format "notifications/requests/%s/%s"
id (if reject "dismiss" "accept"))))
(resp (mastodon-http--post url)))
(mastodon-http--triage
resp
(lambda (_resp)
(message "%s notifications from %s"
(if reject "Not accepting" "Accepting") user)
;; reload view:
(mastodon-notifications-requests)))))
(defun mastodon-notifications-request-reject ()
"Reject a notification request for a user.
Rejecting a request means any notifications from them will continue to
be filtered."
(interactive)
(mastodon-notifications-request-accept :reject))
(defun mastodon-notifications-requests ()
"Open a new buffer displaying the user's notification requests."
;; calqued off `mastodon-views-view-follow-requests'
(interactive)
(mastodon-tl--init-sync
"notification-requests"
"notifications/requests"
'mastodon-views--insert-notification-requests
nil
'(("limit" . "40")) ; server max is 80
:headers
"notification requests"
"a/j - accept/reject request at point\n\
n/p - go to next/prev request\n\
\\[mastodon-notifications-policy] - set filtering policy")
(mastodon-tl--goto-first-item)
(with-current-buffer "*mastodon-notification-requests*"
(use-local-map mastodon-notifications--requests-map)))
(defun mastodon-views--insert-notification-requests (json)
"Insert the user's current notification requests.
JSON is the data returned by the server."
(mastodon-views--minor-view
"notification requests"
#'mastodon-notifications--insert-users
json))
;; masto-notif-req))
(defun mastodon-notifications--insert-users (json)
"Insert users list into the buffer.
JSON is the data from the server."
;; calqued off `mastodon-views--insert-users-propertized-note'
;; and `mastodon-search--insert-users-propertized'
(cl-loop for req in json
do (insert
(concat
(mastodon-notifications--format-req-user req)
mastodon-tl--horiz-bar "\n\n"))))
(defun mastodon-notifications--format-req-user (req &optional note)
"Format a notification request user, REQ.
NOTE means to include a profile note."
;; calqued off `mastodon-search--propertize-user'
(let-alist req
(propertize
(concat
(propertize .account.username
'face 'mastodon-display-name-face
'byline t
'notif-req-user .account.username
'item-type 'notif-req
'item-id .id) ;; notif req id
" : \n : "
(propertize (concat "@" .account.acct)
'face 'mastodon-handle-face
'mouse-face 'highlight
'mastodon-tab-stop 'user-handle
'keymap mastodon-tl--link-keymap
'mastodon-handle (concat "@" .account.acct)
'help-echo (concat "Browse user profile of @" .account.acct))
" : \n"
(when note
(mastodon-tl--render-text .account.note .account))
"\n")
'item-json req)))
(provide 'mastodon-notifications)
;;; mastodon-notifications.el ends here
mastodon.el/lisp/mastodon-profile.el 0000664 0000000 0000000 00000135234 15017331127 0020064 0 ustar 00root root 0000000 0000000 ;;; mastodon-profile.el --- Functions for inspecting Mastodon profiles -*- lexical-binding: t -*-
;; Copyright (C) 2017-2019 Johnson Denen
;; Copyright (C) 2020-2024 Marty Hiatt
;; Author: Johnson Denen
;; Marty Hiatt
;; Maintainer: Marty Hiatt
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
;; This file is part of mastodon.el.
;; mastodon.el 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.
;; mastodon.el 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 mastodon.el. If not, see .
;;; Commentary:
;; mastodon-profile.el generates a stream of users toots.
;; To add
;; - Option to follow
;; - wheather they follow you or not
;; - Show only Media
;;; Code:
(require 'seq)
(require 'cl-lib)
(require 'persist)
(require 'parse-time)
(require 'mastodon-http)
(eval-when-compile
(require 'mastodon-tl))
(require 'mastodon-widget)
(autoload 'mastodon-auth--get-account-id "mastodon-auth")
(autoload 'mastodon-auth--get-account-name "mastodon-auth.el")
(autoload 'mastodon-http--api "mastodon-http.el")
(autoload 'mastodon-http--get-json "mastodon-http.el")
(autoload 'mastodon-http--get-json-async "mastodon-http.el")
(autoload 'mastodon-http--get-response "mastodon-http")
(autoload 'mastodon-http--patch "mastodon-http")
(autoload 'mastodon-http--patch-json "mastodon-http")
(autoload 'mastodon-http--post "mastodon-http.el")
(autoload 'mastodon-http--triage "mastodon-http.el")
(autoload 'mastodon-kill-window "mastodon")
(autoload 'mastodon-media--get-media-link-rendering "mastodon-media.el")
(autoload 'mastodon-media--inline-images "mastodon-media.el")
(autoload 'mastodon-mode "mastodon.el")
(autoload 'mastodon-notifications-follow-request-accept "mastodon-notifications")
(autoload 'mastodon-notifications-follow-request-reject "mastodon-notifications")
(autoload 'mastodon-search--insert-users-propertized "mastodon-search")
(autoload 'mastodon-tl--as-string "mastodon-tl.el")
(autoload 'mastodon-tl--buffer-type-eq "mastodon tl")
(autoload 'mastodon-tl--byline-author "mastodon-tl.el")
(autoload 'mastodon-tl--find-property-range "mastodon-tl.el")
(autoload 'mastodon-tl--get-link-header-from-response "mastodon-tl")
(autoload 'mastodon-tl--init "mastodon-tl.el")
(autoload 'mastodon-tl--user-handles-get "mastodon-tl")
(autoload 'mastodon-tl--map-alist "mastodon-tl")
(autoload 'mastodon-tl--map-alist-vals-to-alist "mastodon-tl")
(autoload 'mastodon-tl--profile-buffer-p "mastodon tl")
(autoload 'mastodon-tl--property "mastodon-tl.el")
(autoload 'mastodon-tl--render-text "mastodon-tl.el")
(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl")
(autoload 'mastodon-tl--set-face "mastodon-tl.el")
(autoload 'mastodon-tl--symbol "mastodon-tl")
(autoload 'mastodon-tl--timeline "mastodon-tl.el")
(autoload 'mastodon-tl--toot "mastodon-tl")
(autoload 'mastodon-tl--item-id "mastodon-tl")
(autoload 'mastodon-toot--count-toot-chars "mastodon-toot")
(autoload 'mastodon-toot--get-max-toot-chars "mastodon-toot")
(autoload 'mastodon-views-add-account-to-list "mastodon-views")
(autoload 'mastodon-return-credential-account "mastodon")
(autoload 'mastodon-tl--buffer-property "mastodon-tl")
(autoload 'mastodon-search-query "mastodon-search")
(autoload 'mastodon-tl--field-status "mastodon-tl")
(autoload 'mastodon-toot--with-toot-item "mastodon-toot" nil nil 'macro)
(autoload 'mastodon-tl--toot-or-base "mastodon-tl")
(defvar mastodon-active-user)
(defvar mastodon-tl--horiz-bar)
(defvar mastodon-tl--update-point)
(defvar mastodon-toot--max-toot-chars)
(defvar mastodon-toot--visibility)
(defvar mastodon-toot--content-nsfw)
(defvar mastodon-tl--timeline-posts-count)
(defvar-local mastodon-profile--account nil
"The data for the account being described in the current profile buffer.")
(defvar mastodon-profile-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-c") #'mastodon-profile-account-view-cycle)
(define-key map (kbd "C-c C-s") #'mastodon-profile-account-search)
(define-key map (kbd "C-c #") #'mastodon-profile-open-statuses-tagged)
map)
"Keymap for `mastodon-profile-mode'.")
(define-minor-mode mastodon-profile-mode
"Toggle mastodon profile minor mode.
This minor mode is used for mastodon profile pages and adds a couple of
extra keybindings."
:init-value nil
:lighter " Profile"
:keymap mastodon-profile-mode-map
:group 'mastodon
:global nil)
(defvar mastodon-profile-credential-account nil
"Holds the JSON data of the CredentialAccount entity.
It contains details of the current user's account.")
(defvar mastodon-profile-acccount-preferences-data nil
"Holds the JSON data of the current user's preferences.")
(defvar mastodon-profile-update-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-c") #'mastodon-profile-user-profile-send-updated)
(define-key map (kbd "C-c C-k") #'mastodon-profile-update-profile-note-cancel)
map)
"Keymap for `mastodon-profile-update-mode'.")
(persist-defvar mastodon-profile-account-settings nil
"An alist of account settings saved from the server.
Other clients can change these settings on the server at any
time, so this list is not the canonical source for settings. It
is updated on entering mastodon mode and on toggle any setting it
contains.
This variable is set from data in
`mastodon-profile-credential-account' not
`mastodon-profile-account-preferences-data'.")
(define-minor-mode mastodon-profile-update-mode
"Minor mode to update user profile."
:group 'mastodon-profile
:keymap mastodon-profile-update-mode-map
:global nil)
(defun mastodon-profile--item-json ()
"Get the next item-json."
(mastodon-tl--property 'item-json))
(defun mastodon-profile--make-author-buffer
(account &optional no-reblogs no-replies only-media tag max-id)
"Take an ACCOUNT json and insert a user account into a new buffer.
NO-REBLOGS means do not display boosts in statuses.
NO-REPLIES means to exlude replies.
ONLY-MEDIA means show only posts containing attachments.
TAG is a hashtag to restrict posts to.
MAX-ID is a flag to include the max_id pagination parameter."
(mastodon-profile--make-profile-buffer-for
account "statuses" #'mastodon-tl--timeline no-reblogs nil
no-replies only-media tag max-id))
;;; PROFILE VIEW COMMANDS
(defvar mastodon-profile--account-view-alist
'((statuses . mastodon-profile-open-statuses)
(no-boosts . mastodon-profile-open-statuses-no-reblogs)
(no-replies . mastodon-profile-open-statuses-no-replies)
(only-media . mastodon-profile-open-statuses-only-media)
(followers . mastodon-profile-open-followers)
(following . mastodon-profile-open-following)
(tag . mastodon-profile-open-statuses-tagged)))
(defun mastodon-profile--view-types ()
"Return the keys of `mastodon-profile--account-view-alist' as a list."
(map-keys mastodon-profile--account-view-alist))
(defun mastodon-profile-account-view-cycle (&optional prefix)
"Cycle through profile view: toots, toot sans boosts, followers, and following.
If a PREFIX argument is provided, prompt for a view type and load."
(interactive "P")
(if prefix
(let* ((choice
(completing-read "Profile view:"
mastodon-profile--account-view-alist))
(fun (alist-get choice mastodon-profile--account-view-alist)))
(funcall fun))
(cond ((mastodon-tl--buffer-type-eq 'profile-statuses)
(mastodon-profile-open-statuses-no-reblogs))
((mastodon-tl--buffer-type-eq 'profile-statuses-no-boosts)
(mastodon-profile-open-statuses-no-replies))
((mastodon-tl--buffer-type-eq 'profile-statuses-no-replies)
(mastodon-profile-open-statuses-only-media))
((mastodon-tl--buffer-type-eq 'profile-statuses-only-media)
(mastodon-profile-open-followers))
((mastodon-tl--buffer-type-eq 'profile-followers)
(mastodon-profile-open-following))
((mastodon-tl--buffer-type-eq 'profile-following)
(mastodon-profile-open-statuses)))))
(defun mastodon-profile-open-statuses ()
"Open a profile showing statuses."
(interactive)
(if mastodon-profile--account
(mastodon-profile--make-author-buffer
mastodon-profile--account)
(user-error "Not in a mastodon profile")))
(defun mastodon-profile-open-statuses-no-replies ()
"Open a profile buffer showing statuses without replies."
(interactive)
(if mastodon-profile--account
(mastodon-profile--make-author-buffer
mastodon-profile--account nil :no-replies)
(user-error "Not in a mastodon profile")))
(defun mastodon-profile-open-statuses-no-reblogs ()
"Open a profile buffer showing statuses without reblogs."
(interactive)
(if mastodon-profile--account
(mastodon-profile--make-author-buffer
mastodon-profile--account :no-reblogs)
(user-error "Not in a mastodon profile")))
(defun mastodon-profile-open-statuses-only-media ()
"Open a profile buffer showing only statuses with media."
(interactive)
(if mastodon-profile--account
(mastodon-profile--make-author-buffer
mastodon-profile--account nil nil :only-media)
(user-error "Not in a mastodon profile")))
(defun mastodon-profile-open-statuses-tagged ()
"Prompt for a hashtag and display a profile with only statuses containing it."
(interactive)
(let ((tag (read-string "Statuses containing tag: ")))
(if mastodon-profile--account
(mastodon-profile--make-author-buffer
mastodon-profile--account nil nil nil tag)
(user-error "Not in a mastodon profile"))))
(defun mastodon-profile-open-following ()
"Open a profile buffer showing the accounts that current profile follows."
(interactive)
(if mastodon-profile--account
(mastodon-profile--make-profile-buffer-for
mastodon-profile--account "following"
#'mastodon-profile--format-user nil :headers)
(user-error "Not in a mastodon profile")))
(defun mastodon-profile-open-followers ()
"Open a profile buffer showing the accounts following the current profile."
(interactive)
(if mastodon-profile--account
(mastodon-profile--make-profile-buffer-for
mastodon-profile--account "followers"
#'mastodon-profile--format-user nil :headers)
(user-error "Not in a mastodon profile")))
(defun mastodon-profile-view-favourites ()
"Open a new buffer displaying the user's favourites."
(interactive)
(message "Loading your favourited toots...")
(mastodon-tl--init "favourites" "favourites"
'mastodon-tl--timeline :headers))
(defun mastodon-profile-view-bookmarks ()
"Open a new buffer displaying the user's bookmarks."
(interactive)
(message "Loading your bookmarked toots...")
(mastodon-tl--init "bookmarks" "bookmarks"
'mastodon-tl--timeline :headers))
(defun mastodon-profile-add-account-to-list ()
"Add account of current profile buffer to a list."
(interactive)
(if (not mastodon-profile--account)
(user-error "No profile to add?")
(let-alist mastodon-profile--account
(mastodon-views-add-account-to-list nil .id .acct))))
(defun mastodon-profile-account-search (query)
"Run a statuses search QUERY for the currently viewed account."
(interactive "sSearch account for: ")
(let* ((ep (mastodon-tl--buffer-property 'endpoint))
(id (nth 1 (split-string ep "/"))))
(mastodon-search-query query "statuses" nil nil id)))
;;; ACCOUNT PREFERENCES
(defun mastodon-profile--get-account-value (key function)
"Fetch KEY from data returned by FUNCTION.
If value is :json-false, return nil."
(let* ((response (funcall function))
(value (alist-get key response)))
(if (eq value :json-false) nil value)))
(defun mastodon-profile--get-json-value (key)
"Fetch value for KEY from account.
Account details are from `mastodon-return-credential-account'.
If value is :json-false, return nil."
(mastodon-profile--get-account-value
key #'mastodon-return-credential-account))
(defun mastodon-profile--get-source-values ()
"Return the \"source\" preferences from the server."
(mastodon-profile--get-json-value 'source))
(defun mastodon-profile--get-source-value (pref)
"Return PREF erence from the account's \"source\" field."
(mastodon-profile--get-account-value
pref #'mastodon-profile--get-source-values))
(defun mastodon-profile-update-user-profile-note ()
"Fetch user's profile note and display for editing."
(interactive)
(let* ((source (mastodon-profile--get-source-values))
(note (alist-get 'note source))
(buffer (get-buffer-create "*mastodon-update-profile*"))
(inhibit-read-only t)
(msg-str
(substitute-command-keys
"Edit your profile note. \\`C-c C-c' to send, \\`C-c C-k' to cancel.")))
(switch-to-buffer-other-window buffer)
(text-mode)
(mastodon-tl--set-buffer-spec (buffer-name buffer)
"accounts/verify_credentials" nil)
(setq-local header-line-format msg-str)
(mastodon-profile-update-mode t)
(insert (propertize (concat
(propertize "0"
'note-counter t
'display nil)
"/500 characters")
'read-only t
'face 'mastodon-toot-docs-face
'note-header t)
"\n")
(make-local-variable 'after-change-functions)
(cl-pushnew #'mastodon-profile--update-note-count after-change-functions)
(let ((start-point (point)))
(insert note)
(goto-char start-point))
(delete-trailing-whitespace) ; remove all ^M's
(message msg-str)))
(defun mastodon-profile--update-note-count (&rest _args)
"Display the character count of the profile note buffer."
(let* ((inhibit-read-only t)
(header-region (mastodon-tl--find-property-range 'note-header
(point-min)))
(count-region (mastodon-tl--find-property-range 'note-counter
(point-min)))
(count (number-to-string (mastodon-toot--count-toot-chars
(buffer-substring-no-properties
(cdr header-region) (point-max))))))
(add-text-properties (car count-region) (cdr count-region)
(list 'display count))))
(defun mastodon-profile-update-profile-note-cancel ()
"Cancel updating user profile and kill buffer and window."
(interactive)
(when (y-or-n-p "Cancel updating your profile note?")
(mastodon-kill-window)))
(defun mastodon-profile--note-remove-header ()
"Get the profile note, without the buffer header."
(let ((header-region (mastodon-tl--find-property-range 'note-header
(point-min))))
(buffer-substring (cdr header-region) (point-max))))
(defun mastodon-profile-user-profile-send-updated ()
"Send PATCH request with the updated profile note.
Ask for confirmation if length > 500 characters."
(interactive)
(let* ((note (mastodon-profile--note-remove-header))
(url (mastodon-http--api "accounts/update_credentials")))
(when (or (not (> (mastodon-toot--count-toot-chars note) 500))
(y-or-n-p "Note is over mastodon's max for profile notes (500). Proceed?"))
(quit-window 'kill)
(mastodon-profile--user-profile-send-updated-do url note))))
(defun mastodon-profile--user-profile-send-updated-do (url note)
"Send PATCH request with the updated profile NOTE to URL."
(let ((response (mastodon-http--patch url `(("note" . ,note)))))
(mastodon-http--triage response
(lambda (_) (message "Profile note updated!")))))
(defun mastodon-profile--update-preference (pref val &optional source)
"Update account PREF erence to setting VAL.
Both args are strings.
SOURCE means that the preference is in the `source' part of the account JSON."
(let* ((url (mastodon-http--api "accounts/update_credentials"))
(pref-formatted (if source (concat "source[" pref "]") pref))
(response (mastodon-http--patch url `((,pref-formatted . ,val)))))
(mastodon-http--triage response
(lambda (_)
(mastodon-profile--fetch-server-account-settings)
(message "Account setting %s updated to %s!" pref val)))))
(defun mastodon-profile--get-pref (pref)
"Return PREF from `mastodon-profile-account-settings'."
(plist-get mastodon-profile-account-settings pref))
(defun mastodon-profile--update-preference-plist (pref val)
"Set local account preference plist preference PREF to VAL.
This is done after changing the setting on the server."
(setq mastodon-profile-account-settings
(plist-put mastodon-profile-account-settings pref val)))
;; used in toot.el
(defun mastodon-profile--fetch-server-account-settings-maybe ()
"Fetch account settings from the server.
Only do so if `mastodon-profile-account-settings' is nil."
(mastodon-profile--fetch-server-account-settings :no-force))
;; FIXME: this does one request per setting! should just do one request then
;; parse
(defun mastodon-profile--fetch-server-account-settings (&optional no-force)
"Fetch basic account settings from the server.
Store the values in `mastodon-profile-account-settings'.
Run in `mastodon-mode-hook'.
If NO-FORCE, only fetch if `mastodon-profile-account-settings' is nil."
(unless (and no-force mastodon-profile-account-settings)
(let ((keys '(locked discoverable display_name bot))
(source-keys '(privacy sensitive language)))
(mapc (lambda (k)
(mastodon-profile--update-preference-plist
k (mastodon-profile--get-json-value k)))
keys)
(mapc (lambda (sk)
(mastodon-profile--update-preference-plist
sk (mastodon-profile--get-source-value sk)))
source-keys)
;; hack for max toot chars:
(mastodon-toot--get-max-toot-chars :no-toot)
(mastodon-profile--update-preference-plist 'max_toot_chars
mastodon-toot--max-toot-chars)
;; TODO: remove now redundant vars, replace with fetchers from the plist
(setq mastodon-toot--visibility (mastodon-profile--get-pref 'privacy)
mastodon-toot--content-nsfw (mastodon-profile--get-pref 'sensitive))
mastodon-profile-account-settings)))
(defun mastodon-profile-account-locked-toggle ()
"Toggle the locked status of your account.
Locked means follow requests have to be approved."
(interactive)
(mastodon-profile--toggle-account-key 'locked))
(defun mastodon-profile-account-discoverable-toggle ()
"Toggle the discoverable status of your account.
Discoverable means the account is listed in the server directory."
(interactive)
(mastodon-profile--toggle-account-key 'discoverable))
(defun mastodon-profile-account-bot-toggle ()
"Toggle the bot status of your account."
(interactive)
(mastodon-profile--toggle-account-key 'bot))
(defun mastodon-profile-account-sensitive-toggle ()
"Toggle the sensitive status of your account.
When enabled, statuses are marked as sensitive by default."
(interactive)
(mastodon-profile--toggle-account-key 'sensitive :source))
(defun mastodon-profile--toggle-account-key (key &optional source)
"Toggle the boolean account setting KEY.
SOURCE means the setting is located under \"source\" in the account JSON.
Current settings are fetched from the server."
(let* ((val (if source
(mastodon-profile--get-source-value key)
(mastodon-profile--get-json-value key)))
(prompt (format "Account setting %s is %s. Toggle?" key val)))
(when (y-or-n-p prompt)
(mastodon-profile--update-preference (symbol-name key)
(if val "false" "true")
source))))
(defun mastodon-profile--edit-string-value (key)
"Edit the string for account preference KEY."
(let* ((val (mastodon-profile--get-json-value key))
(new-val (read-string (format "Edit account setting %s: " key)
val)))
(mastodon-profile--update-preference (symbol-name key) new-val)))
(defun mastodon-profile-update-display-name ()
"Update display name for your account."
(interactive)
(mastodon-profile--edit-string-value 'display_name))
(defun mastodon-profile--make-meta-fields-params (fields)
"Construct a parameter query string from metadata alist FIELDS.
Returns an alist."
(let ((keys
(cl-loop
for count from 1 to 5
collect (cons (format "fields_attributes[%s][name]" count)
(format "fields_attributes[%s][value]" count)))))
(cl-loop for a-pair in keys
for b-pair in fields
append (list (cons (car a-pair) (car b-pair))
(cons (cdr a-pair) (cdr b-pair))))))
(defun mastodon-profile-update-meta-fields ()
"Prompt for new metadata fields information and PATCH the server."
(interactive)
(let* ((url (mastodon-http--api "accounts/update_credentials"))
(fields-updated (mastodon-profile--update-meta-fields-alist))
(params (mastodon-profile--make-meta-fields-params fields-updated))
(response (mastodon-http--patch url params)))
(mastodon-http--triage response
(lambda (_)
(mastodon-profile--fetch-server-account-settings)
(message "Metadata fields updated to %s!"
fields-updated)))))
(defun mastodon-profile--update-meta-fields-alist ()
"Prompt for new metadata fields information.
Returns the results as an alist."
(let ((fields-old (mastodon-profile--fields-get
nil ;; we must fetch the plaintext version:
(mastodon-profile--get-source-value 'fields))))
;; offer empty fields if user currently has less than four filled:
(while (< (length fields-old) 4)
(setq fields-old (append fields-old '(("" . "")))))
(let* ((f-str "Metadata %s [%s/4] (max. 255 chars): ")
(alist
(cl-loop for f in fields-old
for x from 1 to 5
collect
(cons (read-string (format f-str "key" x) (car f))
(read-string (format f-str "value" x) (cdr f))))))
(mapcar (lambda (x)
(cons (mastodon-profile--limit-to-255 (car x))
(mastodon-profile--limit-to-255 (cdr x))))
alist))))
(defun mastodon-profile--limit-to-255 (x)
"Limit string X to 255 chars max."
(if (> (length x) 255) (substring x 0 255) x))
;; used in tl.el and toot.el:
(defun mastodon-profile--get-preferences-pref (pref)
"Fetch PREF from the endpoint \"/preferences\".
If `mastodon-profile-acccount-preferences-data' is set, fetch
from that instead.
The endpoint only holds a few preferences. For others, see
`mastodon-profile--update-preference' and its endpoint,
\"/accounts/update_credentials.\""
(alist-get pref
(or mastodon-profile-acccount-preferences-data
(setq mastodon-profile-acccount-preferences-data
(mastodon-http--get-json
(mastodon-http--api "preferences"))))))
(defun mastodon-profile-view-preferences ()
"View user preferences in another window."
(interactive)
(let* ((url (mastodon-http--api "preferences"))
(response (mastodon-http--get-json url))
(buf (get-buffer-create "*mastodon-preferences*")))
(with-mastodon-buffer buf #'special-mode :other-window
(mastodon-tl--set-buffer-spec (buffer-name buf) "preferences" nil)
(while-let ((el (pop response)))
(insert (format "%-30s %s"
(prin1-to-string (car el))
(prin1-to-string (cdr el)))
"\n\n"))
(goto-char (point-min)))))
;;; PROFILE VIEW DETAILS
(defun mastodon-profile--relationships-get (id)
"Fetch info about logged-in user's relationship to user with id ID."
(let* ((args `(("id[]" . ,id)))
(url (mastodon-http--api "accounts/relationships")))
;; FIXME: API takes array, we just get 1st
(car (mastodon-http--get-json url args))))
(defun mastodon-profile--fields-get (&optional account fields)
"Fetch the fields vector (aka profile metadata) from profile of ACCOUNT.
Returns an alist.
FIELDS means provide a fields vector fetched by other means."
(let ((fields (or fields (alist-get 'fields account))))
(when fields
(mastodon-tl--map-alist-vals-to-alist 'name 'value fields))))
(defun mastodon-profile--fields-insert (fields)
"Format and insert field pairs (a.k.a profile metadata) in FIELDS."
(let* ((car-fields (mapcar #'car fields))
(left-width (apply #'max (mapcar #'length car-fields))))
(mapconcat (lambda (field)
(mastodon-tl--render-text
(concat
(format "_ %s " (car field))
(make-string (- (+ 1 left-width) (length (car field))) ?_)
(format " :: %s" (cdr field)))
field)) ; hack to make links tabstops
fields "")))
(defun mastodon-profile--get-statuses-pinned (account)
"Fetch the pinned toots for ACCOUNT."
(let* ((id (alist-get 'id account))
(args `(("pinned" . "true")))
(url (mastodon-http--api (format "accounts/%s/statuses" id))))
(mastodon-http--get-json url args)))
(defun mastodon-profile--insert-statuses-pinned (pinned-statuses)
"Insert each of the PINNED-STATUSES for a given account."
(cl-loop for s in pinned-statuses
do (progn
(insert
(concat "\n "
(propertize " pinned "
'face '(:inherit success :box t))
" "))
(mastodon-tl--toot s))))
(defun mastodon-profile--follows-p (list)
"T if you have any relationship with the accounts in LIST."
(let (result)
(dolist (x list result)
(when (not (eq :json-false x))
(setq result x)))))
(defun mastodon-profile--render-roles (roles)
"Return a propertized string of badges for ROLES."
(mapconcat
(lambda (role)
(propertize (alist-get 'name role)
'face `(:box t :foreground ,(alist-get 'color role))))
roles))
(defun mastodon-profile--make-profile-buffer-for
(account endpoint-type update-function
&optional no-reblogs headers no-replies only-media tag max-id)
"Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION.
NO-REBLOGS means do not display boosts in statuses.
HEADERS means also fetch link headers for pagination.
NO-REPLIES means to exlude replies.
ONLY-MEDIA means show only posts containing attachments.
TAG is a hashtag to restrict posts to.
MAX-ID is a flag to include the max_id pagination parameter."
(let-alist account
(let* ((max-id-str (when max-id
(mastodon-tl--buffer-property 'max-id)))
(args `(("limit" . ,mastodon-tl--timeline-posts-count)
,(when max-id `("max_id" . ,max-id-str))))
(args (cond (no-reblogs
(push '("exclude_reblogs" . "t") args))
(no-replies
(push '("exclude_replies" . "t") args))
(only-media
(push '("only_media" . "t") args))
(tag
(push `("tagged" . ,tag) args))
(t args)))
(endpoint (format "accounts/%s/%s" .id endpoint-type))
(url (mastodon-http--api endpoint))
(buffer (concat "*mastodon-" .acct "-"
(concat endpoint-type
(cond (no-reblogs "-no-boosts")
(no-replies "-no-replies")
(only-media "-only-media")
(tag (format "-tagged-%s" tag))
(t "")))
"*"))
(response (if headers
(mastodon-http--get-response url args)
(mastodon-http--get-json url args)))
(json (if headers (car response) response))
(link-header (when headers
(mastodon-tl--get-link-header-from-response
(cdr response))))
(fields (mastodon-profile--fields-get account))
(pinned (mastodon-profile--get-statuses-pinned account))
(relationships (mastodon-profile--relationships-get .id)))
(with-mastodon-buffer buffer #'mastodon-mode nil
(mastodon-profile-mode)
(setq mastodon-profile--account account)
(mastodon-tl--set-buffer-spec buffer endpoint update-function
link-header args nil max-id-str)
(let* ((inhibit-read-only t))
(insert
(propertize
(concat
"\n"
(mastodon-profile--image-from-account account 'avatar_static)
(mastodon-profile--image-from-account account 'header_static)
"\n"
(when .display_name
(propertize .display_name 'face 'mastodon-display-name-face))
;; roles
(when .roles
(concat " " (mastodon-profile--render-roles .roles)))
"\n"
(propertize (concat "@" .acct) 'face 'default)
(when (eq .locked t)
(concat " " (mastodon-tl--symbol 'locked)))
"\n " mastodon-tl--horiz-bar "\n"
;; profile note:
(mastodon-tl--render-text .note account) ; account = tab-stops in profile
;; meta fields:
(when fields
(concat "\n" (mastodon-tl--set-face
(mastodon-profile--fields-insert fields)
'success)))
"\n"
;; Joined date:
(propertize
(mastodon-profile--format-joined-date-string .created_at)
'face 'success)
"\n\n")
'profile-json account)
;; insert counts
(mastodon-tl--set-face
(concat " " mastodon-tl--horiz-bar "\n"
" TOOTS: " (mastodon-tl--as-string .statuses_count) " | "
"FOLLOWERS: " (mastodon-tl--as-string .followers_count) " | "
"FOLLOWING: " (mastodon-tl--as-string .following_count) "\n"
" " mastodon-tl--horiz-bar "\n\n")
'success)
;; insert relationship (follows)
(let-alist relationships
(if (not .id)
;; sharkey has no relationships endpoint, returns 500.
;; or poss it has a different endpoint
""
(let* ((followsp (mastodon-profile--follows-p
(list .requested_by .following .followed_by .blocked_by)))
(rels (mastodon-profile--relationships-get .id))
(langs-filtered (if-let* ((langs (alist-get 'languages rels)))
(concat " ("
(mapconcat #'identity langs " ")
")")
"")))
(if followsp
(mastodon-tl--set-face
(concat (when (eq .following t)
(format " | FOLLOWED BY YOU%s" langs-filtered))
(when (eq .followed_by t)
" | FOLLOWS YOU")
(when (eq .requested_by t)
" | REQUESTED TO FOLLOW YOU")
(when (eq .blocked_by t)
" | BLOCKS YOU")
"\n\n")
'success)
""))))) ; for insert call
(mastodon-media--inline-images (point-min) (point))
;; widget items description
(mastodon-widget--create
"View" (mastodon-profile--view-types)
(or (mastodon-profile--current-view-type
endpoint-type no-reblogs no-replies only-media tag)
'statuses)
(lambda (widget &rest _ignore)
(let ((value (widget-value widget)))
(funcall
(alist-get value
mastodon-profile--account-view-alist)))))
(insert "\n")
(setq mastodon-tl--update-point (point))))
;; split insert of items from insert of profile:
(with-current-buffer buffer
(let* ((inhibit-read-only t))
;; insert pinned toots first
(when (and pinned (string= endpoint-type "statuses"))
(let ((beg (point)))
(mastodon-profile--insert-statuses-pinned pinned)
(setq mastodon-tl--update-point (point))
(mastodon-media--inline-images beg (point)))) ; updates after pinned toots
;; insert items
(funcall update-function json)
(goto-char (point-min))
(message
(substitute-command-keys
;; "\\[mastodon-profile-account-view-cycle]" ; not always bound?
"\\`C-c C-c' to cycle profile views: toots, no replies, no boosts,\
only media, followers, following.
\\`C-c C-s' to search user's toots, \\`C-c \#' to search user's posts for a hashtag.")))))))
(defun mastodon-profile--current-view-type (type no-reblogs no-replies
only-media tag)
"Return the type of current profile view.
Return a member of `mastodon-profile--view-types', based on TYPE,
NO-REBLOGS, NO-REPLIES, ONLY-MEDIA and TAG."
(cond (no-reblogs 'no-boosts)
(no-replies 'no-replies)
(only-media 'only-media)
(tag 'tag)
(t (if (stringp type) (intern type) type))))
(defun mastodon-profile--format-joined-date-string (joined)
"Format a human-readable Joined string from timestamp JOINED.
JOINED is the `created_at' field in profile account JSON, and of
the format \"2000-01-31T00:00:00.000Z\"."
(format-time-string "Joined: %d %B %Y"
(parse-iso8601-time-string joined)))
(defun mastodon-profile-get-toot-author (&optional max-id)
"Open profile of author of toot under point.
If toot is a boost, load the profile of the author of the original item.
MAX-ID is a flag to include the max_id pagination parameter."
(interactive)
(mastodon-tl--do-if-item
(let ((json (mastodon-tl--toot-or-base
(mastodon-profile--item-json))))
(mastodon-profile--make-author-buffer
(alist-get 'account json)
nil nil nil nil max-id))))
(defun mastodon-profile--image-from-account (account img-type)
"Return a avatar image from ACCOUNT.
IMG-TYPE is the JSON key from the account data."
(let ((img (alist-get img-type account)))
(unless (string= img "/avatars/original/missing.png")
(mastodon-media--get-media-link-rendering img))))
(defun mastodon-profile-show-user (user-handle)
"Query for USER-HANDLE from current status and show that user's profile."
(interactive
(list
(if (and (not (mastodon-tl--profile-buffer-p))
(not (mastodon-tl--property 'item-json :no-move)))
(user-error "Looks like there's no toot or user at point?")
(let ((user-handles (mastodon-profile--extract-users-handles
(mastodon-profile--item-json))))
(completing-read "View profile of user [choose or enter any handle]: "
user-handles
nil ; predicate
'confirm)))))
(if (not (or ; own profile has no need for item-json test:
(string= user-handle (mastodon-auth--get-account-name))
(mastodon-tl--profile-buffer-p)
(mastodon-tl--property 'item-json :no-move)))
(user-error "Looks like there's no toot or user at point?")
(let ((account (mastodon-profile--lookup-account-in-status
user-handle (mastodon-profile--item-json))))
(if (not account)
(user-error "Cannot find a user with handle %S" user-handle)
(progn
(message "Loading profile of user %s..." user-handle)
(mastodon-profile--make-author-buffer account))))))
(defun mastodon-profile-my-profile ()
"Show the profile of the currently signed in user."
(interactive)
(message "Loading your profile...")
(let ((account (mastodon-profile--account-from-id
(mastodon-auth--get-account-id))))
(mastodon-profile--make-author-buffer account)))
(defun mastodon-profile--format-user (tootv)
"Convert TOOTV into author-bylines and insert.
Also insert their profile note.
Used to view a user's followers and those they're following."
(let ((inhibit-read-only t))
(unless (seq-empty-p tootv)
(mapc
(lambda (toot)
(let ((start-pos (point)))
(insert
"\n"
(propertize
(mastodon-tl--byline-author `((account . ,toot)) :avatar)
'byline 't
'item-id (alist-get 'id toot)
'base-item-id (mastodon-tl--item-id toot)
'item-json toot))
(mastodon-media--inline-images start-pos (point))
(insert "\n"
(propertize
(mastodon-tl--render-text (alist-get 'note toot) nil)
'item-json toot)
"\n")))
tootv))))
(defun mastodon-profile--search-account-by-handle (handle)
"Return an account based on a user's HANDLE.
If the handle does not match a search return then retun NIL."
(let* ((handle (if (string= "@" (substring handle 0 1))
(substring handle 1 (length handle))
handle))
(args `(("q" . ,handle)
("type" . "accounts")))
(result (mastodon-http--get-json
(mastodon-http--api-v2 "search") args))
(matching-account (seq-remove
(lambda (x)
(not (string= handle (alist-get 'acct x))))
(alist-get 'accounts result))))
(when (eq 1 (length matching-account))
(elt matching-account 0))))
(defun mastodon-profile--account-from-id (user-id)
"Request an account object relating to a USER-ID."
(mastodon-http--get-json
(mastodon-http--api (format "accounts/%s" user-id))))
(defun mastodon-profile--extract-users-handles (status)
"Return all user handles found in STATUS.
These include the author, author of reblogged entries and any user mentioned."
(when status
(let ((this-account (or (alist-get 'account status) ; status is a toot
status)) ; status is a user listing
(mentions (mastodon-tl--field-status 'mentions status))
(reblog (mastodon-tl--field-status 'reblog status)))
(seq-remove
(lambda (x) (string= x mastodon-active-user))
(seq-filter #'stringp
(seq-uniq
(seq-concatenate
'list
(list (alist-get 'acct this-account))
(mastodon-profile--extract-users-handles reblog)
(mastodon-tl--map-alist 'acct mentions))))))))
(defun mastodon-profile--lookup-account-in-status (handle status)
"Return account for HANDLE using hints in STATUS if possible."
(let* ((this-account (alist-get 'account status))
(reblog-account (alist-get 'account (alist-get 'reblog status)))
(mention-id (seq-some
(lambda (mention)
(when (string= handle (alist-get 'acct mention))
(alist-get 'id mention)))
(alist-get 'mentions status))))
(cond ((string= handle (alist-get 'acct this-account))
this-account)
((string= handle (alist-get 'acct reblog-account))
reblog-account)
(mention-id
(mastodon-profile--account-from-id mention-id))
(t
(mastodon-profile--search-account-by-handle handle)))))
;;; REMOVE
(defun mastodon-profile-remove-user-from-followers (&optional id)
"Remove a user from your followers.
Optionally provide the ID of the account to remove."
(interactive)
(let* ((account (unless id (mastodon-tl--property 'item-json :no-move)))
(id (or id (alist-get 'id account)))
(handle (let ((account (or account
(mastodon-profile--account-from-id id))))
(alist-get 'acct account)))
(url (mastodon-http--api
(format "accounts/%s/remove_from_followers" id))))
(when (y-or-n-p (format "Remove follower %s? " handle))
(let ((response (mastodon-http--post url)))
(mastodon-http--triage response
(lambda (_)
(message "Follower %s removed!" handle)))))))
(defun mastodon-profile-remove-from-followers-at-point ()
"Prompt for a user in the item at point and remove from followers."
(interactive)
(let* ((handles (mastodon-profile--extract-users-handles
(mastodon-profile--item-json)))
(handle (completing-read "Remove from followers: " handles))
(account (mastodon-profile--lookup-account-in-status
handle (mastodon-profile--item-json)))
(id (alist-get 'id account)))
(mastodon-profile-remove-user-from-followers id)))
(defun mastodon-profile-remove-from-followers-list ()
"Select a user from your followers and remove from followers.
Currently limited to 100 handles. If not found, try
`mastodon-search-query'."
(interactive)
(let* ((endpoint (format "accounts/%s/followers"
(mastodon-auth--get-account-id)))
(url (mastodon-http--api endpoint))
(response (mastodon-http--get-json url `(("limit" . "100"))))
(handles (mastodon-tl--map-alist-vals-to-alist 'acct 'id response))
(choice (completing-read "Remove from followers: " handles))
(id (alist-get choice handles)))
(mastodon-profile-remove-user-from-followers id)))
;;; PRIVATE NOTES
(defun mastodon-profile-add-private-note-to-account ()
"Add a private note to an account.
Can be called from a profile page or normal timeline.
Send an empty note to clear an existing one."
(interactive)
(mastodon-profile--add-or-view-private-note
'mastodon-profile--post-private-note-to-account
"add a note to"))
(defun mastodon-profile--post-private-note-to-account (id handle note-old)
"POST a private note onto an account ID with user HANDLE on the server.
NOTE-OLD is the text of any existing note."
(let* ((note (read-string
(format "Add private note to account %s: " handle)
note-old))
(params `(("comment" . ,note)))
(url (mastodon-http--api (format "accounts/%s/note" id)))
(response (mastodon-http--post url params)))
(mastodon-http--triage response
(lambda (_)
(message "Private note on %s added!" handle)))))
(defun mastodon-profile-view-account-private-note ()
"Display the private note about a user."
(interactive)
(mastodon-profile--add-or-view-private-note
'mastodon-profile--display-private-note
"view private note of"
:view))
(defun mastodon-profile--display-private-note (note)
"Display private NOTE in a temporary buffer."
(with-output-to-temp-buffer "*mastodon-profile-private-note*"
(let ((inhibit-read-only t))
(princ note))))
(defun mastodon-profile--profile-json ()
"Return the profile-json property if we are in a profile buffer."
(if (not (mastodon-tl--profile-buffer-p))
(error "Not viewing a profile")
(save-excursion
(goto-char (point-min))
(or (mastodon-tl--property 'profile-json :no-move)
(error "No profile data found")))))
(defun mastodon-profile--add-or-view-private-note (action-fun
&optional message view)
"Add or view a private note for an account.
ACTION-FUN does the adding or viewing, MESSAGE is a prompt for
`mastodon-tl--user-handles-get', VIEW is a flag."
(let* ((profile-json (mastodon-profile--profile-json))
(handle (if (mastodon-tl--profile-buffer-p)
(alist-get 'acct profile-json)
(mastodon-tl--user-handles-get message)))
(account (if (mastodon-tl--profile-buffer-p)
profile-json
(mastodon-profile--search-account-by-handle handle)))
(id (alist-get 'id account))
(relationships (mastodon-profile--relationships-get id))
(note (alist-get 'note relationships)))
(if view
(if (string-empty-p note)
(user-error "No private note for %s" handle)
;; `mastodon-profile--display-private-note' takes 1 arg:
(funcall action-fun note))
;; `mastodon-profile--post-private-note-to-account' takes 3 args:
(funcall action-fun id handle note))))
;;; FAMILIAR FOLLOWERS
(defun mastodon-profile-show-familiar-followers ()
"Show a list of familiar followers.
Familiar followers are accounts that you follow, and that follow
the given account."
(interactive)
(let* ((profile-json (mastodon-profile--profile-json))
(handle
(if (mastodon-tl--profile-buffer-p)
(alist-get 'acct profile-json)
(mastodon-tl--user-handles-get "show familiar followers of")))
(account (if (mastodon-tl--profile-buffer-p)
profile-json
(mastodon-profile--search-account-by-handle handle)))
(id (alist-get 'id account)))
(mastodon-profile--get-familiar-followers id)))
(defun mastodon-profile--get-familiar-followers (id)
"Return JSON data of familiar followers for account ID."
;; the server handles multiple IDs, but we just handle one.
(let* ((params `(("id" . ,id)))
(url (mastodon-http--api "accounts/familiar_followers"))
(json (mastodon-http--get-json url params))
(accounts (alist-get 'accounts (car json))) ; first id
(handles (mastodon-tl--map-alist 'acct accounts)))
(if (null handles)
(user-error "Looks like there are no familiar followers for this account")
(let ((choice (completing-read "Show profile of user: " handles)))
(mastodon-profile-show-user choice)))))
(provide 'mastodon-profile)
;;; mastodon-profile.el ends here
mastodon.el/lisp/mastodon-search.el 0000664 0000000 0000000 00000036667 15017331127 0017703 0 ustar 00root root 0000000 0000000 ;;; mastodon-search.el --- Search functions for mastodon.el -*- lexical-binding: t -*-
;; Copyright (C) 2017-2019 Marty Hiatt
;; Author: Marty Hiatt
;; Maintainer: Marty Hiatt
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
;; This file is part of mastodon.el.
;; mastodon.el 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.
;; mastodon.el 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 mastodon.el. If not, see .
;;; Commentary:
;; A basic search function for mastodon.el
;;; Code:
(require 'json)
(require 'mastodon-tl)
(require 'mastodon-widget)
(autoload 'mastodon-auth--access-token "mastodon-auth")
(autoload 'mastodon-http--api "mastodon-http")
(autoload 'mastodon-http--get-json "mastodon-http")
(autoload 'mastodon-http--get-search-json "mastodon-http")
(autoload 'mastodon-mode "mastodon")
(autoload 'mastodon-tl--as-string "mastodon-tl")
(autoload 'mastodon-tl--as-string "mastodon-tl")
(autoload 'mastodon-tl--render-text "mastodon-tl")
(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl")
(autoload 'mastodon-tl--set-face "mastodon-tl")
(autoload 'mastodon-tl--timeline "mastodon-tl")
(autoload 'mastodon-tl--toot "mastodon-tl")
(autoload 'mastodon-tl--buffer-property "mastodon-tl")
(autoload 'mastodon-http--api-v2 "mastodon-http")
(defvar mastodon-toot--completion-style-for-mentions)
(defvar mastodon-instance-url)
(defvar mastodon-tl--link-keymap)
(defvar mastodon-tl--horiz-bar)
;; functions for completion of mentions in mastodon-toot
(defun mastodon-search--get-user-info-@ (account)
"Get user handle, display name and account URL from ACCOUNT."
(list (concat "@" (cdr (assoc 'acct account)))
(cdr (assoc 'url account))
(cdr (assoc 'display_name account))))
(defun mastodon-search--search-accounts-query (query)
"Prompt for a search QUERY and return accounts synchronously.
Returns a nested list containing user handle, display name, and URL."
(let* ((url (mastodon-http--api "accounts/search"))
(response
(mastodon-http--get-json
url
`(("q" . ,query) ;; NB: nil can break params (but works for me)
,(when (string= "following"
mastodon-toot--completion-style-for-mentions)
'("following" . "true")))
:silent)))
(mapcar #'mastodon-search--get-user-info-@ response)))
;; functions for tags completion:
(defun mastodon-search--search-tags-query (query)
"Return an alist containing tag strings plus their URLs.
QUERY is the string to search."
(let* ((url (mastodon-http--api-v2 "search"))
(params `(("q" . ,query) ("type" . "hashtags")))
(response (mastodon-http--get-json url params :silent))
(tags (alist-get 'hashtags response)))
(mapcar #'mastodon-search--get-hashtag-info tags)))
;; trending tags
(defun mastodon-search-trending-tags ()
"Display a list of tags trending on your instance."
(interactive)
(mastodon-search--view-trending "tags"
#'mastodon-search--print-tags))
(defun mastodon-search-trending-statuses ()
"Display a list of statuses trending on your instance."
(interactive)
(mastodon-search--view-trending "statuses"
#'mastodon-tl--timeline))
(defun mastodon-search-trending-links ()
"Display a list of links trending on your instance."
(interactive)
(mastodon-search--view-trending "links"
#'mastodon-search--render-links))
(defun mastodon-search--render-links (links)
"Render trending LINKS."
(cl-loop for l in links
do (mastodon-search--render-link l)))
(defun mastodon-search--render-link (link)
"Render a trending LINK."
(let-alist link
(insert
(propertize
(mastodon-tl--render-text
(concat "" .url "\n" .title)
link)
'item-type 'link
'item-json link
'shr-url .url
'byline t ;; nav
'help-echo
(substitute-command-keys
"\\[`mastodon-search-load-link-posts'] to view a link's timeline"))
;; TODO: display card link author here
"\n\n")))
(defun mastodon-search-load-link-posts ()
"Load timeline of posts containing link at point."
(interactive)
(let* ((url (mastodon-tl--property 'shr-url)))
(mastodon-tl--link-timeline url)))
(defun mastodon-search--view-trending (type print-fun)
"Display a list of tags trending on your instance.
TYPE is a string, either tags, statuses, or links.
PRINT-FUN is the function used to print the data from the response."
(let* ((url (mastodon-http--api (format "trends/%s" type)))
;; max for statuses = 40, for others = 20
(limit (if (string= type "statuses")
'("limit" . "40")
'("limit" . "20")))
(offset '(("offset" . "0")))
(params (push limit offset))
(data (mastodon-http--get-json url params))
(buffer (get-buffer-create
(format "*mastodon-trending-%s*" type))))
(with-mastodon-buffer buffer #'mastodon-mode nil
(mastodon-tl--set-buffer-spec (buffer-name buffer)
(format "trends/%s" type)
print-fun nil params)
(mastodon-search--insert-heading "trending" type)
(funcall print-fun data)
(unless (string= type "statuses")
(goto-char (point-min))))))
;; functions for mastodon search
(defun mastodon-search--insert-heading (str &optional type)
"Insert STR as a heading.
Optionally add string TYPE after HEADING."
(insert
(mastodon-search--format-heading str type)))
(defun mastodon-search--format-heading (str &optional type no-newline)
"Format STR as a heading.
Optionally add string TYPE after HEADING.
NO-NEWLINE means don't add add a newline at end."
(mastodon-tl--set-face
(concat "\n " mastodon-tl--horiz-bar "\n "
(upcase str) " "
(when type (upcase type)) "\n"
" " mastodon-tl--horiz-bar (unless no-newline "\n"))
'success))
(defvar mastodon-search-types
'("statuses" "accounts" "hashtags"))
(defun mastodon-search-query (query &optional type limit
following account-id offset)
"Prompt for a search QUERY and return accounts, statuses, and hashtags.
TYPE is a member of `mastodon-search-types'.
LIMIT is a number as string, up to 40, with 40 the default.
FOLLOWING means limit to accounts followed, for \"accounts\" type only.
A single prefix arg also sets FOLLOWING to true.
ACCOUNT-ID means limit search to that account, for \"statuses\" type only.
OFFSET is a number as string, means to skip that many results. It
is used for pagination."
;; TODO: handle no results
(interactive "sSearch mastodon for: ")
(let* ((url (mastodon-http--api-v2 "search"))
(following (when (or following (equal current-prefix-arg '(4)))
"true"))
(type (or type
(if (equal current-prefix-arg '(4))
"accounts" ; if FOLLOWING, must be "accounts"
(completing-read "Search type: "
mastodon-search-types nil :match))))
(limit (or limit "40"))
(offset (or offset "0"))
(buffer (format "*mastodon-search-%s-%s*" type query))
(params `(("q" . ,query)
,@(when type `(("type" . ,type)))
,@(when limit `(("limit" . ,limit)))
,@(when offset `(("offset" . ,offset)))
,@(when following `(("following" . ,following)))
,@(when account-id `(("account_id" . ,account-id)))))
(response (mastodon-http--get-json url params))
(items (alist-get (intern type) response)))
(with-mastodon-buffer buffer #'mastodon-mode nil
(mastodon-search-mode)
(mastodon-search--insert-heading "search")
(mastodon-widget--create
"Results"
'(accounts hashtags statuses)
(intern type)
(lambda (widget &rest _ignore)
(let ((value (widget-value widget)))
(mastodon-search-query query (symbol-name value)))))
(insert "\n\n")
(cond ((string= type "accounts")
(mastodon-search--render-response items type buffer params
'mastodon-views--insert-users-propertized-note
'mastodon-views--insert-users-propertized-note))
((string= type "hashtags")
(mastodon-search--render-response items type buffer params
'mastodon-search--print-tags
'mastodon-search--print-tags))
((string= type "statuses")
(mastodon-search--render-response items type buffer params
#'mastodon-tl--timeline
#'mastodon-tl--timeline)))
(goto-char (point-min))
(message
(substitute-command-keys
"\\[mastodon-search-query-cycle] to cycle result types.")))))
(defun mastodon-search-insert-no-results (&optional thing)
"Insert a no results message for object THING."
(let ((thing (or thing "items")))
(insert
(propertize (format "Looks like search returned no %s." thing)
'face 'mastodon-toot-docs-face))))
(defun mastodon-search--render-response (data type buffer params
insert-fun update-fun)
"Call INSERT-FUN on DATA of result TYPE if non-nil.
BUFFER, PARAMS, and UPDATE-FUN are for `mastodon-tl--buffer-spec'."
(if (not data)
(mastodon-search-insert-no-results type)
(funcall insert-fun data))
(mastodon-tl--set-buffer-spec buffer "search"
update-fun nil params))
(defun mastodon-search--buf-type ()
"Return search buffer type, a member of `mastodon-search-types'."
;; called in `mastodon-tl--get-buffer-type'
(let* ((spec (mastodon-tl--buffer-property 'update-params)))
(alist-get "type" spec nil nil #'string=)))
(defun mastodon-search-query-cycle ()
"Cycle through search types: accounts, hashtags, and statuses."
(interactive)
(let* ((spec (mastodon-tl--buffer-property 'update-params))
(type (alist-get "type" spec nil nil #'string=))
(query (alist-get "q" spec nil nil #'string=)))
(cond ((string= type "hashtags")
(mastodon-search-query query "accounts"))
((string= type "accounts")
(mastodon-search-query query "statuses"))
((string= type "statuses")
(mastodon-search-query query "hashtags")))))
(defun mastodon-search-query-accounts-followed (query)
"Run an accounts search QUERY, limited to your followers."
(interactive "sSearch mastodon for: ")
(mastodon-search-query query "accounts" :following))
(defun mastodon-search--insert-users-propertized (json &optional note)
"Insert users list into the buffer.
JSON is the data from the server.
If NOTE is non-nil, include user's profile note. This is also
called by `mastodon-tl--get-follow-suggestions' and
`mastodon-profile--insert-follow-requests'."
(cl-loop for acct in json
do (insert (concat (mastodon-search--propertize-user acct note)
mastodon-tl--horiz-bar
"\n\n"))))
(defun mastodon-search--propertize-user (acct &optional note)
"Propertize display string for ACCT, optionally including profile NOTE."
(let* ((user (mastodon-search--get-user-info acct))
(id (alist-get 'id acct)))
(propertize
(concat
(propertize (car user)
'face 'mastodon-display-name-face
'byline t
'item-type 'user
'item-id id) ; for prev/next nav
" : \n : "
(propertize (concat "@" (cadr user))
'face 'mastodon-handle-face
'mouse-face 'highlight
'mastodon-tab-stop 'user-handle
'keymap mastodon-tl--link-keymap
'mastodon-handle (concat "@" (cadr user))
'help-echo (concat "Browse user profile of @" (cadr user)))
" : \n"
(when note
(mastodon-tl--render-text (cadddr user) acct))
"\n")
'item-json acct))) ; for compat w other processing functions
(defun mastodon-search--print-tags (tags)
"Print TAGS data as returned from a \"hashtags\" search query."
(let ((tags-list (mapcar #'mastodon-search--get-hashtag-info tags)))
(mastodon-search--print-tags-list tags-list)))
(defun mastodon-search--print-tags-list (tags-list)
"Insert a propertized list of TAGS-LIST."
(cl-loop for el in tags-list
do (insert
" : "
(propertize (concat "#" (car el))
'face '(:box t)
'mouse-face 'highlight
'mastodon-tag (car el)
'mastodon-tab-stop 'hashtag
'item-type 'tag ; for next/prev nav
'byline t ; for next/prev nav
'help-echo (concat "Browse tag #" (car el))
'keymap mastodon-tl--link-keymap)
" : \n\n")))
(defun mastodon-search--get-user-info (account)
"Get user handle, display name, account URL and profile note from ACCOUNT."
(list (mastodon-tl--display-or-uname account)
(alist-get 'acct account)
(alist-get 'url account)
(alist-get 'note account)))
(defun mastodon-search--get-hashtag-info (tag)
"Get hashtag name and URL from TAG."
(list (alist-get 'name tag)
(alist-get 'url tag)))
;; These functions are all unused!
;; (defun mastodon-search--get-status-info (status)
;; "Get ID, timestamp, content, and spoiler from STATUS."
;; (list (alist-get 'id status)
;; (alist-get 'created_at status)
;; (alist-get 'spoiler_text status)
;; (alist-get 'content status)))
;; (defun mastodon-search--id-from-status (status)
;; "Fetch the id from a STATUS returned by a search call to the server.
;; We use this to fetch the complete status from the server."
;; (alist-get 'id status))
;; (defun mastodon-search--full-status-from-id (id)
;; "Fetch the full status with id ID from the server.
;; This allows us to access the full account etc. details and to
;; render them properly."
;; (let* ((url (mastodon-http--api (format "statuses/%s" id)))
;; ;; (concat mastodon-instance-url "/api/v1/statuses/"
;; ;; (mastodon-tl--as-string id)))
;; (json (mastodon-http--get-json url)))
;; json))
(defvar mastodon-search-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-c") #'mastodon-search-query-cycle)
map)
"Keymap for `mastodon-search-mode'.")
(define-minor-mode mastodon-search-mode
"Toggle mastodon search minor mode.
This minor mode is used for mastodon search pages to adds a keybinding."
:init-value nil
:lighter " Search"
:keymap mastodon-search-mode-map
:group 'mastodon
:global nil)
(provide 'mastodon-search)
;;; mastodon-search.el ends here
mastodon.el/lisp/mastodon-tl.el 0000664 0000000 0000000 00000513545 15017331127 0017050 0 ustar 00root root 0000000 0000000 ;;; mastodon-tl.el --- Timeline functions for mastodon.el -*- lexical-binding: t -*-
;; Copyright (C) 2017-2019 Johnson Denen
;; Copyright (C) 2020-2024 Marty Hiatt
;; Author: Johnson Denen
;; Marty Hiatt
;; Maintainer: Marty Hiatt
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
;; This file is part of mastodon.el.
;; mastodon.el 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.
;; mastodon.el 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 mastodon.el. If not, see .
;;; Commentary:
;; mastodon-tl.el provides timeline functions.
;;; Code:
(require 'shr)
(require 'thingatpt) ; for word-at-point
(require 'time-date)
(require 'cl-lib)
(require 'mastodon-iso)
(require 'mpv nil :no-error)
(require 'url-cache)
(autoload 'mastodon-mode "mastodon")
(autoload 'mastodon-notifications-get "mastodon")
(autoload 'mastodon-url-lookup "mastodon")
(autoload 'mastodon-auth--get-account-id "mastodon-auth")
(autoload 'mastodon-auth--get-account-name "mastodon-auth")
(autoload 'mastodon-http--api "mastodon-http")
(autoload 'mastodon-http--build-array-params-alist "mastodon-http")
(autoload 'mastodon-http--build-params-string "mastodon-http")
(autoload 'mastodon-http--delete "mastodon-http")
(autoload 'mastodon-http--get-json "mastodon-http")
(autoload 'mastodon-http--get-json-async "mastodon-http")
(autoload 'mastodon-http--get-response-async "mastodon-http")
(autoload 'mastodon-http--post "mastodon-http")
(autoload 'mastodon-http--process-json "mastodon-http")
(autoload 'mastodon-http--put "mastodon-http")
(autoload 'mastodon-http--triage "mastodon-http")
(autoload 'mastodon-media--get-avatar-rendering "mastodon-media")
(autoload 'mastodon-media--get-media-link-rendering "mastodon-media")
(autoload 'mastodon-media--inline-images "mastodon-media")
(autoload 'mastodon-notifications--filter-types-list "mastodon-notifications")
(autoload 'mastodon-notifications-get-mentions "mastodon-notifications")
(autoload 'mastodon-profile--account-from-id "mastodon-profile")
(autoload 'mastodon-profile--extract-users-handles "mastodon-profile")
(autoload 'mastodon-profile--get-preferences-pref "mastodon-profile")
(autoload 'mastodon-profile-get-toot-author "mastodon-profile")
(autoload 'mastodon-profile--lookup-account-in-status "mastodon-profile")
(autoload 'mastodon-profile--make-author-buffer "mastodon-profile")
(autoload 'mastodon-profile-my-profile "mastodon-profile")
(autoload 'mastodon-profile-open-statuses-no-reblogs "mastodon-profile")
(autoload 'mastodon-profile--profile-json "mastodon-profile")
(autoload 'mastodon-profile--search-account-by-handle "mastodon-profile")
(autoload 'mastodon-profile--item-json "mastodon-profile")
(autoload 'mastodon-profile--view-author-profile "mastodon-profile")
(autoload 'mastodon-profile-mode "mastodon-profile")
(autoload 'mastodon-search--get-user-info "mastodon-search")
(autoload 'mastodon-search--insert-users-propertized "mastodon-search")
(autoload 'mastodon-search--propertize-user "mastodon-search")
(autoload 'mastodon-toot--compose-buffer "mastodon-toot")
(autoload 'mastodon-toot-delete-toot "mastodon-toot")
(autoload 'mastodon-toot--get-toot-edits "mastodon-toot")
(autoload 'mastodon-toot--iso-to-human "mastodon-toot")
(autoload 'mastodon-toot-schedule-toot "mastodon-toot")
(autoload 'mastodon-toot--set-toot-properties "mastodon-toot")
(autoload 'mastodon-toot--update-status-fields "mastodon-toot")
(autoload 'mastodon-search--buf-type "mastodon-search")
(autoload 'mastodon-views--insert-users-propertized-note "mastodon-views") ; for search pagination
(autoload 'mastodon-http--get-response "mastodon-http")
(autoload 'mastodon-search--insert-heading "mastodon-search")
(autoload 'mastodon-media--process-full-sized-image-response "mastodon-media")
(autoload 'mastodon-search-trending-statuses "mastodon-search")
(autoload 'mastodon-search--format-heading "mastodon-search")
(autoload 'mastodon-media--image-or-cached "mastodon-media")
(autoload 'mastodon-toot--base-toot-or-item-json "mastodon-toot")
(autoload 'mastodon-search-load-link-posts "mastodon-search")
(autoload 'mastodon-notifications--current-type "mastodon-notifications")
(autoload 'mastodon-notifications--timeline "mastodon-notifications")
(autoload 'mastodon-notifications--empty-group-json-p "mastodon-notifications")
(autoload 'mastodon-search--print-tags "mastodon-search")
(autoload 'mastodon-profile-show-user "mastodon-profile")
(defvar mastodon-toot--visibility)
(defvar mastodon-toot-mode)
(defvar mastodon-active-user)
(defvar mastodon-images-in-notifs)
(defvar mastodon-group-notifications)
(when (require 'mpv nil :no-error)
(declare-function mpv-start "mpv"))
(defvar mastodon-mode-map)
(defvar mastodon-instance-url)
(defvar mastodon-toot-timestamp-format)
(defvar shr-use-fonts) ;; declare it since Emacs24 didn't have this
(defvar mastodon-media--enable-image-caching)
(defvar mastodon-media--generic-broken-image-data)
(defvar mastodon-media--sensitive-image-data)
(defvar mastodon-media--attachments)
;;; CUSTOMIZES
(defgroup mastodon-tl nil
"Timelines in Mastodon."
:prefix "mastodon-tl-"
:group 'mastodon)
(defcustom mastodon-tl--enable-relative-timestamps t
"Whether to show relative (to the current time) timestamps.
This will require periodic updates of a timeline buffer to
keep the timestamps current as time progresses."
:type '(boolean :tag "Enable relative timestamps and background updater task"))
(defcustom mastodon-tl--enable-proportional-fonts nil
"Nonnil to enable using proportional fonts when rendering HTML.
By default fixed width fonts are used."
:type '(boolean :tag "Enable using proportional rather than fixed \
width fonts when rendering HTML text"))
(defcustom mastodon-tl--no-fill-on-render nil
"Non-nil to disable filling by shr.el while rendering toot body.
Use this if your setup isn't compatible with shr's window width filling."
:type '(boolean))
(defcustom mastodon-tl--display-media-p t
"A boolean value stating whether to show media in timelines."
:type 'boolean)
(defcustom mastodon-tl--display-caption-not-url-when-no-media t
"Display an image's caption rather than URL.
Only has an effect when `mastodon-tl--display-media-p' is set to
nil."
:type 'boolean)
(defcustom mastodon-tl--show-avatars nil
"Whether to enable display of user avatars in timelines."
:type '(boolean :tag "Whether to display user avatars in timelines"))
(defcustom mastodon-tl--show-stats t
"Whether to show toot stats (faves, boosts, replies counts)."
:type 'boolean)
(defcustom mastodon-tl--symbols
'((reply . ("đŹ" . "R"))
(boost . ("đ" . "B"))
(reblog . ("đ" . "B")) ;; server compat
(favourite . ("â" . "F"))
(bookmark . ("đ" . "K"))
(media . ("đš" . "[media]"))
(verified . ("â" . "V"))
(locked . ("đ" . "[locked]"))
(private . ("đ" . "[followers]"))
(mention . ("@" . "[mention]"))
(direct . ("â" . "[direct]"))
(edited . ("â" . "[edited]"))
(update . ("â" . "[edited]")) ;; server compat
(status . ("â" . "[posted]"))
(replied . ("âŹ" . "â"))
(reply-bar . ("â" . "|"))
(poll . ("đ" . "[poll]"))
(follow . ("đ¤" . "+"))
(follow_request . ("đ¤" . "+"))
(severed_relationships . ("đ" . "//"))
(moderation_warning . ("â " . "!!")))
"A set of symbols (and fallback strings) to be used in timeline.
If a symbol does not look right (tofu), it means your
font settings do not support it."
:type '(alist :key-type symbol :value-type string))
(defcustom mastodon-tl-position-after-update nil
"Defines where `point' should be located after a timeline update.
Valid values are:
- nil Top/bottom depending on timeline type
- keep-point Keep original position of point
- last-old-toot The last toot before the new ones"
:type '(choice (const :tag "Top/bottom depending on timeline type" nil)
(const :tag "Keep original position of point" keep-point)
(const :tag "The last toot before the new ones" last-old-toot)))
(defcustom mastodon-tl--timeline-posts-count "20"
"Number of posts to display when loading a timeline.
Must be an integer between 20 and 40 inclusive."
:type '(string))
(defcustom mastodon-tl--hide-replies nil
"Whether to hide replies from the timelines.
Note that you can hide replies on a one-off basis by loading a
timeline with a simple prefix argument, `C-u'."
:type '(boolean :tag "Whether to hide replies from the timelines."))
(defcustom mastodon-tl--highlight-current-toot nil
"Whether to highlight the toot at point. Uses `cursor-face' special property."
:type '(boolean))
(defcustom mastodon-tl--expand-content-warnings 'server
"Whether to expand content warnings by default.
The API returns data about this setting on the server, but no
means to set it, so we roll our own option here to override the
server setting if desired. If you change the server setting and
want it to be respected by mastodon.el, you'll likely need to
either unset `mastodon-profile-acccount-preferences-data' and
re-load mastodon.el, or restart Emacs."
:type '(choice (const :tag "true" t)
(const :tag "false" nil)
(const :tag "follow server setting" server)))
(defcustom mastodon-tl--tag-timeline-tags nil
"A list of up to four tags for use with `mastodon-tl-followed-tags-timeline'."
:type '(repeat string))
(defcustom mastodon-tl--load-full-sized-images-in-emacs t
"Whether to load full-sized images inside Emacs.
Full-sized images are loaded when you hit return on or click on
an image in a timeline.
If nil, mastodon.el will instead call `shr-browse-image', which
respects the user's `browse-url' settings."
:type '(boolean))
(defcustom mastodon-tl--remote-local-domains nil
"A list of domains to view the local timelines of.
See `mastodon-tl-get-remote-local-timeline' for view remote local domains."
:type '(repeat string))
(defcustom mastodon-tl--fold-toots-at-length 1200
"Length, in characters, to fold a toot at.
Longer toots will be folded and the remainder replaced by a
\"read more\" button. If the value is nil, don't fold at all."
:type '(integer))
;;; VARIABLES
(defvar-local mastodon-tl--buffer-spec nil
"A unique identifier and functions for each mastodon buffer.")
(defvar-local mastodon-tl--update-point nil
"When updating a mastodon buffer this is where new toots will be inserted.
If nil `(point-min)' is used instead.")
(defvar-local mastodon-tl--after-update-marker nil
"Marker defining the position of point after the update is done.")
(defvar-local mastodon-tl--timestamp-next-update nil
"The timestamp when the buffer should next be scanned to update the timestamps.")
(defvar-local mastodon-tl--timestamp-update-timer nil
"The timer that, when set will scan the buffer to update the timestamps.")
(defvar mastodon-tl--horiz-bar
(make-string 12
(if (char-displayable-p ?â) ?â ?-)))
;;; KEYMAPS
(defvar mastodon-tl--link-keymap
(let ((map (make-sparse-keymap)))
(define-key map [return] #'mastodon-tl-do-link-action-at-point)
(define-key map [mouse-2] #'mastodon-tl-do-link-action)
(define-key map [follow-link] 'mouse-face)
map)
"The keymap for link-like things in buffer (except for shr.el generate links).
This will make the region of text act like like a link with mouse
highlighting, mouse click action tabbing to next/previous link
etc.")
(defvar mastodon-tl--shr-map-replacement
(let ((map (make-sparse-keymap)))
(set-keymap-parent map shr-map)
;; Replace the move to next/previous link bindings with our
;; version that knows about more types of links.
(define-key map [remap shr-next-link] #'mastodon-tl-next-tab-item)
(define-key map [remap shr-previous-link] #'mastodon-tl-previous-tab-item)
;; keep new my-profile binding; shr 'O' doesn't work here anyway
(define-key map (kbd "O") #'mastodon-profile-my-profile)
;; remove shr's u binding, as it the maybe-probe-and-copy-url
;; is already bound to w also
(define-key map (kbd "u") #'mastodon-tl-update)
(define-key map [remap shr-browse-url] #'mastodon-url-lookup)
(define-key map (kbd "M-RET") #'mastodon-search-load-link-posts)
map)
"The keymap to be set for shr.el generated links that are not images.
We need to override the keymap so tabbing will navigate to all
types of mastodon links and not just shr.el-generated ones.")
(defvar mastodon-tl--shr-image-map-replacement
(let ((map (make-sparse-keymap)))
(set-keymap-parent map (if (boundp 'shr-image-map)
shr-image-map
shr-map))
;; Replace the move to next/previous link bindings with our
;; version that knows about more types of links.
(define-key map [remap shr-next-link] #'mastodon-tl-next-tab-item)
(define-key map [remap shr-previous-link] #'mastodon-tl-previous-tab-item)
;; browse-url loads the preview only, we want browse-image
;; on RET to browse full sized image URL
(define-key map [remap shr-browse-url] #'mastodon-tl-view-full-image-or-play-video)
;; remove shr's u binding, as it the maybe-probe-and-copy-url
;; is already bound to w also
(define-key map (kbd "u") #'mastodon-tl-update)
;; keep new my-profile binding; shr 'O' doesn't work here anyway
(define-key map (kbd "O") #'mastodon-profile-my-profile)
(define-key map (kbd "C") #'mastodon-tl-copy-image-caption)
(define-key map (kbd "S") #'mastodon-tl-toggle-sensitive-image)
(define-key map (kbd "") #'mastodon-tl-mpv-play-video-at-point)
(define-key map (kbd "") #'mastodon-tl-click-image-or-video)
map)
"The keymap to be set for shr.el generated image links.
We need to override the keymap so tabbing will navigate to all
types of mastodon links and not just shr.el-generated ones.")
(defvar mastodon-tl--byline-link-keymap
(when (require 'mpv nil :no-error)
(let ((map (make-sparse-keymap)))
(define-key map (kbd "") #'mastodon-tl-mpv-play-video-from-byline)
(define-key map (kbd "RET") #'mastodon-profile-get-toot-author)
(define-key map (kbd "S") #'mastodon-tl-toggle-sensitive-image)
map))
"The keymap to be set for the author byline.
It is active where point is placed by `mastodon-tl-goto-next-item.'")
(require 'image-mode)
(defvar mastodon-image-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map image-mode-map)
(define-key map (kbd ">") #'mastodon-tl-next-full-image)
(define-key map (kbd "<") #'mastodon-tl-prev-full-image)
(define-key map (kbd ".") #'mastodon-tl-next-full-image)
(define-key map (kbd ",") #'mastodon-tl-prev-full-image)
;; matches view full image binding in main keymap:
(define-key map (kbd "=") #'mastodon-tl-next-full-image)
(define-key map (kbd "-") #'mastodon-tl-prev-full-image)
(define-key map (kbd "") #'mastodon-tl-next-full-image)
(define-key map (kbd "") #'mastodon-tl-prev-full-image)
map))
;;; MACROS
(defmacro with-mastodon-buffer (buffer mode-fun other-window &rest body)
"Evaluate BODY in a new or existing buffer called BUFFER.
MODE-FUN is called to set the major mode.
OTHER-WINDOW means call `switch-to-buffer-other-window' rather
than `pop-to-buffer'."
(declare (debug t)
(indent 3))
`(with-current-buffer (get-buffer-create ,buffer)
(let ((inhibit-read-only t))
(erase-buffer)
(funcall ,mode-fun)
(remove-overlays) ; video overlays
,@body
;; return result of switching buffer:
(if ,other-window
(switch-to-buffer-other-window ,buffer)
(pop-to-buffer ,buffer '(display-buffer-same-window))))))
(defmacro mastodon-tl--do-if-item (&rest body)
"Execute BODY if we have an item at point."
(declare (debug t))
`(if (and (not (mastodon-tl--profile-buffer-p))
(not (mastodon-tl--property 'item-json))) ; includes users but not tags
(user-error "Looks like there's no item at point?")
,@body))
;;; NAV
(defun mastodon-tl-scroll-up-command ()
"Call `scroll-up-command', loading more toots if necessary.
If we hit `point-max', call `mastodon-tl--more' then `scroll-up-command'."
(interactive)
(if (not (eq (point) (point-max)))
(scroll-up-command)
(mastodon-tl--more)
(scroll-up-command)))
(defun mastodon-tl-next-tab-item (&optional previous)
"Move to the next interesting item.
This could be the next toot, link, or image; whichever comes first.
Don't move if nothing to move to is found, i.e. near the end of the buffer.
This also skips tab items in invisible text, i.e. hidden spoiler text.
PREVIOUS means move to previous item."
(interactive)
(let (next-range
(search-pos (point)))
(while (and (setq next-range
(mastodon-tl--find-next-or-previous-property-range
'mastodon-tab-stop search-pos previous))
(get-text-property (car next-range) 'invisible)
(setq search-pos (if previous
(1- (car next-range))
(1+ (cdr next-range)))))
;; do nothing, all the action is in the while condition
)
(if (null next-range)
(user-error "Nothing else here")
(goto-char (car next-range))
(message "%s" (mastodon-tl--property 'help-echo :no-move)))))
(defun mastodon-tl-previous-tab-item ()
"Move to the previous interesting item.
This could be the previous toot, link, or image; whichever comes
first. Don't move if nothing else to move to is found, i.e. near
the start of the buffer. This also skips tab items in invisible
text, i.e. hidden spoiler text."
(interactive)
(mastodon-tl-next-tab-item :previous))
(defun mastodon-tl--goto-item-pos (find-pos refresh &optional pos)
"Search for item with function FIND-POS.
If search returns nil, execute REFRESH function.
Optionally start from POS."
(let* ((npos ; toot/user items have byline:
(funcall find-pos
(or pos (point))
;; FIXME: we need to fix item-type?
;; 'item-type ; breaks nav to last item in a view?
'byline
(current-buffer)))
(max-lisp-eval-depth 4)) ;; clamp down on endless loops
(if npos
(if (not (get-text-property npos 'item-type)) ; generic
;; FIXME let's make refresh &optional and only call refresh/recur
;; if non-nil:
(mastodon-tl--goto-item-pos find-pos refresh npos)
(goto-char npos)
;; force display of help-echo on moving to a toot byline:
(mastodon-tl--message-help-echo))
(condition-case nil
(funcall refresh)
(error "No more items")))))
(defun mastodon-tl-goto-next-item (&optional no-refresh)
"Jump to next item.
Load more items it no next item.
NO-REFRESH means do no not try to load more items if no next item
found."
(interactive)
(condition-case nil
(mastodon-tl--goto-item-pos 'next-single-property-change
(unless no-refresh 'mastodon-tl--more))
(t (error "No more items"))))
(defun mastodon-tl-goto-prev-item (&optional no-refresh)
"Jump to previous item.
Update if no previous items.
NO-REFRESH means do no not try to load more items if no next item
found."
(interactive)
(condition-case nil
(mastodon-tl--goto-item-pos 'previous-single-property-change
(unless no-refresh 'mastodon-tl-update))
(t (error "No more items"))))
(defun mastodon-tl--goto-first-item ()
"Jump to first toot or item in buffer.
Used on initializing a timeline or thread."
(goto-char (point-min))
(condition-case nil
(mastodon-tl--goto-item-pos 'next-single-property-change
'next-line)
(t (error "No item"))))
;;; TIMELINES
(defun mastodon-tl-get-federated-timeline (&optional prefix local max-id)
"Open federated timeline.
If LOCAL, get only local timeline.
With a single PREFIX arg, hide-replies.
With a double PREFIX arg, only show posts with media."
(interactive "p")
(let ((params
`(("limit" . ,mastodon-tl--timeline-posts-count)
,@(when (eq prefix 16)
'(("only_media" . "true")))
,@(when local
'(("local" . "true")))
,@(when max-id
`(("max_id" . ,(mastodon-tl--buffer-property 'max-id)))))))
(message "Loading federated timeline...")
(mastodon-tl--init (if local "local" "federated")
"timelines/public" 'mastodon-tl--timeline nil
params
(when (eq prefix 4) t))))
(defun mastodon-tl-get-home-timeline (&optional arg max-id)
"Open home timeline.
With a single prefix ARG, hide replies.
MAX-ID is a flag to add the max_id pagination parameter."
(interactive "p")
(let* ((params
`(("limit" . ,mastodon-tl--timeline-posts-count)
,@(when max-id
`(("max_id" . ,(mastodon-tl--buffer-property 'max-id)))))))
(message "Loading home timeline...")
(mastodon-tl--init "home" "timelines/home" 'mastodon-tl--timeline nil
params
(when (eq arg 4) t))))
(defun mastodon-tl-get-remote-local-timeline (&optional endpoint)
"Prompt for an instance domain and try to display its local timeline.
You can enter any working instance domain. Domains that you want
to regularly load can be stored in
`mastodon-tl--remote-local-domains' for easy access with completion.
Note that some instances do not make their local timelines public, in
which case this will not work.
To interact with any item, you must view it from your own
instance, which you can do with
`mastodon-tl-view-item-on-own-instance'.
Optionally, provide API ENDPOINT."
(interactive)
(let* ((domain (completing-read "Domain for remote local tl: "
mastodon-tl--remote-local-domains))
(params `(("limit" . ,mastodon-tl--timeline-posts-count)
("local" . "true")))
(buf (concat "remote-local-" domain))
(known (member domain
(mastodon-http--get-json
(mastodon-http--api "instance/peers")))))
;; condition-case doesn't work here, so i added basic error handling to
;; `mastodon-tl--init*' instead
(when (or known
(y-or-n-p
"Domain appears unknown to your instance. Proceed?"))
(mastodon-tl--init buf
(or endpoint "timelines/public")
'mastodon-tl--timeline nil
params nil domain))))
(defun mastodon-tl-remote-tag-timeline (&optional tag)
"Call `mastodon-tl-get-remote-local-timeline' but for a TAG timeline."
(interactive)
(let* ((tag (or tag (read-string "Tag: ")))
(endpoint (format "timelines/tag/%s" tag)))
(mastodon-tl-get-remote-local-timeline endpoint)))
(defun mastodon-tl-view-item-on-own-instance ()
"Load current toot on your own instance.
Use this to re-load remote-local items in order to interact with them."
(interactive)
(mastodon-tl--do-if-item
(let* ((toot (mastodon-tl--property 'item-json))
(uri (mastodon-tl--field 'uri toot)))
(mastodon-url-lookup uri))))
(defun mastodon-tl-get-local-timeline (&optional prefix max-id)
"Open local timeline.
With a single PREFIX arg, hide-replies.
With a double PREFIX arg, only show posts with media.
MAX-ID is a flag to add the max_id pagination parameter."
(interactive "p")
(message "Loading local timeline...")
(mastodon-tl-get-federated-timeline prefix :local max-id))
(defun mastodon-tl-get-tag-timeline (&optional prefix tag)
"Prompt for tag and opens its timeline.
Optionally load TAG timeline directly.
With a single PREFIX arg, only show posts with media.
With a double PREFIX arg, limit results to your own instance."
(interactive "p")
(let* ((word (or (word-at-point) ""))
(input (or tag (read-string
(format "Load timeline for tag (%s): " word))))
(tag (or tag (if (string-empty-p input) word input))))
(message "Loading timeline for #%s..." tag)
(mastodon-tl--show-tag-timeline prefix tag)))
(defun mastodon-tl--show-tag-timeline (&optional prefix tag)
"Opens a new buffer showing the timeline of posts with hastag TAG.
If TAG is a list, show a timeline for all tags.
With a single PREFIX arg, only show posts with media.
With a double PREFIX arg, limit results to your own instance."
(let ((params
`(("limit" . ,mastodon-tl--timeline-posts-count)
,@(when (eq prefix 4)
'(("only_media" . "true")))
,@(when (eq prefix 16)
'(("local" . "true"))))))
(when (listp tag)
(let ((list (mastodon-http--build-array-params-alist "any[]" (cdr tag))))
(while list
(push (pop list) params))))
(mastodon-tl--init
(if (listp tag) "tags-multiple" (concat "tag-" tag))
(concat "timelines/tag/" (if (listp tag) (car tag) tag)) ; must be /tag/:sth
'mastodon-tl--timeline nil params)))
(defun mastodon-tl--link-timeline (url)
"Load a link timeline, displaying posts containing URL."
(let ((params `(("url" . ,url))))
(mastodon-tl--init "links" "timelines/link"
'mastodon-tl--timeline nil
params)))
(defun mastodon-tl-announcements ()
"Display announcements from your instance."
(interactive)
(mastodon-tl--init "announcements" "announcements"
'mastodon-tl--timeline nil nil nil nil :no-byline))
;;; BYLINES, etc.
(defun mastodon-tl--message-help-echo ()
"Call message on `help-echo' property at point.
Do so if type of status at poins is not follow_request/follow."
(let ((type (alist-get 'type
(mastodon-tl--property 'item-json :no-move)))
(echo (mastodon-tl--property 'help-echo :no-move)))
(when (not (string= "" echo)) ; not for followers/following in profile
(unless (or (string= type "follow_request")
(string= type "follow")) ; no counts for these
(message "%s" echo)))))
(defun mastodon-tl--byline-username (toot)
"Format a byline username from account in TOOT.
TOOT may be account data, or toot data, in which case acount data
is extracted from it."
(let ((data (or (alist-get 'account toot)
toot))) ;; grouped nofifs use account data directly
(let-alist data
(propertize (if (and .display_name
(not (string-empty-p .display_name)))
.display_name
.username)
'face 'mastodon-display-name-face
;; enable playing of videos when point is on byline:
;; 'attachments (mastodon-tl--get-attachments-for-byline toot)
'keymap mastodon-tl--byline-link-keymap
;; echo faves count when point on post author name:
;; which is where --goto-next-toot puts point.
'help-echo
;; but don't add it to "following"/"follows" on
;; profile views: we don't have a tl--buffer-spec
;; yet:
(unless (or (string-suffix-p "-followers*" (buffer-name))
(string-suffix-p "-following*" (buffer-name)))
(mastodon-tl--format-byline-help-echo data))))))
(defun mastodon-tl--byline-handle (toot &optional domain string face)
"Format a byline handle from account in TOOT.
DOMAIN is optionally added to the handle.
ACCOUNT is optionally acccount data to use.
STRING is optionally the string to propertize, it is used to make
username rather than handle buttons.
FACE is optionally the face to use.
The last two args allow for display a username as a clickable
handle."
(let-alist (or (alist-get 'account toot)
toot) ;; grouped notifs
(mastodon-tl--buttonify-link
(or string
(concat "@" .acct
(when domain
(concat "@"
(url-host
(url-generic-parse-url .url))))))
'face (or face 'mastodon-handle-face)
'mastodon-tab-stop 'user-handle
'shr-url .url
'mastodon-handle (concat "@" .acct)
'help-echo (concat "Browse user profile of @" .acct))))
(defun mastodon-tl--byline-uname-+-handle (data &optional domain)
"Concatenate a byline username and handle.
DATA is the (toot) data to use.
DOMAIN is optionally a domain for the handle.
ACCOUNT is optionally acccount data to use."
(concat (mastodon-tl--byline-username data)
" (" (mastodon-tl--byline-handle data domain) ")"))
(defun mastodon-tl--display-or-uname (account)
"Return display name or username from ACCOUNT data."
(if (not (string-empty-p (alist-get 'display_name account)))
(alist-get 'display_name account)
(alist-get 'username account)))
(defun mastodon-tl--byline-author (toot &optional avatar domain base)
"Propertize author of TOOT.
With arg AVATAR, include the account's avatar image.
When DOMAIN, force inclusion of user's domain in their handle.
BASE means to use data from the base item (reblog slot) if possible.
If BASE is nil, we are a boosted byline, so show less info.
ACCOUNT is optionally acccount data to use."
(let* ((data (if base
(mastodon-tl--toot-or-base toot)
toot))
(account (alist-get 'account data))
(uname (mastodon-tl--display-or-uname account)))
(concat
;; avatar insertion moved up to `mastodon-tl--byline' by default to
;; be outside 'byline propt.
(when (and avatar ; used by `mastodon-profile--format-user'
mastodon-tl--show-avatars
mastodon-tl--display-media-p
(mastodon-tl--image-trans-check))
(mastodon-media--get-avatar-rendering
(map-nested-elt data '(account avatar))))
(if (not base)
;; boost symbol:
(concat (mastodon-tl--symbol 'boost)
" "
;; username as button:
(mastodon-tl--byline-handle
data domain
;; display uname not handle (for boosts):
uname 'mastodon-display-name-face))
;; normal combo author byline:
(mastodon-tl--byline-uname-+-handle data domain)))))
(defun mastodon-tl--format-byline-help-echo (toot)
"Format a help-echo for byline of TOOT.
Displays a toot's media types and optionally the binding to play
moving image media from the byline.
Used when point is at the start of a byline, i.e. where
`mastodon-tl-goto-next-item' leaves point."
(let* ((toot-to-count
(or ; simply praying this order works
(alist-get 'status toot) ; notifications timeline
;; fol-req notif, has 'type placed before boosts coz fol-reqs have
;; a (useless) reblog entry:
(when (and (or (mastodon-tl--buffer-type-eq 'notifications)
(mastodon-tl--buffer-type-eq 'mentions))
(alist-get 'type toot))
toot)
(alist-get 'reblog toot) ; boosts
toot)) ; everything else
(fol-req-p (let ((type (alist-get 'type toot-to-count)))
(or (string= type "follow")
(string= type "follow_request")))))
(unless fol-req-p
(let* ((media-types (mastodon-tl--get-media-types toot))
(format-media (when media-types
(format "media: %s"
(mapconcat #'identity media-types " "))))
(format-media-binding (when (and (or (member "video" media-types)
(member "gifv" media-types))
(require 'mpv nil :no-error))
" | C-RET to view with mpv")))
(concat format-media format-media-binding)))))
(defun mastodon-tl--get-media-types (toot)
"Return a list of the media attachment types of the TOOT at point."
(let* ((attachments (mastodon-tl--field 'media_attachments toot)))
(mastodon-tl--map-alist 'type attachments)))
(defun mastodon-tl--get-attachments-for-byline (toot)
"Return a list of attachment URLs and types for TOOT.
The result is added as an attachments property to author-byline."
(let ((media (mastodon-tl--field 'media_attachments toot)))
(mapcar (lambda (attachment)
(let-alist attachment
(list :id .id
:type .type
;; fallback for notifications:
:url (or .remote_url .url))))
media)))
(defun mastodon-tl--byline-booster (toot)
"Add author byline for booster from TOOT.
Only return something if TOOT contains a reblog."
(let ((reblog (alist-get 'reblog toot)))
(if reblog
(mastodon-tl--byline-author toot)
"")))
(defun mastodon-tl--byline-booster-str (toot)
"Format boosted string for action byline.
Only return string if TOOT contains a reblog."
(let ((reblog (alist-get 'reblog toot)))
(if reblog
(concat
" " (propertize "boosted" 'face 'mastodon-boosted-face) "\n")
"")))
(defun mastodon-tl--byline-boost (toot)
"Format a boost action-byline element for TOOT."
(concat (mastodon-tl--byline-booster toot)
(mastodon-tl--byline-booster-str toot)))
(defun mastodon-tl--format-faved-or-boosted-byline (letter)
"Format the byline marker for a boosted or favourited status.
LETTER is a string, F for favourited, B for boosted, or K for bookmarked."
(let ((help-string (cond ((string= letter "F")
"favourited")
((string= letter "B")
"boosted")
((string= letter (or "đ" "K"))
"bookmarked"))))
(format "(%s) "
(propertize letter 'face 'mastodon-boost-fave-face
;; emojify breaks this for đ:
'help-echo (format "You have %s this status."
help-string)))))
(defun mastodon-tl--image-trans-check ()
"Call `image-transforms-p', or `image-type-available-p' imagemagick."
(if (version< emacs-version "27.1")
(image-type-available-p 'imagemagick)
(image-transforms-p)))
(defun mastodon-tl--byline (toot &optional detailed-p
domain base-toot group ts)
"Generate (bottom) byline for TOOT.
AUTHOR-BYLINE is a function for adding the author portion of
the byline that takes one variable.
DETAILED-P means display more detailed info. For now
this just means displaying toot client.
When DOMAIN, force inclusion of user's domain in their handle.
BASE-TOOT is JSON for the base toot, if any.
GROUP is the notification group if any.
ACCOUNT is the notification account if any.
TS is a timestamp from the server, if any."
(let* ((type (alist-get 'type (or group toot)))
(created-time
(or ts ;; mentions, statuses, folls/foll-reqs
;; bosts, faves, edits, polls in notifs view use base item
;; timestamp:
(mastodon-tl--field 'created_at
(mastodon-tl--field 'status toot))
;; all other toots, inc. boosts/faves in timelines:
;; (mastodon-tl--field auto fetches from reblogs if needed):
(mastodon-tl--field 'created_at toot)))
(parsed-time (when created-time (date-to-time created-time)))
;; non-grouped notifs now need to pull the following data from
;; base toot:
(base-maybe (or base-toot ;; show edits for notifs
(mastodon-tl--toot-or-base toot))) ;; for boosts
(faved (eq t (mastodon-tl--field 'favourited base-maybe)))
(boosted (eq t (mastodon-tl--field 'reblogged base-maybe)))
(bookmarked (eq t (mastodon-tl--field 'bookmarked base-maybe)))
(visibility (mastodon-tl--field 'visibility base-maybe))
(account (alist-get 'account base-maybe))
(avatar-url (alist-get 'avatar account))
(edited-time (alist-get 'edited_at base-maybe))
(edited-parsed (when edited-time (date-to-time edited-time))))
(concat
;; Boosted/favourited markers are not technically part of the byline, so
;; we don't propertize them with 'byline t', as per the rest. This
;; ensures that `mastodon-tl-goto-next-item' puts point on
;; author-byline, not before the (F) or (B) marker. Not propertizing like
;; this makes the behaviour of these markers consistent whether they are
;; displayed for an already boosted/favourited toot or as the result of
;; the toot having just been favourited/boosted.
(concat (when boosted
(mastodon-tl--format-faved-or-boosted-byline
(mastodon-tl--symbol 'boost)))
(when faved
(mastodon-tl--format-faved-or-boosted-byline
(mastodon-tl--symbol 'favourite)))
(when bookmarked
(mastodon-tl--format-faved-or-boosted-byline
(mastodon-tl--symbol 'bookmark))))
;; we remove avatars from the byline also, so that they also do not
;; mess with `mastodon-tl-goto-next-item':
(when (and mastodon-tl--show-avatars
mastodon-tl--display-media-p
(mastodon-tl--image-trans-check))
(mastodon-media--get-avatar-rendering avatar-url))
(propertize
(concat
;; NB: action-byline (boost) is now added in insert-status, so no
;; longer part of the byline.
;; (base) author byline:
;; we use base-toot if poss for fave/boost notifs that need to show
;; base item in author byline
(mastodon-tl--byline-author (or base-toot toot)
nil domain :base)
;; visibility:
(cond ((string= visibility "direct")
(propertize (concat " " (mastodon-tl--symbol 'direct))
'help-echo visibility))
((string= visibility "private")
(propertize (concat " " (mastodon-tl--symbol 'private))
'help-echo visibility)))
" "
;; timestamp:
(let ((ts (format-time-string
mastodon-toot-timestamp-format parsed-time)))
(propertize ts
'timestamp parsed-time
'display
(if mastodon-tl--enable-relative-timestamps
(mastodon-tl--relative-time-description parsed-time)
parsed-time)
'help-echo ts))
;; detailed:
(when detailed-p
(let* ((app-name (map-nested-elt toot '(application name)))
(app-url (map-nested-elt toot '(application website))))
(when app-name
(concat
(propertize " via " 'face 'default)
(propertize app-name
'face 'mastodon-display-name-face
'follow-link t
'mouse-face 'highlight
'mastodon-tab-stop 'shr-url
'shr-url app-url
'help-echo app-url
'keymap mastodon-tl--shr-map-replacement)))))
;; edited:
(when edited-time
(concat
" "
(mastodon-tl--symbol 'edited)
" "
(propertize
(format-time-string mastodon-toot-timestamp-format
edited-parsed)
'face 'mastodon-toot-docs-face
'timestamp edited-parsed
'display (if mastodon-tl--enable-relative-timestamps
(mastodon-tl--relative-time-description edited-parsed)
edited-parsed))))
(propertize (concat "\n " mastodon-tl--horiz-bar)
'face 'default)
;; stats:
(when (and mastodon-tl--show-stats
(not (member type '("follow" "follow_request"))))
(mastodon-tl--toot-stats toot))
"\n")
'favourited-p faved
'boosted-p boosted
'bookmarked-p bookmarked
;; enable playing of videos when point is on byline:
'attachments (mastodon-tl--get-attachments-for-byline toot)
'edited edited-time
'edit-history (when edited-time
(mastodon-toot--get-toot-edits
(alist-get 'id base-maybe)))
'byline t))))
;;; TIMESTAMPS
(defun mastodon-tl--relative-time-details (timestamp &optional current-time)
"Return cons of (DESCRIPTIVE STRING . NEXT-CHANGE) for the TIMESTAMP.
Use the optional CURRENT-TIME as the current time (only used for
reliable testing).
The descriptive string is a human readable version relative to
the current time while the next change timestamp give the first
time that this description will change in the future.
TIMESTAMP is assumed to be in the past."
(let* ((time-difference (time-subtract current-time timestamp))
(seconds-difference (float-time time-difference))
(tmp (mastodon-tl--human-duration (max 0 seconds-difference))))
;; revert to old just now style for < 1 min
(cons (concat (car tmp) (if (string= "just now" (car tmp)) "" " ago"))
(time-add current-time (cdr tmp)))))
(defun mastodon-tl--relative-time-description (timestamp &optional current-time)
"Return a string with a human readable TIMESTAMP relative to the current time.
Use the optional CURRENT-TIME as the current time (only used for
reliable testing).
E.g. this could return something like \"1 min ago\", \"yesterday\", etc.
TIME-STAMP is assumed to be in the past."
(car (mastodon-tl--relative-time-details timestamp current-time)))
;;; RENDERING HTML, LINKS, HASHTAGS, HANDLES
(defun mastodon-tl--render-text (string &optional toot)
"Return a propertized text rendering the given HTML string STRING.
The contents comes from the given TOOT which is used in parsing
links in the text. If TOOT is nil no parsing occurs."
(when string ; handle rare empty notif server bug
(with-temp-buffer
(insert string)
(let ((shr-use-fonts mastodon-tl--enable-proportional-fonts)
(shr-width (when mastodon-tl--enable-proportional-fonts
(if mastodon-tl--no-fill-on-render
0
(- (window-width) 3))))
(cat (get 'mastodon-tl-link 'button-category-symbol)))
(shr-render-region (point-min) (point-max))
(alter-text-property
(point-min) (point-max) 'category
(lambda (type) (when type cat))))
;; Make all links a tab stop recognized by our own logic, make
;; things point to our own logic (e.g. hashtags), and update keymaps
;; where needed:
(when toot
(let (region)
(while (setq region (mastodon-tl--find-property-range
'shr-url (or (cdr region) (point-min))))
(mastodon-tl--process-link toot
(car region) (cdr region)
(get-text-property (car region) 'shr-url))
(when (proper-list-p toot) ;; not on profile fields cons cells
;; render card author maybe:
(let* ((card-url (map-nested-elt toot '(card url)))
(authors (map-nested-elt toot '(card authors)))
(url (buffer-substring (car region) (cdr region)))
(url-no-query (car (split-string url "?"))))
(when (and (string= url-no-query card-url)
;; only if we have an account's data:
(alist-get 'account (car authors)))
(goto-char (point-max))
(mastodon-tl--insert-card-authors authors)))))))
(buffer-string))))
(defun mastodon-tl--insert-card-authors (authors)
"Insert a string of card AUTHORS."
(let ((authors-str (format "Author%s: "
(if (< 1 (length authors)) "s" ""))))
(insert
(concat
"\n(" authors-str
(mapconcat #'mastodon-tl--format-card-author authors "\n")
")\n"))))
(defun mastodon-tl--format-card-author (data)
"Render card author DATA."
(when-let* ((account (alist-get 'account data))) ;.account
(let-alist account ;.account
;; FIXME: replace with refactored handle render fun
;; in byline refactor branch:
(concat
(propertize (or .display_name .username)
'face 'mastodon-display-name-face
'item-type 'user
'item-id .id)
" "
(propertize (concat "@" .acct)
'face 'mastodon-handle-face
'mouse-face 'highlight
'mastodon-tab-stop 'user-handle
'keymap mastodon-tl--link-keymap
'mastodon-handle (concat "@" .acct)
'help-echo (concat "Browse user profile of @" .acct))))))
(defun mastodon-tl--process-link (toot start end url)
"Process link URL in TOOT as hashtag, userhandle, or normal link.
START and END are the boundaries of the link in the toot."
(let* (mastodon-tab-stop-type
keymap
(help-echo (get-text-property start 'help-echo))
extra-properties
;; handle calling this on non-toots, e.g. for profiles:
(toot-url (when (proper-list-p toot)
(mastodon-tl--field 'url toot)))
(toot-url (when toot-url (url-generic-parse-url toot-url)))
(toot-instance-url (if toot-url
(concat (url-type toot-url) "://"
(url-host toot-url))
mastodon-instance-url))
(link-str (buffer-substring-no-properties start end))
(maybe-hashtag (mastodon-tl--hashtag-from-url
url toot-instance-url))
(maybe-userhandle
(if (proper-list-p toot) ; fails for profile buffers?
(or (mastodon-tl--userhandle-from-mentions toot link-str)
(mastodon-tl--userhandle-from-url url link-str))
(mastodon-tl--userhandle-from-url url link-str))))
(cond (maybe-hashtag
(setq mastodon-tab-stop-type 'hashtag
keymap mastodon-tl--link-keymap
help-echo (concat "Browse tag #" maybe-hashtag)
extra-properties (list 'mastodon-tag maybe-hashtag)))
(maybe-userhandle ;; fails on mentions in profile notes:
(let ((maybe-userid (when (proper-list-p toot)
(mastodon-tl--extract-userid-toot
toot link-str))))
(setq mastodon-tab-stop-type 'user-handle
keymap mastodon-tl--link-keymap
help-echo (concat "Browse user profile of " maybe-userhandle)
extra-properties (append
(list 'mastodon-handle maybe-userhandle)
(when maybe-userid
(list 'account-id maybe-userid))))))
(t ;; Anything else (leave it as a url handled by shr.el):
(setq keymap (if (eq shr-map (get-text-property start 'keymap))
mastodon-tl--shr-map-replacement
mastodon-tl--shr-image-map-replacement)
mastodon-tab-stop-type 'shr-url)))
(add-text-properties start end
(append
(list 'mastodon-tab-stop mastodon-tab-stop-type
'keymap keymap
'help-echo help-echo)
extra-properties))))
(defun mastodon-tl--userhandle-from-mentions (toot link)
"Extract a user handle from mentions in json TOOT.
LINK is maybe the `@handle' to search for."
(mastodon-tl--el-from-mentions 'acct toot link))
(defun mastodon-tl--extract-userid-toot (toot link)
"Extract a user id for an ACCT from mentions in a TOOT.
LINK is maybe the `@handle' to search for."
(mastodon-tl--el-from-mentions 'id toot link))
(defun mastodon-tl--el-from-mentions (el toot link)
"Extract element EL from TOOT mentions that matches LINK.
LINK should be a simple handle string with no domain, i.e. \"@user\".
Return nil if no matching element."
(let ((mentions (alist-get 'mentions toot)))
(when mentions
(let* ((mention (pop mentions))
(name (substring-no-properties link 1 (length link))) ; cull @
return)
(while mention
(when (string= name (alist-get 'username mention))
(setq return (alist-get el mention)))
(setq mention (pop mentions)))
return))))
(defun mastodon-tl--userhandle-from-url (url &optional buffer-text)
"Return the user hande the URL points to or nil if it is not a profile link.
BUFFER-TEXT is the text covered by the link with URL, for a user profile
this should be of the form , e.g. \"@Gargon\".
This is called on all post URLs, so needs to handle non profile URLs
gracefully."
(let* ((parsed-url (url-generic-parse-url url))
(host (url-host parsed-url))
(local-p (string=
(url-host (url-generic-parse-url mastodon-instance-url))
host))
(path-raw (url-filename parsed-url)))
(unless (string-empty-p path-raw)
(let ((path (substring path-raw 1))) ;; remove "/" prefix
(if (not buffer-text)
(when (string-prefix-p "@" path)
(if local-p path (concat "@" host)))
(when (and (string= "@" (substring buffer-text 0 1))
;; don't error on domain only url (rare):
(string= (downcase buffer-text)
(downcase path)))
(if local-p
buffer-text ; no instance suffix for local mention
(concat buffer-text "@" host))))))))
(defun mastodon-tl--hashtag-from-url (url instance-url)
"Return the hashtag that URL points to or nil if URL is not a tag link.
INSTANCE-URL is the url of the instance for the toot that the link
came from (tag links always point to a page on the instance publishing
the toot)."
;; TODO: do we rly need to check it against instance-url?
;; test suggests we might
(let* ((instance-host (url-host
(url-generic-parse-url instance-url)))
(parsed (url-generic-parse-url url))
(path (url-filename parsed))
(split (split-string path "/")))
(when (and (string= instance-host (url-host parsed))
(string-prefix-p "/tag" path)) ;; "/tag/" or "/tags/"
(nth 2 split))))
(defun mastodon-tl--base-tags (tags body-tags)
"Return a string of all tags not in BODY-TAGS, linkified.
TAGS is a list of tag alists, from a post's JSON."
(when (mastodon-tl--base-tags-print-p tags body-tags)
(concat
"\n"
(cl-loop for tag in tags
concat (concat (mastodon-tl--render-base-tag tag body-tags)
" ")))))
(defun mastodon-tl--base-tags-print-p (tags body-tags)
"Non-nil if we need to print base tags.
We need to do so if TAGS contains any elements not in BODY-TAGS."
(cl-remove-if (lambda (tag)
(member (alist-get 'name tag) body-tags))
tags))
(defun mastodon-tl--render-base-tag (tag body-tags)
"Return TAG as a linkified string, provided it is not in BODY-TAGS."
(let ((name (alist-get 'name tag)))
(unless (member (downcase name) body-tags)
(mastodon-tl--buttonify-link
(concat "#" name)
'mastodon-tab-stop 'hashtag
'mastodon-tag name
'mouse-face '(highlight)
'keymap mastodon-tl--link-keymap
'face '(shr-text shr-link)
'follow-link t
'shr-tab-stop t
'shr-url (alist-get 'url tag)
'help-echo (concat "Browse tag #" name)))))
;;; HYPERLINKS
(define-button-type 'mastodon-tl-link
'action #'mastodon-tl--push-button
'keymap mastodon-tl--link-keymap
'mouse-face 'highlight)
(defun mastodon-tl--push-button (button)
"Do the appropriate action for BUTTON."
(mastodon-tl-do-link-action-at-point (button-start button)))
(defun mastodon-tl--buttonify-link (string &rest properties)
"Make STRING a `mastodon-tl-link' type button.
PROPERTIES are additional properties to attach to string."
(apply #'propertize string
'button t
'category (get 'mastodon-tl-link 'button-category-symbol)
properties))
(defun mastodon-tl--make-link (string link-type)
"Return a propertized version of STRING that will act like link.
LINK-TYPE is the type of link to produce."
(let ((help-text (cond ((eq link-type 'content-warning)
"Toggle hidden text")
((or (eq link-type 'read-more)
(eq link-type 'read-less))
"Toggle full post")
(t
(error "Unknown link type %s" link-type)))))
(mastodon-tl--buttonify-link string
'mastodon-tab-stop link-type
'help-echo help-text)))
(defun mastodon-tl-do-link-action-at-point (pos)
"Do the action of the link at POS.
Used for hitting RET on a given link."
(interactive "d")
(let ((link-type (get-text-property pos 'mastodon-tab-stop)))
(cond ((eq link-type 'content-warning)
(mastodon-tl--toggle-spoiler-text pos))
((eq link-type 'hashtag)
(mastodon-tl--show-tag-timeline
nil (get-text-property pos 'mastodon-tag)))
;; 'account / 'account-id is not set for mentions, only bylines
((eq link-type 'user-handle)
(let ((account-json (get-text-property pos 'account))
(account-id (get-text-property pos 'account-id)))
(cond
(account-json
(mastodon-profile--make-author-buffer account-json))
(account-id
(mastodon-profile--make-author-buffer
(mastodon-profile--account-from-id account-id)))
(t
(let ((account (mastodon-profile--search-account-by-handle
(get-text-property pos 'mastodon-handle))))
;; never call make-author-buffer on nil account:
(cond (account
(mastodon-profile--make-author-buffer account))
;; optional webfinger lookup:
((y-or-n-p
"Search for account returned nothing. Perform URL lookup?")
(mastodon-url-lookup (get-text-property pos 'shr-url)))
(t
(error "Unable to find account"))))))))
((eq link-type 'shr-url)
(mastodon-url-lookup (get-text-property pos 'shr-url)))
((eq link-type 'read-more)
(mastodon-tl-unfold-post))
((eq link-type 'read-less)
(mastodon-tl-fold-post))
(t
(error "Unknown link type %s" link-type)))))
(defun mastodon-tl-do-link-action (event)
"Do the action of the link at point.
Used for a mouse-click EVENT on a link."
(interactive "@e")
(mastodon-tl-do-link-action-at-point (posn-point (event-end event))))
;;; CONTENT WARNINGS
(defun mastodon-tl--has-spoiler (toot)
"Check if the given TOOT has a spoiler text.
Spoiler text should initially be shown only while the main
content should be hidden."
(let ((spoiler (mastodon-tl--field 'spoiler_text toot)))
(and spoiler (> (length spoiler) 0))))
(defun mastodon-tl--toggle-spoiler-text (position)
"Toggle the visibility of the spoiler text at/after POSITION."
(let* ((inhibit-read-only t)
(spoiler-region (mastodon-tl--find-property-range
'mastodon-content-warning-body position nil))
(new-state (not (get-text-property (car spoiler-region)
'invisible))))
(if (not spoiler-region)
(user-error "No spoiler text here")
(add-text-properties (car spoiler-region) (cdr spoiler-region)
(list 'invisible new-state))
new-state))) ;; return what we set invisibility to
(defun mastodon-tl-toggle-spoiler-text-in-toot ()
"Toggle the visibility of the spoiler text in the current toot."
(interactive)
(let* ((toot-range (or (mastodon-tl--find-property-range
'item-json (point))
(mastodon-tl--find-property-range
'item-json (point) t)))
(spoiler-range (when toot-range
(mastodon-tl--find-property-range
'mastodon-content-warning-body
(car toot-range)))))
(cond ((null toot-range)
(user-error "No toot here"))
((or (null spoiler-range)
(> (car spoiler-range) (cdr toot-range)))
(user-error "No content warning text here"))
(t
(mastodon-tl--toggle-spoiler-text (car spoiler-range))))))
(defun mastodon-tl-toggle-spoiler-in-thread ()
"Toggler content warning for all posts in current thread."
(interactive)
(let ((thread-p (eq (mastodon-tl--buffer-property 'update-function)
'mastodon-tl--thread-do)))
(if (not thread-p)
(user-error "Not in a thread")
(save-excursion
(goto-char (point-min))
(while (not (string= "No more items" ; improve this hack test!
(mastodon-tl-goto-next-item :no-refresh)))
(let* ((json (mastodon-tl--property 'item-json :no-move))
(cw (alist-get 'spoiler_text json)))
(when (not (string= "" cw))
(let ((new-state
(pcase
(mastodon-tl-toggle-spoiler-text-in-toot)
('t 'folded)
('nil 'unfolded))))
(plist-put mastodon-tl--buffer-spec
'thread-unfolded new-state)))))))))
(defun mastodon-tl--spoiler (toot &optional filter)
"Render TOOT with spoiler message.
This assumes TOOT is a toot with a spoiler message.
The main body gets hidden and only the spoiler text and the
content warning message are displayed. The content warning
message is a link which unhides/hides the main body.
FILTER is a string to use as a filter warning spoiler instead."
(let* ((spoiler (mastodon-tl--field 'spoiler_text toot))
(string (mastodon-tl--set-face
(mastodon-tl--clean-tabs-and-nl
(mastodon-tl--render-text spoiler toot))
'default))
(message (concat " " mastodon-tl--horiz-bar "\n "
(mastodon-tl--make-link
(if filter
(concat "Filtered: " filter)
(concat "CW: " string))
'content-warning)
"\n "
mastodon-tl--horiz-bar "\n"))
(cw (mastodon-tl--set-face message 'mastodon-cw-face)))
(concat
cw
(propertize
(mastodon-tl--content toot)
'invisible
(or filter ;; filters = invis
(let ((cust mastodon-tl--expand-content-warnings))
(if (not (eq 'server cust))
(not cust) ;; opp to setting
;; respect server setting:
;; If something goes wrong reading prefs,
;; just return t so CWs fold by default.
(condition-case nil
(if (eq :json-false
(mastodon-profile--get-preferences-pref
'reading:expand:spoilers))
t
nil)
(error t)))))
'mastodon-content-warning-body t))))
;;; MEDIA
(defun mastodon-tl--media (toot)
"Retrieve a media attachment link for TOOT if one exists.
Else return an empty string."
(let* ((attachments (mastodon-tl--field 'media_attachments toot))
(sensitive (mastodon-tl--field 'sensitive toot))
(media-string (mapconcat
(lambda (x)
(mastodon-tl--media-attachment x sensitive))
attachments "")))
(if (not (and mastodon-tl--display-media-p
(string-empty-p media-string)))
(concat "\n" media-string)
"")))
(defun mastodon-tl--media-attachment (attachment sensitive)
"Return a propertized string for ATTACHMENT.
SENSITIVE is a flag from the item's JSON data."
(let-alist attachment
(let ((display-str
(concat "Media:: "
(if (and mastodon-tl--display-caption-not-url-when-no-media
.description)
.description
.preview_url)))
(remote-url (or .remote_url .url)))
(if (and mastodon-tl--display-media-p
;; if in notifs, also check notifs images custom:
(if (or (mastodon-tl--buffer-type-eq 'notifications)
(mastodon-tl--buffer-type-eq 'mentions))
mastodon-images-in-notifs
t))
(mastodon-media--get-media-link-rendering ; placeholder: "[img]"
.preview_url remote-url ; for shr-browse-url
.type .description sensitive)
;; return URL/caption:
(concat (mastodon-tl--propertize-img-str-or-url
(concat "Media:: " .preview_url) ; string
.preview_url remote-url .type .description
display-str 'shr-link .description sensitive)
"\n")))))
(defun mastodon-tl--propertize-img-str-or-url
(str media-url full-remote-url type help-echo
&optional display face caption sensitive)
"Propertize an media placeholder string \"[img]\" or media URL.
STR is the string to propertize, MEDIA-URL is the preview link,
FULL-REMOTE-URL is the link to the full resolution image on the
server, TYPE is the media type.
HELP-ECHO, DISPLAY, and FACE are the text properties to add.
CAPTION is the image caption, added as a text property.
SENSITIVE is a flag from the item's JSON data."
(propertize str
'media-url media-url
'media-state (when (string= str "[img]") 'needs-loading)
'media-type 'media-link
'mastodon-media-type type
'display display
'face face
'mouse-face 'highlight
'mastodon-tab-stop 'image ; for do-link-action-at-point
'image-url (or full-remote-url media-url) ; for shr-browse-image
'keymap mastodon-tl--shr-image-map-replacement
'image-description caption
'sensitive sensitive
'help-echo (if (or (string= type "image")
(string= type nil)
(string= type "unknown")) ; handle borked images
help-echo
(concat help-echo "\nC-RET: play " type " with mpv"))))
;;; FULL IMAGE VIEW
(define-derived-mode mastodon-image-mode image-mode
"mastodon-image"
:group 'mastodon)
;; patch `shr-browse-image' to accept url arg:
(defun mastodon-tl-shr-browse-image (&optional image-url copy-url)
"Browse the image under point.
If COPY-URL (the prefix if called interactively) is non-nil, copy
the URL of the image to the kill buffer instead.
Optionally use IMAGE-URL rather than the image-url property at point."
(interactive "sP")
(let ((url (or image-url (get-text-property (point) 'image-url))))
(cond
((not url)
(message "No image under point"))
(copy-url
(with-temp-buffer
(insert url)
(copy-region-as-kill (point-min) (point-max))
(message "Copied %s" url)))
(t
(message "Browsing %s..." url)
(browse-url url)))))
(defun mastodon-tl--view-image-url (url attachments)
"View image URL. Set ATTACHMENTS metadata in image buffer."
(if (not url)
(user-error "No url found")
(if (not mastodon-tl--load-full-sized-images-in-emacs)
(mastodon-tl-shr-browse-image url)
(mastodon-media--image-or-cached
url #'mastodon-media--process-full-sized-image-response
`(nil ,url ,attachments ,(buffer-name))))))
(defun mastodon-tl-view-full-image-at-point ()
"Browse full-sized version of image at point in a new window."
(interactive)
(if (not (eq (mastodon-tl--property 'mastodon-tab-stop) 'image))
(user-error "No image at point?")
(let* ((url (mastodon-tl--property 'image-url))
(attachments (mastodon-tl--property 'attachments)))
(mastodon-tl--view-image-url url attachments))))
(defun mastodon-tl-view-first-full-image ()
"From item byline, fetch load its first full image."
(interactive)
(let* ((attachments (mastodon-tl--property 'attachments))
(url (plist-get (car attachments) :url)))
(if (not attachments)
(user-error "Toot has no attachments")
(mastodon-tl--view-image-url url attachments))))
(defun mastodon-tl--get-next-image-url ()
"Return the url for the next image to load.
Cycles through values in `mastodon-media--attachments'."
(let* ((url (car mastodon-media--attachments))
;; match url against our plists:
(current (mastodon-tl--current-image-url url)))
;; fetch from next item in current or use first item if current has
;; only 1 item:
(plist-get (if (= 1 (length current))
(cadr mastodon-media--attachments)
(cadr current))
:url)))
(defun mastodon-tl--current-image-url (url)
"Try to fetch URL from `mastodon-media--attachments'.
The return value is that of `cl-member-if', ie if a match is found, it
returns the match and the list of which it is the car."
(cl-member-if
(lambda (attachment)
(equal url (plist-get attachment :url)))
(cdr mastodon-media--attachments)))
(defun mastodon-tl--get-prev-image-url ()
"Return the URL of the previous item in `mastodon-media--attachments'."
(let* ((url (car mastodon-media--attachments))
(current (mastodon-tl--current-image-url url)))
(plist-get (nth (1- (length current))
(cdr mastodon-media--attachments))
:url)))
(defun mastodon-tl-next-full-image ()
"From full image view buffer, load the toot's next image."
(interactive)
(let* ((next-url (mastodon-tl--get-next-image-url)))
(mastodon-tl--view-image-url next-url
(cdr mastodon-media--attachments))))
(defun mastodon-tl-prev-full-image ()
"From full image view buffer, load the toot's prev image."
(interactive)
(let* ((prev-url (mastodon-tl--get-prev-image-url)))
(mastodon-tl--view-image-url prev-url
(cdr mastodon-media--attachments))))
(defun mastodon-tl-toggle-sensitive-image ()
"Toggle dislay of sensitive image at point."
(interactive)
(if (not (eq t (mastodon-tl--property 'sensitive)))
(user-error "No sensitive media at point?")
(let ((data (mastodon-tl--property 'image-data :no-move))
(inhibit-read-only t)
(end (next-single-property-change (point) 'sensitive-state)))
(add-text-properties
(point) end
(if (eq 'hidden (mastodon-tl--property 'sensitive-state :no-move))
;; display:
`( display ,data
sensitive-state showing)
;; hide:
`( sensitive-state hidden
display
,(create-image
mastodon-media--sensitive-image-data nil t)))))))
;; POLLS
(defun mastodon-tl--format-poll-option (option counter length)
"Format poll OPTION. COUNTER is a counter.
LENGTH is of the longest option, for formatting."
(format "%s: %s%s%s\n"
counter
(propertize (alist-get 'title option)
'face 'success)
(make-string (1+ (- length
(length (alist-get 'title option))))
?\ )
;; TODO: disambiguate no votes from hidden votes
(format "[%s votes]" (or (alist-get 'votes_count option)
"0"))))
(defun mastodon-tl--format-poll (poll)
"From json poll data POLL, return a display string."
(let-alist poll
(let* ((options (mastodon-tl--map-alist 'title .options))
(longest (car (sort (mapcar #'length options ) #'>)))
(counter 0))
(concat "\n"
(mastodon-tl--symbol 'poll)
"\n\n"
(mapconcat (lambda (option)
(setq counter (1+ counter))
(mastodon-tl--format-poll-option
option counter longest))
.options
"\n")
"\n"
(propertize
(cond (.voters_count ; sometimes it is nil
(format "%s %s | " .voters_count
(if (= .voters_count 1) "person" "people")))
(.vote_count
(format "%s votes | " .vote_count))
(t ""))
'face 'mastodon-toot-docs-face)
(let ((str (if (eq .expired :json-false)
(if (eq .expires_at nil)
""
(mastodon-tl--format-poll-expiry .expires_at))
"Poll expired.")))
(propertize str 'face 'mastodon-toot-docs-face))
"\n"))))
(defconst mastodon-tl--time-units
'("sec" 60.0 ;; Use a float to convert `n' to float.
"min" 60
"hour" 24
"day" 7
"week" 4.345
"month" 12
"year"))
(defun mastodon-tl--format-poll-expiry (timestamp)
"Convert poll expiry TIMESTAMP into a descriptive string.
TIMESTAMP is from the expires_at field of a poll's JSON data, and
is in ISO 8601 Datetime format."
(let* ((ts (encode-time (parse-time-string timestamp)))
(seconds (time-to-seconds (time-subtract ts nil))))
;; FIXME: Use the `cdr' to update poll expiry times?
(concat (car (mastodon-tl--human-duration (max 0 seconds))) " left")))
(defun mastodon-tl--human-duration (seconds &optional resolution)
"Return a string describing SECONDS in a more human-friendly way.
The return format is (STRING . RES) where RES is the resolution of
this string, in seconds.
RESOLUTION is the finest resolution, in seconds, to use for the
second part of the output (defaults to 60, so that seconds are only
displayed when the duration is smaller than a minute)."
(cl-assert (>= seconds 0))
(unless resolution (setq resolution 60))
(let* ((units mastodon-tl--time-units)
(n1 seconds) (unit1 (pop units)) (res1 1)
n2 unit2 res2
next)
(while (and units (> (truncate (setq next (/ n1 (car units)))) 0))
(setq unit2 unit1)
(setq res2 res1)
(setq n2 (- n1 (* (car units) (truncate n1 (car units)))))
(setq n1 next)
(setq res1 (truncate (* res1 (car units))))
(pop units)
(setq unit1 (pop units)))
(setq n1 (truncate n1))
(if n2 (setq n2 (truncate n2)))
(cond
((null n2)
;; revert to old just now style for < 1 min:
(cons "just now" 60))
;; (cons (format "%d %s%s" n1 unit1 (if (> n1 1) "s" ""))
;; (max resolution res1)))
((< (* res2 n2) resolution)
(cons (format "%d %s%s" n1 unit1 (if (> n1 1) "s" ""))
(max resolution res2)))
((< res2 resolution)
(let ((n2 (/ (* resolution (/ (* n2 res2) resolution)) res2)))
(cons (format "%d %s%s, %d %s%s"
n1 unit1 (if (> n1 1) "s" "")
n2 unit2 (if (> n2 1) "s" ""))
resolution)))
(t
(cons (format "%d %s%s, %d %s%s"
n1 unit1 (if (> n1 1) "s" "")
n2 unit2 (if (> n2 1) "s" ""))
(max res2 resolution))))))
(defun mastodon-tl--format-read-poll-option (options)
"Format poll OPTIONS for `completing-read'.
OPTIONS is an alist."
;; we display option number and the option title
;; but also store both as a cons cell as the cdr, as we need it later
(cl-loop for cell in options
collect (cons (format "%s | %s" (car cell) (cdr cell))
cell)))
(defun mastodon-tl--read-poll-option ()
"Read a poll option to vote on a poll."
(let* ((toot (mastodon-tl--property 'item-json))
(poll (mastodon-tl--field 'poll toot)))
(if (null poll)
(user-error "No poll here")
(let* ((options (mastodon-tl--field 'options poll))
(titles (mastodon-tl--map-alist 'title options))
(number-seq (number-sequence 1 (length options)))
(numbers (mapcar #'number-to-string number-seq))
(options-alist (cl-mapcar #'cons numbers titles))
(candidates (mastodon-tl--format-read-poll-option options-alist))
(choice (completing-read "Poll option to vote for: "
candidates nil :match)))
(list (cdr (assoc choice candidates)))))))
(defun mastodon-tl-poll-vote (option)
"If there is a poll at point, prompt user for OPTION to vote on it."
(interactive (mastodon-tl--read-poll-option))
(let ((toot (mastodon-tl--property 'item-json)))
(if (null (mastodon-tl--field 'poll toot))
(user-error "No poll here")
(let* ((poll (mastodon-tl--field 'poll toot))
(id (alist-get 'id poll))
(url (mastodon-http--api (format "polls/%s/votes" id)))
;; zero-index our option:
(option-arg (number-to-string
(1- (string-to-number (car option)))))
(arg `(("choices[]" . ,option-arg)))
(response (mastodon-http--post url arg)))
(mastodon-http--triage response
(lambda (_)
(message "You voted for option %s: %s!"
(car option) (cdr option))))))))
;; VIDEOS / MPV
(defun mastodon-tl--find-first-video-in-attachments ()
"Return the first media attachment that is a moving image."
(let ((attachments (mastodon-tl--property 'attachments))
vids)
(cl-loop for x in attachments
do (let ((att-type (plist-get x :type)))
(when (or (string= "video" att-type)
(string= "gifv" att-type))
(push x vids))))
(car vids)))
(defun mastodon-tl-mpv-play-video-from-byline ()
"Run `mastodon-tl-mpv-play-video-at-point' on first moving image in post."
(interactive)
(let* ((video (mastodon-tl--find-first-video-in-attachments))
(url (plist-get video :url))
(type (plist-get video :type)))
(mastodon-tl-mpv-play-video-at-point url type)))
(defun mastodon-tl-view-full-image-or-play-video (_pos)
"View full sized version of image at point, or try to play video."
(interactive "d")
(if (mastodon-tl--media-video-p)
(mastodon-tl-mpv-play-video-at-point)
(mastodon-tl-view-full-image-at-point)))
(defun mastodon-tl-click-image-or-video (event)
"Click to play video with `mpv.el'.
EVENT is a mouse-click arg."
(interactive "@e")
(mastodon-tl-view-full-image-or-play-video
(posn-point (event-end event))))
(defun mastodon-tl--media-video-p (&optional type)
"T if mastodon-media-type prop is \"gifv\" or \"video\".
TYPE is a mastodon media type."
(let ((type (or type (mastodon-tl--property 'mastodon-media-type :no-move))))
(or (string= type "gifv")
(string= type "video"))))
(defun mastodon-tl-mpv-play-video-at-point (&optional url type)
"Play the video or gif at point with an mpv process.
URL and TYPE are provided when called while point is on byline,
in which case play first video or gif from current toot."
(interactive)
(let ((url (or url ; point in byline:
(mastodon-tl--property 'image-url :no-move)))) ; point in toot
(if (or (not url)
(not (mastodon-tl--media-video-p type)))
(user-error "No moving image here?")
(message "'q' to kill mpv.")
(condition-case x
(mpv-start "--loop" url)
(void-function
(message "Looks like mpv.el not installed. Error: %s"
(error-message-string x)))))))
(defun mastodon-tl-copy-image-caption ()
"Copy the caption of the image at point."
(interactive)
(if-let* ((desc (get-text-property (point) 'image-description)))
(progn
(kill-new desc)
(message "Image caption copied."))
(message "No image caption.")))
;;; INSERT TOOTS
(defun mastodon-tl--content (toot)
"Retrieve text content from TOOT.
Runs `mastodon-tl--render-text' and fetches poll or media."
(let* ((content (mastodon-tl--field 'content toot))
(poll-p (mastodon-tl--field 'poll toot))
(media-p (mastodon-tl--field 'media_attachments toot)))
(concat (mastodon-tl--render-text content toot)
(when poll-p
(mastodon-tl--format-poll
(mastodon-tl--field 'poll toot))) ;; toot or reblog
(when media-p
(mastodon-tl--media toot)))))
(defun mastodon-tl--prev-item-id ()
"Return the id of the last toot inserted into the buffer."
(let* ((prev-change
(save-excursion
(previous-single-property-change (point) 'base-item-id)))
(prev-pos (when prev-change (1- prev-change))))
(when prev-pos
(get-text-property prev-pos 'base-item-id))))
(defun mastodon-tl--after-reply-status (reply-to-id)
"T if REPLY-TO-ID is equal to that of the last toot inserted in the bufer."
(let ((prev-id (mastodon-tl--prev-item-id)))
(string= reply-to-id prev-id)))
(defun mastodon-tl--body-tags (body)
"Return a plain string list of the tags in BODY."
;; NB: replies on text props 'mastodon-tab-stop and 'shr-url
;; FIXME: snac tags fail our prop test, not sure about others.
(let (list prop)
(with-temp-buffer
(insert body)
(goto-char (point-min))
(save-match-data
(while
(setq prop (text-property-search-forward
'mastodon-tab-stop 'hashtag t))
(goto-char (prop-match-beginning prop))
(let ((tag (mastodon-tl--property 'mastodon-tag)))
(when tag
(push (downcase tag) list)))
(goto-char (prop-match-end prop)))))
list))
(defun mastodon-tl--insert-status
(toot body &optional detailed-p thread domain unfolded no-byline
cw-expanded)
"Display the content and byline of timeline element TOOT.
BODY will form the section of the toot above the byline.
DETAILED-P means display more detailed info. For now
this just means displaying toot client.
THREAD means the status will be displayed in a thread view.
When DOMAIN, force inclusion of user's domain in their handle.
UNFOLDED is a boolean meaning whether to unfold or fold item if foldable.
NO-BYLINE means just insert toot body, used for folding.
CW-EXPANDED means treat content warnings as unfolded."
(let* ((reply-to-id (alist-get 'in_reply_to_id toot))
(after-reply-status-p
(when (and thread reply-to-id)
(mastodon-tl--after-reply-status reply-to-id)))
;; (type (alist-get 'type toot))
(toot-foldable
(and mastodon-tl--fold-toots-at-length
(length> body mastodon-tl--fold-toots-at-length)))
(cw-p (not
(string-empty-p
(alist-get 'spoiler_text toot))))
(body-tags (mastodon-tl--body-tags body)))
(insert
(propertize ;; body + byline:
(concat
(propertize ;; body only:
(concat
"\n"
(mastodon-tl--byline-boost toot) ;; top byline (boost)
;; relpy symbol:
(when (and after-reply-status-p thread)
(concat (mastodon-tl--symbol 'replied)
"\n"))
;; actual body:
(let ((bar (mastodon-tl--symbol 'reply-bar))
(body (if (and toot-foldable (not unfolded))
(mastodon-tl--fold-body body)
body)))
(if (and after-reply-status-p thread)
(propertize body
'line-prefix bar
'wrap-prefix bar)
body))
(if (and toot-foldable unfolded cw-expanded)
(mastodon-tl--read-more-or-less
"LESS" cw-p (not cw-expanded))
""))
'toot-body t) ;; includes newlines etc. for folding
;; post tags:
(let ((tags (alist-get 'tags toot)))
;; FIXME: we also need to test here for normal body tags, and if
;; so, don't go ahead:
(if tags (concat (mastodon-tl--base-tags tags body-tags)) ""))
;; byline:
"\n"
(if no-byline
""
(mastodon-tl--byline toot detailed-p domain)))
'item-type 'toot
'item-id (alist-get 'id toot) ; toot id
'base-item-id (mastodon-tl--item-id toot) ; with reblog check
'item-json toot
'cursor-face 'mastodon-cursor-highlight-face
'toot-foldable toot-foldable
'toot-folded (and toot-foldable (not unfolded)))
(if no-byline "" "\n"))))
(defun mastodon-tl--is-reply (toot)
"Check if the TOOT is a reply to another one (and not boosted).
Used as a predicate in `mastodon-tl--timeline'."
(and (mastodon-tl--field 'in_reply_to_id toot)
(eq :json-false (mastodon-tl--field 'reblogged toot))))
(defun mastodon-tl--filters-alist (filters)
"Parse filter data for FILTERS.
For each filter, return a list of action (warn or hide), filter
title, and context."
(cl-loop for x in filters ;; includes non filter elts!
for f = (alist-get 'filter x)
collect (list (alist-get 'filter_action f)
(alist-get 'title f)
(alist-get 'context f))))
(defun mastodon-tl--filter-by-context (context filters)
"Remove FILTERS that don't apply to the current CONTEXT."
(cl-remove-if-not
(lambda (x)
(member context (nth 2 x)))
filters))
(defun mastodon-tl--filters-context ()
"Return a string of the current buffer's filter context.
Returns a member of `mastodon-views--filter-types'."
(let ((buf (mastodon-tl--get-buffer-type)))
(cond ((or (eq buf 'local) (eq buf 'federated))
"public")
((mastodon-tl--profile-buffer-p)
"profile")
((eq buf 'list-timeline)
"home") ;; lists are "home" filter
(t ;; thread, notifs, home:
(symbol-name buf)))))
(defun mastodon-tl--current-filters (filters)
"Return the filters from FILTERS data that apply in the current context.
For each filter, return a list of action (warn or hide), filter
title, and context."
(let ((context (mastodon-tl--filters-context))
(filters-no-context (mastodon-tl--filters-alist filters)))
(mastodon-tl--filter-by-context context filters-no-context)))
(defun mastodon-tl--toot (toot &optional detailed-p thread domain
unfolded no-byline cw-expanded)
"Format TOOT and insert it into the buffer.
DETAILED-P means display more detailed info. For now
this just means displaying toot client.
THREAD means the status will be displayed in a thread view.
When DOMAIN, force inclusion of user's domain in their handle.
UNFOLDED is a boolean meaning whether to unfold or fold item if foldable.
NO-BYLINE means just insert toot body, used for folding.
CW-EXPANDED means treat content warnings as unfolded."
(let* ((mastodon-tl--expand-content-warnings
(or cw-expanded mastodon-tl--expand-content-warnings))
(filtered (mastodon-tl--field 'filtered toot))
(filters (when filtered
(mastodon-tl--current-filters filtered)))
(spoiler-or-content (if-let* ((match (assoc "warn" filters)))
(mastodon-tl--spoiler toot (cadr match))
(if (mastodon-tl--has-spoiler toot)
(mastodon-tl--spoiler toot)
(mastodon-tl--content toot)))))
;; If any filters are "hide", then we hide,
;; even though item may also have a "warn" filter:
(unless (and filtered (assoc "hide" filters)) ;; no insert
(mastodon-tl--insert-status
toot (mastodon-tl--clean-tabs-and-nl spoiler-or-content)
detailed-p thread domain unfolded no-byline cw-expanded))))
(defun mastodon-tl--timeline (toots &optional thread domain no-byline)
"Display each toot in TOOTS.
This function removes replies if user required.
THREAD means the status will be displayed in a thread view.
When DOMAIN, force inclusion of user's domain in their handle.
NO-BYLINE means just insert toot body, used for folding."
(let ((start-pos (point))
(toots ;; hack to *not* filter replies on profiles:
(if (eq (mastodon-tl--get-buffer-type) 'profile-statuses)
toots
(if (or ; we were called via --more*:
(mastodon-tl--buffer-property 'hide-replies nil :no-error)
;; loading a tl with a prefix arg:
(mastodon-tl--hide-replies-p current-prefix-arg))
(cl-remove-if-not #'mastodon-tl--is-reply toots)
toots))))
(cl-loop for toot in toots
do (mastodon-tl--toot toot nil thread domain nil no-byline))
;; media:
(when mastodon-tl--display-media-p
(mastodon-media--inline-images start-pos (point)))
(goto-char (point-min))))
;;; FOLDING
(defun mastodon-tl--read-more-or-less (str cw invis)
"Return a read more or read less heading.
STR is an uppercase string, either MORE or LESS.
The heading is a link to toggle the fold status of the toot.
CW and INVIS are boolean values for the properties invisible and
mastodon-content-warning-body."
(let ((type (if (string= str "MORE") 'read-more 'read-less)))
(propertize
(mastodon-search--format-heading
(mastodon-tl--make-link (format "READ %s" str) type)
nil :no-newline)
'mastodon-content-warning-body cw
'invisible invis)))
(defun mastodon-tl--fold-body (body)
"Fold toot BODY if it is very long.
Folding decided by `mastodon-tl--fold-toots-at-length'."
(let* ((invis (get-text-property (1- (length body)) 'invisible body))
(cw (get-text-property (1- (length body))
'mastodon-content-warning-body body))
(heading (mastodon-tl--read-more-or-less "MORE" cw invis))
(display (concat (substring body 0
mastodon-tl--fold-toots-at-length)
heading)))
(propertize display
'read-more body)))
(defun mastodon-tl-unfold-post (&optional fold)
"Unfold the toot at point if it is folded (read-more).
FOLD means to fold it instead."
(interactive)
(let ((at-byline (mastodon-tl--property 'byline :no-move)))
(if (save-excursion
(when (not at-byline)
(mastodon-tl-goto-next-item))
(not (mastodon-tl--property 'toot-foldable :no-move)))
(user-error "No foldable item at point?")
(let* ((inhibit-read-only t)
(body-range (mastodon-tl--find-property-range 'toot-body
(point) :backward))
(cw-range (mastodon-tl--find-property-range
'mastodon-content-warning-body
(point) :backward))
(cw-invis (when cw-range
(get-text-property (car cw-range) 'invisible)))
(toot (mastodon-tl--property 'item-json :no-move))
;; `replace-region-contents' is much too slow, our hack from
;; fedi.el is much simpler and much faster:
(beg (car body-range))
(end (cdr body-range))
(last-point (point))
(point-after-fold (> last-point
(+ beg mastodon-tl--fold-toots-at-length))))
;; save-excursion here useless actually:
;; FIXME: because point goes to top of item, the screen gets scrolled
;; by insertion
(goto-char beg)
(delete-region beg end)
(delete-char 1) ;; prevent newlines accumulating
;; insert toot body:
(mastodon-tl--toot toot nil nil nil (not fold) :no-byline
(unless cw-invis :cw-expanded)) ;; respect CW state
;; set toot-folded prop on entire toot (not just body):
(let ((toot-range ;; post fold action range:
(mastodon-tl--find-property-range 'item-json
(point) :backward)))
(add-text-properties (car toot-range)
(cdr toot-range)
`(toot-folded ,fold)))
;; try to leave point somewhere sane:
(cond ((or at-byline
(and fold point-after-fold)) ;; point was in area now folded
(ignore-errors (forward-line -1)) ;; in case we are between
(mastodon-tl-goto-next-item)) ;; goto byline
(t
(goto-char last-point)
(when point-after-fold ;; point was in READ MORE heading:
(beginning-of-line))))
(message (format "%s toot" (if fold "Fold" "Unfold")))))))
(defun mastodon-tl-fold-post ()
"Fold post at point, if it is too long."
(interactive)
(mastodon-tl-unfold-post :fold))
(defun mastodon-tl-fold-post-toggle ()
"Toggle the folding status of the toot at point."
(interactive)
(let* ((folded (mastodon-tl--property 'toot-folded :no-move)))
(mastodon-tl-unfold-post (not folded))))
;;; TOOT STATS
;; calqued off mastodon-alt.el:
(defun mastodon-tl--toot-for-stats (&optional toot)
"Return the TOOT on which we want to extract stats.
If no TOOT is given, the one at point is considered."
(let* ((original-toot (or toot (get-text-property (point) 'item-json)))
(toot (or (alist-get 'status original-toot)
(when (alist-get 'type original-toot)
original-toot)
(alist-get 'reblog original-toot)
original-toot))
(type (alist-get 'type (or toot))))
(unless (member type '("follow" "follow_request"))
toot)))
(defun mastodon-tl--toot-stats (toot)
"Return a right aligned string (using display align-to).
String is filled with TOOT statistics (boosts, favs, replies).
When the TOOT is a reblog (boost), statistics from reblogged
toots are returned.
To disable showing the stats, customize
`mastodon-tl--show-stats'."
(let-alist (mastodon-tl--toot-for-stats toot)
(let* ((faves-prop (propertize (format "%s" .favourites_count)
'favourites-count .favourites_count))
(boosts-prop (propertize (format "%s" .reblogs_count)
'boosts-count .reblogs_count))
(faves (format "%s %s" faves-prop (mastodon-tl--symbol 'favourite)))
(boosts (format "%s %s" boosts-prop (mastodon-tl--symbol 'boost)))
(replies (format "%s %s" .replies_count (mastodon-tl--symbol 'reply)))
(stats (concat
(propertize faves
'favourited-p (eq t .favourited)
'favourites-field t
'help-echo (format "%s favourites" .favourites_count)
'face 'mastodon-toot-docs-face)
(propertize " | " 'face 'mastodon-toot-docs-face)
(propertize boosts
'boosted-p (eq t .reblogged)
'boosts-field t
'help-echo (format "%s boosts" .reblogs_count)
'face 'mastodon-toot-docs-face)
(propertize " | " 'face 'mastodon-toot-docs-face)
(propertize replies
'replies-field t
'replies-count .replies_count
'help-echo (format "%s replies" .replies_count)
'face 'mastodon-toot-docs-face)))
(right-spacing
(propertize " "
'display
`(space :align-to (- right ,(+ (length stats) 7))))))
(concat right-spacing stats))))
;;; BUFFER SPEC
(defun mastodon-tl--update-function (&optional buffer)
"Get the UPDATE-FUNCTION stored in `mastodon-tl--buffer-spec'.
Optionally get it for BUFFER."
(mastodon-tl--buffer-property 'update-function buffer))
(defun mastodon-tl--endpoint (&optional buffer no-error)
"Get the ENDPOINT stored in `mastodon-tl--buffer-spec'.
Optionally set it for BUFFER.
NO-ERROR means to fail silently."
(mastodon-tl--buffer-property 'endpoint buffer no-error))
(defun mastodon-tl--buffer-name (&optional buffer no-error)
"Get the BUFFER-NAME stored in `mastodon-tl--buffer-spec'.
Optionally get it for BUFFER.
NO-ERROR means to fail silently."
(mastodon-tl--buffer-property 'buffer-name buffer no-error))
(defun mastodon-tl--link-header (&optional buffer)
"Get the LINK HEADER stored in `mastodon-tl--buffer-spec'.
Optionally get it for BUFFER."
(mastodon-tl--buffer-property 'link-header buffer :no-error))
(defun mastodon-tl--update-params (&optional buffer)
"Get the UPDATE PARAMS stored in `mastodon-tl--buffer-spec'.
Optionally get it for BUFFER."
(mastodon-tl--buffer-property 'update-params buffer :no-error))
(defun mastodon-tl--buffer-property (property &optional buffer no-error)
"Get PROPERTY from `mastodon-tl--buffer-spec' in BUFFER or `current-buffer'.
If NO-ERROR is non-nil, do not error when property is empty."
(with-current-buffer (or buffer (current-buffer))
(if no-error
(plist-get mastodon-tl--buffer-spec property)
(or (plist-get mastodon-tl--buffer-spec property)
(error "Mastodon-tl--buffer-spec not defined for buffer %s, prop %s"
(or buffer (current-buffer))
property)))))
(defun mastodon-tl--set-buffer-spec
(buffer endpoint update-fun
&optional link-header update-params hide-replies max-id
thread-item-id)
"Set `mastodon-tl--buffer-spec' for the current buffer.
BUFFER is buffer name, ENDPOINT is buffer's enpoint,
UPDATE-FUN is its update function.
LINK-HEADER is the http Link header if present.
UPDATE-PARAMS is any http parameters needed for the update function.
HIDE-REPLIES is a flag indicating if replies are hidden in the current buffer.
MAX-ID is the pagination parameter.
THREAD-ITEM-ID is the ID of the item in thread that we opened the thread with."
(setq mastodon-tl--buffer-spec
`( account ,(cons mastodon-active-user mastodon-instance-url)
buffer-name ,buffer
endpoint ,endpoint
update-function ,update-fun
link-header ,link-header
update-params ,update-params
hide-replies ,hide-replies
max-id ,max-id
thread-item-id ,thread-item-id)))
;;; BUFFERS
(defun mastodon-tl--endpoint-str-= (str &optional type)
"Return T if STR is equal to the current buffer's endpoint.
TYPE may be :prefix or :suffix, in which case, T if STR is a prefix or suffix."
(let ((endpoint-fun (mastodon-tl--endpoint nil :no-error)))
(cond ((eq type :prefix)
(string-prefix-p str endpoint-fun))
((eq type :suffix)
(string-suffix-p str endpoint-fun))
(t
(string= str endpoint-fun)))))
(defun mastodon-tl--get-buffer-type ()
"Return a symbol descriptive of current mastodon buffer type.
Should work in all mastodon buffers.
Note that for many buffers, this requires `mastodon-tl--buffer-spec'
to be set. It is set for almost all buffers, but you still have to
call this function after it is set or use something else."
(let ((buffer-name (mastodon-tl--buffer-name nil :no-error)))
(cond (mastodon-toot-mode
;; composing/editing (no buffer spec):
(if (string= "*edit toot*" (buffer-name))
'edit-toot
'new-toot))
;; main timelines:
((mastodon-tl--endpoint-str-= "timelines/home")
'home)
((string= "*mastodon-local*" buffer-name)
'local)
((mastodon-tl--endpoint-str-= "timelines/public")
'federated)
((mastodon-tl--endpoint-str-= "timelines/tag/" :prefix)
'tag-timeline)
((mastodon-tl--endpoint-str-= "timelines/list/" :prefix)
'list-timeline)
;; notifs:
((string-suffix-p "mentions*" buffer-name)
'mentions)
((mastodon-tl--endpoint-str-= "notifications")
'notifications)
((mastodon-tl--endpoint-str-= "notifications/requests")
'notification-requests)
;; threads:
((mastodon-tl--endpoint-str-= "context" :suffix)
'thread)
((mastodon-tl--endpoint-str-= "statuses" :prefix)
'single-status)
;; profiles:
((mastodon-tl--profile-buffer-p)
(cond
;; an own profile option is needlessly confusing e.g. for
;; `mastodon-profile-account-view-cycle'
;; profile note:
((string-suffix-p "update-profile*" buffer-name)
'update-profile-note)
;; posts inc. boosts:
((string-suffix-p "no-boosts*" buffer-name)
'profile-statuses-no-boosts)
((string-suffix-p "no-replies*" buffer-name)
'profile-statuses-no-replies)
((string-suffix-p "only-media*" buffer-name)
'profile-statuses-only-media)
((string-match-p "-tagged-" buffer-name)
'profile-statuses-tagged)
((mastodon-tl--endpoint-str-= "statuses" :suffix)
'profile-statuses)
;; profile followers
((mastodon-tl--endpoint-str-= "followers" :suffix)
'profile-followers)
;; profile following
((mastodon-tl--endpoint-str-= "following" :suffix)
'profile-following)))
((mastodon-tl--endpoint-str-= "preferences")
'preferences)
;; search
((mastodon-tl--search-buffer-p)
(cond ((string= "accounts" (mastodon-search--buf-type))
'search-accounts)
((string= "hashtags" (mastodon-search--buf-type))
'search-hashtags)
((string= "statuses" (mastodon-search--buf-type))
'search-statuses)))
;; trends
((mastodon-tl--endpoint-str-= "trends/statuses")
'trending-statuses)
((mastodon-tl--endpoint-str-= "trends/tags")
'trending-tags)
((mastodon-tl--endpoint-str-= "trends/links")
'trending-links)
;; User's views:
((mastodon-tl--endpoint-str-= "filters")
'filters)
((mastodon-tl--endpoint-str-= "lists")
'lists)
((mastodon-tl--endpoint-str-= "suggestions")
'follow-suggestions)
((mastodon-tl--endpoint-str-= "favourites")
'favourites)
((mastodon-tl--endpoint-str-= "bookmarks")
'bookmarks)
((mastodon-tl--endpoint-str-= "follow_requests")
'follow-requests)
((mastodon-tl--endpoint-str-= "scheduled_statuses")
'scheduled-statuses)
;; instance description
((mastodon-tl--endpoint-str-= "instance")
'instance-description)
((string= "*mastodon-toot-edits*" buffer-name)
'toot-edits)
((string= "*masto-image*" (buffer-name))
'mastodon-image)
((mastodon-tl--endpoint-str-= "timelines/link")
'link-timeline)
((mastodon-tl--endpoint-str-= "announcements")
'announcements)
;; followed hashtags
((mastodon-tl--endpoint-str-= "followed_tags")
'followed-hashtags))))
(defun mastodon-tl--buffer-type-eq (type)
"Return t if current buffer type is equal to symbol TYPE."
(eq (mastodon-tl--get-buffer-type) type))
(defun mastodon-tl--profile-buffer-p ()
"Return t if current buffer is a profile buffer of any kind.
This includes the update profile note buffer, but not the preferences one."
(string-prefix-p "accounts" (mastodon-tl--endpoint nil :no-error)))
(defun mastodon-tl--own-profile-buffer-p ()
"Return t if we are viewing our own profile buffer.
We check that our account credientials id matches the endpoint id in the
buffer spec, which if in a profile buffer is of the form
\"accounts/$id/statuses\"."
(and (mastodon-tl--profile-buffer-p)
(let ((endpoint-id
(nth 1
(split-string (mastodon-tl--endpoint) "/"))))
(string= (mastodon-auth--get-account-id)
endpoint-id))))
(defun mastodon-tl--search-buffer-p ()
"T if current buffer is a search buffer."
(string-suffix-p "search" (mastodon-tl--endpoint nil :no-error)))
(defun mastodon-tl--timeline-proper-p ()
"Return non-nil if the current buffer is a \"proper\" timeline.
A proper timeline excludes notifications, threads, profiles, and
other toot buffers that aren't strictly mastodon timelines."
(let ((timeline-buffers
'(home federated local tag-timeline list-timeline profile-statuses)))
(member (mastodon-tl--get-buffer-type) timeline-buffers)))
(defun mastodon-tl--hide-replies-p (&optional prefix)
"Return non-nil if replies should be hidden in the timeline.
We hide replies if user explictly set the
`mastodon-tl--hide-replies' or used PREFIX combination to open a
timeline."
(and (mastodon-tl--timeline-proper-p) ; Only if we are in a proper timeline
(or (mastodon-tl--buffer-property 'hide-replies nil :noerror)
mastodon-tl--hide-replies ; User configured to hide replies
(equal '(4) prefix)))) ; Timeline called with C-u prefix
;;; UTILITIES
(defun mastodon-tl--clean-tabs-and-nl (string)
"Remove tabs and newlines from STRING."
(replace-regexp-in-string "[\t\n ]*\\'" "" string))
(defun mastodon-tl--map-alist (key alists &optional testfn)
"Return a list of values extracted from ALISTS with KEY.
Key is a symbol, as with `alist-get', or else compatible with TESTFN.
ALISTS is a list of alists."
;; this actually for a list of alists, right? so change the arg?
(cl-loop for x in alists
collect (alist-get key x nil nil testfn)))
(defun mastodon-tl--map-alist-vals-to-alist (key1 key2 alist)
"From ALIST, return an alist consisting of (val1 . val2) elements.
Values are accessed by `alist-get', using KEY1 and KEY2."
(cl-loop for x in alist
collect (cons (alist-get key1 x)
(alist-get key2 x))))
(defun mastodon-tl--symbol (name)
"Return the unicode symbol (as a string) corresponding to NAME.
If symbol is not displayable, an ASCII equivalent is returned. If
NAME is not part of the symbol table, '?' is returned."
(if-let* ((symbol (alist-get name mastodon-tl--symbols)))
(if (char-displayable-p (string-to-char (car symbol)))
(car symbol)
(cdr symbol))
"?"))
(defun mastodon-tl--set-face (string face)
"Return the propertized STRING with the face property set to FACE."
(propertize string 'face face))
(defun mastodon-tl--field (field toot)
"Return FIELD from TOOT.
Return value from boosted content if available."
(or (alist-get field (alist-get 'reblog toot))
(alist-get field toot)))
(defun mastodon-tl--field-status (field toot)
"Return FIELD from TOOT.
Return value from status field if available."
(or (alist-get field (alist-get 'status toot))
(alist-get field toot)))
(defun mastodon-tl--remove-html (toot)
"Remove unrendered tags from TOOT."
(let* ((t1 (replace-regexp-in-string "<\/p>" "\n\n" toot))
(t2 (replace-regexp-in-string "<\/?span>" "" t1)))
(replace-regexp-in-string "" "" t2)))
(defun mastodon-tl--property (prop &optional no-move backward)
"Get property PROP for toot at point.
Move forward (down) the timeline unless NO-MOVE is non-nil.
BACKWARD means move backward (up) the timeline."
(if no-move
(get-text-property (point) prop)
;; NB: this doesn't differentiate absence of property from
;; property set to zero, making flag props fraught:
(or (get-text-property (point) prop)
(save-excursion
(if backward
(mastodon-tl-goto-prev-item)
(mastodon-tl-goto-next-item))
(get-text-property (point) prop)))))
(defun mastodon-tl--newest-id ()
"Return item-id from the top of the buffer.
If we are in a notifications view, return `notifications-max-id'."
(save-excursion
(goto-char (point-min))
(mastodon-tl--property
(if (eq (mastodon-tl--get-buffer-type)
(member (mastodon-tl--get-buffer-type)
'(mentions notifications)))
'notifications-max-id
'item-id))))
(defun mastodon-tl--oldest-id ()
"Return item-id from the bottom of the buffer.
If we are in a notifications view, return `notifications-min-id'."
(save-excursion
(goto-char (point-max))
(mastodon-tl--property
(if (and mastodon-group-notifications
(member (mastodon-tl--get-buffer-type)
'(mentions notifications)))
'notifications-min-id
'item-id)
nil :backward)))
(defun mastodon-tl--as-string (numeric)
"Convert NUMERIC to string."
(cond ((numberp numeric)
(number-to-string numeric))
((stringp numeric) numeric)
(t (error "Numeric: %s must be either a string or a number"
numeric))))
(defun mastodon-tl--item-id (json)
"Find approproiate toot id in JSON.
If the toot has been boosted use the id found in the
reblog portion of the toot. Otherwise, use the body of
the toot. This is the same behaviour as the mastodon.social
webapp"
(let-alist json
(if .reblog .reblog.id .id)))
(defun mastodon-tl--toot-or-base (json)
"Return the base toot or just the toot from toot JSON."
(or (alist-get 'reblog json) json))
;;; THREADS
(defun mastodon-tl-view-single-toot ()
"View toot at point in a separate buffer."
(interactive)
(let ((id (mastodon-tl--property 'base-item-id)))
(mastodon-tl--single-toot id)))
(defun mastodon-tl--single-toot (id)
"View toot in separate buffer.
ID is that of the toot to view."
(let* ((buffer (format "*mastodon-toot-%s*" id))
(toot (mastodon-http--get-json
(mastodon-http--api (concat "statuses/" id)))))
(if (eq (caar toot) 'error)
(user-error "Error: %s" (cdar toot))
(with-mastodon-buffer buffer #'mastodon-mode nil
(mastodon-tl--set-buffer-spec buffer (format "statuses/%s" id)
#'mastodon-tl--update-toot
;; id for reload on reply:
nil nil nil nil id)
(mastodon-tl--toot toot :detailed-p)
(goto-char (point-min))
(when mastodon-tl--display-media-p
(mastodon-media--inline-images (point-min)
(point-max)))
(mastodon-tl-goto-next-item :no-refresh)))))
(defun mastodon-tl--update-toot (json)
"Call `mastodon-tl-single-toot' on id found in JSON."
(let ((id (alist-get 'id json)))
(mastodon-tl--single-toot id)))
(defun mastodon-tl-view-whole-thread ()
"From a thread view, view entire thread.
If you load a thread from a toot, only the branches containing
are displayed by default. Call this if you subsequently want to
view all branches of a thread."
(interactive)
(if (not (eq (mastodon-tl--get-buffer-type) 'thread))
(user-error "You need to be viewing a thread to call this")
(goto-char (point-min))
(let ((id (mastodon-tl--property 'base-item-id)))
(mastodon-tl--thread-do id))))
(defun mastodon-tl-return ()
"Load user profile or thread of item at point.
If item at point is a follow or follow request, load user profile.
Else load thread."
(interactive)
(let ((notif (mastodon-tl--property 'notification-type)))
(if (or (equal "follow" notif)
(equal "follow_request" notif))
(let* ((json (mastodon-tl--property 'item-json))
(handle (alist-get 'acct json)))
(mastodon-profile-show-user handle))
(mastodon-tl-thread))))
(defun mastodon-tl-thread ()
"Open thread buffer for toot at point."
(interactive)
(if (not (eq 'toot (mastodon-tl--property 'item-type :no-move)))
(user-error "Looks like there's no toot at point?")
(mastodon-tl--thread-do)))
(defun mastodon-tl--thread-do (&optional thread-id)
"Open thread buffer for toot at point or with THREAD-ID.
This is the non-interactive version, so we can call it
programmatically and not crash into
`mastodon-toot--with-toot-item'."
;; this function's var must not be id as the above macro binds id and
;; even if we provide the arg (e.g. url-lookup), the macro definition
;; overrides it, making the optional arg unusable!
(let* ((id (or thread-id (mastodon-tl--property 'base-item-id :no-move)))
(type
(if (and (mastodon-tl--buffer-type-eq 'notifications)
mastodon-group-notifications)
(mastodon-tl--property 'notification-type)
(mastodon-tl--field 'type
(mastodon-tl--property 'item-json :no-move))))
(unfolded-state (mastodon-tl--buffer-property 'thread-unfolded
(current-buffer) :noerror))
(mastodon-tl--expand-content-warnings
;; if reloading and thread was explicitly (un)folded, respect it:
(or (pcase unfolded-state
('folded nil)
('unfolded t)
(_ mastodon-tl--expand-content-warnings)))))
(if (or (string= type "follow_request")
(string= type "follow")) ; no can thread these
(user-error "No thread")
(let* ((endpoint (format "statuses/%s/context" id))
(url (mastodon-http--api endpoint))
(buffer (format "*mastodon-thread-%s*" id))
(toot (mastodon-http--get-json ; refetch in case we just faved/boosted:
(mastodon-http--api (concat "statuses/" id))
nil :silent))
(context (mastodon-http--get-json url nil :silent)))
(if (eq (caar toot) 'error)
(user-error "Error: %s" (cdar toot))
(when (member (alist-get 'type toot) '("reblog" "favourite"))
(setq toot (alist-get 'status toot)))
(if (not (< 0 (+ (length (alist-get 'ancestors context))
(length (alist-get 'descendants context)))))
;; just print the lone toot:
(mastodon-tl--single-toot id)
;; we have a thread:
(with-mastodon-buffer buffer #'mastodon-mode nil
(let ((marker (make-marker)))
(mastodon-tl--set-buffer-spec buffer endpoint
#'mastodon-tl--thread-do
nil nil nil nil id)
(when unfolded-state
(plist-put mastodon-tl--buffer-spec
'thread-unfolded unfolded-state))
(when-let* ((ancestors (alist-get 'ancestors context)))
(mastodon-tl--timeline ancestors :thread))
(goto-char (point-max))
(move-marker marker (point))
;; print re-fetched toot:
(mastodon-tl--toot toot :detailed-p :thread)
;; inline images only for the toot
;; (`mastodon-tl--timeline' handles the rest):
(when mastodon-tl--display-media-p
(mastodon-media--inline-images marker ;start-pos
(point)))
(when-let* ((descendants (alist-get 'descendants context)))
(mastodon-tl--timeline descendants :thread))
;; put point at the toot:
(goto-char (marker-position marker))
(mastodon-tl-goto-next-item :no-refresh)))))))))
(defun mastodon-tl-mute-thread ()
"Mute the thread displayed in the current buffer.
Note that you can only (un)mute threads you have posted in."
(interactive)
(mastodon-tl--mute-or-unmute-thread))
(defun mastodon-tl-unmute-thread ()
"Unmute the thread displayed in the current buffer.
Note that you can only (un)mute threads you have posted in."
(interactive)
(mastodon-tl--mute-or-unmute-thread :unmute))
(defun mastodon-tl--thread-parent-id ()
"Return the ID of the top item in a thread."
(save-excursion
(mastodon-tl--goto-first-item)
(mastodon-tl--property 'base-item-id :no-move)))
(defun mastodon-tl--mute-or-unmute-thread (&optional unmute)
"Mute a thread.
If UNMUTE, unmute it."
(let ((mute-str (if unmute "unmute" "mute")))
(when (or (mastodon-tl--buffer-type-eq 'thread)
(mastodon-tl--buffer-type-eq 'notifications))
(let* ((id
;; the id for `mastodon-tl--user-in-thread-p' ought to be the
;; top-level item:
(if (mastodon-tl--buffer-type-eq 'notifications)
(mastodon-tl--property 'base-item-id :no-move)
(mastodon-tl--thread-parent-id)))
(we-posted-p (mastodon-tl--user-in-thread-p id))
(url (mastodon-http--api (format "statuses/%s/%s" id mute-str))))
(if (not we-posted-p)
(user-error "You can only (un)mute a thread you have posted in")
(when (y-or-n-p (format "%s this thread? " (capitalize mute-str)))
(let ((response (mastodon-http--post url)))
(mastodon-http--triage
response
(lambda (_)
(message (format "Thread %sd!" mute-str)))))))))))
(defun mastodon-tl--map-account-id-from-toot (statuses)
"Return a list of the account IDs of the author of each toot in STATUSES."
(mapcar (lambda (status)
(map-nested-elt status '(account id)))
statuses))
(defun mastodon-tl--user-in-thread-p (id)
"Return non-nil if the logged-in user has posted to the current thread.
ID is that of the post the context is currently displayed for."
(let* ((context-json (mastodon-http--get-json
(mastodon-http--api (format "statuses/%s/context" id))
nil :silent))
(ancestors (alist-get 'ancestors context-json))
(descendants (alist-get 'descendants context-json))
(a-ids (mastodon-tl--map-account-id-from-toot ancestors))
(d-ids (mastodon-tl--map-account-id-from-toot descendants)))
(or (member (mastodon-auth--get-account-id) a-ids)
(member (mastodon-auth--get-account-id) d-ids))))
;;; FOLLOW/BLOCK/MUTE, ETC
(defun mastodon-tl-follow-user (user-handle
&optional notify langs reblogs json)
"Query for USER-HANDLE from current status and follow that user.
If NOTIFY is \"true\", enable notifications when that user posts.
If NOTIFY is \"false\", disable notifications when that user posts.
Can be called to toggle NOTIFY on users already being followed.
LANGS is an array parameters alist of languages to filer user's posts by.
REBLOGS is a boolean string like NOTIFY, enabling or disabling
display of the user's boosts in your timeline.
JSON is a flag arg for `mastodon-http--post'."
(interactive (list (mastodon-tl--user-handles-get "follow")))
(mastodon-tl--do-if-item
(mastodon-tl--do-user-action-and-response
user-handle "follow" nil notify langs reblogs json)))
(defun mastodon-tl-follow-user-by-handle (user-handle)
"Prompt for a USER-HANDLE and follow that user.
USER-HANDLE can also be a URL to a user profile page."
;; code adapted from sachac:
;; https://sachachua.com/dotemacs/index.html#mastodon. thanks sachac!
(interactive "MHandle: ")
(when (string-match "https?://\\(.+?\\)/\\(@.+\\)" user-handle)
(setq user-handle
;; sachac's model doesn't work with local user handles in URL,
;; meaning the search below will fail, so we use our own
;; URL-to-handle function, modified for the purpose:
;; (concat (match-string 2 user-handle) "@" (match-string 1 user-handle))))
(mastodon-tl--userhandle-from-url user-handle)))
(let* ((account (mastodon-profile--search-account-by-handle
user-handle))
(user-id (alist-get 'id account))
(name (if (not (string-empty-p
(alist-get 'display_name account)))
(alist-get 'display_name account)
(alist-get 'username account)))
(url (mastodon-http--api (format "accounts/%s/%s" user-id "follow"))))
(if account
(mastodon-tl--do-user-action-function url name
(substring user-handle 1) "follow")
(user-error "Cannot find a user with handle %S" user-handle))))
;; TODO: make this action "enable/disable notifications"
(defun mastodon-tl-enable-notify-user-posts (user-handle)
"Query for USER-HANDLE and enable notifications when they post."
(interactive (list (mastodon-tl--user-handles-get "enable")))
(mastodon-tl--do-if-item
(mastodon-tl-follow-user user-handle "true")))
(defun mastodon-tl-disable-notify-user-posts (user-handle)
"Query for USER-HANDLE and disable notifications when they post."
(interactive (list (mastodon-tl--user-handles-get "disable")))
(mastodon-tl-follow-user user-handle "false"))
(defun mastodon-tl-follow-user-disable-boosts (user-handle)
"Prompt for a USER-HANDLE, and disable display of boosts in home timeline.
If they are also not yet followed, follow them."
(interactive (list (mastodon-tl--user-handles-get "disable boosts")))
(mastodon-tl-follow-user user-handle nil nil "false"))
(defun mastodon-tl-follow-user-enable-boosts (user-handle)
"Prompt for a USER-HANDLE, and enable display of boosts in home timeline.
If they are also not yet followed, follow them.
You only need to call this if you have previously disabled
display of boosts."
(interactive (list (mastodon-tl--user-handles-get "enable boosts")))
(mastodon-tl-follow-user user-handle nil nil "true"))
(defun mastodon-tl-filter-user-user-posts-by-language (user-handle)
"Query for USER-HANDLE and filter display of their posts by language.
If they are not already followed, they will be too.
To be filtered, a post has to be marked as in the language given.
This may mean that you will not see posts that are in your
desired language if they are not marked as such (or as anything)."
(interactive (list (mastodon-tl--user-handles-get "filter by language")))
(let ((langs (mastodon-tl--read-filter-langs)))
(mastodon-tl--do-if-item
(if (string= "" (cdar langs))
(mastodon-tl-unfilter-user-languages user-handle)
(mastodon-tl-follow-user user-handle nil langs)))))
(defun mastodon-tl-unfilter-user-languages (user-handle)
"Remove any language filters for USER-HANDLE.
This means you will receive posts of theirs marked as being in
any or no language."
(interactive (list (mastodon-tl--user-handles-get "filter by language")))
(let ((langs "languages[]"))
(mastodon-tl--do-if-item
;; we need "languages[]" as a param, with no "=" and not json-encoded as
;; a string
(mastodon-tl-follow-user user-handle nil langs nil :raw))))
(defun mastodon-tl--read-filter-langs (&optional langs)
"Read language choices and return an alist array parameter.
LANGS is the accumulated array param alist if we re-run recursively."
(let* ((iso-const mastodon-iso-639-1)
(iso (cons '("None (all)" . "") iso-const))
(langs-alist langs)
(choice (completing-read "Filter user's posts by language: "
iso)))
(when choice
(setq langs-alist
(push `("languages[]" . ,(alist-get choice iso
nil nil #'string=))
langs-alist))
(if (y-or-n-p "Filter by another language? ")
(mastodon-tl--read-filter-langs langs-alist)
langs-alist))))
(defun mastodon-tl-unfollow-user (user-handle)
"Query for USER-HANDLE from current status and unfollow that user."
(interactive (list (mastodon-tl--user-handles-get "unfollow")))
(mastodon-tl--do-if-item
(mastodon-tl--do-user-action-and-response user-handle "unfollow" t)))
(defun mastodon-tl-block-user (user-handle)
"Query for USER-HANDLE from current status and block that user."
(interactive (list (mastodon-tl--user-handles-get "block")))
(mastodon-tl--do-if-item
(mastodon-tl--do-user-action-and-response user-handle "block")))
(defun mastodon-tl-unblock-user (user-handle)
"Query for USER-HANDLE from list of blocked users and unblock that user."
(interactive (list (mastodon-tl--get-blocks-or-mutes-list "unblock")))
(if (not user-handle)
(user-error "Looks like you have no blocks to unblock!")
(mastodon-tl--do-user-action-and-response user-handle "unblock" t)))
(defun mastodon-tl-mute-user (user-handle)
"Query for USER-HANDLE from current status and mute that user."
(interactive (list (mastodon-tl--user-handles-get "mute")))
(mastodon-tl--do-if-item
(mastodon-tl--do-user-action-and-response user-handle "mute")))
(defun mastodon-tl-unmute-user (user-handle)
"Query for USER-HANDLE from list of muted users and unmute that user."
(interactive (list (mastodon-tl--get-blocks-or-mutes-list "unmute")))
(if (not user-handle)
(user-error "Looks like you have no mutes to unmute!")
(mastodon-tl--do-user-action-and-response user-handle "unmute" t)))
(defun mastodon-tl-dm-user (user-handle)
"Query for USER-HANDLE from current status and compose a message to that user."
(interactive (list (mastodon-tl--user-handles-get "message")))
(mastodon-tl--do-if-item
(mastodon-toot--compose-buffer (concat "@" user-handle))
(setq mastodon-toot--visibility "direct")
(mastodon-toot--update-status-fields)))
(defun mastodon-tl--user-handles-get (action)
"Get the list of user-handles for ACTION from the current toot."
(mastodon-tl--do-if-item
(let ((user-handles
(cond
((or ; follow suggests / search / foll requests compat:
(member (mastodon-tl--get-buffer-type)
'( follow-suggestions search follow-requests
;; profile follows/followers but not statuses:
profile-followers profile-following)))
;; fetch 'item-json:
(list (alist-get 'acct
(mastodon-tl--property 'item-json :no-move))))
;; profile view, point in profile details, poss no toots
;; needed for e.g. gup.pe groups which show no toots publically:
((and (mastodon-tl--profile-buffer-p)
(get-text-property (point) 'profile-json))
(list (alist-get 'acct
(mastodon-profile--profile-json))))
;; (grouped) notifications:
((member (mastodon-tl--get-buffer-type) '(mentions notifications))
(append ;; those acting on item:
(cl-remove-duplicates
(cl-loop for a in (mastodon-tl--property
'notification-accounts :no-move)
collect (alist-get 'acct a)))
;; mentions in item:
(mastodon-profile--extract-users-handles
(mastodon-profile--item-json))))
(t
(mastodon-profile--extract-users-handles
(mastodon-profile--item-json))))))
(completing-read
(cond ((or ; TODO: make this "enable/disable notifications"
(string= action "disable")
(string= action "enable"))
(format "%s notifications when user posts: " action))
((string-suffix-p "boosts" action)
(format "%s by user: " action))
(t (format "Handle of user to %s: " action)))
user-handles nil ; predicate
'confirm))))
(defun mastodon-tl--get-blocks-or-mutes-list (action)
"Fetch the list of accounts for ACTION from the server.
Action must be either \"unblock\" or \"unmute\"."
(let* ((endpoint (cond ((string= action "unblock")
"blocks")
((string= action "unmute")
"mutes")))
(url (mastodon-http--api endpoint))
(json (mastodon-http--get-json url))
(accts (mastodon-tl--map-alist 'acct json)))
(when accts
(completing-read (format "Handle of user to %s: " action)
accts nil :match))))
(defun mastodon-tl--do-user-action-and-response
(user-handle action &optional negp notify langs reblogs json)
"Do ACTION on user USER-HANDLE.
NEGP is whether the action involves un-doing something.
If NOTIFY is \"true\", enable notifications when that user posts.
If NOTIFY is \"false\", disable notifications when that user posts.
NOTIFY is only non-nil when called by `mastodon-tl-follow-user'.
LANGS is an array parameters alist of languages to filer user's posts by.
REBLOGS is a boolean string like NOTIFY, enabling or disabling
display of the user's boosts in your timeline."
(let* ((account
(cond
(negp ;; unmuting/unblocking, use mute/block list
(mastodon-profile--search-account-by-handle user-handle))
;; (grouped) notifications:
((member (mastodon-tl--get-buffer-type)
'(mentions notifications))
(let ((accounts (mastodon-tl--property 'notification-accounts)))
(or (cl-some (lambda (x)
(when (string= user-handle (alist-get 'acct x))
x))
accounts)
(mastodon-profile--lookup-account-in-status
user-handle
(mastodon-profile--item-json)))))
(t
(mastodon-profile--lookup-account-in-status
user-handle
(if (mastodon-tl--profile-buffer-p)
;; profile view, use 'profile-json as status:
(mastodon-profile--profile-json)
;; muting/blocking, select from handles in current status
(mastodon-profile--item-json))))))
(user-id (alist-get 'id account))
(name (mastodon-tl--display-or-uname account))
(args (cond (notify `(("notify" . ,notify)))
(langs langs)
(reblogs `(("reblogs" . ,reblogs)))
(t nil)))
(url (mastodon-http--api (format "accounts/%s/%s" user-id action))))
(if (not account)
(user-error "Cannot find a user with handle %S" user-handle)
(when (or (string= action "follow") ;; y-or-n for all but follow
(y-or-n-p (format "%s user %s? " action name)))
(mastodon-tl--do-user-action-function
url name user-handle action notify args reblogs json)))))
(defun mastodon-tl--do-user-action-function
(url name user-handle action &optional notify args reblogs json)
"Post ACTION on user NAME/USER-HANDLE to URL.
NOTIFY is either \"true\" or \"false\", and used when we have been called
by `mastodon-tl-follow-user' to enable or disable notifications.
ARGS is an alist of any parameters to send with the request."
(let ((response (mastodon-http--post url args nil nil json)))
(mastodon-http--triage
response
(lambda (response)
(let ((json (with-current-buffer response
(mastodon-http--process-json))))
;; TODO: when > if, with failure msg
(cond ((string= notify "true")
(when (eq t (alist-get 'notifying json))
(message "Receiving notifications for user %s (@%s)!"
name user-handle)))
((string= notify "false")
(when (eq :json-false (alist-get 'notifying json))
(message "Not receiving notifications for user %s (@%s)!"
name user-handle)))
((string= reblogs "true")
(when (eq t (alist-get 'showing_reblogs json))
(message "Receiving boosts by user %s (@%s)!"
name user-handle)))
((string= reblogs "false")
(when (eq :json-false (alist-get 'showing_reblogs json))
(message "Not receiving boosts by user %s (@%s)!"
name user-handle)))
((or (string= action "mute")
(string= action "unmute"))
(message "User %s (@%s) %sd!" name user-handle action))
((string= args "languages[]")
(message "User %s language filters removed!" name))
((assoc "languages[]" args #'string=)
(message "User %s filtered by language(s): %s" name
(mapconcat #'cdr args " ")))
((not (or notify reblogs))
(if (and (string= action "follow")
(eq t (alist-get 'requested json)))
(message "Follow requested for user %s (@%s)!" name user-handle)
(message "User %s (@%s) %sed!" name user-handle action)))))))))
(defun mastodon-tl--get-domain-blocks ()
"Return a list of current domain blocks."
(mastodon-http--get-json
(mastodon-http--api "domain_blocks")))
(defun mastodon-tl-block-domain ()
"Read a domain and block it."
(interactive)
(let* ((domain (read-string "Block domain: "))
(params `(("domain" . ,domain)))
(url (mastodon-http--api "domain_blocks"))
(resp (mastodon-http--post url params)))
(mastodon-http--triage
resp
(lambda (_)
(message "Domain blocked!")))))
(defun mastodon-tl-unblock-domain ()
"Read a blocked domain and unblock it."
(interactive)
(let ((blocks (mastodon-tl--get-domain-blocks)))
(if (not blocks)
(user-error "No blocked domains?")
(let* ((domain (completing-read "Unblock domain: "
blocks))
(params `(("domain" . ,domain)))
(url (mastodon-http--api "domain_blocks"))
(resp (mastodon-http--delete url params)))
(mastodon-http--triage
resp
(lambda (_)
(message "Domain unblocked!")))))))
;; FOLLOW TAGS
(defun mastodon-tl--get-tags-list ()
"Return the list of tags of the toot at point."
(let* ((toot (mastodon-toot--base-toot-or-item-json))
(tags (mastodon-tl--field 'tags toot)))
(mastodon-tl--map-alist 'name tags)))
(defun mastodon-tl-follow-tag (&optional tag)
"Prompt for a tag (from post at point) and follow it.
If TAG provided, follow it."
(interactive)
(let* ((tags (unless tag (mastodon-tl--get-tags-list)))
(tag-at-point
(unless tag
(when (eq 'hashtag
(mastodon-tl--property 'mastodon-tab-stop :no-move))
(mastodon-tl--property 'mastodon-tag :no-move))))
(tag (or tag (completing-read
(format "Tag to follow [%s]: " tag-at-point)
tags nil nil nil nil tag-at-point)))
(url (mastodon-http--api (format "tags/%s/follow" tag)))
(response (mastodon-http--post url)))
(mastodon-http--triage response
(lambda (_)
(message "tag #%s followed!" tag)))))
(defun mastodon-tl--followed-tags ()
"Return JSON of tags followed."
(let ((url (mastodon-http--api (format "followed_tags"))))
(mastodon-http--get-json url)))
(defun mastodon-tl-unfollow-tag (&optional tag)
"Prompt for a followed tag, and unfollow it.
If TAG is provided, unfollow it."
(interactive)
(let* ((followed-tags-json (unless tag (mastodon-tl--followed-tags)))
(tags (unless tag (mastodon-tl--map-alist 'name followed-tags-json)))
(tag (or tag (completing-read "Unfollow tag: " tags)))
(url (mastodon-http--api (format "tags/%s/unfollow" tag)))
(response (mastodon-http--post url)))
(mastodon-http--triage response
(lambda (_)
(message "tag #%s unfollowed!" tag)))))
(defun mastodon-tl-jump-to-followed-tag (&optional prefix)
"Prompt for a followed tag and view its timeline.
PREFIX is sent to `mastodon-tl-get-tag-timeline', which see."
(interactive "p")
(let* ((followed-tags-json (mastodon-tl--followed-tags))
(tags (mastodon-tl--map-alist 'name followed-tags-json))
(tag (completing-read "Tag: " tags nil)))
(if (null tag)
(user-error "You have to follow some tags first")
(mastodon-tl-get-tag-timeline prefix tag))))
(defun mastodon-tl-list-followed-tags ()
"List followed tags. View timeline of tag user choses.
PREFIX is sent to `mastodon-tl-get-tag-timeline', which see."
(interactive)
(let* ((json (mastodon-tl--followed-tags))
(sorted (sort json :key (lambda (x)
(downcase (alist-get 'name x)))))
(buf "*mastodon-followed-tags*"))
(if (null sorted)
(user-error "You have to follow some tags first")
(with-mastodon-buffer (get-buffer-create buf)
#'mastodon-mode nil
(mastodon-tl--set-buffer-spec
buf "followed_tags" #'mastodon-tl-list-followed-tags)
(mastodon-search--insert-heading "followed tags")
(insert "\n")
(mastodon-search--print-tags sorted)
(goto-char (point-min))))))
(defun mastodon-tl-followed-tags-timeline (&optional prefix)
"Open a timeline of multiple tags.
With a single PREFIX arg, only show posts with media.
With a double PREFIX arg, limit results to your own instance.
If `mastodon-tl--tag-timeline-tags' is set, use its tags, else
fetch followed tags and load the first four of them."
(interactive "p")
(let* ((followed-tags-json (mastodon-tl--followed-tags))
(tags (or mastodon-tl--tag-timeline-tags
(mastodon-tl--map-alist 'name followed-tags-json))))
(mastodon-tl--show-tag-timeline prefix tags)))
(defun mastodon-tl-some-followed-tags-timeline (&optional prefix)
"Prompt for some tags, and open a timeline for them.
The suggestions are from followed tags, but any other tags are also allowed.
PREFIX is for `mastodon-tl--show-tag-timeline', which see."
(interactive "p")
(let* ((followed-tags-json (mastodon-tl--followed-tags))
(tags (mastodon-tl--map-alist 'name followed-tags-json))
(selection (completing-read-multiple
"Tags' timelines to view [TAB to view, comma to separate]: "
tags)))
(mastodon-tl--show-tag-timeline prefix selection)))
(defcustom mastodon-tl--tags-groups nil
"A list containing lists of up to four tags each.
You can load a tag timeline list with one of these by calling
`mastodon-tl-tag-group-timeline'."
:group 'mastodon-tl
:type '(repeat (list string string string string)))
(defun mastodon-tl-tag-group-timeline (&optional prefix)
"Load a timeline of a tag group from `mastodon-tl--tags-groups'.
PREFIX is for `mastodon-tl--show-tag-timeline', which see."
(interactive "P")
(if (not mastodon-tl--tags-groups)
(user-error
"Set `mastodon-tl--tags-groups' to view tag group timelines")
(let* ((list-strs (mapcar (lambda (x)
;; cons of list-as-string and list:
(cons (prin1-to-string x) x))
mastodon-tl--tags-groups))
(choice (completing-read "Tag group: " list-strs))
(choice-list (cdr (assoc choice list-strs #'equal))))
(mastodon-tl--show-tag-timeline prefix choice-list))))
;;; REPORT TO MODERATORS
(defun mastodon-tl--instance-rules ()
"Return the rules of the user's instance."
(let ((url (mastodon-http--api "instance/rules")))
(mastodon-http--get-json url nil :silent)))
(defun mastodon-tl--report-params (account toot)
"Query user and return report params alist.
ACCOUNT and TOOT are the data to use."
(let* ((account-id (alist-get 'id account))
(comment (read-string "Add comment [optional]: "))
(item-id (when (y-or-n-p "Also report status at point? ")
(mastodon-tl--item-id toot))) ; base toot if poss
(forward-p (when (y-or-n-p "Forward to remote admin? ") "true"))
(rules (when (y-or-n-p "Cite a rule broken? ")
(mastodon-tl--read-rules-ids)))
(cat (unless rules (if (y-or-n-p "Spam? ") "spam" "other"))))
(mastodon-tl--report-build-params account-id comment item-id
forward-p cat rules)))
(defun mastodon-tl--report-build-params
(account-id comment item-id forward-p cat &optional rules)
"Build the parameters alist based on user responses.
ACCOUNT-ID, COMMENT, ITEM-ID, FORWARD-P, CAT, and RULES are all from
`mastodon-tl--report-params', which see."
(let ((params
`(("account_id" . ,account-id)
,@(when comment `(("comment" . ,comment)))
,@(when item-id `(("status_ids[]" . ,item-id)))
,@(when forward-p `(("forward" . ,forward-p)))
,@(when cat `(("category" . ,cat))))))
(if (not rules)
params
(let ((alist
(mastodon-http--build-array-params-alist "rule_ids[]" rules)))
(append alist params)))))
(defun mastodon-tl-report-to-mods ()
"Report the author of the toot at point to your instance moderators.
Optionally report the toot at point, add a comment, cite rules
that have been broken, forward the report to the remove admin,
report the account for spam."
(interactive)
(mastodon-tl--do-if-item
(when (y-or-n-p "Report author of toot at point?")
(let* ((url (mastodon-http--api "reports"))
(toot (mastodon-tl--toot-or-base
(mastodon-tl--property 'item-json :no-move)))
(account (alist-get 'account toot))
(handle (alist-get 'acct account))
(params (mastodon-tl--report-params account toot))
(response (mastodon-http--post url params)))
(mastodon-http--triage response
(lambda (_)
(message "User %s reported!" handle)))))))
(defvar crm-separator)
(defun mastodon-tl--map-rules-alist (rules)
"Convert RULES text and id fields into an alist."
(mastodon-tl--map-alist-vals-to-alist 'text 'id rules))
(defun mastodon-tl--read-rules-ids ()
"Prompt for a list of instance rules and return a list of selected ids."
(let* ((rules (mastodon-tl--instance-rules))
(alist (mastodon-tl--map-rules-alist rules))
(crm-separator (replace-regexp-in-string "," "|" crm-separator))
(choices (completing-read-multiple
"rules [TAB for options, | to separate]: "
alist nil t)))
(mapcar (lambda (x)
(alist-get x alist nil nil #'string=))
choices)))
;;; UPDATING, etc.
(defun mastodon-tl--no-json (json)
"Nil if JSON is nil or empty group notif data."
(if (and (mastodon-tl--buffer-type-eq 'notifications)
mastodon-group-notifications)
(mastodon-notifications--empty-group-json-p json)
(not json)))
(defun mastodon-tl--more-json (endpoint id)
"Return JSON for timeline ENDPOINT before ID."
(let* ((args `(("max_id" . ,(mastodon-tl--as-string id))))
(url (mastodon-http--api endpoint)))
(mastodon-http--get-json url args)))
(defun mastodon-tl--more-json-async
(endpoint id &optional params callback &rest cbargs)
"Return JSON for timeline ENDPOINT before ID.
Then run CALLBACK with arguments CBARGS.
PARAMS is used to send any parameters needed to correctly update
the current view."
(let* ((args `(("max_id" . ,(mastodon-tl--as-string id))))
(args (append args params))
(url (mastodon-http--api
endpoint
(when (or (and mastodon-group-notifications
(string= endpoint "notifications"))
(string-suffix-p "search" endpoint))
"v2"))))
(apply #'mastodon-http--get-json-async url args callback cbargs)))
(defun mastodon-tl--more-json-async-offset (endpoint &optional params
callback &rest cbargs)
"Return JSON for ENDPOINT, using the \"offset\" query param.
This is used for pagination with endpoints that implement the
\"offset\" parameter, rather than using link-headers or
\"max_id\".
PARAMS are the update parameters, see
`mastodon-tl--update-params'. These (\"limit\" and \"offset\")
must be set in `mastodon-tl--buffer-spec' for pagination to work.
Then run CALLBACK with arguments CBARGS."
(let* ((params (or params (mastodon-tl--update-params)))
(limit (string-to-number
(alist-get "limit" params nil nil #'string=)))
(offset (number-to-string
(+ limit ; limit + old offset = new offset
(string-to-number
(alist-get "offset" params nil nil #'string=)))))
(url (mastodon-http--api
endpoint
(when (string-suffix-p "search" endpoint)
"v2"))))
;; increment:
(setf (alist-get "offset" params nil nil #'string=) offset)
(apply #'mastodon-http--get-json-async url params callback cbargs)))
(defun mastodon-tl--updated-json (endpoint id &optional params version)
"Return JSON for timeline ENDPOINT since ID.
PARAMS is used to send any parameters needed to correctly update
the current view.
VERSION is the API version to use, as grouped notifs use v2."
(let* ((args `(("since_id" . ,(mastodon-tl--as-string id))))
(args (append args params))
(url (mastodon-http--api endpoint version)))
(mastodon-http--get-json url args)))
;; TODO: add this to new posts in some cases, e.g. in thread view.
(defun mastodon-tl--reload-timeline-or-profile (&optional pos)
"Reload the current timeline or profile page.
For use after e.g. deleting a toot.
POS is a number, where point will be placed.
Aims to respect any pagination in effect."
(let ((type (mastodon-tl--get-buffer-type))
(max-id (mastodon-tl--buffer-property 'max-id nil :no-error)))
(cond ((eq type 'home)
(mastodon-tl-get-home-timeline nil max-id))
((eq type 'federated)
(mastodon-tl-get-federated-timeline nil nil max-id))
((eq type 'local)
(mastodon-tl-get-local-timeline nil max-id))
((eq type 'mentions)
(mastodon-notifications-get-mentions))
((eq type 'notifications)
(mastodon-notifications-get nil nil max-id))
((eq type 'profile-statuses-no-boosts)
;; TODO: max-id arg needed here also
(mastodon-profile-open-statuses-no-reblogs))
((eq type 'profile-statuses)
(save-excursion
(goto-char (point-min))
(mastodon-profile--make-author-buffer
;; (mastodon-profile-get-toot-author max-id)))
(mastodon-profile--profile-json))))
((or (eq type 'single-status)
(eq type 'thread))
(let ((id (mastodon-tl--buffer-property
'thread-item-id (current-buffer) :no-error)))
(mastodon-tl--thread-do id))))
;; TODO: sends point to where point was in buffer. This is very rough; we
;; may have removed an item , so the buffer will be smaller, point will
;; end up past where we were, etc.
(when pos
(goto-char pos)
(mastodon-tl-goto-prev-item :no-refresh))))
(defun mastodon-tl--build-link-header-url (str)
"Return a URL from STR, an http Link header."
(let* ((split (split-string str "; "))
(url-base (string-trim (car split) "<" ">"))
(param (cadr split)))
(concat url-base "&" param)))
(defun mastodon-tl--use-link-header-p ()
"Return t if we are in a view needing Link header pagination.
Currently this includes favourites, bookmarks, follow requests,
and profile pages when showing followers or accounts followed."
(or (mastodon-tl--buffer-type-eq 'favourites)
(mastodon-tl--buffer-type-eq 'bookmarks)
(mastodon-tl--buffer-type-eq 'profile-followers)
(mastodon-tl--buffer-type-eq 'profile-following)
(mastodon-tl--buffer-type-eq 'follow-requests)))
(defun mastodon-tl--get-link-header-from-response (headers)
"Get http Link header from list of http HEADERS."
;; pleroma uses "link", so case-insensitive match required:
(when-let* ((link-headers (alist-get "Link" headers nil nil #'cl-equalp)))
(split-string link-headers ", ")))
(defun mastodon-tl--more ()
"Append older toots to timeline, asynchronously."
(message "Loading...")
(if (mastodon-tl--use-link-header-p)
;; link-header paginate:
;; can't build a URL with --more-json-async, endpoint/id:
;; ensure we have a "next" type here, otherwise the CAR will be the
;; "prev" type!
(let ((link-header (mastodon-tl--link-header)))
(if (> 2 (length link-header))
(user-error "No next page")
(let* ((next (car link-header))
;;(prev (cadr (mastodon-tl--link-header)))
(url (mastodon-tl--build-link-header-url next)))
(mastodon-http--get-response-async
url nil 'mastodon-tl--more* (current-buffer) (point) :headers))))
(cond (;; no paginate
(or (mastodon-tl--buffer-type-eq 'follow-suggestions)
(mastodon-tl--buffer-type-eq 'filters)
(mastodon-tl--buffer-type-eq 'lists))
(user-error "No more results"))
;; offset paginate (search, trending, user lists, ...?):
((or (string-prefix-p "*mastodon-trending-" (buffer-name))
(mastodon-tl--search-buffer-p))
(mastodon-tl--more-json-async-offset
(mastodon-tl--endpoint)
(mastodon-tl--update-params)
'mastodon-tl--more* (current-buffer) (point)))
(t ;; max_id paginate (timelines, items with ids/timestamps):
(let ((max-id (mastodon-tl--oldest-id))
(params (mastodon-tl--update-params)))
(mastodon-tl--more-json-async
(mastodon-tl--endpoint)
max-id params
'mastodon-tl--more*
(current-buffer) (point) nil max-id))))))
(defun mastodon-tl--more*
(response buffer point-before &optional headers max-id)
"Append older toots to timeline, asynchronously.
Runs the timeline's update function on RESPONSE, in BUFFER.
When done, places point at POINT-BEFORE.
HEADERS is the http headers returned in the response, if any.
MAX-ID is the pagination parameter, a string.
UPDATE-PARAMS is from prev buffer spec, added to the new one."
(with-current-buffer buffer
(if (not response)
(user-error "No more results")
(let* ((inhibit-read-only t)
(json (if headers (car response) response))
;; FIXME: max-id pagination works for statuses only, not other
;; search results pages:
(json (if (not (mastodon-tl--search-buffer-p))
json
(let ((type (mastodon-search--buf-type)))
(cond ((string= "statuses" type)
(cdr ; avoid repeat of last status
(alist-get 'statuses response)))
((string= "hashtags" type)
(alist-get 'hashtags response))
((string= "accounts" type)
(alist-get 'accounts response))))))
(headers (when headers (cdr response)))
(link-header
(mastodon-tl--get-link-header-from-response headers))
(buf-type (mastodon-tl--get-buffer-type))
(notifs-p (or (eq buf-type 'notifications)
(eq buf-type 'mentions)))
(notif-type (when notifs-p
(mastodon-notifications--current-type))))
(goto-char (point-max))
(if (eq 'thread buf-type)
;; if thread fully unfolded, respect it:
;; if thread view, call --thread-do with parent ID
(progn (goto-char (point-min))
(mastodon-tl-goto-next-item)
(mastodon-tl--thread-do)
(goto-char point-before)
(message "Loaded full thread."))
(if (mastodon-tl--no-json json)
(user-error "No more results")
(if notifs-p
(mastodon-notifications--timeline json notif-type :update)
(funcall (mastodon-tl--update-function) json))
(goto-char point-before)
;; update buffer spec to new link-header or max-id:
;; (other values should just remain as they were)
(mastodon-tl--set-buffer-spec
(mastodon-tl--buffer-name)
(mastodon-tl--endpoint)
(mastodon-tl--update-function)
link-header (mastodon-tl--update-params)
(mastodon-tl--hide-replies-p) max-id)
(message "Loading... done.")))))))
(defun mastodon-tl--find-property-range (property start-point
&optional search-backwards)
"Return nil if no such range is found.
If PROPERTY is set at START-POINT returns a range around
START-POINT otherwise before/after START-POINT.
SEARCH-BACKWARDS determines whether we pick point
before (non-nil) or after (nil)"
(if (get-text-property start-point property)
;; We are within a range, so look backwards for the start:
(cons (previous-single-property-change
(if (eq start-point (point-max)) start-point (1+ start-point))
property nil (point-min))
(next-single-property-change start-point property nil (point-max)))
(if search-backwards
(let* ((end (or (previous-single-property-change
(if (eq start-point (point-max))
start-point
(1+ start-point))
property)
;; we may either be just before the range or there
;; is nothing at all
(and (not (eq start-point (point-min)))
(get-text-property (1- start-point) property)
start-point)))
(start (and end (previous-single-property-change
end property nil (point-min)))))
(when end
(cons start end)))
(let* ((start (next-single-property-change start-point property))
(end (and start (next-single-property-change
start property nil (point-max)))))
(when start
(cons start end))))))
(defun mastodon-tl--find-next-or-previous-property-range
(property start-point search-backwards)
"Find (start . end) property range after/before START-POINT.
Does so while PROPERTY is set to a consistent value (different
from the value at START-POINT if that is set).
Return nil if no such range exists.
If SEARCH-BACKWARDS is non-nil it find a region before
START-POINT otherwise after START-POINT."
(if (not (get-text-property start-point property))
;; If we are not within a range, we can just defer to
;; mastodon-tl--find-property-range directly.
(mastodon-tl--find-property-range property start-point search-backwards)
;; We are within a range, we need to start the search from
;; before/after this range:
(let ((current-range
(mastodon-tl--find-property-range property start-point)))
(if search-backwards
(unless (eq (car current-range) (point-min))
(mastodon-tl--find-property-range
property (1- (car current-range)) search-backwards))
(unless (eq (cdr current-range) (point-max))
(mastodon-tl--find-property-range
property (1+ (cdr current-range)) search-backwards))))))
(defun mastodon-tl--consider-timestamp-for-updates (timestamp)
"Take note that TIMESTAMP is used in buffer and ajust timers as needed.
This calculates the next time the text for TIMESTAMP will change
and may adjust existing or future timer runs should that time
before current plans to run the update function.
The adjustment is only made if it is significantly (a few
seconds) before the currently scheduled time. This helps reduce
the number of occasions where we schedule an update only to
schedule the next one on completion to be within a few seconds.
If relative timestamps are disabled (i.e. if
`mastodon-tl--enable-relative-timestamps' is nil), this is a
no-op."
(when mastodon-tl--enable-relative-timestamps
(let ((this-update (cdr (mastodon-tl--relative-time-details timestamp))))
(when (time-less-p this-update
(time-subtract mastodon-tl--timestamp-next-update
(seconds-to-time 10)))
(setq mastodon-tl--timestamp-next-update this-update)
(when mastodon-tl--timestamp-update-timer
;; We need to re-schedule for an earlier time
(cancel-timer mastodon-tl--timestamp-update-timer)
(setq mastodon-tl--timestamp-update-timer
(run-at-time (time-to-seconds (time-subtract this-update
(current-time)))
nil ;; don't repeat
#'mastodon-tl--update-timestamps-callback
(current-buffer) nil)))))))
(defun mastodon-tl--update-timestamps-callback (buffer previous-marker)
"Update the next few timestamp displays in BUFFER.
Start searching for more timestamps from PREVIOUS-MARKER or
from the start if it is nil."
;; only do things if the buffer hasn't been killed in the meantime
(when (and mastodon-tl--enable-relative-timestamps ; just in case
(buffer-live-p buffer))
(save-excursion
(with-current-buffer buffer
(let ((previous-timestamp (if previous-marker
(marker-position previous-marker)
(point-min)))
(iteration 0)
next-timestamp-range)
(if previous-marker
;; a follow-up call to process the next batch of timestamps.
;; Release the marker to not slow things down.
(set-marker previous-marker nil)
;; Otherwise this is a rew run, so let's initialize the next-run time.
(setq mastodon-tl--timestamp-next-update (time-add (current-time)
(seconds-to-time 300))
mastodon-tl--timestamp-update-timer nil))
(while (and (< iteration 5)
(setq next-timestamp-range
(mastodon-tl--find-property-range 'timestamp
previous-timestamp)))
(let* ((start (car next-timestamp-range))
(end (cdr next-timestamp-range))
(timestamp (get-text-property start 'timestamp))
(current-display (get-text-property start 'display))
(new-display (mastodon-tl--relative-time-description timestamp)))
(unless (string= current-display new-display)
(let ((inhibit-read-only t))
(add-text-properties
start end
(list 'display
(mastodon-tl--relative-time-description timestamp)))))
(mastodon-tl--consider-timestamp-for-updates timestamp)
(setq iteration (1+ iteration)
previous-timestamp (1+ (cdr next-timestamp-range)))))
(if next-timestamp-range
;; schedule the next batch from the previous location to
;; start very soon in the future:
(run-at-time 0.1 nil #'mastodon-tl--update-timestamps-callback buffer
(copy-marker previous-timestamp))
;; otherwise we are done for now; schedule a new run for when needed
(setq mastodon-tl--timestamp-update-timer
(run-at-time (time-to-seconds
(time-subtract mastodon-tl--timestamp-next-update
(current-time)))
nil ;; don't repeat
#'mastodon-tl--update-timestamps-callback
buffer nil))))))))
(defun mastodon-tl--set-after-update-marker ()
"Set `mastodon-tl--after-update-marker' to the after-update location.
This location is defined by a non-nil value of
`mastodon-tl-position-after-update'."
(if (not mastodon-tl-position-after-update)
(setq mastodon-tl--after-update-marker nil)
(let ((marker (make-marker)))
(set-marker marker
(cond
((eq 'keep-point mastodon-tl-position-after-update)
(point))
((eq 'last-old-toot mastodon-tl-position-after-update)
(next-single-property-change
(or mastodon-tl--update-point (point-min))
'byline))
(t
(error "Unknown mastodon-tl-position-after-update value %S"
mastodon-tl-position-after-update))))
;; Make the marker advance if text gets inserted there.
(set-marker-insertion-type marker t)
(setq mastodon-tl--after-update-marker marker))))
(defun mastodon-tl-update ()
"Update timeline with new toots."
(interactive)
;; FIXME: actually these buffers should just reload by calling their own
;; load function (actually g is mostly mapped as such)
;; well actually, g should be for reload, update is different.
(if (or (member (mastodon-tl--get-buffer-type)
'(trending-statuses
trending-tags
follow-suggestions
lists
filters
scheduled-statuses))
(mastodon-tl--search-buffer-p))
(user-error "Update not available in this view")
;; FIXME: handle update for search and trending buffers
(let* ((endpoint (mastodon-tl--endpoint))
(update-fun (mastodon-tl--update-function))
(id (mastodon-tl--newest-id)))
;; update a thread, without calling `mastodon-tl--updated-json':
(if (mastodon-tl--buffer-type-eq 'thread)
;; load whole thread:
(progn (mastodon-tl--thread-do id)
(message "Loaded full thread."))
(if (not id) ;; if e.g. notifs all cleared:
(user-error "No last id")
;; update other timelines:
(let* ((params (mastodon-tl--update-params))
(notifs-p
(eq update-fun 'mastodon-notifications--timeline))
(json (mastodon-tl--updated-json
endpoint id params
(when (and notifs-p mastodon-group-notifications)
"v2"))))
(if (mastodon-tl--no-json json)
(user-error "Nothing to update")
(let ((inhibit-read-only t))
(mastodon-tl--set-after-update-marker)
(goto-char (or mastodon-tl--update-point (point-min)))
(if notifs-p
(funcall update-fun json nil :update)
(funcall update-fun json))
(if mastodon-tl--after-update-marker
(goto-char mastodon-tl--after-update-marker)
(mastodon-tl-goto-next-item))))))))))
;;; LOADING TIMELINES
(defun mastodon-tl--init
(buffer-name endpoint update-function &optional headers params
hide-replies instance no-byline)
"Initialize BUFFER-NAME with timeline targeted by ENDPOINT asynchronously.
UPDATE-FUNCTION is used to recieve more toots.
HEADERS means to also collect the response headers. Used for paginating
favourites and bookmarks.
PARAMS is any parameters to send with the request.
HIDE-REPLIES is a flag indicating if replies are hidden in the current buffer.
INSTANCE is a string of another instance domain we are displaying
a timeline from.
NO-BYLINE means just insert toot body, used for announcements."
(let ((url (if instance
(concat "https://" instance "/api/v1/" endpoint)
(mastodon-http--api endpoint)))
(buffer (concat "*mastodon-" buffer-name "*")))
(funcall
(if headers
#'mastodon-http--get-response-async
#'mastodon-http--get-json-async)
url params 'mastodon-tl--init*
buffer endpoint update-function headers params hide-replies
instance no-byline)))
(defun mastodon-tl--init*
(response buffer endpoint update-function &optional headers
update-params hide-replies instance no-byline)
"Initialize BUFFER with timeline targeted by ENDPOINT.
UPDATE-FUNCTION is used to recieve more toots.
RESPONSE is the data returned from the server by
`mastodon-http--process-json', with arg HEADERS a cons cell of
JSON and http headers, without it just the JSON.
NO-BYLINE means just insert toot body, used for announcements."
(let ((json (if headers (car response) response)))
(cond ((not json) ; praying this is right here, else try "\n[]"
;; this means that whatever tl was inited won't load, which is not
;; always wanted, as sometimes you still need the page to load so
;; you can be in eg mastodon-mode, have keymap, search etc.
(message "Looks like nothing returned from endpoint: %s" endpoint)
;; if we are a new account, home tl may have nothing, but then
;; this clause means we can never load mastodon.el at all!
;; so as a fallback, load trending statuses:
;; FIXME: this could possibly be a fallback for all timelines not
;; just home?
(when (string= endpoint "timelines/home")
(mastodon-search-trending-statuses)))
((eq (caar json) 'error)
(user-error "Looks like the server bugged out: \"%s\"" (cdar json)))
(t
(let* ((headers (when headers (cdr response)))
(link-header
(mastodon-tl--get-link-header-from-response headers)))
(with-mastodon-buffer buffer #'mastodon-mode nil
(mastodon-tl--set-buffer-spec
buffer endpoint update-function
link-header update-params hide-replies
;; awful hack to fix multiple reloads:
(alist-get "max_id" update-params nil nil #'string=))
(mastodon-tl--do-init json update-function instance no-byline)))))))
(defun mastodon-tl--init-sync
(buffer-name endpoint update-function &optional note-type params
headers view-name binding-str endpoint-version)
"Initialize BUFFER-NAME with timeline targeted by ENDPOINT.
UPDATE-FUNCTION is used to receive more toots.
Runs synchronously.
Optional arg NOTE-TYPE means only get that type of notification.
PARAMS is an alist of any params to include in the request.
HEADERS are any headers to send in the request.
VIEW-NAME is a string, to be used as a heading for the view.
BINDING-STR is a string explaining any bindins in the view, it can have
formatting for `substitute-command-keys'.
ENDPOINT-VERSION is a string, format Vx, e.g. V2."
;; Used by `mastodon-notifications-get' and in views.el
(let* ((notes-params (when note-type
(mastodon-http--build-array-params-alist
"types[]" (list note-type))))
(params (append notes-params params))
(url (mastodon-http--api endpoint endpoint-version))
(buffer (concat "*mastodon-" buffer-name "*"))
(response (mastodon-http--get-response url params))
(json (car response))
(headers (when headers (cdr response)))
(link-header (when headers
(mastodon-tl--get-link-header-from-response headers))))
(with-mastodon-buffer buffer #'mastodon-mode nil
;; insert view-name/ heading-str
(when view-name
(mastodon-search--insert-heading view-name))
(when binding-str
(insert
(substitute-command-keys
(mastodon-tl--set-face (concat "[" binding-str "]\n\n")
'mastodon-toot-docs-face))))
(mastodon-tl--set-buffer-spec
buffer endpoint update-function
link-header params nil
;; awful hack to fix multiple reloads:
(alist-get "max_id" params nil nil #'string=))
(mastodon-tl--do-init json update-function nil nil note-type)
buffer)))
(defun mastodon-tl--do-init (json update-fun &optional domain no-byline type)
"Utility function for `mastodon-tl--init*' and `mastodon-tl--init-sync'.
JSON is the data to call UPDATE-FUN on.
When DOMAIN, force inclusion of user's domain in their handle.
NO-BYLINE means just insert toot body, used for announcements.
TYPE is a notification type."
(remove-overlays) ; video overlays
(cond (domain ;; maybe our update-fun doesn't always have 3 args...:
(funcall update-fun json nil domain))
(type (funcall update-fun json type)) ;; notif types
(no-byline (funcall update-fun json nil nil no-byline))
(t (funcall update-fun json)))
(setq
;; Initialize with a minimal interval; we re-scan at least once
;; every 5 minutes to catch any timestamps we may have missed
mastodon-tl--timestamp-next-update (time-add (current-time)
(seconds-to-time 300)))
(setq mastodon-tl--timestamp-update-timer
(when mastodon-tl--enable-relative-timestamps
(run-at-time (time-to-seconds
(time-subtract mastodon-tl--timestamp-next-update
(current-time)))
nil ;; don't repeat
#'mastodon-tl--update-timestamps-callback
(current-buffer)
nil)))
(unless (mastodon-tl--profile-buffer-p)
(mastodon-tl--goto-first-item)))
;;; BOOKMARKS
(require 'bookmark)
(defun mastodon-tl--bookmark-handler (record)
"Jump to a bookmarked location in mastodon.el.
RECORD is the bookmark record."
(let ((id (bookmark-prop-get record 'id)))
;; we need to handle thread and single toot for starters
(pop-to-buffer
(mastodon-tl--thread-do id))))
(defun mastodon-tl--bookmark-make-record ()
"Return a bookmark record for the current mastodon buffer."
(let ((id (mastodon-tl--property 'item-id :no-move))
(name (buffer-name)))
`(,name
(buf . ,name)
(id . ,id)
(handler . mastodon-tl--bookmark-handler))))
(add-hook 'mastodon-mode-hook
(lambda ()
(setq-local bookmark-make-record-function
#'mastodon-tl--bookmark-make-record)))
(provide 'mastodon-tl)
;;; mastodon-tl.el ends here
mastodon.el/lisp/mastodon-toot.el 0000664 0000000 0000000 00000263452 15017331127 0017415 0 ustar 00root root 0000000 0000000 ;;; mastodon-toot.el --- Minor mode for sending Mastodon toots -*- lexical-binding: t -*-
;; Copyright (C) 2017-2019 Johnson Denen
;; Copyright (C) 2020-2024 Marty Hiatt
;; Author: Johnson Denen
;; Marty Hiatt
;; Maintainer: Marty Hiatt
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
;; This file is part of mastodon.el.
;; mastodon.el 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.
;; mastodon.el 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 mastodon.el. If not, see .
;;; Commentary:
;; mastodon-toot.el supports POSTing status data to Mastodon.
;;; Code:
(eval-when-compile (require 'subr-x))
(defvar mastodon-use-emojify)
(require 'emojify nil :noerror)
(declare-function emojify-insert-emoji "emojify")
(declare-function emojify-set-emoji-data "emojify")
(declare-function emojify-mode "emojify")
(declare-function emojify-emojis-each "emojify")
(defvar emojify-emojis-dir)
(defvar emojify-user-emojis)
(defvar emojify-emoji-styles)
(require 'cl-lib)
(require 'persist)
(require 'mastodon-iso)
(require 'facemenu)
(require 'text-property-search)
(eval-when-compile
(require 'mastodon-tl))
(defvar mastodon-instance-url)
(defvar mastodon-tl--buffer-spec)
(defvar mastodon-tl--enable-proportional-fonts)
(defvar mastodon-profile-account-settings)
(defvar mastodon-profile-acccount-preferences-data)
(autoload 'iso8601-parse "iso8601")
(autoload 'ht-get "ht")
(autoload 'mastodon-auth--user-acct "mastodon-auth")
(autoload 'mastodon-http--api "mastodon-http")
(autoload 'mastodon-http--build-array-params-alist "mastodon-http")
(autoload 'mastodon-http--delete "mastodon-http")
(autoload 'mastodon-http--get-json "mastodon-http")
(autoload 'mastodon-http--get-json-async "mastodon-http")
(autoload 'mastodon-http--post "mastodon-http")
(autoload 'mastodon-http--post-media-attachment "mastodon-http")
(autoload 'mastodon-http--process-json "mastodon-http")
(autoload 'mastodon-http--put "mastodon-http")
(autoload 'mastodon-http--read-file-as-string "mastodon-http")
(autoload 'mastodon-http--triage "mastodon-http")
(autoload 'mastodon-kill-window "mastodon")
(autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile")
(autoload 'mastodon-profile--fetch-server-account-settings-maybe "mastodon-profile")
(autoload 'mastodon-profile--get-source-pref "mastodon-profile")
(autoload 'mastodon-profile-show-user "mastodon-profile")
(autoload 'mastodon-profile--update-preference "mastodon-profile")
(autoload 'mastodon-search--search-accounts-query "mastodon-search")
(autoload 'mastodon-search--search-tags-query "mastodon-search")
(autoload 'mastodon-tl--as-string "mastodon-tl")
(autoload 'mastodon-tl--buffer-type-eq "mastodon-tl")
(autoload 'mastodon-tl--clean-tabs-and-nl "mastodon-tl")
(autoload 'mastodon-tl--field "mastodon-tl")
(autoload 'mastodon-tl--find-property-range "mastodon-tl")
(autoload 'mastodon-tl--find-property-range "mastodon-tl")
(autoload 'mastodon-tl-goto-next-item "mastodon-tl")
(autoload 'mastodon-tl--map-alist "mastodon-tl")
(autoload 'mastodon-tl--property "mastodon-tl")
(autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl")
(autoload 'mastodon-tl--render-text "mastodon-tl")
(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl")
(autoload 'mastodon-tl--symbol "mastodon-tl")
(autoload 'mastodon-tl--item-id "mastodon-tl")
(autoload 'mastodon-toot "mastodon")
(autoload 'mastodon-views-cancel-scheduled-toot "mastodon-views")
(autoload 'mastodon-views-view-scheduled-toots "mastodon-views")
(autoload 'org-read-date "org")
(autoload 'mastodon-tl--toot-or-base "mastodon-tl")
(autoload 'mastodon-profile--get-source-value "mastodon-toot")
(autoload 'mastodon-tl--get-buffer-type "mastodon-tl")
(autoload 'mastodon-tl--human-duration "mastodon-tl")
(autoload 'mastodon-profile--get-preferences-pref "mastodon-profile")
(autoload 'mastodon-views--get-own-instance "mastodon-views")
(autoload 'mastodon-tl--image-trans-check "mastodon-tl")
(autoload 'mastodon-instance-data "mastodon")
(autoload 'mastodon-create-poll "mastodon-transient")
(autoload 'mastodon-tl--own-profile-buffer-p "mastodon-tl")
;; for mastodon-toot-translate-toot-text
(autoload 'mastodon-tl--content "mastodon-tl")
(when (require 'lingva nil :no-error)
(declare-function lingva-translate "lingva"))
(defgroup mastodon-toot nil
"Tooting in Mastodon."
:prefix "mastodon-toot-"
:group 'mastodon)
(defcustom mastodon-toot--default-media-directory "~/"
"The default directory when prompting for a media file to upload."
:type 'string)
(defcustom mastodon-toot--attachment-height 80
"Height of the attached images preview in the toot draft buffer."
:type 'integer)
(defcustom mastodon-toot--enable-completion t
"Whether to enable completion of mentions and hashtags.
Used for completion in toot compose buffer."
:type 'boolean)
(defcustom mastodon-toot--use-company-for-completion nil
"Whether to enable company for completion.
When non-nil, `company-mode' is enabled in the toot compose
buffer, and mastodon completion backends are added to
`company-capf'.
You need to install company yourself to use this."
:type 'boolean)
(defcustom mastodon-toot--completion-style-for-mentions "all"
"The company completion style to use for mentions."
:type '(choice
(const :tag "off" nil)
(const :tag "following only" "following")
(const :tag "all users" "all")))
(defcustom mastodon-toot-display-orig-in-reply-buffer nil
"Display a copy of the toot replied to in the compose buffer."
:type 'boolean)
(defcustom mastodon-toot-orig-in-reply-length 191
;; three lines of divider width: (- (* 3 67) (length " Reply to: "))
"Length to crop toot replied to in the compose buffer to."
:type 'integer)
(defcustom mastodon-toot--default-reply-visibility "public"
"Default visibility settings when replying.
If the original toot visibility is different we use the more restricted one."
:type '(choice
(const :tag "public" "public")
(const :tag "unlisted" "unlisted")
(const :tag "followers only" "private")
(const :tag "direct" "direct")))
(defcustom mastodon-toot--enable-custom-instance-emoji nil
"Whether to enable your instance's custom emoji by default."
:type 'boolean)
(defcustom mastodon-toot--proportional-fonts-compose nil
"Nonnil to enable using proportional fonts in the compose buffer.
By default fixed width fonts are used."
:type '(boolean :tag "Enable using proportional rather than fixed \
width fonts"))
(defcustom mastodon-toot-poll-use-transient t
"Whether to use the transient menu to create a poll."
:type '(boolean))
(defvar-local mastodon-toot--content-warning nil
"The content warning of the current toot.")
(defvar-local mastodon-toot--content-nsfw nil
"A flag indicating whether the toot should be marked as NSFW.")
(defvar mastodon-toot-visibility-list
'(public unlisted private direct)
"A list of the available toot visibility settings.")
(defvar mastodon-toot-visibility-settings-list
'("public" "unlisted" "private")
"A list of the available default toot visibility settings.
Like `mastodon-toot-visibility-list' but without direct.")
(defvar-local mastodon-toot--visibility nil
"A string indicating the visibility of the toot being composed.
Valid values are \"direct\", \"private\" (followers-only),
\"unlisted\", and \"public\".
This is determined by the account setting on the server. To
change the setting on the server, see
`mastodon-toot-set-default-visibility'.")
(defvar-local mastodon-toot--media-attachments nil
"A list of the media attachments of the toot being composed.")
(defvar-local mastodon-toot--media-attachment-ids nil
"A list of any media attachment ids of the toot being composed.")
(defvar mastodon-toot-poll nil
"A plist of poll options for the toot being composed.")
(defvar-local mastodon-toot--language nil
"The language of the toot being composed, in ISO 639 (two-letter).")
(defvar-local mastodon-toot--scheduled-for nil
"An ISO 8601 timestamp that specifying when the post should be published.
Should be at least 5 minutes into the future.")
(defvar-local mastodon-toot--scheduled-id nil
"The id of the scheduled post that we are now editing.")
(defvar-local mastodon-toot--reply-to-id nil
"Buffer-local variable to hold the id of the toot being replied to.")
(defvar-local mastodon-toot--edit-item-id nil
"The id of the toot being edited.")
(defvar-local mastodon-toot-previous-window-config nil
"A list of window configuration prior to composing a toot.
Takes its form from `window-configuration-to-register'.")
(defvar mastodon-toot--max-toot-chars nil
"The maximum allowed characters count for a single toot.")
(defvar-local mastodon-toot-completions nil
"The data of completion candidates for the current completion at point.")
(defvar mastodon-toot-current-toot-text nil
"The text of the toot being composed.")
(persist-defvar mastodon-toot-draft-toots-list nil
"A list of toots that have been saved as drafts.
For the moment we just put all composed toots in here, as we want
to also capture toots that are \"sent\" but that don't successfully
send.")
;;; REGEXES
(defvar mastodon-toot-handle-regex
(rx (| (any ?\( "\n" "\t "" ") bol) ; preceding things
(group-n 2 (+ ?@ (* (any ?- ?_ ?. "A-Z" "a-z" "0-9" ))) ; handle
(? ?@ (* (not (any "\n" "\t" " "))))) ; optional domain
(| "'" word-boundary))) ; boundary or possessive
(defvar mastodon-toot-tag-regex
(rx (| (any ?\( "\n" "\t" " ") bol)
(group-n 2 ?# (+ (any "_" "A-Z" "a-z" "0-9")))
(| "'" word-boundary))) ; boundary or possessive
(defvar mastodon-toot-emoji-regex
(rx (| (any ?\( "\n" "\t" " ") bol)
(group-n 2 ?: ; opening :
(+ (any "A-Z" "a-z" "0-9" "_"))
(? ?:)) ; closing :
word-boundary)) ; boundary
(defvar mastodon-toot-url-regex
;; adapted from ffap-url-regexp
(concat
"\\(?2:\\(news\\(post\\)?:\\|mailto:\\|file:\\|\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\)://\\)" ; uri prefix
"[^ \n\t]*\\)" ; any old thing, that is, i.e. we allow invalid/unwise chars
;; "[ .,:;!?]\\b"))
;; "/" ; poss an ending slash? incompat with boundary end:
"\\>")) ; boundary end
;;; UTILS
(defun mastodon-toot--base-toot-or-item-json ()
"Return the JSON data of either base-toot or item-json property.
The former is for boost or favourite notifications, returning
data about the item boosted or favourited."
(or (mastodon-tl--property 'base-toot :no-move) ; fave/boost notifs
(mastodon-tl--property 'item-json)))
(defun mastodon-toot--inc-or-dec (count subtract)
"If SUBTRACT, decrement COUNT, else increment."
(if subtract
(1- count)
(1+ count)))
;;; MACRO
(defmacro mastodon-toot--with-toot-item (&rest body)
"Execute BODY if we have a toot object at point.
Includes boosts, and notifications that display toots.
This macro makes the local variable ID available."
(declare (debug t))
`(if (or (not (eq 'toot (mastodon-tl--property 'item-type :no-move)))
(member (mastodon-tl--property 'notification-type :no-move)
'("follow" "follow_request")))
(user-error "Looks like there's no toot at point?")
(mastodon-tl--with-toot-helper
(lambda (id)
,@body))))
(defun mastodon-tl--with-toot-helper (body-fun)
"Helper function for `mastodon-tl--with-toot-item'.
Extract any common variables needed, such as base-item-id
property, and call BODY-FUN on them."
(let ((id (mastodon-tl--property 'base-item-id)))
(funcall body-fun id)))
;;; MODE MAP
(defvar mastodon-toot-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-c") #'mastodon-toot-send)
(define-key map (kbd "C-c C-k") #'mastodon-toot-cancel)
(define-key map (kbd "C-c C-w") #'mastodon-toot-set-content-warning)
(define-key map (kbd "C-c C-n") #'mastodon-toot-toggle-nsfw)
(define-key map (kbd "C-c C-v") #'mastodon-toot-change-visibility)
(define-key map (kbd "C-c C-e") #'mastodon-toot-insert-emoji)
(define-key map (kbd "C-c C-a") #'mastodon-toot-attach-media)
(define-key map (kbd "C-c !") #'mastodon-toot-clear-all-attachments)
(define-key map (kbd "C-c C-p") #'mastodon-toot-create-poll)
(define-key map (kbd "C-c C-o") #'mastodon-toot-clear-poll)
(define-key map (kbd "C-c C-l") #'mastodon-toot-set-toot-language)
(define-key map (kbd "C-c C-s") #'mastodon-toot-schedule-toot)
map)
"Keymap for `mastodon-toot'.")
(defun mastodon-toot-set-default-visibility ()
"Set the default visibility for toots on the server."
(interactive)
(let ((vis (completing-read "Set default visibility to:"
mastodon-toot-visibility-list
nil t)))
(mastodon-profile--update-preference "privacy" vis :source)))
(defun mastodon-toot--get-max-toot-chars (&optional no-toot)
"Fetch max_toot_chars from `mastodon-instance-url' asynchronously.
NO-TOOT means we are not calling from a toot buffer."
(mastodon-http--get-json-async
(mastodon-http--api "instance")
nil
'mastodon-toot--get-max-toot-chars-callback no-toot))
(defun mastodon-toot--get-max-toot-chars-callback (json-response
&optional no-toot)
"Set max_toot_chars returned in JSON-RESPONSE and display in new toot buffer.
NO-TOOT means we are not calling from a toot buffer."
(let ((max-chars
(or (alist-get 'max_toot_chars json-response)
(alist-get 'max_characters ; some servers have this instead
(alist-get 'statuses
(alist-get 'configuration
json-response))))))
(setq mastodon-toot--max-toot-chars max-chars)
(unless no-toot
(with-current-buffer "*new toot*"
(mastodon-toot--update-status-fields)))))
(defun mastodon-toot--action-success (marker byline-region remove &optional json)
"Insert/remove the text MARKER with `success' face in byline.
BYLINE-REGION is a cons of start and end pos of the byline to be
modified.
Remove MARKER if REMOVE is non-nil, otherwise add it.
JSON is added to the string as its item-json."
(let ((inhibit-read-only t)
(bol (car byline-region))
(eol (cdr byline-region))
(at-byline-p (eq t (mastodon-tl--property 'byline :no-move))))
(save-excursion
(when remove
(goto-char bol)
(beginning-of-line) ;; The marker is not part of the byline
(if (search-forward (format "(%s) " marker) eol :no-error)
(replace-match "")
(user-error "Oops: could not find marker '(%s)'" marker)))
(unless remove
(goto-char bol)
(insert
(propertize
(format "(%s) "
(propertize marker
'face 'success))
'cursor-face 'mastodon-cursor-highlight-face
'item-json json)))) ;; for (un)folding items
(when at-byline-p
;; leave point after the marker:
(unless remove
;; if point is inside the byline, back up first so
;; we don't move to the following toot:
(beginning-of-line)
(forward-line -1)
(mastodon-tl-goto-next-item)))))
(defun mastodon-toot--action (action callback)
"Take ACTION, a string, on toot at point, then execute CALLBACK.
Makes a POST request to the server. Used for favouriting,
boosting, or bookmarking toots."
(let* ((id (mastodon-tl--property 'base-item-id))
(url (mastodon-http--api
(concat "statuses/" (mastodon-tl--as-string id) "/" action)))
(response (mastodon-http--post url)))
(mastodon-http--triage response callback)))
(defun mastodon-toot--toggle-boost-or-favourite (action)
"Toggle boost or favourite of toot at point.
ACTION is a symbol, either `favourite' or `boost.'"
(mastodon-toot--with-toot-item
(let* ((n-type (mastodon-tl--property 'notification-type :no-move))
(byline-region (mastodon-tl--find-property-range 'byline (point)))
(boost-p (eq action 'boost))
(action-str (symbol-name action))
(item-json (mastodon-tl--property 'item-json))
(vis (mastodon-tl--field 'visibility item-json)))
(cond
((not byline-region)
(user-error "Nothing to %s here?!?" action-str))
;; there's nothing wrong with faving/boosting own toots
;; & nothing wrong with faving/boosting own toots from notifs,
;; it boosts/faves the base toot, not the notif status
((or (string= n-type "follow")
(string= n-type "follow_request"))
(user-error "Can't %s %s notifications" action n-type))
((and boost-p
(or (string= vis "direct")
(string= vis "private")))
(user-error "Can't boost posts with visibility: %s" vis))
(t
(let* ((boosted (when byline-region
(get-text-property (car byline-region) 'boosted-p)))
(faved (when byline-region
(get-text-property (car byline-region) 'favourited-p)))
(str-api (if boost-p "reblog" action-str))
(action-str-api (mastodon-toot--str-negify str-api faved boosted
action))
(action-pp (concat
(mastodon-toot--str-negify action-str faved boosted
action)
(if boost-p "ed" "d")))
(remove-p (if boost-p boosted faved)))
(mastodon-toot--action
action-str-api
(lambda (_)
(let ((inhibit-read-only t))
(add-text-properties (car byline-region)
(cdr byline-region)
(if boost-p
(list 'boosted-p (not boosted))
(list 'favourited-p (not faved))))
(mastodon-toot--update-stats-on-action action remove-p)
(mastodon-toot--action-success (mastodon-tl--symbol action)
byline-region remove-p item-json))
(message "%s #%s" action-pp id)))))))))
(defun mastodon-toot--str-negify (str faved boosted action)
"Add \"un\" to STR if item is already FAVED or BOOSTED.
ACTION is the action currently being taken."
(if (eq action 'boost)
(if boosted (concat "un" str) str)
(if faved
(concat "un" str)
str)))
(defun mastodon-toot--update-stats-on-action (action &optional subtract)
"Increment the toot stats display upon ACTION.
ACTION is a symbol, either `favourite' or `boost'.
SUBTRACT means we are un-favouriting or unboosting, so we decrement."
(if (not (symbolp action))
(error "Invalid argument: symbolp %s" action)
(let* ((count-prop (if (eq action 'favourite)
'favourites-count
'boosts-count))
(count-range (mastodon-tl--find-property-range count-prop (point)))
(count (get-text-property (car count-range) count-prop))
(inhibit-read-only 1))
;; TODO another way to implement this would be to async fetch counts again
;; and re-display from count-properties
(add-text-properties (car count-range)
(cdr count-range)
(list 'display
(number-to-string
(mastodon-toot--inc-or-dec count subtract))
;; update the count prop
;; we rely on this for any subsequent actions:
count-prop
(mastodon-toot--inc-or-dec count subtract))))))
(defun mastodon-toot-toggle-boost ()
"Boost/unboost toot at `point'."
(interactive)
(mastodon-toot--toggle-boost-or-favourite 'boost))
(defun mastodon-toot-toggle-favourite ()
"Favourite/unfavourite toot at `point'."
(interactive)
(mastodon-toot--toggle-boost-or-favourite 'favourite))
;; TODO maybe refactor into boost/fave fun
(defun mastodon-toot-toggle-bookmark ()
"Bookmark or unbookmark toot at point."
(interactive)
(mastodon-toot--with-toot-item
(let* ((n-type (mastodon-tl--property 'notification-type :no-move))
(byline-region (mastodon-tl--find-property-range 'byline (point)))
(bookmarked-p (when byline-region
(get-text-property (car byline-region) 'bookmarked-p)))
(action (if bookmarked-p "unbookmark" "bookmark")))
(cond ((or (string= n-type "follow")
(string= n-type "follow_request"))
(user-error "Can't bookmark %s notifications" n-type))
((not byline-region)
(user-error "Nothing to %s here?!?" action))
(t
(let* ((bookmark-str (mastodon-tl--symbol 'bookmark))
(message (if bookmarked-p
"Bookmark removed!"
"Toot bookmarked!"))
(item-json (mastodon-tl--property 'item-json)))
(mastodon-toot--action
action
(lambda (_)
(let ((inhibit-read-only t))
(add-text-properties (car byline-region)
(cdr byline-region)
(list 'bookmarked-p (not bookmarked-p)))
(mastodon-toot--action-success bookmark-str
byline-region bookmarked-p item-json)
(message "%s #%s" message id))))))))))
(defun mastodon-toot-list-boosters ()
"List the boosters of toot at point."
(interactive)
;; use grouped notifs data if present:
;; only send accounts as arg if type matches notif type we are acting
;; on, to prevent showing accounts for a boost notif when asking for
;; favers, and vice versa.
(let* ((type (mastodon-tl--property 'notification-type :no-move))
(accounts (when (string= type "reblog")
(mastodon-tl--property 'notification-accounts :no-move))))
(mastodon-toot--list-boosters-or-favers nil accounts)))
(defun mastodon-toot-list-favouriters ()
"List the favouriters of toot at point."
(interactive)
(let* ((type (mastodon-tl--property 'notification-type :no-move))
(accounts (when (string= type "favourite")
(mastodon-tl--property 'notification-accounts :no-move))))
(mastodon-toot--list-boosters-or-favers :favourite accounts)))
(defun mastodon-toot--list-boosters-or-favers (&optional favourite accounts)
"List the favouriters or boosters of toot at point.
With FAVOURITE, list favouriters, else list boosters.
ACCOUNTS is notfications accounts if any."
(mastodon-toot--with-toot-item
(let* ((endpoint (unless accounts
(if favourite "favourited_by" "reblogged_by")))
(url (unless accounts
(mastodon-http--api (format "statuses/%s/%s" id endpoint))))
(params (unless accounts '(("limit" . "80"))))
(json (or accounts (mastodon-http--get-json url params))))
(if (eq (caar json) 'error)
(user-error "%s (Status does not exist or is private)"
(alist-get 'error json))
(let ((handles (mastodon-tl--map-alist 'acct json))
(type-string (if favourite "Favouriters" "Boosters")))
(if (not handles)
(user-error "Looks like this toot has no %s" type-string)
(let ((choice (completing-read
(format "%s (enter to view profile): " type-string)
handles nil t)))
(mastodon-profile-show-user choice))))))))
(defun mastodon-toot-copy-toot-url ()
"Copy URL of toot at point.
If the toot is a fave/boost notification, copy the URL of the
base toot."
(interactive)
(let* ((url (mastodon-toot--toot-url)))
(kill-new url)
(message "Toot URL copied to the clipboard.")))
(defun mastodon-toot-browse-toot-url ()
"Browse URL of toot at point.
Calls `browse-url'."
(interactive)
(browse-url
(mastodon-toot--toot-url)))
(defun mastodon-toot--toot-url ()
"Return the URL of the base toot at point."
(let* ((toot (mastodon-toot--base-toot-or-item-json)))
(if (mastodon-tl--field 'reblog toot)
(alist-get 'url (alist-get 'reblog toot))
(alist-get 'url toot))))
(defun mastodon-toot-copy-toot-text ()
"Copy text of toot at point.
If the toot is a fave/boost notification, copy the text of the
base toot."
(interactive)
(let* ((toot (mastodon-toot--base-toot-or-item-json)))
(kill-new (mastodon-tl--content toot))
(message "Toot content copied to the clipboard.")))
(defun mastodon-toot-translate-toot-text ()
"Translate text of toot at point.
Uses `lingva.el'."
(interactive)
(if mastodon-tl--buffer-spec
(if-let* ((toot (mastodon-tl--property 'item-json)))
(condition-case x
(lingva-translate nil
(mastodon-tl--content toot)
(when mastodon-tl--enable-proportional-fonts
t))
(void-function
(user-error "Looks like you need to install lingva.el. Error: %s"
(error-message-string x))))
(user-error "No toot to translate?"))
(user-error "No mastodon buffer?")))
(defun mastodon-toot--own-toot-p (toot)
"Check if TOOT is user's own, for deleting, editing, or pinning it."
;; this check needs to allow acting on own toots displayed as boosts, so we
;; call `mastodon-tl--toot-or-base'.
(let ((json (mastodon-tl--toot-or-base toot)))
(string= (alist-get 'acct (alist-get 'account json))
(mastodon-auth--user-acct))))
(defun mastodon-toot-pin-toot-toggle ()
"Pin or unpin user's toot at point."
(interactive)
(let* ((toot (mastodon-toot--base-toot-or-item-json))
(pinnable-p (mastodon-toot--own-toot-p toot))
(pinned-p (eq t (alist-get 'pinned toot)))
(action (if pinned-p "unpin" "pin"))
(msg (if pinned-p "unpinned" "pinned")))
(if (not pinnable-p)
(user-error "You can only pin your own toots")
(when (y-or-n-p (format "%s this toot? " (capitalize action)))
(mastodon-toot--action
action
(lambda (_)
;; let's only reload when in own profile view:
(when (mastodon-tl--own-profile-buffer-p)
(mastodon-tl--reload-timeline-or-profile))
(message "Toot %s!" msg)))))))
;;; DELETE, DRAFT, REDRAFT
(defun mastodon-toot-delete-toot ()
"Delete user's toot at point synchronously."
(interactive)
(mastodon-toot-delete-and-redraft-toot t))
;; TODO: handle media/poll for redrafting toots
(defun mastodon-toot-delete-and-redraft-toot (&optional no-redraft)
"Delete and redraft user's toot at point synchronously.
NO-REDRAFT means delete toot only."
(interactive)
(let* ((toot (mastodon-toot--base-toot-or-item-json))
(id (mastodon-tl--as-string (mastodon-tl--item-id toot)))
(url (mastodon-http--api (format "statuses/%s" id)))
(pos (point)))
(let-alist toot
(if (not (mastodon-toot--own-toot-p toot))
(user-error "You can only delete (and redraft) your own toots")
(when (y-or-n-p (if no-redraft
(format "Delete this toot? ")
(format "Delete and redraft this toot? ")))
(let* ((response (mastodon-http--delete url)))
(mastodon-http--triage
response
(lambda (_)
(if no-redraft
(progn
(when mastodon-tl--buffer-spec
(mastodon-tl--reload-timeline-or-profile pos))
(message "Toot deleted!"))
(mastodon-toot--redraft response
.in_reply_to_id
.visibility
.spoiler_text))))))))))
(defun mastodon-toot--set-cw (&optional cw)
"Set content warning to CW if it is non-nil."
(unless (or (null cw) ; cw is nil for `mastodon-tl-dm-user'
(string-empty-p cw))
(setq mastodon-toot--content-warning cw)))
;;; REDRAFT
(defun mastodon-toot--redraft (response &optional reply-id toot-visibility
toot-cw)
"Opens a new toot compose buffer using values from RESPONSE buffer.
REPLY-ID, TOOT-VISIBILITY, and TOOT-CW of deleted toot are preseved."
(with-current-buffer response
(let* ((response (mastodon-http--process-json))
(content (alist-get 'text response)))
(mastodon-toot--compose-buffer)
(goto-char (point-max))
(insert content)
;; adopt reply-to-id, visibility and CW from deleted toot:
(mastodon-toot--set-toot-properties
reply-id toot-visibility toot-cw
;; TODO set new lang/scheduled props here
nil))))
(defun mastodon-toot--set-toot-media-attachments (media)
"Set the media attachments variables.
MEDIA is the media_attachments data for a status from the server."
(mapcar (lambda (x)
(cl-pushnew (alist-get 'id x)
mastodon-toot--media-attachment-ids)
(cl-pushnew `((:contents . ,(mastodon-http--read-file-as-string
(alist-get 'url x) :url))
(:description . ,(alist-get 'description x)))
mastodon-toot--media-attachments))
media))
(defun mastodon-toot--set-toot-properties
(reply-id visibility cw lang &optional scheduled scheduled-id media poll)
"Set the toot properties for the current redrafted or edited toot.
REPLY-ID, VISIBILITY, CW, SCHEDULED, and LANG are the properties to set.
MEDIA is the media_attachments data for a status from the server."
(with-current-buffer "*edit toot*"
(when reply-id
(setq mastodon-toot--reply-to-id reply-id))
(setq mastodon-toot--visibility visibility)
(setq mastodon-toot--scheduled-for scheduled)
(setq mastodon-toot--scheduled-id scheduled-id)
(when (not (string-empty-p lang))
(setq mastodon-toot--language lang))
(mastodon-toot--set-cw cw)
(when media
(mastodon-toot--set-toot-media-attachments media))
(when poll
(mastodon-toot--server-poll-to-local poll))
(mastodon-toot--refresh-attachments-display)
(mastodon-toot--update-status-fields)))
(defun mastodon-toot--kill (&optional cancel)
"Kill `mastodon-toot-mode' buffer and window.
CANCEL means the toot was not sent, so we save the toot text as a draft."
(let ((prev-window-config mastodon-toot-previous-window-config))
(unless (eq mastodon-toot-current-toot-text nil)
(when cancel
(cl-pushnew mastodon-toot-current-toot-text
mastodon-toot-draft-toots-list :test #'string=)))
;; prevent some weird bug when cancelling a non-empty toot:
(delete #'mastodon-toot--save-toot-text after-change-functions)
(quit-window 'kill)
(mastodon-toot--restore-previous-window-config prev-window-config)))
(defun mastodon-toot-cancel ()
"Kill new-toot buffer/window. Does not POST content.
If toot is not empty, prompt to save text as a draft."
(interactive)
(when (and (not (mastodon-toot--empty-p))
(y-or-n-p "Save draft toot?"))
(mastodon-toot-save-draft))
(mastodon-toot--kill))
(defun mastodon-toot-save-draft ()
"Save the current compose toot text as a draft.
Pushes `mastodon-toot-current-toot-text' to
`mastodon-toot-draft-toots-list'."
(interactive)
(unless (string= mastodon-toot-current-toot-text nil)
(cl-pushnew mastodon-toot-current-toot-text
mastodon-toot-draft-toots-list :test 'string=)
(message "Draft saved!")))
(defun mastodon-toot--empty-p (&optional text-only)
"Return t if toot has no text, attachments, or polls.
TEXT-ONLY means don't check for attachments or polls."
(and (if text-only
t
(and (not mastodon-toot--media-attachments)
(not mastodon-toot-poll)))
(string-empty-p (mastodon-tl--clean-tabs-and-nl
(mastodon-toot--remove-docs)))))
;;; EMOJIS
(defun mastodon-toot-insert-emoji ()
"Prompt to insert an emoji."
(interactive)
(if mastodon-use-emojify
(emojify-insert-emoji)
(emoji-search))) ;; 29.1
(defun mastodon-toot--emoji-dir ()
"Return the file path for the mastodon custom emojis directory."
(concat (expand-file-name emojify-emojis-dir)
"/mastodon-custom-emojis/"))
(defun mastodon-toot-download-custom-emoji ()
"Download `mastodon-instance-url's custom emoji.
Emoji images are stored in a subdir of `emojify-emojis-dir'.
To use the downloaded emoji, run `mastodon-toot-enable-custom-emoji'."
(interactive)
(let* ((url (mastodon-http--api "custom_emojis"))
(custom-emoji (mastodon-http--get-json url))
(mastodon-custom-emoji-dir (mastodon-toot--emoji-dir)))
(if (not (file-directory-p emojify-emojis-dir))
(user-error "Looks like you need to set up emojify first")
(unless (file-directory-p mastodon-custom-emoji-dir)
(make-directory mastodon-custom-emoji-dir nil)) ; no add parent
(cl-loop for x in custom-emoji
do (let ((url (alist-get 'url x))
(shortcode (alist-get 'shortcode x)))
;; skip anything that contains unexpected characters
(when (and url shortcode
(string-match-p "^[a-zA-Z0-9-_]+$" shortcode)
(string-match-p "^[a-zA-Z]+$" (file-name-extension url)))
(url-copy-file url
(concat mastodon-custom-emoji-dir
shortcode
"."
(file-name-extension url))
t))))
(message "Custom emoji for %s downloaded to %s"
mastodon-instance-url
mastodon-custom-emoji-dir))))
(defun mastodon-toot--collect-custom-emoji ()
"Return a list of `mastodon-instance-url's custom emoji.
The list is formatted for `emojify-user-emojis', which see."
(let* ((mastodon-custom-emojis-dir (mastodon-toot--emoji-dir))
(custom-emoji-files (directory-files mastodon-custom-emojis-dir
nil ; not full path
"^[^.]")) ; no dot files
mastodon-emojify-user-emojis)
(cl-loop for x in custom-emoji-files
do (push
`(,(concat ":"
(file-name-base x) ":")
. (("name" . ,(file-name-base x))
("image" . ,(concat mastodon-custom-emojis-dir x))
("style" . "github")))
mastodon-emojify-user-emojis))
(reverse mastodon-emojify-user-emojis)))
(defun mastodon-toot-enable-custom-emoji ()
"Add `mastodon-instance-url's custom emoji to `emojify'.
Custom emoji must first be downloaded with
`mastodon-toot-download-custom-emoji'. Custom emoji are appended
to `emojify-user-emojis', and the emoji data is updated."
(interactive)
(unless (file-exists-p (mastodon-toot--emoji-dir))
(when (y-or-n-p "Looks like you haven't downloaded your
instance's custom emoji yet. Download now? ")
(mastodon-toot-download-custom-emoji)))
(let ((masto-emojis (mastodon-toot--collect-custom-emoji)))
(unless (cl-find (car masto-emojis)
emojify-user-emojis
:test #'equal)
(setq emojify-user-emojis
(append masto-emojis
emojify-user-emojis))
;; if already loaded, reload
(when (featurep 'emojify)
;; we now only do this within the unless test above, as it is extremely
;; slow and runs in `mastodon-mode-hook'.
(emojify-set-emoji-data)))))
(defun mastodon-toot--remove-docs ()
"Get the body of a toot from the current compose buffer."
(let ((header-region (mastodon-tl--find-property-range 'toot-post-header
(point-min))))
(string-trim-left
(buffer-substring (cdr header-region) (point-max)))))
(defun mastodon-toot--build-poll-params ()
"Return an alist of parameters for POSTing a poll status."
(if mastodon-toot-poll-use-transient
(let-alist mastodon-toot-poll
(append
(mastodon-http--build-array-params-alist
"poll[options][]"
(list .one .two .three .four))
(list (cons "poll[expires_in]" .expiry)
(cons "poll[multiple]" .multi)
(cons "poll[hide_totals]" .hide))))
(append
(mastodon-http--build-array-params-alist
"poll[options][]"
(plist-get mastodon-toot-poll :options))
`(("poll[expires_in]" . ,(plist-get mastodon-toot-poll :expiry)))
`(("poll[multiple]" . ,(symbol-name (plist-get mastodon-toot-poll :multi))))
`(("poll[hide_totals]" . ,(symbol-name (plist-get mastodon-toot-poll :hide)))))))
;;; SEND TOOT FUNCTION
(defun mastodon-toot-send ()
"POST contents of new-toot buffer to fediverse instance and kill buffer.
If media items have been attached and uploaded with
`mastodon-toot-attach-media', they are attached to the toot.
If `mastodon-toot--edit-item-id' is non-nil, PUT contents to
instance to edit a toot."
(interactive)
(let* ((toot (mastodon-toot--remove-docs))
(scheduled mastodon-toot--scheduled-for)
(scheduled-id mastodon-toot--scheduled-id)
(edit-id mastodon-toot--edit-item-id)
(endpoint (mastodon-http--api (if edit-id ; we are sending an edit:
(format "statuses/%s" edit-id)
"statuses")))
(args-no-media
(append
`(("status" . ,toot)
("in_reply_to_id" . ,mastodon-toot--reply-to-id)
("visibility" . ,mastodon-toot--visibility)
("sensitive" . ,(when mastodon-toot--content-nsfw
(symbol-name t)))
("spoiler_text" . ,mastodon-toot--content-warning)
("language" . ,mastodon-toot--language))
;; Pleroma instances can't handle null-valued
;; scheduled_at args, so only add if non-nil
(when scheduled `(("scheduled_at" . ,scheduled)))))
(args-media (when mastodon-toot--media-attachment-ids
(mastodon-http--build-array-params-alist
"media_ids[]"
mastodon-toot--media-attachment-ids)))
(args-poll (when mastodon-toot-poll
(mastodon-toot--build-poll-params)))
;; media || polls:
(args (if mastodon-toot--media-attachment-ids
(append args-media args-no-media)
(if mastodon-toot-poll
(append args-no-media args-poll)
args-no-media)))
(prev-window-config mastodon-toot-previous-window-config))
(cond ((and mastodon-toot--media-attachment-ids
;; make sure we have media args
;; and the same num of ids as attachments
(or (not args-media)
(not (= (length mastodon-toot--media-attachments)
(length mastodon-toot--media-attachment-ids)))))
(user-error "Something is wrong with your uploads. Wait for them to complete or try again"))
((and mastodon-toot--max-toot-chars
(> (mastodon-toot--count-toot-chars toot mastodon-toot--content-warning)
mastodon-toot--max-toot-chars))
(user-error "Looks like your toot (inc. CW) is longer than that maximum allowed length"))
;; polls must have text, so we use poll as flag for text-only
;; check here:
((mastodon-toot--empty-p mastodon-toot-poll)
(user-error "Empty toot. Cowardly refusing to post this"))
(t
(let ((response (funcall (if edit-id ; we are sending an edit:
#'mastodon-http--put
#'mastodon-http--post)
endpoint args)))
(mastodon-http--triage
response
(lambda (_)
;; kill buffer:
(mastodon-toot--kill)
;; nil our poll var:
(setq mastodon-toot-poll nil)
(message "Toot %s!" (if scheduled "scheduled" "toot"))
;; cancel scheduled toot if we were editing it:
(when scheduled-id
(mastodon-views-cancel-scheduled-toot
scheduled-id :no-confirm))
;; window config:
(mastodon-toot--restore-previous-window-config prev-window-config)
;; reload: - when we have been editing
;; - when we are in thread view
;; (we don't reload in every case as it can be slow and we
;; may lose our place in a timeline.)
(let ((type (mastodon-tl--get-buffer-type)))
(when (or edit-id
(eq 'single-status type)
(eq 'thread type))
(let ((pos (marker-position (cadr prev-window-config))))
(mastodon-tl--reload-timeline-or-profile pos)))))))))))
;;; EDITING TOOTS:
(defun mastodon-toot-edit-toot-at-point ()
"Edit the user's toot at point."
(interactive)
(mastodon-toot--with-toot-item
(let ((toot (mastodon-toot--base-toot-or-item-json)))
(if (not (mastodon-toot--own-toot-p toot))
(user-error "You can only edit your own toots")
(let* ((source (mastodon-toot--get-toot-source id))
(content (alist-get 'text source))
(source-cw (alist-get 'spoiler_text source)))
(let-alist toot
(when (y-or-n-p "Edit this toot? ")
(mastodon-toot--compose-buffer nil .in_reply_to_id nil
content :edit)
(goto-char (point-max))
;; adopt reply-to-id, visibility, CW, language, and media:
(mastodon-toot--set-toot-properties .in_reply_to_id .visibility
source-cw .language nil nil
;; maintain media order:
(reverse .media_attachments) .poll)
(setq mastodon-toot--edit-item-id id))))))))
(defun mastodon-toot--get-toot-source (id)
"Fetch the source JSON of toot with ID."
(let ((url (mastodon-http--api (format "/statuses/%s/source" id))))
(mastodon-http--get-json url nil :silent)))
(defun mastodon-toot--get-toot-edits (id)
"Return the edit history of toot with ID."
(let* ((url (mastodon-http--api (format "statuses/%s/history" id))))
(mastodon-http--get-json url)))
(defun mastodon-toot-view-toot-edits ()
"View editing history of the toot at point in a popup buffer."
(interactive)
(let ((id (mastodon-tl--property 'base-item-id))
(history (mastodon-tl--property 'edit-history)) ;; at byline
(buf "*mastodon-toot-edits*"))
(if (not history)
(user-error "No editing history for this toot")
(with-mastodon-buffer buf #'special-mode :other-window
(cl-loop for count from 1
for x in history
do (insert (propertize (if (= count 1)
(format "%s [original]:\n" count)
(format "%s:\n" count))
'face 'mastodon-toot-docs-face)
(mastodon-toot--insert-toot-iter x)
"\n"))
(goto-char (point-min))
(setq-local header-line-format
(propertize
(format "Edits to toot by %s:"
(alist-get 'username
(alist-get 'account (car history))))
'face 'mastodon-toot-docs-face))
(mastodon-tl--set-buffer-spec (buffer-name (current-buffer))
(format "statuses/%s/history" id)
nil)))))
(defun mastodon-toot--insert-toot-iter (it)
"Insert iteration IT of toot."
(let ((content (alist-get 'content it)))
;; TODO: handle polls, media
(mastodon-tl--render-text content)))
(defun mastodon-toot--restore-previous-window-config (config)
"Restore the window CONFIG after killing the toot compose buffer.
Buffer-local variable `mastodon-toot-previous-window-config' holds the config."
(set-window-configuration (car config))
(goto-char (cadr config)))
(defun mastodon-toot--mentions-to-string (mentions)
"Apply `mastodon-toot--process-local' function to each mention in MENTIONS.
Remove empty string (self) from result and joins the sequence with whitespace."
(let ((mentions (remove ""
(mapcar #'mastodon-toot--process-local mentions))))
(mapconcat #'identity mentions " ")))
(defun mastodon-toot--process-local (acct)
"Add domain to local ACCT and replace the curent user name with \"\".
Mastodon requires the full @user@domain, even in the case of local accts.
eg. \"user\" -> \"@user@local.social\" (when local.social is the domain of the
`mastodon-instance-url').
eg. \"yourusername\" -> \"\"
eg. \"feduser@fed.social\" -> \"@feduser@fed.social\"."
(cond ((string-match-p "@" acct) (concat "@" acct)) ; federated acct
((string= (mastodon-auth--user-acct) acct) "") ; your acct
(t
(concat "@" acct "@" ; local acct
(cadr
(split-string mastodon-instance-url "/" :omit-nulls))))))
;;; COMPLETION (TAGS, MENTIONS)
(defun mastodon-toot--mentions (status)
"Extract mentions (not the reply-to author or booster) from STATUS.
The mentioned users look like this:
Local user (including the logged in): `username`.
Federated user: `username@host.co`."
(let* ((mentions (mastodon-tl--field 'mentions status)))
;; reverse does not work on vectors in 24.5
(mastodon-tl--map-alist 'acct (reverse mentions))))
(defun mastodon-toot--get-bounds (regex)
"Get bounds of tag or handle before point using REGEX."
;; # and @ are not part of any existing thing at point
(save-match-data
(save-excursion
;; match full handle inc. domain, or tag including #
;; (see the regexes for subexp 2)
(when (re-search-backward regex
(save-excursion (forward-whitespace -1)
(point))
:no-error)
(cons (match-beginning 2)
(match-end 2))))))
(defun mastodon-toot--fetch-emojify-candidates ()
"Get the candidates to be used for emojis completion.
The candidates are calculated according to currently active
`emojify-emoji-styles'. Hacked off
`emojify--get-completing-read-candidates'."
(let ((styles (mapcar #'symbol-name emojify-emoji-styles)))
(let ((emojis '()))
(emojify-emojis-each
(lambda (key value)
(when (seq-position styles (ht-get value "style"))
(push (cons key
(format "%s (%s)"
(ht-get value "name")
(ht-get value "style")))
emojis))))
emojis)))
(defun mastodon-toot--fetch-candidates (start end &optional type)
"Search for a completion prefix from buffer positions START to END.
Return a list of candidates.
TYPE is the candidate type, it may be :tags, :handles, or :emoji."
;; we can't save the first two-letter search then only filter the
;; resulting list, as max results returned is 40.
(setq mastodon-toot-completions
(cond ((eq type :tags)
(let ((tags-list (mastodon-search--search-tags-query
(buffer-substring-no-properties start end))))
(cl-loop for tag in tags-list
collect (cons (concat "#" (car tag))
(cdr tag)))))
((eq type :emoji)
(when (bound-and-true-p emojify-mode)
(mastodon-toot--fetch-emojify-candidates)))
(t
(mastodon-search--search-accounts-query
(buffer-substring-no-properties start end))))))
(defun mastodon-toot--make-capf (regex annot-fun type)
"Build a completion backend for `completion-at-point-functions'.
REGEX is the regex to match preceding text.
TYPE is a keyword symbol for `mastodon-toot--fetch-candidates'.
ANNOT-FUN is a function returning an annotatation from a single
arg, a candidate."
(let* ((bounds (mastodon-toot--get-bounds regex))
(start (car bounds))
(end (cdr bounds)))
(when bounds
(list start
end
(completion-table-dynamic ; only search when necessary
(lambda (_)
;; Interruptible candidate computation, from minad/d mendler, thanks!
(let ((result
(while-no-input
(mastodon-toot--fetch-candidates
start end type))))
(and (consp result) result))))
:exclusive 'no
:annotation-function
(lambda (cand)
(concat " " (funcall annot-fun cand)))))))
(defun mastodon-toot--mentions-capf ()
"Build a mentions completion backend for `completion-at-point-functions'."
(mastodon-toot--make-capf mastodon-toot-handle-regex
#'mastodon-toot--mentions-annotation-fun
:handles))
(defun mastodon-toot--tags-capf ()
"Build a tags completion backend for `completion-at-point-functions'."
(mastodon-toot--make-capf mastodon-toot-tag-regex
#'mastodon-toot--tags-annotation-fun
:tags))
(defun mastodon-toot--emoji-capf ()
"Build an emoji completion backend for `completion-at-point-functions'."
(mastodon-toot--make-capf mastodon-toot-emoji-regex
#'mastodon-toot--emoji-annotation-fun
:emoji))
(defun mastodon-toot--mentions-annotation-fun (candidate)
"Given a handle completion CANDIDATE, return its annotation string, a username."
(caddr (assoc candidate mastodon-toot-completions)))
(defun mastodon-toot--tags-annotation-fun (candidate)
"Given a tag string CANDIDATE, return an annotation, the tag's URL."
;; TODO: check the list returned here? should be cadr
;; or make it an alist and use cdr
(cadr (assoc candidate mastodon-toot-completions)))
(defun mastodon-toot--emoji-annotation-fun (candidate)
"CANDIDATE."
;; TODO: emoji image as annot
(cdr (assoc candidate mastodon-toot-completions)))
;;; REPLY
(defun mastodon-toot-reply ()
"Reply to toot at `point'.
Customize `mastodon-toot-display-orig-in-reply-buffer' to display
text of the toot being replied to in the compose buffer.
If the region is active, inject it into the reply buffer,
prefixed by >."
(interactive)
(mastodon-toot--with-toot-item
(let* ((quote (when (region-active-p)
(buffer-substring (region-beginning)
(region-end))))
(toot (mastodon-toot--base-toot-or-item-json))
(account (mastodon-tl--field 'account toot))
(user (alist-get 'acct account))
(mentions (mastodon-toot--mentions toot))
(boosted (mastodon-tl--field 'reblog toot))
(booster (when boosted
(alist-get 'acct
(alist-get 'account toot))))
(mentions
(cond ((and booster ;; different booster, user and mentions:
(and (not (string= user booster))
(not (member booster mentions))))
(mastodon-toot--mentions-to-string
(append (list user booster) mentions nil)))
((not (member user mentions)) ;; user not in mentions:
(mastodon-toot--mentions-to-string
(append (list user) mentions nil)))
(t ;; user already in mentions:
(mastodon-toot--mentions-to-string
(copy-sequence mentions))))))
(mastodon-toot--compose-buffer mentions id toot quote))))
;;; COMPOSE TOOT SETTINGS
(defun mastodon-toot-set-content-warning ()
"Set a content warning for the current toot."
(interactive)
(setq mastodon-toot--content-warning
(read-string "Warning: " mastodon-toot--content-warning))
(mastodon-toot--update-status-fields))
(defun mastodon-toot-toggle-nsfw ()
"Toggle `mastodon-toot--content-nsfw'."
(interactive)
(setq mastodon-toot--content-nsfw
(not mastodon-toot--content-nsfw))
(message "NSFW flag is now %s" (if mastodon-toot--content-nsfw "on" "off"))
(mastodon-toot--update-status-fields))
(defun mastodon-toot-change-visibility (&optional arg)
"Change the current visibility to the next valid value.
With prefix ARG, read a visibility type in the minibuffer."
(interactive "P")
(if (mastodon-tl--buffer-type-eq 'edit-toot)
(user-error "You can't change visibility when editing toots")
(setq mastodon-toot--visibility
(if arg
(completing-read "Visibility: "
mastodon-toot-visibility-list)
(cond ((string= mastodon-toot--visibility "public")
"unlisted")
((string= mastodon-toot--visibility "unlisted")
"private")
((string= mastodon-toot--visibility "private")
"direct")
(t
"public"))))
(mastodon-toot--update-status-fields)))
(defun mastodon-toot-set-toot-language ()
"Prompt for a language and set `mastodon-toot--language'.
Return its two letter ISO 639 1 code."
(interactive)
(let* ((choice (completing-read "Language for this toot: "
mastodon-iso-639-1)))
(setq mastodon-toot--language
(alist-get choice mastodon-iso-639-1 nil nil #'string=))
(message "Language set to %s" choice)
(mastodon-toot--update-status-fields)))
;;; ATTACHMENTS
(defun mastodon-toot-clear-all-attachments ()
"Remove all attachments from a toot draft."
(interactive)
(setq mastodon-toot--media-attachments nil)
(setq mastodon-toot--media-attachment-ids nil)
(mastodon-toot--refresh-attachments-display)
(mastodon-toot--update-status-fields))
(defun mastodon-toot--get-instance-max-attachments ()
"Return the maximum attachments from `mastodon-active-user's instance.
If that fails, return 4 as a fallback"
;; FIXME: this likely various for other server types:
;; pleroma doesn't advertise this on "api/v1/instance" (checked
;; fe.disroot.org)
(or
(let ((config (alist-get 'statuses
(alist-get 'configuration
(mastodon-views--get-own-instance)))))
(alist-get 'max_media_attachments config))
4)) ; mastodon default as fallback
(defun mastodon-toot-attach-media (file description)
"Prompt for an attachment FILE with DESCRIPTION.
A preview is displayed in the new toot buffer, and the file
is uploaded asynchronously using `mastodon-toot--upload-attached-media'.
File is actually attached to the toot upon posting."
(interactive "fFilename: \nsDescription: ")
(let ((max-attachments (mastodon-toot--get-instance-max-attachments)))
(when (>= (length mastodon-toot--media-attachments)
max-attachments)
;; warn + pop the oldest one:
(when (y-or-n-p
(format "Maximum attachments (%s) reached: remove first one?"
max-attachments))
(pop mastodon-toot--media-attachments)))
(if (file-directory-p file)
(user-error "Looks like you chose a directory not a file")
(setq mastodon-toot--media-attachments
(nconc mastodon-toot--media-attachments
`(((:contents . ,(mastodon-http--read-file-as-string file))
(:description . ,description)
(:filename . ,file)))))
(mastodon-toot--refresh-attachments-display)
;; upload only most recent attachment:
(mastodon-toot--upload-attached-media
(car (last mastodon-toot--media-attachments))))))
(defun mastodon-toot--attachment-descriptions ()
"Return a list of image descriptions for current attachments."
(mastodon-tl--map-alist :description mastodon-toot--media-attachments))
(defun mastodon-toot--attachment-from-desc (desc)
"Return an attachment based on its description DESC."
(car
(cl-member-if (lambda (x)
(rassoc desc x))
mastodon-toot--media-attachments)))
(defun mastodon-toot-edit-media-description ()
"Prompt for an attachment, and update its description."
(interactive)
(let* ((descs (mastodon-toot--attachment-descriptions))
(choice (completing-read "Attachment: " descs nil :match))
(attachment (mastodon-toot--attachment-from-desc choice))
(desc-new (read-string "Description: " choice)))
(setf (alist-get :description attachment)
desc-new)
(mastodon-toot--refresh-attachments-display)))
(defun mastodon-toot--upload-attached-media (attachment)
"Upload a single ATTACHMENT using `mastodon-http--post-media-attachment'.
The item's id is added to `mastodon-toot--media-attachment-ids',
which is used to attach it to a toot when posting."
(let* ((filename (expand-file-name (alist-get :filename attachment)))
(caption (alist-get :description attachment))
(url (concat mastodon-instance-url "/api/v2/media")))
(message "Uploading %s... (please wait before starting further uploads)"
(file-name-nondirectory filename))
(mastodon-http--post-media-attachment url filename caption)))
(defun mastodon-toot--refresh-attachments-display ()
"Update the display attachment previews in toot draft buffer."
(let ((inhibit-read-only t)
(attachments-region (mastodon-tl--find-property-range
'toot-attachments (point-min)))
(display-specs (mastodon-toot--format-attachments)))
(dotimes (i (- (cdr attachments-region) (car attachments-region)))
(add-text-properties (+ i (car attachments-region))
(+ i 1 (car attachments-region))
(list 'display (or (nth i display-specs) ""))))))
(defun mastodon-toot--format-attachments ()
"Format the attachment previews for display in toot draft buffer."
(or
(let ((image-options (when (mastodon-tl--image-trans-check)
`(:height ,mastodon-toot--attachment-height))))
(cl-loop for count from 1
for att in mastodon-toot--media-attachments
nconc
(let* ((data (alist-get :contents att))
(image (apply #'create-image data
(if (version< emacs-version "27.1")
(when image-options 'imagemagick)
nil) ; inbuilt scaling in 27.1
t image-options))
(desc (alist-get :description att)))
(list (format "\n %d: " count)
image
(format " \"%s\"" desc)))))
(list "None")))
;;; POLL
(defun mastodon-toot--fetch-max-poll-options (instance)
"Return the maximum number of poll options from JSON data INSTANCE."
(mastodon-toot--fetch-poll-field 'max_options instance))
(defun mastodon-toot--fetch-max-poll-option-chars (instance)
"Return the maximum number of characters a poll option may have.
INSTANCE is JSON."
(if (alist-get 'pleroma instance)
(mastodon-toot--fetch-poll-field 'max_option_chars instance)
(or (mastodon-toot--fetch-poll-field 'max_characters_per_option instance)
50))) ; masto default
(defun mastodon-toot--fetch-poll-field (field instance)
"Return FIELD from the poll settings from JSON data INSTANCE."
(let* ((polls (if (alist-get 'pleroma instance)
(alist-get 'poll_limits instance)
(alist-get 'polls
(alist-get 'configuration instance)))))
(alist-get field polls)))
(defun mastodon-toot--read-poll-options-count (max)
"Read the user's choice of the number of options the poll should have.
MAX is the maximum number set by their instance."
(let ((number (read-number (format "Number of options [2-%s]: " max) 2)))
(if (> number max)
(user-error "You need to choose a number between 2 and %s" max)
number)))
(defun mastodon-toot-create-poll ()
"Prompt for new poll options and return as a list."
(interactive)
(if mastodon-toot-poll-use-transient
(call-interactively #'mastodon-create-poll)
(mastodon-toot--read-poll)))
(defun mastodon-toot--read-poll ()
"Read poll options."
(let* ((instance (mastodon-instance-data))
(max-options (mastodon-toot--fetch-max-poll-options instance))
(count (mastodon-toot--read-poll-options-count max-options))
(length (mastodon-toot--fetch-max-poll-option-chars instance))
(multiple-p (y-or-n-p "Multiple choice? "))
(options (mastodon-toot--read-poll-options count length))
(hide-totals (y-or-n-p "Hide votes until poll ends? "))
(expiry (mastodon-toot--read-poll-expiry))
(expiry-str (cdr expiry))
(expiry-human (car expiry)))
(setq mastodon-toot-poll
`( :options ,options :length ,length :expiry-readable ,expiry-human
:expiry ,expiry-str :multi ,multiple-p :hide ,hide-totals))
(message "poll created!")
(mastodon-toot--update-status-fields)))
(defun mastodon-toot--read-poll-options (count length)
"Read a list of options for poll with COUNT options.
LENGTH is the maximum character length allowed for a poll option."
(let* ((choices
(cl-loop for x from 1 to count
collect (read-string
(format "Poll option [%s/%s] [max %s chars]: "
x count length))))
(longest (apply #'max (mapcar #'length choices))))
(if (not (> longest length))
choices
(user-error "Looks like you went over the max length. Try again")
(sleep-for 2)
(mastodon-toot--read-poll-options count length))))
(defun mastodon-toot--read-poll-expiry ()
"Prompt for a poll expiry time.
Return a cons of a human readable string, and a seconds-from-now string."
;; API requires this in seconds
(let* ((options (mastodon-toot--poll-expiry-options-alist))
(response (completing-read "poll ends in [or enter seconds]: "
options nil 'confirm)))
(or (assoc response options #'string=)
(if (< (string-to-number response) 300)
(cons "5 minutes" (number-to-string (* 60 5))) ;; min 5 mins
(cons (format "%s seconds" response) response)))))
(defun mastodon-toot--poll-expiry-options-alist ()
"Return an alist of expiry options options in seconds."
`(("5 minutes" . ,(number-to-string (* 60 5)))
("30 minutes" . ,(number-to-string (* 60 30)))
("1 hour" . ,(number-to-string (* 60 60)))
("6 hours" . ,(number-to-string (* 60 60 6)))
("1 day" . ,(number-to-string (* 60 60 24)))
("3 days" . ,(number-to-string (* 60 60 24 3)))
("7 days" . ,(number-to-string (* 60 60 24 7)))
("14 days" . ,(number-to-string (* 60 60 24 14)))
("30 days" . ,(number-to-string (* 60 60 24 30)))))
(defun mastodon-toot-clear-poll (&optional transient)
"Remove poll from toot compose buffer.
Sets `mastodon-toot-poll' to nil.
If TRANSIENT, we are called from a transient, so nil
`tp-transient-settings' too."
(interactive)
(let ((var (if transient
'tp-transient-settings
'mastodon-toot-poll)))
(if (not (symbol-value var))
(user-error "No poll?")
(set var nil)
(when transient
(setq mastodon-toot-poll nil))
(mastodon-toot--update-status-fields))))
(defun mastodon-toot--server-poll-to-local (json)
"Convert server poll data JSON to a `mastodon-toot-poll' plist."
(let-alist json
(let* ((expiry-seconds-rel
(time-to-seconds
(time-subtract
(encode-time
(parse-time-string .expires_at))
(current-time))))
(expiry-str (format-time-string "%s" expiry-seconds-rel))
(expiry-human (car
(mastodon-tl--human-duration expiry-seconds-rel)))
(options (mastodon-tl--map-alist 'title .options))
(multiple (if (eq :json-false .multiple) nil t)))
(if mastodon-toot-poll-use-transient
(setq mastodon-toot-poll
`((multi . ,multiple)
(expiry . ,expiry-str)
;; (hide . ,hide)
(one . ,(nth 0 options))
(two . ,(nth 1 options))
(three . ,(nth 2 options))
(four . ,(nth 3 options))))
(setq mastodon-toot-poll
`( :options ,options :expiry-readable ,expiry-human
:expiry ,expiry-str :multi ,multiple))))))
;;; SCHEDULE
(defun mastodon-toot-schedule-toot (&optional reschedule)
"Read a date (+ time) in the minibuffer and schedule the current toot.
With RESCHEDULE, reschedule the scheduled toot at point without editing."
;; original idea by christian tietze, thanks!
;; https://codeberg.org/martianh/mastodon.el/issues/285
(interactive)
(cond ((mastodon-tl--buffer-type-eq 'edit-toot)
(user-error "You can't schedule toots you're editing"))
((not (or (mastodon-tl--buffer-type-eq 'new-toot)
(mastodon-tl--buffer-type-eq 'scheduled-statuses)))
(user-error "You can only schedule toots from the compose buffer or scheduled toots view"))
(t
(let* ((id (when reschedule (mastodon-tl--property 'id :no-move)))
(ts (when reschedule
(alist-get 'scheduled_at
(mastodon-tl--property 'scheduled-json :no-move))))
(time-value
(org-read-date t t nil "Schedule toot:"
;; default to scheduled timestamp if already set:
(mastodon-toot--iso-to-org
;; we are rescheduling without editing:
(or ts
;; we are maybe editing the scheduled toot:
mastodon-toot--scheduled-for))))
(iso8601-str (format-time-string "%FT%T%z" time-value))
(msg-str (format-time-string "%d-%m-%y at %H:%M[%z]" time-value)))
(if (not reschedule)
(progn
(setq-local mastodon-toot--scheduled-for iso8601-str)
(message "Toot scheduled for %s." msg-str))
(let* ((args `(("scheduled_at" . ,iso8601-str)))
(url (mastodon-http--api (format "scheduled_statuses/%s" id)))
(response (mastodon-http--put url args)))
(mastodon-http--triage
response
(lambda (_)
;; reschedule means we are in scheduled toots view:
(mastodon-views-view-scheduled-toots)
(message "Toot rescheduled for %s." msg-str)))))))))
(defun mastodon-toot--iso-to-human (ts)
"Format an ISO8601 timestamp TS to be more human-readable."
(let* ((decoded (iso8601-parse ts))
(encoded (encode-time decoded)))
(format-time-string "%d-%m-%y, %H:%M[%z]" encoded)))
(defun mastodon-toot--iso-to-org (ts)
"Convert ISO8601 timestamp TS to something `org-read-date' can handle."
(when ts
(let* ((decoded (iso8601-parse ts)))
(encode-time decoded))))
;;; DISPLAY KEYBINDINGS
(defun mastodon-toot--get-kbinds ()
"Get a list of the keybindings in the `mastodon-toot-mode'."
(let* ((binds (copy-tree mastodon-toot-mode-map))
(prefix (car (cadr binds)))
(bindings (remove nil
(mapcar (lambda (i)
(when (listp i) i))
(cadr binds)))))
(mapcar (lambda (b)
(setf (car b) (vector prefix (car b)))
b)
bindings)))
(defun mastodon-toot--format-kbind-command (cmd)
"Format CMD to be more readable.
e.g. `mastodon-toot-send' -> Send."
(let* ((str (symbol-name cmd))
(re "mastodon-toot-\\(.*\\)$")
(str2 (save-match-data
(string-match re str)
(match-string 1 str))))
(capitalize (replace-regexp-in-string "-" " " str2))))
(defun mastodon-toot--format-kbind (kbind)
"Format a single keybinding, KBIND, for display in documentation."
(let ((key (concat "\\`"
(help-key-description (car kbind) nil)
"'"))
(command (mastodon-toot--format-kbind-command (cdr kbind))))
(substitute-command-keys
(format
(concat (mastodon-toot--comment " ")
"%-10s"
(mastodon-toot--comment " - %s"))
key command))))
(defun mastodon-toot--comment (str)
"Propertize STR with `mastodon-toot-docs-face'."
(propertize str
'face 'mastodon-toot-docs-face))
(defun mastodon-toot--format-kbinds (kbinds)
"Format a list of keybindings, KBINDS, for display in documentation."
(mapcar #'mastodon-toot--format-kbind kbinds))
(defvar-local mastodon-toot--kbinds-pairs nil
"Contains a list of paired toot compose buffer keybindings for inserting.")
(defun mastodon-toot--formatted-kbinds-pairs (kbinds-list longest)
"Return a list of strings each containing two formatted kbinds.
KBINDS-LIST is the list of formatted bindings to pair.
LONGEST is the length of the longest binding."
(when kbinds-list
(push (concat "\n"
(car kbinds-list)
(make-string (- (1+ longest) (length (car kbinds-list)))
?\ )
(cadr kbinds-list))
mastodon-toot--kbinds-pairs)
(mastodon-toot--formatted-kbinds-pairs (cddr kbinds-list) longest))
(reverse mastodon-toot--kbinds-pairs))
(defun mastodon-toot--kbinds-longest (kbinds-list)
"Return the length of the longest item in KBINDS-LIST."
(let ((lengths (mapcar #'length kbinds-list)))
(car (sort lengths #'>))))
;;; DISPLAY DOCS
(defun mastodon-toot--make-mode-docs ()
"Create formatted documentation text for `mastodon-toot-mode'."
(let* ((kbinds (mastodon-toot--get-kbinds))
(formatted (mastodon-toot--format-kbinds kbinds))
(longest-kbind (mastodon-toot--kbinds-longest
formatted)))
(concat
(mastodon-toot--comment
" Compose a new toot here. The following keybindings are available:")
(mapconcat
#'identity
(mastodon-toot--formatted-kbinds-pairs formatted longest-kbind)
nil))))
(defun mastodon-toot--format-reply-in-compose (reply-text)
"Format a REPLY-TEXT for display in compose buffer docs."
(let* ((rendered (mastodon-tl--render-text reply-text))
(no-props (substring-no-properties rendered))
;; FIXME: this replaces \n at end of every post, so we have to trim:
(no-newlines (string-trim
(replace-regexp-in-string "[\n]+" " " no-props)))
(reply-to (concat " Reply to: \"" no-newlines "\""))
(crop (truncate-string-to-width reply-to
mastodon-toot-orig-in-reply-length)))
(if (> (length no-newlines)
(length crop)) ; we cropped:
(concat crop "\n")
(concat reply-to "\n"))))
(defun mastodon-toot--display-docs-and-status-fields (&optional reply-text)
"Insert propertized text with documentation about `mastodon-toot-mode'.
Also includes and the status fields which will get updated based
on the status of NSFW, content warning flags, media attachments, etc.
REPLY-TEXT is the text of the toot being replied to."
(let ((divider
"|=================================================================|"))
(insert
(concat
(mastodon-toot--make-mode-docs) "\n"
(mastodon-toot--comment divider) "\n"
(propertize
(concat
" "
(propertize "Count"
'toot-post-counter t)
" â
"
(propertize "Visibility"
'toot-post-visibility t)
" â
"
(propertize "Language"
'toot-post-language t)
" "
(propertize "Scheduled"
'toot-post-scheduled t)
" "
(propertize "CW"
'toot-post-cw-flag t)
" "
(propertize "POLL"
'toot-post-poll-flag t)
" "
(propertize "NSFW"
'toot-post-nsfw-flag t)
"\n"
" Attachments: "
(propertize "None "
'toot-attachments t)
"\n"
(when reply-text
(propertize
(mastodon-toot--format-reply-in-compose reply-text)
'toot-reply t))
divider)
'face 'mastodon-toot-docs-face
'read-only "Edit your message below."
'toot-post-header t))
;; allow us to enter text after read-only header:
(propertize "\n\n"
'rear-nonsticky t))))
(defun mastodon-toot--most-restrictive-visibility (reply-visibility)
"Return REPLY-VISIBILITY or default visibility, whichever is more restrictive.
The default is given by `mastodon-toot--default-reply-visibility'."
(unless (null reply-visibility)
(let ((less-restrictive (member (intern mastodon-toot--default-reply-visibility)
mastodon-toot-visibility-list)))
(if (member (intern reply-visibility) less-restrictive)
reply-visibility
mastodon-toot--default-reply-visibility))))
(defun mastodon-toot--render-reply-region-str (str)
"Refill STR and prefix all lines with >, as reply-quote text."
(with-temp-buffer
(insert str)
;; unfill first:
(let ((fill-column (point-max)))
(fill-region (point-min) (point-max)))
;; then fill:
(fill-region (point-min) (point-max))
;; add our own prefix, pauschal:
(goto-char (point-min))
(save-match-data
(while (re-search-forward "^" nil t)
(replace-match " > ")))
(buffer-substring-no-properties (point-min) (point-max))))
(defun mastodon-toot--setup-as-reply (reply-to-user reply-to-id
reply-json reply-region)
"If REPLY-TO-USER is provided, inject their handle into the message.
If REPLY-TO-ID is provided, set `mastodon-toot--reply-to-id'.
REPLY-JSON is the full JSON of the toot being replied to.
REPLY-REGION is a string to be injected into the buffer."
(let ((reply-visibility (mastodon-toot--most-restrictive-visibility
(alist-get 'visibility reply-json)))
(reply-cw (alist-get 'spoiler_text reply-json)))
(when reply-to-user
(when (> (length reply-to-user) 0) ; self is "" unforch
(insert (format "%s " reply-to-user)))
(when reply-region
(insert "\n"
(mastodon-toot--render-reply-region-str reply-region)
"\n"))
(setq mastodon-toot--reply-to-id reply-to-id)
(unless (string= mastodon-toot--visibility reply-visibility)
(setq mastodon-toot--visibility reply-visibility))
(mastodon-toot--set-cw reply-cw))))
(defun mastodon-toot--update-status-fields (&rest _args)
"Update the status fields in the header based on the current state."
(ignore-errors ;; called from after-change-functions so let's not leak errors
(let* ((inhibit-read-only t)
(header-region (mastodon-tl--find-property-range 'toot-post-header
(point-min)))
(count-region (mastodon-tl--find-property-range 'toot-post-counter
(point-min)))
(vis-region (mastodon-tl--find-property-range
'toot-post-visibility (point-min)))
(nsfw-region (mastodon-tl--find-property-range 'toot-post-nsfw-flag
(point-min)))
(cw-region (mastodon-tl--find-property-range 'toot-post-cw-flag
(point-min)))
(lang-region (mastodon-tl--find-property-range 'toot-post-language
(point-min)))
(sched-region (mastodon-tl--find-property-range 'toot-post-scheduled
(point-min)))
(poll-region (mastodon-tl--find-property-range 'toot-post-poll-flag
(point-min)))
(toot-string (buffer-substring-no-properties (cdr header-region)
(point-max))))
(mastodon-toot--apply-fields-props
count-region
(format "%s/%s chars"
(mastodon-toot--count-toot-chars toot-string)
(number-to-string mastodon-toot--max-toot-chars)))
(mastodon-toot--apply-fields-props
vis-region
(format "%s"
(if (string= "private" mastodon-toot--visibility)
"followers-only"
mastodon-toot--visibility)))
;; WHEN clauses don't work here, we need "" as display arg:
(mastodon-toot--apply-fields-props
lang-region
(if mastodon-toot--language
(format "Lang: %s â
" mastodon-toot--language)
""))
(mastodon-toot--apply-fields-props
sched-region
(if mastodon-toot--scheduled-for
(format "Scheduled: %s â
"
(mastodon-toot--iso-to-human
mastodon-toot--scheduled-for))
""))
(mastodon-toot--apply-fields-props
nsfw-region
(if mastodon-toot--content-nsfw
(if mastodon-toot--media-attachments
"NSFW" "NSFW (attachments only)")
"")
'mastodon-cw-face)
(mastodon-toot--apply-fields-props
poll-region
(if mastodon-toot-poll
"POLL"
"")
'mastodon-cw-face
(prin1-to-string mastodon-toot-poll))
(mastodon-toot--apply-fields-props
cw-region
(if (and mastodon-toot--content-warning
(not (string= "" mastodon-toot--content-warning)))
(format "CW: %s" mastodon-toot--content-warning)
" ") ;; hold the blank space
'mastodon-cw-face))))
(defun mastodon-toot--apply-fields-props (region display &optional face help-echo)
"Apply DISPLAY props FACE and HELP-ECHO to REGION, a cons of beg and end."
(add-text-properties (car region) (cdr region)
`(display
,display
,@(when face `(face ,face))
,@(when help-echo `(help-echo ,help-echo)))))
(defun mastodon-toot--count-toot-chars (toot-string &optional cw)
"Count the characters in TOOT-STRING.
URLs always = 23, and domain names of handles are not counted.
This is how mastodon does it.
CW is the content warning, which contributes to the character count."
;; FIXME: URL chars is avail at /api/v1/instance
;; for masto, it's .statuses.characters_reserved_per_url
(let* ((url-replacement (make-string 23 ?x))
(count-str (replace-regexp-in-string ; handle @handles
mastodon-toot-handle-regex "\2"
(replace-regexp-in-string ; handle URLs
mastodon-toot-url-regex url-replacement toot-string))))
(+ (length cw)
(length count-str))))
;;; DRAFTS
(defun mastodon-toot--save-toot-text (&rest _args)
"Save the current toot text in `mastodon-toot-current-toot-text'.
Added to `after-change-functions' in new toot buffers."
(let ((text (mastodon-toot--remove-docs)))
(unless (string-empty-p text)
(setq mastodon-toot-current-toot-text text))))
(defun mastodon-toot-open-draft-toot ()
"Prompt for a draft and compose a toot with it."
(interactive)
(if mastodon-toot-draft-toots-list
(let ((text (completing-read "Select draft toot: "
mastodon-toot-draft-toots-list
nil t)))
(if (not (mastodon-toot--compose-buffer-p))
(mastodon-toot--compose-buffer nil nil nil text)
(when (and (not (mastodon-toot--empty-p :text-only))
(y-or-n-p "Replace current text with draft?"))
(cl-pushnew mastodon-toot-current-toot-text
mastodon-toot-draft-toots-list)
(goto-char
(cdr (mastodon-tl--find-property-range 'toot-post-header
(point-min))))
(kill-region (point) (point-max))
;; to not save to kill-ring:
;; (delete-region (point) (point-max))
(insert text))))
(unless (mastodon-toot--compose-buffer-p)
(mastodon-toot--compose-buffer))
(message "No drafts available.")))
(defun mastodon-toot-delete-draft-toot ()
"Prompt for a draft toot and delete it."
(interactive)
(if (not mastodon-toot-draft-toots-list)
(user-error "No drafts to delete")
(let ((draft (completing-read "Select draft to delete: "
mastodon-toot-draft-toots-list
nil t)))
(setq mastodon-toot-draft-toots-list
(cl-delete draft mastodon-toot-draft-toots-list :test #'equal))
(message "Draft deleted!"))))
(defun mastodon-toot-delete-all-drafts ()
"Delete all drafts."
(interactive)
(setq mastodon-toot-draft-toots-list nil)
(message "All drafts deleted!"))
;;; PROPERTIZE TAGS AND HANDLES
(defun mastodon-toot--propertize-tags-and-handles (&rest _args)
"Propertize tags and handles in toot compose buffer.
Added to `after-change-functions'."
(when (mastodon-toot--compose-buffer-p)
(let ((header-region (mastodon-tl--find-property-range 'toot-post-header
(point-min)))
(face (when mastodon-toot--proportional-fonts-compose
'variable-pitch)))
;; cull any prev props:
;; stops all text after a handle or mention being propertized:
(set-text-properties (cdr header-region) (point-max) `(face ,face))
(mastodon-toot--propertize-item mastodon-toot-tag-regex
'success
(cdr header-region))
(mastodon-toot--propertize-item mastodon-toot-handle-regex
'mastodon-display-name-face
(cdr header-region))
(mastodon-toot--propertize-item mastodon-toot-url-regex
'link
(cdr header-region)))))
(defun mastodon-toot--propertize-item (regex face start)
"Propertize item matching REGEX with FACE starting from START."
(save-excursion
(goto-char start)
(cl-loop while (search-forward-regexp regex nil :noerror)
do (add-text-properties (match-beginning 2)
(match-end 2)
`(face ,face)))))
(defun mastodon-toot--compose-buffer-p ()
"Return t if compose buffer is current."
(or (mastodon-tl--buffer-type-eq 'edit-toot)
(mastodon-tl--buffer-type-eq 'new-toot)))
(defun mastodon-toot--fill-reply-in-compose ()
"Fill reply text in compose buffer to the width of the divider."
(save-excursion
(save-match-data
(let* ((fill-column 67))
(goto-char (point-min))
(when-let* ((prop (text-property-search-forward 'toot-reply)))
(fill-region (prop-match-beginning prop)
(point)))))))
;;; COMPOSE BUFFER FUNCTION
(defun mastodon-toot--compose-buffer
(&optional reply-to-user reply-to-id reply-json initial-text edit)
"Create a new buffer to capture text for a new toot.
If REPLY-TO-USER is provided, inject their handle into the message.
If REPLY-TO-ID is provided, set the `mastodon-toot--reply-to-id' var.
REPLY-JSON is the full JSON of the toot being replied to.
INITIAL-TEXT is used by `mastodon-toot-insert-draft-toot' to add
a draft into the buffer.
EDIT means we are editing an existing toot, not composing a new one."
(let* ((buffer-name (if edit "*edit toot*" "*new toot*"))
(buffer-exists (get-buffer buffer-name))
(buffer (if (not buffer-exists)
(get-buffer-create buffer-name)
;; if a user hits reply while a compose buffer is already
;; open, we really ought to wipe it all and start over.
(switch-to-buffer-other-window buffer-exists)
(if (not (y-or-n-p "Overwrite existing compose buffer?"))
(user-error "Aborting")
(kill-buffer-and-window)
(get-buffer-create buffer-name))))
(inhibit-read-only t)
(reply-text (alist-get 'content
(or (alist-get 'reblog reply-json)
reply-json)))
(previous-window-config (list (current-window-configuration)
(point-marker))))
(switch-to-buffer-other-window buffer)
(text-mode)
(mastodon-toot-mode t)
;; set visibility:
(setq mastodon-toot--visibility
(or (plist-get mastodon-profile-account-settings 'privacy)
;; use toot visibility setting from the server:
(mastodon-profile--get-source-value 'privacy)
"public")) ; fallback
;; default language:
;; NB: this is not necessarily set in
;; `mastodon-profile-credential-account' nor in
;; `mastodon-profile-account-settings'!
(setq mastodon-toot--language
(mastodon-profile--get-preferences-pref 'posting:default:language))
;; display original toot:
(if mastodon-toot-display-orig-in-reply-buffer
(progn
(mastodon-toot--display-docs-and-status-fields reply-text)
(mastodon-toot--fill-reply-in-compose))
(mastodon-toot--display-docs-and-status-fields))
;; `reply-to-user' (alone) is also used by `mastodon-tl-dm-user', so
;; perhaps we should not always call --setup-as-reply, or make its
;; workings conditional on reply-to-id. currently it only checks for
;; reply-to-user.
(mastodon-toot--setup-as-reply reply-to-user reply-to-id reply-json
;; only initial-text if reply (not edit):
(when reply-json initial-text))
(unless mastodon-toot--max-toot-chars
;; no need to fetch from `mastodon-profile-account-settings' as
;; `mastodon-toot--max-toot-chars' is set when we set it
(mastodon-toot--get-max-toot-chars))
;; set up completion:
(setq-local completion-ignore-case t)
(when mastodon-toot--enable-completion
(set (make-local-variable 'completion-at-point-functions)
(add-to-list 'completion-at-point-functions
#'mastodon-toot--mentions-capf))
(add-to-list 'completion-at-point-functions
#'mastodon-toot--tags-capf)
(add-to-list 'completion-at-point-functions
#'mastodon-toot--emoji-capf)
;; company
(when (and mastodon-toot--use-company-for-completion
(require 'company nil :no-error))
(declare-function company-mode-on "company")
(set (make-local-variable 'company-backends)
(add-to-list 'company-backends 'company-capf))
(company-mode-on)))
;; after-change:
(make-local-variable 'after-change-functions)
(cl-pushnew #'mastodon-toot--save-toot-text after-change-functions)
(cl-pushnew #'mastodon-toot--update-status-fields after-change-functions)
(mastodon-toot--update-status-fields)
(cl-pushnew #'mastodon-toot--propertize-tags-and-handles after-change-functions)
(mastodon-toot--propertize-tags-and-handles)
(mastodon-toot--refresh-attachments-display)
;; draft toot text saving:
(setq mastodon-toot-current-toot-text nil)
;; if we set this before changing modes, it gets nuked:
(setq mastodon-toot-previous-window-config previous-window-config)
(when mastodon-toot--proportional-fonts-compose
(facemenu-set-face 'variable-pitch))
(when (and mastodon-use-emojify
;; emojify loaded but poss not enabled in our buffer:
(boundp 'emojify-mode))
(emojify-mode))
(when (and initial-text
(not reply-json))
(insert initial-text))))
;; flyspell ignore masto toot regexes:
(defvar flyspell-generic-check-word-predicate)
(defun mastodon-toot-mode-flyspell-verify ()
"A predicate function for `flyspell'.
Only text that is not one of these faces will be spell-checked."
(let ((faces '(mastodon-display-name-face
mastodon-toot-docs-face font-lock-comment-face
success link)))
(unless (eql (point) (point-min))
;; (point) is next char after the word. Must check one char before.
(let ((f (get-text-property (1- (point)) 'face)))
(not (memq f faces))))))
(defun mastodon-toot-mode-hook-fun ()
"Function for code to run in `mastodon-toot-mode-hook'."
;; disable auto-fill-mode:
(auto-fill-mode -1)
;; add flyspell predicate function:
(setq flyspell-generic-check-word-predicate
#'mastodon-toot-mode-flyspell-verify))
(add-hook 'mastodon-toot-mode-hook #'mastodon-toot-mode-hook-fun)
;;;###autoload
(add-hook 'mastodon-toot-mode-hook
#'mastodon-profile--fetch-server-account-settings-maybe)
(define-minor-mode mastodon-toot-mode
"Minor mode for composing toots."
:keymap mastodon-toot-mode-map
:global nil)
(provide 'mastodon-toot)
;;; mastodon-toot.el ends here
mastodon.el/lisp/mastodon-transient.el 0000664 0000000 0000000 00000050006 15017331127 0020424 0 ustar 00root root 0000000 0000000 ;;; mastodon-transient.el --- transient menus for mastodon.el -*- lexical-binding: t; -*-
;; Copyright (C) 2024 martian hiatus
;; Author: martian hiatus
;; Keywords: convenience
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see .
;;; Commentary:
;;
;;; Code:
(require 'transient)
(require 'tp)
(defvar mastodon-active-user)
(defvar mastodon-toot-visibility-settings-list)
(defvar mastodon-iso-639-regional)
(defvar mastodon-toot-poll)
(autoload 'mastodon-toot-visibility-settings-list "mastodon-toot")
(autoload 'mastodon-http--get-json "mastodon-http")
(autoload 'mastodon-http--api "mastodon-http")
(autoload 'mastodon-http--triage "mastodon-http")
(autoload 'mastodon-http--patch "mastodon-http")
(autoload 'mastodon-profile-update-user-profile-note "mastodon-profile")
(autoload 'mastodon-toot--fetch-max-poll-options "mastodon-toot")
(autoload 'mastodon-toot--fetch-max-poll-option-chars "mastodon-toot")
(autoload 'mastodon-instance-data "mastodon")
(autoload 'mastodon-toot--update-status-fields "mastodon-toot")
(autoload 'mastodon-toot--read-poll-expiry "mastodon-toot")
(autoload 'mastodon-toot--poll-expiry-options-alist "mastodon-toot")
(autoload 'mastodon-toot-clear-poll "mastodon-toot")
(autoload 'mastodon-notifications-get-policy "mastodon-notifications")
;;; UTILS
(transient-define-suffix mastodon-transient--prefix-inspect ()
"Inspect a transient prefix's arguments and scope."
(interactive)
:transient 'transient--do-return
(let ((args (transient-args (oref transient-current-prefix command)))
(scope (oref transient-current-prefix scope)))
(message "prefix's scope: %s \ntransient-args: %s\n last: %s"
scope args
(length
(cl-member-if
(lambda (x)
(equal (car x) 'one))
args)))))
;; some JSON fields that are returned under the "source" field need to be
;; sent back in the format source[key], while some others are sent kust as
;; key:
(defun mastodon-transient-parse-source-key (key)
"Parse mastodon source KEY.
If KEY needs to be source[key], format like so, else just return
the inner key part."
(let* ((split (split-string key "[][]"))
(array-key (cadr split)))
(if (or (= 1 (length split)) ;; no split
(member array-key '("privacy" "sensitive" "language")))
key
array-key)))
(defun mastodon-transient-parse-source-keys (alist)
"Parse ALIST containing source[key] keys."
(cl-loop for a in alist
collect (cons (mastodon-transient-parse-source-key (car a))
(cdr a))))
(defun mastodon-transient-get-creds ()
"Fetch account data."
(mastodon-http--get-json
(mastodon-http--api "accounts/verify_credentials")
nil :silent))
;; fields utils:
;; to PATCH fields, we just need fields[x][name] and fields[x][value]
(defun mastodon-transient--fields-alist (fields)
"Convert fields in FIELDS to numbered conses.
The keys in the data are not numbered, so we convert the key into
the format fields.X.keyname."
(cl-loop
for f in fields
for count from 1 to 5
collect
(cl-loop for x in f
collect
(cons (concat "fields." (number-to-string count)
"." (symbol-name (car x)))
(cdr x)))))
(defun mastodon-transient-field-dot-to-array (key)
"Convert KEY from tp dot annotation to array[key] annotation."
(tp-dot-to-array (symbol-name key) nil "_attributes"))
(defun mastodon-transient-dot-fields-to-arrays (alist)
"Parse fields ALIST in dot notation to array notation."
(cl-loop for y in alist
collect
(cons (mastodon-transient-field-dot-to-array (car y))
(cdr y))))
;;; TRANSIENTS
;; FIXME: PATCHing source vals as JSON request body doesn't work! existing
;; `mastodon-profile--update-preference' doesn't use it! it just uses
;; query params! strange thing is it works for non-source params
(transient-define-suffix mastodon-user-settings-update (&optional args)
"Update current user settings on the server."
:transient 'transient--do-exit
(interactive (list (transient-args 'mastodon-user-settings)))
(let* ((parsed (tp-parse-args-for-send args :strings))
(strs (mastodon-transient-parse-source-keys parsed))
(url (mastodon-http--api "accounts/update_credentials"))
(resp (mastodon-http--patch url strs))) ;; :json fails
(mastodon-http--triage
resp
(lambda (_resp)
(message "Settings updated!\n%s" (pp-to-string strs))))))
(transient-define-prefix mastodon-user-settings ()
"A transient for setting current user settings."
:value (lambda () (tp-return-data
#'mastodon-transient-get-creds))
[:description
(lambda ()
(format "User settings for %s" mastodon-active-user))
(:info
"Note: use the empty string (\"\") to remove a value from an option.")]
;; strings
["Account info"
("n" "display name" "display_name" :alist-key display_name :class tp-option-str)
("t" "update profile note" mastodon-update-profile-note)
("f" "update profile fields" mastodon-profile-fields)]
;; "choice" booleans (so we can PATCH :json-false explicitly):
["Account options"
("l" "locked" "locked" :alist-key locked :class tp-bool)
("b" "bot" "bot" :alist-key bot :class tp-bool)
("d" "discoverable" "discoverable" :alist-key discoverable :class tp-bool)
("c" "hide follower/following lists" "source.hide_collections"
:alist-key source.hide_collections :class tp-bool)
("i" "indexable" "source.indexable" :alist-key source.indexable :class tp-bool)]
["Tooting options"
("p" "default privacy" "source.privacy" :alist-key source.privacy
:class tp-option
:choices (lambda () mastodon-toot-visibility-settings-list))
("s" "mark sensitive" "source.sensitive" :alist-key source.sensitive :class tp-bool)
("g" "default language" "source.language" :alist-key source.language :class tp-option
:choices (lambda () mastodon-iso-639-regional))]
["Update"
("C-c C-c" "Save settings" mastodon-user-settings-update)
("C-x C-k" :info "Revert all changes")]
(interactive)
(if (or (not (boundp 'mastodon-active-user))
(not mastodon-active-user))
(user-error "User not set")
(transient-setup 'mastodon-user-settings)))
(transient-define-suffix mastodon-update-profile-note ()
"Update current user profile note."
:transient 'transient--do-exit
(interactive)
(mastodon-profile-update-user-profile-note))
(transient-define-suffix mastodon-profile-fields-update (args)
"Update current user profile fields."
:transient 'transient--do-return
(interactive (list (transient-args 'mastodon-profile-fields)))
(let* (;; FIXME: maybe only changed also won't work with fields, as
;; perhaps what is PATCHed overwrites whatever is on the server?
;; (only-changed (tp-only-changed-args alist))
(arrays (mastodon-transient-dot-fields-to-arrays args))
(endpoint "accounts/update_credentials")
(url (mastodon-http--api endpoint))
(resp (mastodon-http--patch url arrays))) ; :json)))
(mastodon-http--triage
resp (lambda (_resp) (message "Fields updated!")))))
(defun mastodon-transient-fetch-fields ()
"Fetch profile fields (metadata)."
(tp-return-data #'mastodon-transient-get-creds nil 'fields)
(setq tp-transient-settings
(mastodon-transient--fields-alist tp-transient-settings)))
(transient-define-prefix mastodon-profile-fields ()
"A transient for setting profile fields."
:value (lambda () (mastodon-transient-fetch-fields))
[:description
"Fields"
["Name"
("1 n" "" "fields.1.name" :alist-key fields.1.name :class mastodon-transient-field)
("2 n" "" "fields.2.name" :alist-key fields.2.name :class mastodon-transient-field)
("3 n" "" "fields.3.name" :alist-key fields.3.name :class mastodon-transient-field)
("4 n" "" "fields.4.name" :alist-key fields.4.name :class mastodon-transient-field)]
["Value"
("1 v" "" "fields.1.value" :alist-key fields.1.value :class mastodon-transient-field)
("2 v" "" "fields.2.value" :alist-key fields.2.value :class mastodon-transient-field)
("3 v" "" "fields.3.value" :alist-key fields.3.value :class mastodon-transient-field)
("4 v" "" "fields.4.value" :alist-key fields.4.value :class mastodon-transient-field)]]
["Update"
("C-c C-c" "Save settings" mastodon-profile-fields-update)
("C-x C-k" :info "Revert all changes")]
(interactive)
(if (not mastodon-active-user)
(user-error "User not set")
(transient-setup 'mastodon-profile-fields)))
(defun mastodon-transient-max-poll-opts ()
"Return max poll options of user's instance."
(let ((instance (mastodon-instance-data)))
(mastodon-toot--fetch-max-poll-options instance)))
(defun mastodon-transient-max-poll-opt-chars ()
"Return max poll option characters of user's instance."
(let ((instance (mastodon-instance-data)))
(mastodon-toot--fetch-max-poll-option-chars instance)))
(transient-define-suffix mastodon-transient-choice-add ()
"Add another poll choice if possible.
Do not add more than 9 choices.
Do not add more than the server's maximum setting."
(interactive)
:transient 'transient--do-stay
(let* ((args (transient-args (oref transient-current-prefix command)))
(choice-count (length
(cl-member-if
(lambda (x)
(equal (car x) 'one))
args)))
(inc (1+ choice-count))
(next (number-to-string inc))
(next-symbol (pcase inc
(5 'five)
(6 'six)
(7 'seven)
(8 'eight)
(9 'nine))))
(if (or (>= choice-count (mastodon-transient-max-poll-opts))
(= choice-count 9))
;; FIXME when we hit '10', we get a binding clash with '1'. :/
(message "Max choices reached")
(transient-append-suffix
'mastodon-create-poll
'(2 -1)
`(,next "" ,next
:class mastodon-transient-poll-choice
:alist-key ,next-symbol
:transient t))))
(transient-setup 'mastodon-create-poll))
(transient-define-prefix mastodon-create-poll ()
"A transient for creating a poll."
:value (lambda ()
;; we set `tp-transient-settings' here to the poll value poss
;; pulled from the server by
;; `mastodon-toot--server-poll-to-local'. when we are done with
;; the transient, we set `mastodon-toot-poll' again
(setq tp-transient-settings mastodon-toot-poll))
["Create poll"
(:info (lambda ()
(format "Max options: %s"
(mastodon-transient-max-poll-opts))))
(:info (lambda ()
(format "Max option length: %s"
(mastodon-transient-max-poll-opt-chars))))]
["Options"
("m" "Multiple choice?" "multi" :alist-key multi
:class mastodon-transient-poll-bool)
("h" "Hide vote count till expiry?" "hide" :alist-key hide
:class mastodon-transient-poll-bool)
("e" "Expiry" "expiry" :alist-key expiry
:class mastodon-transient-expiry)]
["Choices"
("1" "" "1" :alist-key one :class mastodon-transient-poll-choice)
("2" "" "2" :alist-key two :class mastodon-transient-poll-choice)
("3" "" "3" :alist-key three :class mastodon-transient-poll-choice)
("4" "" "4" :alist-key four :class mastodon-transient-poll-choice)]
;; TODO: display the max number of options or add options cmd
["Update"
("C-c C-s" "Add another poll choice" mastodon-transient-choice-add
:if (lambda () (< 4 (mastodon-transient-max-poll-opts))))
("C-c C-c" "Save and done" mastodon-create-poll-done)
("C-x C-k" :info "Revert all")
("C-c C-k" "Delete all" mastodon-clear-poll)]
(interactive)
(if (not mastodon-active-user)
(user-error "User not set")
(transient-setup 'mastodon-create-poll)))
(transient-define-suffix mastodon-clear-poll ()
"Clear current poll data."
:transient 'transient--do-stay
(interactive)
(mastodon-toot-clear-poll :transient)
(transient-reset))
(transient-define-suffix mastodon-create-poll-done (args)
"Finish setting poll details."
:transient 'transient--do-exit
(interactive (list (transient-args 'mastodon-create-poll)))
(let* ((options (cl-member-if (lambda (x)
(eq (car x) 'one))
args))
(opt-vals (cl-loop for x in options
collect (cdr x)))
(lengths (mapcar #'length opt-vals))
(vals (cl-remove 'nil
(cl-loop for x in args
collect (cdr x))))
(opts-count (length (cl-remove 'nil opt-vals))))
;; this way of checking gets annoying if we want to just cancel out of
;; the poll (but to actually cancel user should C-g, not C-c C-c):
(if (or (and (< 50 (apply #'max lengths))
(not (y-or-n-p "Options longer than server max. Proceed? ")))
(and (not (alist-get 'expiry args))
(not (y-or-n-p "No expiry. Proceed? ")))
(and (not (< 1 opts-count))
(not (y-or-n-p "Need more than one option. Proceed? ")))
(and (> opts-count (mastodon-transient-max-poll-opts))
(not (y-or-n-p "More options than server max. Proceed? "))))
(call-interactively #'mastodon-create-poll)
;; if we are called with no poll data, do not set:
(unless (not vals)
;; we set `mastodon-toot-poll' here not `tp-transient-settings'
;; as that is our var outside of our transient:
(setq mastodon-toot-poll
(tp-bools-to-strs args)))
(mastodon-toot--update-status-fields))))
(defvar mastodon-notifications-policy-vals)
(declare-function mastodon-notifications-get-policy "mastodon-notifications")
(declare-function mastodon-notifications--update-policy "mastodon-notifications")
(transient-define-prefix mastodon-notifications-policy ()
"A transient to set notifications policy options."
;; https://docs.joinmastodon.org/methods/notifications/#get-policy
:value (lambda () (tp-return-data #'mastodon-notifications-get-policy))
["Notification policy options"
("f" "people you don't follow" "for_not_following"
:alist-key for_not_following :class mastodon-transient-policy)
("F" "people not following you" "for_not_followers"
:alist-key for_not_followers :class mastodon-transient-policy)
("n" "New accounts" "for_new_accounts"
:alist-key for_new_accounts :class mastodon-transient-policy)
("p" "Unsolicited private mentions" "for_private_mentions"
:alist-key for_private_mentions :class mastodon-transient-policy)
("l" "Moderated accounts" "for_limited_accounts"
:alist-key for_limited_accounts :class mastodon-transient-policy)
(:info "")
(:info "\"accept\" = receive notifications")
(:info "\"filter\" = mark as filtered")
(:info "\"drop\" = do not receive any notifications")]
["Notification requests"
(:info #'mastodon-notifications-requests-count)
(:info #'mastodon-notifications-filtered-count)]
["Update"
("C-c C-c" "Save settings" mastodon-notifications-policy-update)
("C-x C-k" :info "Revert all changes")])
(defun mastodon-notifications-requests-count ()
"Format a string for pending requests."
(let ((val (oref transient--prefix value)))
(format "Pending requests: %d"
(or (map-nested-elt
val
'(summary pending_requests_count))
0))))
(defun mastodon-notifications-filtered-count ()
"Format a string for pending notifications."
(let ((val (oref transient--prefix value)))
(format "Pending notifications: %d"
(or (map-nested-elt
val
'(summary pending_notifications_count))
0))))
(transient-define-suffix mastodon-notifications-policy-update (args)
"Send updated notification policy settings."
:transient 'transient--do-exit
;; TODO:
(interactive (list (transient-args 'mastodon-notifications-policy)))
(let* ((parsed (tp-parse-args-for-send args))
(resp (mastodon-notifications--update-policy parsed)))
(mastodon-http--triage
resp
(lambda (_resp)
(message "Settings updated!\n%s" (pp-to-string parsed))))))
;;; CLASSES
(defclass mastodon-transient-policy (tp-cycle)
((choices :initarg :choices :initform 'mastodon-notifications-policy-vals))
"An option class for mastodon notification policy options.")
(defclass mastodon-transient-field (tp-option-str)
((always-read :initarg :always-read :initform t))
"An infix option class for our options.
We always read.")
(cl-defmethod transient-init-value ((obj mastodon-transient-field))
"Initialize value of OBJ."
(let* ((prefix-val (oref transient--prefix value)))
;; (arg (oref obj alist-key)))
(oset obj value
(tp-get-server-val obj prefix-val))))
(cl-defmethod tp-get-server-val ((obj mastodon-transient-field) data)
"Return the server value for OBJ from DATA.
If OBJ's key has dotted notation, drill down into the alist. Currently
only one level of nesting is supported."
;; TODO: handle nested alist keys
(let* ((key (oref obj alist-key))
(split (split-string (symbol-name key) "\\."))
(num (string-to-number (cadr split))))
(alist-get key
(nth (1- num) data) nil nil #'string=)))
(cl-defmethod tp-arg-changed-p ((_obj mastodon-transient-field) cons)
"T if value of OBJ is changed from the server value.
CONS is a cons of the form \"(fields.1.name . val)\"."
(let* ((key-split (split-string
(symbol-name (car cons)) "\\."))
(num (1- (string-to-number (nth 1 key-split))))
(server-key (symbol-name (car cons)))
(server-elt (nth num tp-transient-settings)))
(not (equal (cdr cons)
(alist-get server-key server-elt nil nil #'string=)))))
(defclass mastodon-transient-opt (tp-option tp-option-var)
(()))
(defclass mastodon-transient-poll-bool (tp-bool tp-option-var)
())
(defclass mastodon-transient-poll-choice (tp-option-str tp-option-var)
())
(cl-defmethod transient-infix-read ((obj mastodon-transient-poll-choice))
"Reader function for OBJ, a poll expiry."
(let* ((value (transient-infix-value obj))
(prompt (transient-prompt obj))
(str (read-string prompt (cdr value)))
(max (mastodon-transient-max-poll-opt-chars)))
(if (not (> (length str) max))
str
(if (not
(y-or-n-p
(format "Poll option too long for server (%s/%s chars), retry?"
(length str) max)))
str
(oset obj value str)
(transient-infix-read obj)))))
(defclass mastodon-transient-expiry (tp-option tp-option-var)
())
(cl-defmethod transient-infix-read ((_obj mastodon-transient-expiry))
"Reader function for OBJ, a poll expiry."
(cdr (mastodon-toot--read-poll-expiry)))
(cl-defmethod transient-format-value ((obj mastodon-transient-expiry))
"Format function for OBJ, a poll expiry."
(let* ((cons (transient-infix-value obj))
(value (when cons (cdr cons))))
(if (not value)
""
(let ((readable
(or (car
(rassoc value
(mastodon-toot--poll-expiry-options-alist)))
(concat value " secs")))) ;; editing a poll wont match expiry list
(propertize readable
'face (if (tp-arg-changed-p obj cons)
'transient-value
'transient-inactive-value))))))
(provide 'mastodon-transient)
;;; mastodon-transient.el ends here
mastodon.el/lisp/mastodon-views.el 0000664 0000000 0000000 00000131215 15017331127 0017554 0 ustar 00root root 0000000 0000000 ;;; mastodon-views.el --- Minor views functions for mastodon.el -*- lexical-binding: t -*-
;; Copyright (C) 2020-2024 Marty Hiatt
;; Author: Marty Hiatt
;; Maintainer: Marty Hiatt
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
;; This file is part of mastodon.el.
;; mastodon.el 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.
;; mastodon.el 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 mastodon.el. If not, see .
;;; Commentary:
;; mastodon-views.el provides minor views functions.
;; These are currently lists, follow suggestions, filters, scheduled toots,
;; follow requests, and instance descriptions.
;; It doesn't include favourites, bookmarks, preferences, trending tags, followed tags, toot edits,
;;; Code:
(require 'cl-lib)
(require 'mastodon-http)
(eval-when-compile
(require 'mastodon-tl))
(defvar mastodon-mode-map)
(defvar mastodon-tl--horiz-bar)
(defvar mastodon-tl--timeline-posts-count)
(autoload 'mastodon-mode "mastodon")
(autoload 'mastodon-tl--init "mastodon-tl")
(autoload 'mastodon-tl--init-sync "mastodon-tl")
(autoload 'mastodon-tl--field "mastodon-tl")
(autoload 'mastodon-tl--property "mastodon-tl")
(autoload 'mastodon-tl--set-face "mastodon-tl")
(autoload 'mastodon-tl--buffer-type-eq "mastodon-tl")
(autoload 'mastodon-tl--profile-buffer-p "mastodon-tl")
(autoload 'mastodon-tl--goto-first-item "mastodon-tl")
(autoload 'mastodon-tl--do-if-item "mastodon-tl")
(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl")
(autoload 'mastodon-tl--render-text "mastodon-tl")
(autoload 'mastodon-notifications-follow-request-accept "mastodon-notifications")
(autoload 'mastodon-notifications-follow-request-reject "mastodon-notifications")
(autoload 'mastodon-auth--get-account-id "mastodon-auth")
(autoload 'mastodon-toot--iso-to-human "mastodon-toot")
(autoload 'mastodon-toot-schedule-toot "mastodon-toot")
(autoload 'mastodon-toot--compose-buffer "mastodon-toot")
(autoload 'mastodon-toot--set-toot-properties "mastodon-toot")
(autoload 'mastodon-search--propertize-user "mastodon-search")
(autoload 'mastodon-search--insert-users-propertized "mastodon-search")
(autoload 'mastodon-tl--map-alist "mastodon-tl")
(autoload 'mastodon-tl--map-alist-vals-to-alist "mastodon-tl")
;;; KEYMAPS
;; we copy `mastodon-mode-map', as then all timeline functions are
;; available. this is helpful because if a minor view is the only buffer left
;; open, calling `mastodon' will switch to it, but then we will be unable to
;; switch to timlines without closing the minor view.
;; copying the mode map however means we need to avoid/unbind/override any
;; functions that might interfere with the minor view.
;; this is not redundant, as while the buffer -init function calls
;; `mastodon-mode', it gets overridden in some but not all cases.
(defvar mastodon-views-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map mastodon-mode-map)
map)
"Base keymap for minor mastodon views.")
(defvar mastodon-views--view-filters-keymap
(let ((map (make-sparse-keymap)))
(set-keymap-parent map mastodon-views-map)
(define-key map (kbd "d") #'mastodon-views-delete-filter)
(define-key map (kbd "c") #'mastodon-views-create-filter)
(define-key map (kbd "g") #'mastodon-views-view-filters)
(define-key map (kbd "u") #'mastodon-views-update-filter)
(define-key map (kbd "k") #'mastodon-views-delete-filter)
(define-key map (kbd "a") #'mastodon-views-add-filter-kw)
(define-key map (kbd "r") #'mastodon-views-remove-filter-kw)
(define-key map (kbd "U") #'mastodon-views-update-filter-kw)
map)
"Keymap for viewing filters.")
(defvar mastodon-views--follow-suggestions-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map mastodon-views-map)
(define-key map (kbd "g") #'mastodon-views-view-follow-suggestions)
map)
"Keymap for viewing follow suggestions.")
(defvar mastodon-views--view-lists-keymap
(let ((map (make-sparse-keymap)))
(set-keymap-parent map mastodon-views-map)
(define-key map (kbd "D") #'mastodon-views-delete-list)
(define-key map (kbd "C") #'mastodon-views-create-list)
(define-key map (kbd "A") #'mastodon-views-add-account-to-list)
(define-key map (kbd "R") #'mastodon-views-remove-account-from-list)
(define-key map (kbd "E") #'mastodon-views-edit-list)
(define-key map (kbd "g") #'mastodon-views-view-lists)
map)
"Keymap for viewing lists.")
(defvar mastodon-views--list-name-keymap
(let ((map (make-sparse-keymap)))
(define-key map (kbd "RET") #'mastodon-views-view-timeline-list-at-point)
(define-key map (kbd "d") #'mastodon-views-delete-list-at-point)
(define-key map (kbd "a") #'mastodon-views-add-account-to-list-at-point)
(define-key map (kbd "r") #'mastodon-views-remove-account-from-list-at-point)
(define-key map (kbd "e") #'mastodon-views-edit-list-at-point)
(define-key map (kbd "g") #'mastodon-views-view-lists)
map)
"Keymap for when point is on list name.")
(defvar mastodon-views--scheduled-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map mastodon-views-map)
(define-key map (kbd "r") #'mastodon-views-reschedule-toot)
(define-key map (kbd "c") #'mastodon-views-cancel-scheduled-toot)
(define-key map (kbd "e") #'mastodon-views-edit-scheduled-as-new)
(define-key map (kbd "RET") #'mastodon-views-edit-scheduled-as-new)
(define-key map (kbd "g") #'mastodon-views-view-scheduled-toots)
map)
"Keymap for when point is on a scheduled toot.")
(defvar mastodon-views--view-follow-requests-keymap
(let ((map (make-sparse-keymap)))
(set-keymap-parent map mastodon-views-map)
;; make reject binding match the binding in notifs view
;; 'r' is then reserved for replying, even tho it is not avail
;; in foll-reqs view
(define-key map (kbd "j") #'mastodon-notifications-follow-request-reject)
(define-key map (kbd "a") #'mastodon-notifications-follow-request-accept)
(define-key map (kbd "g") #'mastodon-views-view-follow-requests)
map)
"Keymap for viewing follow requests.")
;;; GENERAL FUNCTION
(defun mastodon-views--minor-view (view-name insert-fun data)
"Load a minor view named VIEW-NAME.
BINDINGS-STRING is a string explaining the view's local bindings.
INSERT-FUN is the function to call to insert the view's elements.
DATA is the argument to insert-fun, usually JSON returned in a
request.
This function is used as the update-function to
`mastodon-tl--init-sync', which initializes a buffer for us and
provides the JSON data."
;; FIXME not tecnically an update-fun for init-sync, but just a simple way
;; to set up the empty buffer or else call the insert-fun. not sure if we cd
;; improve by eg calling init-sync in here, making this a real view function.
(if (seq-empty-p data)
(insert (propertize
(format "Looks like you have no %s for now." view-name)
'face 'mastodon-toot-docs-face
'byline t
'item-type 'no-item ; for nav
'item-id "0")) ; so point can move here when no item
(funcall insert-fun data)
(goto-char (point-min)))
;; (when data
;; FIXME: this seems to trigger a new request, but ideally would run.
;; (mastodon-tl-goto-next-item))
)
;;; LISTS
(defun mastodon-views-view-lists ()
"Show the user's lists in a new buffer."
(interactive)
(mastodon-tl--init-sync "lists" "lists"
'mastodon-views--insert-lists
nil nil nil
"your lists"
"C - create a list\n D - delete a list\
\n A/R - add/remove account from a list\
\n E - edit a list\n n/p - go to next/prev item")
(with-current-buffer "*mastodon-lists*"
(use-local-map mastodon-views--view-lists-keymap)))
(defun mastodon-views--insert-lists (json)
"Insert the user's lists from JSON."
(mastodon-views--minor-view
"lists"
#'mastodon-views--print-list-set
json))
(defun mastodon-views--print-list-set (lists)
"Print each account plus a separator for each list in LISTS."
(cl-loop for x in lists
do (progn
(mastodon-views--print-list-accounts x)
(insert (propertize (concat " " mastodon-tl--horiz-bar "\n\n")
'face 'success)))))
(defun mastodon-views--print-list-accounts (list)
"Insert the accounts in list named LIST, an alist."
(let-alist list
(let* ((accounts (mastodon-views--accounts-in-list .id)))
(insert
(propertize .title
'byline t ; so we nav here
'item-id "0" ; so we nav here
'item-type 'list
'help-echo "RET: view list timeline, d: delete this list, \
a: add account to this list, r: remove account from this list"
'list t
'face 'link
'keymap mastodon-views--list-name-keymap
'list-name .title
'list-id .id)
(propertize (format " [replies: %s, exclusive %s]"
.replies_policy
(when (eq t .exclusive) "true"))
'face 'mastodon-toot-docs-face)
(propertize "\n\n"
'list t
'keymap mastodon-views--list-name-keymap
'list-name .title
'list-id .id)
(propertize
(mapconcat #'mastodon-search--propertize-user accounts
" ")
'list t
'keymap mastodon-views--list-name-keymap
'list-name .title
'list-id .id)))))
(defun mastodon-views--get-users-lists ()
"Get the list of the user's lists from the server."
(let ((url (mastodon-http--api "lists")))
(mastodon-http--get-json url)))
(defun mastodon-views--get-lists-names ()
"Return a list of the user's lists' names."
(let ((lists (mastodon-views--get-users-lists)))
(mastodon-tl--map-alist 'title lists)))
(defun mastodon-views--get-list-by-name (name)
"Return the list data for list with NAME."
(let* ((lists (mastodon-views--get-users-lists)))
(cl-loop for list in lists
if (string= (alist-get 'title list) name)
return list)))
(defun mastodon-views--get-list-id (name)
"Return id for list with NAME."
(let ((list (mastodon-views--get-list-by-name name)))
(alist-get 'id list)))
(defun mastodon-views--get-list-name (id)
"Return name of list with ID."
(let* ((url (mastodon-http--api (format "lists/%s" id)))
(response (mastodon-http--get-json url)))
(alist-get 'title response)))
(defun mastodon-views-edit-list-at-point ()
"Edit list at point."
(interactive)
(let ((id (mastodon-tl--property 'list-id :no-move)))
(mastodon-views-edit-list id)))
(defun mastodon-views-edit-list (&optional id)
"Prompt for a list and edit the name and replies policy.
If ID is provided, use that list."
(interactive)
(let* ((list-names (unless id (mastodon-views--get-lists-names)))
(name-old (if id
(mastodon-tl--property 'list-name :no-move)
(completing-read "Edit list: " list-names)))
(id (or id (mastodon-views--get-list-id name-old)))
(name-choice (read-string "List name: " name-old))
(replies-policy (completing-read "Replies policy: " ; give this a proper name
'("followed" "list" "none")
nil t nil nil "list"))
(exclusive (if (y-or-n-p "Exclude items from home timeline? ")
"true"
"false"))
(url (mastodon-http--api (format "lists/%s" id)))
(response (mastodon-http--put url
`(("title" . ,name-choice)
("replies_policy" . ,replies-policy)
("exclusive" . ,exclusive)))))
(mastodon-http--triage response
(lambda (_)
(with-current-buffer response
(let* ((json (mastodon-http--process-json))
(name-new (alist-get 'title json)))
(message "list %s edited to %s!" name-old name-new)))
(when (mastodon-tl--buffer-type-eq 'lists)
(mastodon-views-view-lists))))))
(defun mastodon-views-view-timeline-list-at-point ()
"View timeline of list at point."
(interactive)
(let ((list-id (mastodon-tl--property 'list-id :no-move)))
(mastodon-views-view-list-timeline list-id)))
(defun mastodon-views-view-list-timeline (&optional id)
"Prompt for a list and view its timeline.
If ID is provided, use that list."
(interactive)
(let* ((list-names (unless id (mastodon-views--get-lists-names)))
(list-name (unless id (completing-read "View list: " list-names)))
(id (or id (mastodon-views--get-list-id list-name)))
(endpoint (format "timelines/list/%s" id))
(name (mastodon-views--get-list-name id))
(buffer-name (format "list-%s" name)))
(mastodon-tl--init buffer-name endpoint
'mastodon-tl--timeline nil
`(("limit" . ,mastodon-tl--timeline-posts-count)))))
(defun mastodon-views-create-list ()
"Create a new list.
Prompt for name and replies policy."
(interactive)
(let* ((title (read-string "New list name: "))
(replies-policy
(completing-read "Replies policy: " ; give this a proper name
'("followed" "list" "none")
nil t nil nil "list")) ; default
(exclusive (when (y-or-n-p "Exclude items from home timeline? ")
"true"))
(response (mastodon-http--post
(mastodon-http--api "lists")
`(("title" . ,title)
("replies_policy" . ,replies-policy)
("exclusive" . ,exclusive)))))
(mastodon-views--list-action-triage
response "list %s created!" title)))
(defun mastodon-views-delete-list-at-point ()
"Delete list at point."
(interactive)
(let ((id (mastodon-tl--property 'list-id :no-move)))
(mastodon-views-delete-list id)))
(defun mastodon-views-delete-list (&optional id)
"Prompt for a list and delete it.
If ID is provided, delete that list."
(interactive)
(let* ((list-names (unless id (mastodon-views--get-lists-names)))
(name (if id
(mastodon-views--get-list-name id)
(completing-read "Delete list: " list-names)))
(id (or id (mastodon-views--get-list-id name)))
(url (mastodon-http--api (format "lists/%s" id))))
(when (y-or-n-p (format "Delete list %s?" name))
(let ((response (mastodon-http--delete url)))
(mastodon-views--list-action-triage
response "list %s deleted!" name)))))
(defun mastodon-views--get-users-followings ()
"Return the list of followers of the logged in account."
(let* ((id (mastodon-auth--get-account-id))
(url (mastodon-http--api (format "accounts/%s/following" id))))
(mastodon-http--get-json url '(("limit" . "80"))))) ; max 80 accounts
(defun mastodon-views-add-account-to-list-at-point ()
"Prompt for account and add to list at point."
(interactive)
(let ((id (mastodon-tl--property 'list-id :no-move)))
(mastodon-views-add-account-to-list id)))
(defun mastodon-views-add-account-to-list (&optional id account-id handle)
"Prompt for a list and for an account, add account to list.
If ID is provided, use that list.
If ACCOUNT-ID and HANDLE are provided use them rather than prompting."
(interactive)
(let* ((list-prompt (if handle
(format "Add %s to list: " handle)
"Add account to list: "))
(list-name (if id
(mastodon-tl--property 'list-name :no-move)
(completing-read list-prompt
(mastodon-views--get-lists-names) nil t)))
(list-id (or id (mastodon-views--get-list-id list-name)))
(followings (unless handle
(mastodon-views--get-users-followings)))
(handles (unless handle
(mastodon-tl--map-alist-vals-to-alist
'acct 'id followings)))
(account (or handle (completing-read "Account to add: "
handles nil t)))
(account-id (or account-id (alist-get account handles)))
(url (mastodon-http--api (format "lists/%s/accounts" list-id)))
(response (mastodon-http--post url `(("account_ids[]" . ,account-id)))))
(mastodon-views--list-action-triage
response "%s added to list %s!" account list-name)))
(defun mastodon-views-add-toot-account-at-point-to-list ()
"Prompt for a list, and add the account of the toot at point to it."
(interactive)
(let* ((toot (mastodon-tl--property 'item-json))
(account (mastodon-tl--field 'account toot))
(account-id (mastodon-tl--field 'id account))
(handle (mastodon-tl--field 'acct account)))
(mastodon-views-add-account-to-list nil account-id handle)))
(defun mastodon-views-remove-account-from-list-at-point ()
"Prompt for account and remove from list at point."
(interactive)
(let ((id (mastodon-tl--property 'list-id :no-move)))
(mastodon-views-remove-account-from-list id)))
(defun mastodon-views-remove-account-from-list (&optional id)
"Prompt for a list, select an account and remove from list.
If ID is provided, use that list."
(interactive)
(let* ((list-name (if id
(mastodon-tl--property 'list-name :no-move)
(completing-read "Remove account from list: "
(mastodon-views--get-lists-names) nil t)))
(list-id (or id (mastodon-views--get-list-id list-name)))
(accounts (mastodon-views--accounts-in-list list-id))
(handles (mastodon-tl--map-alist-vals-to-alist 'acct 'id accounts))
(account (completing-read "Account to remove: " handles nil t))
(account-id (alist-get account handles))
(url (mastodon-http--api (format "lists/%s/accounts" list-id)))
(args (mastodon-http--build-array-params-alist "account_ids[]" `(,account-id)))
(response (mastodon-http--delete url args)))
(mastodon-views--list-action-triage
response "%s removed from list %s!" account list-name)))
(defun mastodon-views--list-action-triage (response &rest args)
"Call `mastodon-http--triage' on RESPONSE and call message on ARGS."
(mastodon-http--triage response
(lambda (_)
(when (mastodon-tl--buffer-type-eq 'lists)
(mastodon-views-view-lists))
(apply #'message args))))
(defun mastodon-views--accounts-in-list (list-id)
"Return the JSON of the accounts in list with LIST-ID."
(let* ((url (mastodon-http--api (format "lists/%s/accounts" list-id))))
(mastodon-http--get-json url)))
;;; FOLLOW REQUESTS
(defun mastodon-views--insert-follow-requests (json)
"Insert the user's current follow requests.
JSON is the data returned by the server."
(mastodon-views--minor-view
"follow requests"
#'mastodon-views--insert-users-propertized-note
json))
(defun mastodon-views-view-follow-requests ()
"Open a new buffer displaying the user's follow requests."
(interactive)
(mastodon-tl--init-sync "follow-requests"
"follow_requests"
'mastodon-views--insert-follow-requests
nil
'(("limit" . "40")) ; server max is 80
:headers
"follow requests"
"a/j - accept/reject request at point\n\
n/p - go to next/prev request")
(mastodon-tl--goto-first-item)
(with-current-buffer "*mastodon-follow-requests*"
(use-local-map mastodon-views--view-follow-requests-keymap)))
;;; SCHEDULED TOOTS
;;;###autoload
(defun mastodon-views-view-scheduled-toots ()
"Show the user's scheduled toots in a new buffer."
(interactive)
(mastodon-tl--init-sync "scheduled-toots"
"scheduled_statuses"
'mastodon-views--insert-scheduled-toots
nil nil nil
"your scheduled toots"
"n/p - prev/next\n r - reschedule\n\
e/RET - edit toot\n c - cancel")
(with-current-buffer "*mastodon-scheduled-toots*"
(use-local-map mastodon-views--scheduled-map)))
(defun mastodon-views--insert-scheduled-toots (json)
"Insert the user's scheduled toots, from JSON."
(mastodon-views--minor-view
"scheduled toots"
#'mastodon-views--insert-scheduled-toots-list
json))
(defun mastodon-views--insert-scheduled-toots-list (scheduleds)
"Insert scheduled toots in SCHEDULEDS."
(mapc #'mastodon-views--insert-scheduled-toot scheduleds))
(defun mastodon-views--insert-scheduled-toot (toot)
"Insert scheduled TOOT into the buffer."
(let-alist toot
(insert
(propertize (concat (string-trim .params.text)
" | "
(mastodon-toot--iso-to-human .scheduled_at))
'byline t ; so we nav here
'item-type 'scheduled ; so we nav here
'face 'mastodon-toot-docs-face
'keymap mastodon-views--scheduled-map
'item-json toot
'id .id)
"\n")))
(defun mastodon-views--get-scheduled-toots (&optional id)
"Get the user's currently scheduled toots.
If ID, just return that toot."
(let* ((endpoint (if id
(format "scheduled_statuses/%s" id)
"scheduled_statuses"))
(url (mastodon-http--api endpoint)))
(mastodon-http--get-json url)))
(defun mastodon-views-reschedule-toot ()
"Reschedule the scheduled toot at point."
(interactive)
(mastodon-tl--do-if-item
(mastodon-toot-schedule-toot :reschedule)))
(defun mastodon-views-copy-scheduled-toot-text ()
"Copy the text of the scheduled toot at point."
(interactive)
(let* ((toot (mastodon-tl--property 'toot :no-move))
(params (alist-get 'params toot))
(text (alist-get 'text params)))
(kill-new text)))
(defun mastodon-views-cancel-scheduled-toot (&optional id no-confirm)
"Cancel the scheduled toot at point.
ID is that of the scheduled toot to cancel.
NO-CONFIRM means there is no ask or message, there is only do."
(interactive)
(mastodon-tl--do-if-item
(when (or no-confirm
(y-or-n-p "Cancel scheduled toot?"))
(let* ((id (or id (mastodon-tl--property 'id :no-move)))
(url (mastodon-http--api (format "scheduled_statuses/%s" id)))
(response (mastodon-http--delete url)))
(mastodon-http--triage response
(lambda (_)
(mastodon-views-view-scheduled-toots)
(unless no-confirm
(message "Toot cancelled!"))))))))
(defun mastodon-views-edit-scheduled-as-new ()
"Edit scheduled status as new toot."
(interactive)
(mastodon-tl--do-if-item
(let* ((toot (mastodon-tl--property 'scheduled-json :no-move))
(id (mastodon-tl--property 'id :no-move))
(scheduled (alist-get 'scheduled_at toot)))
(let-alist (alist-get 'params toot)
;; TODO: preserve polls
;; (poll (alist-get 'poll params))
(mastodon-toot--compose-buffer nil .in_reply_to_id nil .text :edit)
(goto-char (point-max))
;; adopt properties from scheduled toot:
(mastodon-toot--set-toot-properties
.in_reply_to_id .visibility .spoiler_text .language
scheduled id (alist-get 'media_attachments toot))))))
;;; FILTERS
;;;###autoload
(defun mastodon-views-view-filters ()
"View the user's filters in a new buffer."
(interactive)
(mastodon-tl--init-sync "filters" "filters"
'mastodon-views--insert-filters
nil nil nil
"current filters"
"c/u - create/update filter | d/k - delete filter\
at point\n a/r/U - add/remove/Update filter keyword\n\
n/p - next/prev filter" "v2")
(with-current-buffer "*mastodon-filters*"
(use-local-map mastodon-views--view-filters-keymap)))
(defun mastodon-views--insert-filters (json)
"Insert a filter string plus a blank line.
JSON is the filters data."
(mapc #'mastodon-views--insert-filter json))
(require 'table)
(defun mastodon-views--insert-filter-kws (kws)
"Insert filter keywords KWS."
(insert "\n")
(let ((beg (point))
(table-cell-horizontal-chars (if (char-displayable-p ?â)
"â"
"-"))
(whole-str "whole words only:"))
(insert (concat "Keywords: | " whole-str "\n"))
(cl-loop for kw in kws
do (let ((whole (if (eq :json-false (alist-get 'whole_word kw))
"nil"
"t")))
(insert
(propertize (concat
(format "\"%s\" | %s\n"
(alist-get 'keyword kw) whole))
'kw-id (alist-get 'id kw)
'item-json kw
'mastodon-tab-stop t
'whole-word whole))))
;; table display of kws:
(table-capture beg (point) "|" "\n" nil (+ 2 (length whole-str)))
(table-justify-column 'center)
(table-forward-cell) ;; col 2
(table-justify-column 'center)
(while (re-search-forward ;; goto end of table:
(concat table-cell-horizontal-chars
(make-string 1 table-cell-intersection-char)
"\n")
nil :no-error))))
(defun mastodon-views--insert-filter (filter)
"Insert a single FILTER."
(let-alist filter
(insert
;; FIXME: awful hack to fix nav: exclude horiz-bar from propertize then
;; propertize rest of the filter text. if we add only byline prop to
;; title, point will move to end of title, because at that byline-prop
;; change, item-type prop is present.
(mastodon-tl--set-face
(concat "\n " mastodon-tl--horiz-bar "\n ")
'success)
(propertize
(concat
;; heading:
(mastodon-tl--set-face
(concat (upcase .title) " " "\n "
mastodon-tl--horiz-bar "\n")
'success)
;; context:
(concat "Context: " (mapconcat #'identity .context ", "))
;; type (warn or hide):
(concat "\nType: " .filter_action))
'item-json filter
'byline t
'item-id .id
'filter-title .title
'item-type 'filter))
;; terms list:
(when .keywords ;; poss to have no keywords
(mastodon-views--insert-filter-kws .keywords))))
(defvar mastodon-views--filter-types
'("home" "notifications" "public" "thread" "profile"))
(defun mastodon-views-create-filter (&optional id title context type terms)
"Create a filter for a word.
Prompt for a context, must be a list containting at least one of \"home\",
\"notifications\", \"public\", \"thread\".
Optionally, provide ID, TITLE, CONTEXT, TYPE, and TERMS to update a filter."
(interactive)
;; ID non-nil = we are updating
(let* ((url (mastodon-http--api-v2
(if id (format "filters/%s" id) "filters")))
(title (or title (read-string "Filter name: ")))
(terms (or terms
(read-string "Terms to filter (comma or space separated): ")))
(terms-split (split-string terms "[, ]"))
(terms-processed
(if (not terms) ;; well actually it is poss to have no terms
(user-error "You must select at least one term")
(mastodon-http--build-array-params-alist
"keywords_attributes[][keyword]" terms-split)))
(warn-or-hide
(or type (completing-read "Warn (like CW) or hide? "
'("warn" "hide") nil :match)))
;; TODO: display "home (and lists)" but just use "home" for API
(contexts
(or context (completing-read-multiple
"Filter contexts [TAB for options, comma separated]: "
mastodon-views--filter-types nil :match)))
(contexts-processed
(if (not contexts)
(user-error "You must select at least one context")
(mastodon-http--build-array-params-alist "context[]" contexts)))
(params (append `(("title" . ,title)
("filter_action" . ,warn-or-hide))
terms-processed
contexts-processed))
(resp (if id
(mastodon-http--put url params)
(mastodon-http--post url params))))
(mastodon-views--filters-triage
resp
(message "Filter %s %s!" title (if id "updated" "created")))))
(defun mastodon-views-update-filter ()
"Update filter at point."
(interactive)
(if (not (eq 'filter (mastodon-tl--property 'item-type)))
(user-error "No filter at point?")
(let* ((filter (mastodon-tl--property 'item-json))
(id (mastodon-tl--property 'item-id))
(name (read-string "Name: " (alist-get 'title filter)))
(contexts (completing-read-multiple
"Filter contexts [TAB for options, comma separated]: "
mastodon-views--filter-types nil :match
(mapconcat #'identity
(alist-get 'context filter) ",")))
(type (completing-read "Warn (like CW) or hide? "
'("warn" "hide") nil :match
(alist-get 'type filter)))
(terms (read-string "Terms to add (comma or space separated): ")))
(mastodon-views-create-filter id name contexts type terms))))
(defun mastodon-views-delete-filter ()
"Delete filter at point."
(interactive)
(let* ((id (mastodon-tl--property 'item-id :no-move))
(title (mastodon-tl--property 'filter-title :no-move))
(url (mastodon-http--api-v2 (format "filters/%s" id))))
(if (not (eq 'filter (mastodon-tl--property 'item-type)))
(user-error "No filter at point?")
(when (y-or-n-p (format "Delete filter %s? " title))
(let ((resp (mastodon-http--delete url)))
(mastodon-views--filters-triage
resp
(message "Filter \"%s\" deleted!" title)))))))
(defun mastodon-views--get-filter-kw (&optional id)
"GET filter with ID."
(let* ((id (or id (mastodon-tl--property 'kw-id :no-move)))
(url (mastodon-http--api-v2 (format "filters/keywords/%s" id)))
(resp (mastodon-http--get-json url)))
resp))
(defun mastodon-views-update-filter-kw ()
"Update filter keyword.
Prmopt to change the term, and the whole words option.
When t, whole words means only match whole words."
(interactive)
(if (not (eq 'filter (mastodon-tl--property 'item-type)))
(user-error "No filter at point?")
(let* ((kws (alist-get 'keywords
(mastodon-tl--property 'item-json :no-move)))
(alist (mastodon-tl--map-alist-vals-to-alist 'keyword 'id kws))
(choice (completing-read "Update keyword: " alist))
(updated (read-string "Keyword: " choice))
(whole-word (if (y-or-n-p "Match whole words only? ")
"true"
"false"))
(params `(("keyword" . ,updated)
("whole_word" . ,whole-word)))
(id (cdr (assoc choice alist #'string=)))
(url (mastodon-http--api-v2 (format "filters/keywords/%s" id)))
(resp (mastodon-http--put url params)))
(mastodon-views--filters-triage resp
(format "Keyword %s updated!" updated)))))
(defun mastodon-views--filters-triage (resp msg-str)
"Triage filter action response RESP, reload filters, message MSG-STR."
(mastodon-http--triage
resp
(lambda (_resp)
(when (mastodon-tl--buffer-type-eq 'filters)
(mastodon-views-view-filters))
(message msg-str))))
(defun mastodon-views-add-filter-kw ()
"Add a keyword to filter at point."
(interactive)
(if (not (eq 'filter (mastodon-tl--property 'item-type)))
(user-error "No filter at point?")
(let* ((kw (read-string "Keyword: "))
(id (mastodon-tl--property 'item-id :no-move))
(whole-word (if (y-or-n-p "Match whole words only? ")
"true"
"false"))
(params `(("keyword" . ,kw)
("whole_word" . ,whole-word)))
(url (mastodon-http--api-v2 (format "filters/%s/keywords" id)))
(resp (mastodon-http--post url params)))
(mastodon-views--filters-triage resp
(format "Keyword %s added!" kw)))))
(defun mastodon-views-remove-filter-kw ()
"Remove keyword from filter at point."
(interactive)
(if (not (eq 'filter (mastodon-tl--property 'item-type)))
(user-error "No filter at point?")
(let* ((kws (alist-get 'keywords
(mastodon-tl--property 'item-json :no-move)))
(alist (mastodon-tl--map-alist-vals-to-alist 'keyword 'id kws))
(choice (completing-read "Remove keyword: " alist))
(id (cdr (assoc choice alist #'string=)))
(url (mastodon-http--api-v2 (format "filters/keywords/%s" id)))
(resp (mastodon-http--delete url)))
(mastodon-views--filters-triage resp (format "Keyword %s removed!" choice)))))
;;; FOLLOW SUGGESTIONS
;; No pagination: max 80 results
(defun mastodon-views-view-follow-suggestions ()
"Display a buffer of suggested accounts to follow."
(interactive)
(mastodon-tl--init-sync "follow-suggestions"
"suggestions"
'mastodon-views--insert-follow-suggestions
nil
'(("limit" . "80")) ; server max
nil
"suggested accounts")
(with-current-buffer "*mastodon-follow-suggestions*"
(use-local-map mastodon-views--follow-suggestions-map)))
(defun mastodon-views--insert-follow-suggestions (json)
"Insert follow suggestions into buffer.
JSON is the data returned by the server."
(mastodon-views--minor-view
"suggested accounts"
#'mastodon-views--insert-users-propertized-note
json))
(defun mastodon-views--insert-users-propertized-note (json)
"Insert users list into the buffer, including profile note.
JSON is the users list data."
(mastodon-search--insert-users-propertized json :note))
;;; INSTANCES
(defun mastodon-views-view-own-instance (&optional brief)
"View details of your own instance.
BRIEF means show fewer details."
(interactive)
(mastodon-views-view-instance-description :user brief))
(defun mastodon-views-view-own-instance-brief ()
"View brief details of your own instance."
(interactive)
(mastodon-views-view-instance-description :user :brief))
(defun mastodon-views-view-instance-description-brief ()
"View brief details of the instance the current post's author is on."
(interactive)
(mastodon-views-view-instance-description nil :brief))
(defun mastodon-views--get-instance-url (url username &optional instance)
"Return an instance base url from a user account URL.
USERNAME is the name to cull.
If INSTANCE is given, use that."
(cond (instance (concat "https://" instance))
;; pleroma URL is https://instance.com/users/username
((string-suffix-p "users/" (url-basepath url))
(string-remove-suffix "/users/"
(url-basepath url)))
;; friendica is https://instance.com/profile/user
((string-suffix-p "profile/" (url-basepath url))
(string-remove-suffix "/profile/"
(url-basepath url)))
;; snac is https://instance.com/user
((not (string-match-p "@" url))
;; cull trailing slash:
(string-trim-right (url-basepath url) "/"))
;; mastodon is https://instance.com/@user
(t
(string-remove-suffix (concat "/@" username)
url))))
(defun mastodon-views--get-own-instance ()
"Return JSON of `mastodon-active-user's instance."
(mastodon-http--get-json
(mastodon-http--api "instance" "v2") nil nil :vector))
(defun mastodon-views-view-instance-description
(&optional user brief instance misskey)
"View the details of the instance the current post's author is on.
USER means to show the instance details for the logged in user.
BRIEF means to show fewer details.
INSTANCE is an instance domain name.
MISSKEY means the instance is a Misskey or derived server."
(interactive)
(if user
(let ((response (mastodon-views--get-own-instance)))
(mastodon-views--instance-response-fun response brief instance))
(mastodon-tl--do-if-item
(let* ((toot (or (and (mastodon-tl--profile-buffer-p)
(mastodon-tl--property 'profile-json)) ; either profile
(mastodon-tl--property 'item-json))) ; or toot or user listing
(reblog (alist-get 'reblog toot))
(account (or (alist-get 'account reblog)
(alist-get 'account toot)
toot)) ; else `toot' is already an account listing.
;; we may be at toots/boosts/users in a profile buffer.
;; profile-json is a defacto test for if point is on the profile
;; details at the top of a profile buffer.
(profile-note-p (and (mastodon-tl--profile-buffer-p)
;; only call this in profile buffers:
(mastodon-tl--property 'profile-json)))
(url (if profile-note-p
(alist-get 'url toot) ; profile description
(alist-get 'url account)))
(username (if profile-note-p
(alist-get 'username toot) ;; profile
(alist-get 'username account)))
(instance (mastodon-views--get-instance-url url username instance)))
(if misskey
(let* ((params `(("detail" . ,(or brief t))))
(headers '(("Content-Type" . "application/json")))
(url (concat instance "/api/meta"))
(response
(with-current-buffer (mastodon-http--post url params headers t :json)
(mastodon-http--process-response))))
(mastodon-views--instance-response-fun response brief instance :misskey))
(let ((response (mastodon-http--get-json
(concat instance "/api/v1/instance") nil nil :vector)))
;; if non-misskey attempt errors, try misskey instance:
;; akkoma i guess should not error here.
(if (eq 'error (caar response))
(mastodon-views-instance-desc-misskey)
(mastodon-views--instance-response-fun response brief instance))))))))
(defun mastodon-views-instance-desc-misskey (&optional user brief instance)
"Show instance description for a misskey/firefish server.
USER, BRIEF, and INSTANCE are all for
`mastodon-views-view-instance-description', which see."
(interactive)
(mastodon-views-view-instance-description user brief instance :miskey))
(defun mastodon-views--instance-response-fun (response brief instance
&optional misskey)
"Display instance description RESPONSE in a new buffer.
BRIEF means to show fewer details.
INSTANCE is the instance were are working with.
MISSKEY means the instance is a Misskey or derived server."
(when response
(let* ((domain (url-file-nondirectory instance))
(buf (get-buffer-create
(format "*mastodon-instance-%s*" domain))))
(with-mastodon-buffer buf #'special-mode :other-window
(if misskey
(mastodon-views--insert-json response)
(condition-case nil
(progn
(when brief
(setq response
(list (assoc 'uri response)
(assoc 'title response)
(assoc 'short_description response)
(assoc 'email response)
(cons 'contact_account
(list
(assoc 'username
(assoc 'contact_account response))))
(assoc 'rules response)
(assoc 'stats response))))
(mastodon-views--print-json-keys response)
(mastodon-tl--set-buffer-spec (buffer-name buf) "instance" nil)
(goto-char (point-min)))
(error ; just insert the raw response:
(mastodon-views--insert-json response))))))))
(defun mastodon-views--insert-json (response)
"Insert raw JSON RESPONSE in current buffer."
(let ((inhibit-read-only t))
(erase-buffer)
(insert (prin1-to-string response))
(pp-buffer)
(goto-char (point-min))))
(defun mastodon-views--format-key (el pad)
"Format a key of element EL, a cons, with PAD padding."
(format (concat "%-"
(number-to-string pad)
"s: ")
(propertize (prin1-to-string (car el))
'face '(:underline t))))
(defun mastodon-views--print-json-keys (response &optional ind)
"Print the JSON keys and values in RESPONSE.
IND is the optional indentation level to print at."
(let* ((cars (mapcar (lambda (x) (symbol-name (car x)))
response))
(pad (1+ (apply #'max (mapcar #'length cars)))))
(while response
(let ((el (pop response)))
(cond
((and (vectorp (cdr el)) ; vector of alists (fields, instance rules):
(not (seq-empty-p (cdr el)))
(consp (seq-elt (cdr el) 0)))
(insert (mastodon-views--format-key el pad)
"\n\n")
(seq-do #'mastodon-views--print-instance-rules-or-fields (cdr el))
(insert "\n"))
((and (vectorp (cdr el)) ; vector of strings (media types):
(not (seq-empty-p (cdr el)))
(< 1 (seq-length (cdr el)))
(stringp (seq-elt (cdr el) 0)))
(when ind (indent-to ind))
(insert (mastodon-views--format-key el pad)
"\n"
(seq-mapcat
(lambda (x) (concat x ", "))
(cdr el) 'string)
"\n\n"))
((consp (cdr el)) ; basic nesting:
(when ind (indent-to ind))
(insert (mastodon-views--format-key el pad)
"\n\n")
(mastodon-views--print-json-keys
(cdr el) (if ind (+ ind 4) 4)))
(t ; basic handling of raw booleans:
(let ((val (cond ((eq (cdr el) :json-false)
"no")
((eq (cdr el) t)
"yes")
(t
(cdr el)))))
(when ind (indent-to ind))
(insert (mastodon-views--format-key el pad)
" "
(mastodon-views--newline-if-long (cdr el))
;; only send strings to --render-text (for hyperlinks):
(mastodon-tl--render-text
(if (stringp val) val (prin1-to-string val)))
"\n"))))))))
(defun mastodon-views--print-instance-rules-or-fields (alist)
"Print ALIST of instance rules or contact account or emoji fields."
(let-alist alist
(let ((key (or .id .name .shortcode))
(value (or .text .value .url)))
(indent-to 4)
(insert (format "%-5s: "
(propertize key 'face '(:underline t)))
(mastodon-views--newline-if-long value)
(format "%s" (mastodon-tl--render-text
value))
"\n"))))
(defun mastodon-views--newline-if-long (el)
"Return a newline string if the cdr of EL is over 50 characters long."
(let ((rend (if (stringp el) (mastodon-tl--render-text el) el)))
(if (and (sequencep rend)
(< 50 (length rend)))
"\n"
"")))
(provide 'mastodon-views)
;;; mastodon-views.el ends here
mastodon.el/lisp/mastodon-widget.el 0000664 0000000 0000000 00000010027 15017331127 0017677 0 ustar 00root root 0000000 0000000 ;;; mastodon-widget.el --- Widget utilities -*- lexical-binding: t -*-
;; Copyright (C) 2020-2024 Marty Hiatt
;; Author: Marty Hiatt
;; Maintainer: Marty Hiatt
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
;; This file is part of mastodon.el.
;; mastodon.el 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.
;; mastodon.el 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 mastodon.el. If not, see .
;;; Commentary:
;; some widget utilities for mastodon.el
;;; Code:
(require 'cl-lib)
(defvar mastodon-widget-keymap
(let ((map (make-sparse-keymap)))
(define-key map [down-mouse-2] 'widget-button-click)
(define-key map [down-mouse-1] 'widget-button-click)
(define-key map [touchscreen-begin] 'widget-button-click)
;; The following definition needs to avoid using escape sequences that
;; might get converted to ^M when building loaddefs.el
(define-key map [(control ?m)] 'widget-button-press)
map)
"Keymap containing useful binding for buffers containing widgets.
Recommended as a parent keymap for modes using widgets.
Note that such modes will need to require wid-edit.")
(defface mastodon-widget-face
'((t :inherit font-lock-function-name-face :weight bold :underline t))
"Face for widgets."
:group 'mastodon)
(defun mastodon-widget--return-item-widgets (list)
"Return a list of item widgets for each item, a string, in LIST."
(cl-loop for x in list
collect `(choice-item :value ,x :format "%[%v%] "
:keymap ,mastodon-widget-keymap)))
(defun mastodon-widget--format (str &optional padding newline)
"Return a widget format string for STR, its name.
PADDING is an integer, for how much right-side padding to add."
(concat "%[" (propertize str
'face 'mastodon-widget-face
'mastodon-tab-stop t)
"%]: %v"
(make-string padding ? )
(if newline "\n" "")))
(defun mastodon-widget--create (kind type value notify-fun
&optional newline)
"Return a widget of KIND, with TYPE elements, and default VALUE.
KIND is a string, either Listing, Sort, Items, or Inbox, and will
be used for the widget's tag.
VALUE is a string, a member of TYPE.
NOTIFY-FUN is the widget's notify function."
(let* ((val-length (length (if (symbolp value)
(symbol-name value)
value)))
(type-list (if (symbolp type)
(symbol-value type)
type))
(longest (apply #'max
(mapcar #'length
(if (symbolp (car type-list))
(mapcar #'symbol-name type-list)
type-list))))
(padding (- longest val-length)))
(if (not (member value type-list))
(user-error "%s is not a member of %s" value type-list)
(widget-create
'menu-choice
:tag kind
:value value
:args (mastodon-widget--return-item-widgets type-list)
:help-echo (format "Select a %s kind" kind)
:format (mastodon-widget--format kind padding newline)
:notify notify-fun
;; eg format of notify-fun:
;; (lambda (widget &rest ignore)
;; (let ((value (widget-value widget))
;; (tag (widget-get widget :tag)))
;; (notify-fun value)))
:keymap mastodon-widget-keymap))))
(provide 'mastodon-widget)
;;; mastodon-widget.el ends here
mastodon.el/lisp/mastodon.el 0000664 0000000 0000000 00000061327 15017331127 0016427 0 ustar 00root root 0000000 0000000 ;;; mastodon.el --- Client for fediverse services using the Mastodon API -*- lexical-binding: t -*-
;; Copyright (C) 2017-2019 Johnson Denen
;; Copyright (C) 2020-2022 Marty Hiatt
;; Copyright (C) 2021 Abhiseck Paira
;; Author: Johnson Denen
;; Marty Hiatt
;; Maintainer: Marty Hiatt
;; Version: 2.0.1
;; Package-Requires: ((emacs "28.1") (persist "0.4") (tp "0.7"))
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
;; This file is part of mastodon.el.
;; mastodon.el 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.
;; mastodon.el 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 mastodon.el. If not, see .
;;; Commentary:
;; mastodon.el is a client for fediverse services that implement the Mastodon
;; API. See .
;; For set up and usage details, see the Info documentation, or the readme
;; file at .
;;; Code:
(require 'cl-lib) ; for `cl-some' call in `mastodon'
(eval-when-compile (require 'subr-x))
(require 'url)
(require 'thingatpt)
(require 'shr)
(require 'mastodon-http)
(require 'mastodon-toot)
(require 'mastodon-search)
(require 'mastodon-transient)
(require 'mastodon-tl)
(declare-function discover-add-context-menu "discover")
(declare-function emojify-mode "emojify")
(declare-function request "request")
(autoload 'mastodon-auth--get-account-name "mastodon-auth")
(autoload 'mastodon-auth--user-acct "mastodon-auth")
(autoload 'mastodon-discover "mastodon-discover")
(autoload 'mastodon-notifications-follow-request-accept "mastodon-notifications")
(autoload 'mastodon-notifications-follow-request-reject "mastodon-notifications")
(autoload 'mastodon-notifications-get-mentions "mastodon-notifications")
(autoload 'mastodon-notifications--timeline "mastodon-notifications")
(autoload 'mastodon-notifications-policy "mastodon-notifications")
(autoload 'mastodon-notifications-requests "mastodon-notifications")
(autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile")
(autoload 'mastodon-profile-get-toot-author "mastodon-profile")
(autoload 'mastodon-profile--make-author-buffer "mastodon-profile")
(autoload 'mastodon-profile-my-profile "mastodon-profile")
(autoload 'mastodon-profile-show-user "mastodon-profile")
(autoload 'mastodon-profile-update-user-profile-note "mastodon-profile")
(autoload 'mastodon-profile-view-bookmarks "mastodon-profile")
(autoload 'mastodon-profile-view-favourites "mastodon-profile")
(autoload 'mastodon-toot-edit-toot-at-point "mastodon-toot")
(when (require 'lingva nil :no-error)
(autoload 'mastodon-toot-translate-toot-text "mastodon-toot"))
(autoload 'mastodon-toot--view-toot-history "mastodon-tl")
(autoload 'mastodon-tl-return "mastodon-tl")
(autoload 'mastodon-tl-jump-to-followed-tag "mastodon-tl")
;; for M-x visibility
;; (views.el uses `mastodon-mode-map', so we can't easily require it)
(autoload 'mastodon-views-view-follow-suggestions "mastodon-views"
nil :interactive)
(autoload 'mastodon-views-view-filters "mastodon-views"
nil :interactive)
(autoload 'mastodon-views-view-follow-requests "mastodon-views"
nil :interactive)
(autoload 'mastodon-views-view-own-instance "mastodon-views"
nil :interactive)
(autoload 'mastodon-views-view-instance-description "mastodon-views"
nil :interactive)
(autoload 'mastodon-views-view-lists "mastodon-views"
nil :interactive)
(autoload 'mastodon-views-view-scheduled-toots "mastodon-views"
nil :interactive)
(autoload 'mastodon-views-add-account-to-list "mastodon-views"
nil :interactive)
(autoload 'mastodon-views-add-toot-account-at-point-to-list "mastodon-views"
nil :interactive)
(autoload 'mastodon-views-create-list "mastodon-views"
nil :interactive)
(autoload 'mastodon-views-create-filter "mastodon-views"
nil :interactive)
(autoload 'mastodon-views-view-list-timeline "mastodon-views"
nil :interactive)
(autoload 'special-mode "simple")
(defvar mastodon-tl--highlight-current-toot)
(defvar mastodon-notifications--map)
(defvar mastodon-client--token-file)
(defvar mastodon-notifications-grouped-types
'("reblog" "favourite") ;; TODO: implement follow!
"List of notification types for which grouping is implemented.
Used in `mastodon-notifications-get'")
(defgroup mastodon nil
"Interface with Mastodon."
:prefix "mastodon-"
:group 'external)
(defcustom mastodon-instance-url "https://mastodon.social"
"Base URL for the fediverse instance you want to be active.
For example, if your username is
\"example_user@social.instance.org\", and you want this account
to be active, the value of this variable should be
\"https://social.instance.org\".
Also for completeness, the value of `mastodon-active-user' should
be \"example_user\".
After setting these variables you should restart Emacs for these
changes to take effect."
:type 'string)
(defcustom mastodon-active-user nil
"Username of the active user.
For example, if your username is
\"example_user@social.instance.org\", and you want this account
to be active, the value of this variable should be
\"example_user\".
Also for completeness, the value of `mastodon-instance-url'
should be \"https://social.instance.org\".
After setting these variables you should restart Emacs for these
changes to take effect."
:type 'string)
(defcustom mastodon-toot-timestamp-format "%F %T"
"Format to use for timestamps.
For valid formatting options see `format-time-string`.
The default value \"%F %T\" prints ISO8601-style YYYY-mm-dd HH:MM:SS.
Use. e.g. \"%c\" for your locale's date and time format."
:type 'string)
(defcustom mastodon-use-emojify nil
"Whether to use emojify.el to display emojis.
From version 28, Emacs can display emojis natively. But
currently, it doesn't seem to have a way to handle custom emoji,
while emojify,el has this feature and mastodon.el implements it."
:type 'boolean)
;; notifications customizes
;; moved here because we can load notifs without first loading mastodon.el
;; or mastodon-notifications.el
(defcustom mastodon-profile-note-in-foll-reqs t
"If non-nil, show a user's profile note in follow request notifications."
:type '(boolean))
(defcustom mastodon-profile-note-in-foll-reqs-max-length nil
"The max character length for user profile note in follow requests.
Profile notes are only displayed if
`mastodon-profile-note-in-foll-reqs' is non-nil.
If unset, profile notes of any size will be displayed, which may
make them unweildy."
:type '(integer))
(defcustom mastodon-images-in-notifs nil
"Whether to display attached images in notifications."
:type '(boolean))
(defcustom mastodon-group-notifications nil
"Whether to use grouped notifications.
Requires that your instance actually implements grouped notifications.
Mastodon implemented them in 4.3."
:type '(boolean))
(defcustom mastodon-notifications-grouped-names-count 2
"The number of notification authors to display.
A count of 2 for example means to display like so: \"Bob, Jenny
and X others...\"."
:type '(integer))
(defun mastodon-kill-window ()
"Quit window and delete helper."
(interactive)
(quit-window 'kill))
(defvar mastodon-client--active-user-details-plist)
(defvar mastodon-auth--token-alist)
;;;###autoload
(defun mastodon-forget-all-logins ()
"Delete `mastodon-client--token-file'.
Also nil `mastodon-auth--token-alist'."
(interactive)
(when (y-or-n-p "Remove all saved login data?")
(if (not (file-exists-p mastodon-client--token-file))
(message "No plstore file")
(delete-file mastodon-client--token-file)
(message "File %s deleted." mastodon-client--token-file))
;; nil some vars too:
(setq mastodon-client--active-user-details-plist nil)
(setq mastodon-auth--token-alist nil)))
(defvar mastodon-mode-map
(let ((map (make-sparse-keymap)))
;; navigation inside a timeline
(define-key map (kbd "n") #'mastodon-tl-goto-next-item)
(define-key map (kbd "p") #'mastodon-tl-goto-prev-item)
(define-key map (kbd "M-n") #'mastodon-tl-next-tab-item)
(define-key map (kbd "M-p") #'mastodon-tl-previous-tab-item)
(define-key map [?\t] #'mastodon-tl-next-tab-item)
(define-key map [backtab] #'mastodon-tl-previous-tab-item)
(define-key map [?\S-\t] #'mastodon-tl-previous-tab-item)
(define-key map [?\M-\t] #'mastodon-tl-previous-tab-item)
(define-key map (kbd "l") #'recenter-top-bottom)
;; navigation between timelines
(define-key map (kbd "#") #'mastodon-tl-get-tag-timeline)
(define-key map (kbd "\"") #'mastodon-tl-list-followed-tags)
(define-key map (kbd "C-\"") #'mastodon-tl-jump-to-followed-tag)
(define-key map (kbd "'") #'mastodon-tl-followed-tags-timeline)
(define-key map (kbd "C-'") #'mastodon-tl-tag-group-timeline)
(define-key map (kbd "A") #'mastodon-profile-get-toot-author)
(define-key map (kbd "F") #'mastodon-tl-get-federated-timeline)
(define-key map (kbd "H") #'mastodon-tl-get-home-timeline)
(define-key map (kbd "L") #'mastodon-tl-get-local-timeline)
(define-key map (kbd "N") #'mastodon-notifications-get)
(define-key map (kbd "S-C-n") #'mastodon-notifications-requests)
(define-key map (kbd "@") #'mastodon-notifications-get-mentions)
(define-key map (kbd "P") #'mastodon-profile-show-user)
(define-key map (kbd "s") #'mastodon-search-query)
(define-key map (kbd "/") #'mastodon-switch-to-buffer)
(define-key map (kbd "\\") #'mastodon-tl-get-remote-local-timeline)
;; quitting mastodon
(define-key map (kbd "q") #'kill-current-buffer)
(define-key map (kbd "Q") #'mastodon-kill-window)
(define-key map (kbd "M-C-q") #'mastodon-kill-all-buffers)
;; toot actions
(define-key map (kbd "c") #'mastodon-tl-toggle-spoiler-text-in-toot)
(define-key map (kbd "b") #'mastodon-toot-toggle-boost)
(define-key map (kbd "f") #'mastodon-toot-toggle-favourite)
(define-key map (kbd "k") #'mastodon-toot-toggle-bookmark)
(define-key map (kbd "r") #'mastodon-toot-reply)
(define-key map (kbd "C") #'mastodon-toot-copy-toot-url)
(define-key map (kbd "o") #'mastodon-toot-browse-toot-url)
(define-key map (kbd "v") #'mastodon-tl-poll-vote)
(define-key map (kbd "E") #'mastodon-toot-view-toot-edits)
(define-key map (kbd "T") #'mastodon-tl-thread)
(define-key map (kbd "RET") #'mastodon-tl-return)
(define-key map (kbd "m") #'mastodon-tl-dm-user)
(define-key map (kbd "=") #'mastodon-tl-view-first-full-image)
(when (require 'lingva nil :no-error)
(define-key map (kbd "a") #'mastodon-toot-translate-toot-text))
(define-key map (kbd ",") #'mastodon-toot-list-favouriters)
(define-key map (kbd ".") #'mastodon-toot-list-boosters)
(define-key map (kbd ";") #'mastodon-views-view-instance-description)
;; override special mode binding
(define-key map (kbd "g") #'undefined)
(define-key map (kbd "g") #'mastodon-tl-update)
;; this is now duplicated by 'g', cd remove/use for else:
(define-key map (kbd "u") #'mastodon-tl-update)
;; own toot actions:
(define-key map (kbd "t") #'mastodon-toot)
(define-key map (kbd "d") #'mastodon-toot-delete-toot)
(define-key map (kbd "D") #'mastodon-toot-delete-and-redraft-toot)
(define-key map (kbd "i") #'mastodon-toot-pin-toot-toggle)
(define-key map (kbd "e") #'mastodon-toot-edit-toot-at-point)
;; user actions
(define-key map (kbd "W") #'mastodon-tl-follow-user)
(define-key map (kbd "C-S-W") #'mastodon-tl-unfollow-user)
(define-key map (kbd "B") #'mastodon-tl-block-user)
(define-key map (kbd "C-S-B") #'mastodon-tl-unblock-user)
(define-key map (kbd "M") #'mastodon-tl-mute-user)
(define-key map (kbd "C-S-M") #'mastodon-tl-unmute-user)
(define-key map (kbd "Z") #'mastodon-tl-report-to-mods)
;; own profile
(define-key map (kbd "O") #'mastodon-profile-my-profile)
(define-key map (kbd "U") #'mastodon-profile-update-user-profile-note)
(define-key map (kbd "V") #'mastodon-profile-view-favourites)
(define-key map (kbd "K") #'mastodon-profile-view-bookmarks)
(define-key map (kbd ":") #'mastodon-user-settings)
(define-key map (kbd "C-:") #'mastodon-notifications-policy)
;; minor views
(define-key map (kbd "R") #'mastodon-views-view-follow-requests)
(define-key map (kbd "S") #'mastodon-views-view-scheduled-toots)
(define-key map (kbd "I") #'mastodon-views-view-filters)
(define-key map (kbd "G") #'mastodon-views-view-follow-suggestions)
(define-key map (kbd "X") #'mastodon-views-view-lists)
(define-key map (kbd "SPC") #'mastodon-tl-scroll-up-command)
(define-key map (kbd "!") #'mastodon-tl-fold-post-toggle)
(define-key map (kbd "z") #'bury-buffer)
map)
"Keymap for `mastodon-mode'.")
(defcustom mastodon-mode-hook nil
"Hook run when entering Mastodon mode."
:type 'hook
:options '(provide-discover-context-menu))
(defface mastodon-handle-face
'((t :inherit default))
"Face used for user handles in bylines.")
(defface mastodon-display-name-face
'((t :inherit warning))
"Face used for user display names.")
(defface mastodon-boosted-face
'((t :inherit success :weight bold))
"Face to indicate that a toot is boosted.")
(defface mastodon-boost-fave-face
'((t :inherit success))
"Face to indicate that you have boosted or favourited a toot.")
(defface mastodon-cw-face
'((t :inherit success))
"Face used for content warning.")
(defface mastodon-toot-docs-face
`((t :inherit shadow))
"Face used for documentation in toot compose buffer.
If `mastodon-tl--enable-proportional-fonts' is changed,
mastodon.el needs to be re-loaded for this to be correctly set.")
(defface mastodon-toot-docs-reply-text-face
`((t :inherit font-lock-comment-face
:family ,(face-attribute 'variable-pitch :family)))
"Face used for reply text in toot compose buffer.
See `mastodon-toot-display-orig-in-reply-buffer'.")
(defface mastodon-cursor-highlight-face
`((t :inherit highlight :extend t))
"Face for `mastodon-tl--highlight-current-toot'.")
;;;###autoload
(defun mastodon ()
"Connect client to `mastodon-instance-url' instance.
If there are any open mastodon.el buffers, switch to one instead.
Prority in switching is given to timeline views."
(interactive)
(let* ((tls (list "home"
"local"
"federated"
(concat (mastodon-auth--user-acct) "-statuses") ; own profile
"favourites"
"search"))
(buffer (or (cl-some (lambda (el)
(get-buffer (concat "*mastodon-" el "*")))
tls) ; return first buff that exists
(cl-some (lambda (x)
(when (string-prefix-p "*mastodon-"
(buffer-name x))
(get-buffer x)))
(buffer-list))))) ; catch any other masto buffer
(if buffer
(pop-to-buffer buffer '(display-buffer-same-window))
;; we need to update credential-account in case setting have been changed
;; outside mastodon.el in the meantime:
(mastodon-return-credential-account :force)
(mastodon-tl-get-home-timeline)
(message "Loading fediverse account %s on %s..."
(mastodon-auth--user-acct)
mastodon-instance-url))))
(defvar mastodon-profile-credential-account nil)
;; TODO: the get request in mastodon-http--get-response often returns nil
;; after waking from sleep, not sure how to fix, or if just my pc.
;; interestingly it only happens with this function tho.
(defun mastodon-return-credential-account (&optional force)
"Return the CredentialAccount entity.
Either from `mastodon-profile-credential-account' or from the
server if that var is nil.
FORCE means to fetch from the server in any case and update
`mastodon-profile-credential-account'."
(if (or force (not mastodon-profile-credential-account))
(setq mastodon-profile-credential-account
;; TODO: we should signal a quit condition after 5 secs here
(condition-case nil
(mastodon-http--get-json
(mastodon-http--api "accounts/verify_credentials")
nil :silent)
(t ; req fails, return old value
mastodon-profile-credential-account)))
;; else just return the var:
mastodon-profile-credential-account))
(defvar mastodon-instance-data nil
"Instance data from the instance endpoint.")
(defun mastodon-instance-data ()
"Return `mastodon-instnace-data' or else fetch from instance endpoint."
(or mastodon-instance-data
(setq mastodon-instance-data
(mastodon-http--get-json (mastodon-http--api "instance")))))
(defun mastodon-instance-version ()
"Return the version string of user's instance."
(alist-get 'version (mastodon-instance-data)))
;;;###autoload
(defun mastodon-toot (&optional user reply-to-id reply-json)
"Update instance with new toot. Content is captured in a new buffer.
If USER is non-nil, insert after @ symbol to begin new toot.
If REPLY-TO-ID is non-nil, attach new toot to a conversation.
If REPLY-JSON is the json of the toot being replied to."
(interactive)
(mastodon-toot--compose-buffer user reply-to-id reply-json))
;;;###autoload
(defun mastodon-notifications-get (&optional type buffer-name max-id)
"Display NOTIFICATIONS in buffer.
Optionally only print notifications of type TYPE, a string.
BUFFER-NAME is added to \"*mastodon-\" to create the buffer name.
MAX-ID is a request parameter for pagination."
(interactive)
(let* ((buffer-name (or buffer-name "notifications"))
(buffer (concat "*mastodon-" buffer-name "*")))
(message "Loading your notifications...")
(mastodon-tl--init-sync
buffer-name
"notifications"
'mastodon-notifications--timeline
type
`(,@(when mastodon-group-notifications
(mastodon-http--build-array-params-alist
"grouped_types[]" mastodon-notifications-grouped-types))
,@(when max-id
`(("max_id" . ,(mastodon-tl--buffer-property 'max-id)))))
nil nil nil
(if (or (not mastodon-group-notifications)
;; if version less than 1st grouped notifs release:
(> 4.3 (string-to-number
(mastodon-instance-version))))
"v1"
"v2"))
(with-current-buffer (get-buffer-create buffer)
(use-local-map mastodon-notifications--map))
(message "Loading your notifications... Done")))
;; URL lookup: should be available even if `mastodon.el' not loaded:
;;;###autoload
(defun mastodon-url-lookup (&optional query-url force)
"If a URL resembles a fediverse link, try to load in `mastodon.el'.
Does a WebFinger lookup on the server.
URL can be arg QUERY-URL, or URL at point, or provided by the user.
If a status or account is found, load it in `mastodon.el', if
not, just browse the URL in the normal fashion.
If FORCE, do a lookup regardless of the result of `mastodon--fedi-url-p'."
(interactive)
(let* ((query (or query-url
(mastodon-tl--property 'shr-url :no-move)
(thing-at-point-url-at-point)
(read-string "Lookup URL: "))))
(if (and (not force)
(not (mastodon--fedi-url-p query)))
;; (shr-browse-url query) ; doesn't work (keep our shr keymap)
(progn (message "Using external browser")
(browse-url query))
(message "Performing lookup...")
(let* ((url (format "%s/api/v2/search" mastodon-instance-url))
(params `(("q" . ,query)
("resolve" . "t"))) ; webfinger
(response (mastodon-http--get-json url params :silent)))
(cond ((not (seq-empty-p (alist-get 'statuses response)))
(let* ((statuses (assoc 'statuses response))
(status (seq-first (cdr statuses)))
(status-id (alist-get 'id status)))
(mastodon-tl--thread-do status-id)))
((not (seq-empty-p (alist-get 'accounts response)))
(let* ((accounts (assoc 'accounts response))
(account (seq-first (cdr accounts))))
(mastodon-profile--make-author-buffer account)))
(t
(message "Lookup failed. Using external browser")
(browse-url query)))))))
(defun mastodon-url-lookup-force ()
"Call `mastodon-url-lookup' without checking if URL is fedi-like."
(interactive)
(mastodon-url-lookup nil :force))
(defun mastodon--fedi-url-p (query)
"Check if QUERY resembles a fediverse URL."
;; calqued off https://github.com/tuskyapp/Tusky/blob/c8fc2418b8f5458a817bba221d025b822225e130/app/src/main/java/com/keylesspalace/tusky/BottomSheetActivity.kt
;; thx to Conny Duck!
;; mastodon at least seems to allow only [a-z0-9_] for usernames, plus "."
;; but not at beginning or end, see https://github.com/mastodon/mastodon/issues/6830
;; objects may have - in them
(let* ((uri-parsed (url-generic-parse-url query))
(query (url-filename uri-parsed)))
(save-match-data
(or (string-match "^/@[^/]+$" query)
(string-match "^/@[^/]+/[[:digit:]]+$" query)
(string-match "^/user[s]?/@?[[:alnum:]_]+$" query) ; @: pleroma or soapbox
(string-match "^/notice/[[:alnum:]]+$" query)
(string-match "^/objects/[-a-f0-9]+$" query)
(string-match "^/notes/[a-z0-9]+$" query)
(string-match "^/display/[-a-f0-9]+$" query)
(string-match "^/profile/[[:alpha:]_]+$" query)
(string-match "^/p/[[:alpha:]_]+/[[:digit:]]+$" query)
(string-match "^/[[:alpha:]_]+$" query)
(string-match "^/u/[[:alpha:]_]+$" query)
(string-match "^/c/[[:alnum:]_]+$" query)
(string-match "^/post/[[:digit:]]+$" query)
(string-match "^/comment/[[:digit:]]+$" query) ; lemmy
(string-match "^/@[^/]+/statuses/[[:alnum:]]" query) ; GTS
(string-match "^/user[s]?/[[:alnum:]_]+/statuses/[[:digit:]]+$" query) ; hometown
(string-match "^/notes/[[:alnum:]]+$" query) ; misskey post
(string-match "^/w/[[:alnum:]_]+$" query) ; peertube post
))))
(defun mastodon-live-buffers ()
"Return a list of open mastodon buffers.
Calls `mastodon-tl--get-buffer-type', which see."
(cl-loop for x in (buffer-list)
when (with-current-buffer x (mastodon-tl--get-buffer-type))
collect (get-buffer x)))
(defun mastodon-buffer-p (&optional buffer)
"Non-nil if BUFFER or `current-buffer' is a mastodon one."
(let ((buf (or buffer (current-buffer))))
(member buf (mastodon-live-buffers))))
(defun mastodon-kill-all-buffers ()
"Kill any and all open mastodon buffers, hopefully."
(interactive)
(let ((mastodon-buffers (mastodon-live-buffers)))
(cl-loop for x in mastodon-buffers
do (kill-buffer x))))
(defun mastodon-switch-to-buffer ()
"Switch to a live mastodon buffer."
(interactive)
(let ((choice (completing-read
"Switch to mastodon buffer: "
(mapcar #'buffer-name (mastodon-live-buffers))
nil :match)))
(switch-to-buffer choice)))
(defun mastodon--url-at-point ()
"`thing-at-point' provider function."
(get-text-property (point) 'shr-url))
(defun mastodon-mode-hook-fun ()
"Function to add to `mastodon-mode-hook'."
(when (and mastodon-use-emojify
(require 'emojify nil :noerror))
(emojify-mode t)
(when mastodon-toot--enable-custom-instance-emoji
(mastodon-toot-enable-custom-emoji)))
(mastodon-profile--fetch-server-account-settings)
(when (and mastodon-tl--highlight-current-toot
(fboundp #'cursor-face-highlight-mode))
(cursor-face-highlight-mode)) ; 29.1
;; make `thing-at-point' functions work:
(setq-local thing-at-point-provider-alist
(append thing-at-point-provider-alist
'((url . mastodon--url-at-point)))))
;;;###autoload
(add-hook 'mastodon-mode-hook #'mastodon-mode-hook-fun)
(define-derived-mode mastodon-mode special-mode "Mastodon"
"Major mode for fediverse services using the Mastodon API."
(read-only-mode 1))
(provide 'mastodon)
;;; mastodon.el ends here
mastodon.el/mastodon-index.org 0000664 0000000 0000000 00000122474 15017331127 0016755 0 ustar 00root root 0000000 0000000
* mastodon commands index
#+BEGIN_SRC emacs-lisp :results table :colnames '("Binding" "Command" "Description") :exports results
(let (rows)
(mapatoms
(lambda (symbol)
(when (and (string-match "^mastodon"
(symbol-name symbol))
(commandp symbol))
(let* ((doc (car
(split-string
(or (documentation symbol t) "")
"\n")))
;; add more keymaps here
;; some keys are in sub 'keymap keys inside a map
(maps (list mastodon-mode-map
mastodon-toot-mode-map
mastodon-profile-mode-map
mastodon-notifications--map
mastodon-tl--shr-image-map-replacement
mastodon-profile-update-mode-map
mastodon-views-map
mastodon-views--follow-suggestions-map
mastodon-views--scheduled-map
mastodon-views--view-lists-keymap
mastodon-views--view-follow-requests-keymap
mastodon-views--view-filters-keymap))
(binding-code
(let ((keys (where-is-internal symbol maps nil nil (command-remapping symbol))))
;; just take first 2 bindings:
(if (> (length keys) 2)
(list (car keys) (cadr keys))
keys)))
;; (or (car (rassoc symbol mastodon-mode-map))
;; (car (rassoc symbol (cadr mastodon-toot-mode-map)))
;; (car (rassoc symbol (cadr mastodon-profile-mode-map)))
;; (car (rassoc symbol mastodon-notifications--map))))
(binding-str (if binding-code
(mapconcat #'help--key-description-fontified
binding-code ", ")
"")))
(push `(,binding-str ,symbol ,doc) rows)
rows))))
(sort rows (lambda (x y) (string-lessp (cadr x) (cadr y)))))
#+END_SRC
#+RESULTS:
| Binding | Command | Description |
|------------------+---------------------------------------------------+--------------------------------------------------------------------------------|
| | mastodon | Connect client to `mastodon-instance-url' instance. |
| | mastodon-async-mode | Async Mastodon. |
| C-c C-p | mastodon-create-poll | A transient for creating a poll. |
| | mastodon-create-poll-done | Update current user profile fields. |
| C-M-q | mastodon-kill-all-buffers | Kill any and all open mastodon buffers, hopefully. |
| Q | mastodon-kill-window | Quit window and delete helper. |
| | mastodon-mode | Major mode for fediverse services using the Mastodon API. |
| | mastodon-forget-all-logins | Delete `mastodon-client--token-file'. |
| | mastodon-notifications-clear-all | Clear all notifications. |
| C-k | mastodon-notifications-clear-current | Dismiss the notification at point. |
| | mastodon-notifications-cycle-type | Cycle the current notifications view. |
| | mastodon-notifications-follow-request-accept | Accept a follow request. |
| j | mastodon-notifications-follow-request-reject | Reject a follow request. |
| N | mastodon-notifications-get | Display NOTIFICATIONS in buffer. |
| | mastodon-notifications-get-boosts | Display boost notifications in buffer. |
| | mastodon-notifications-get-edits | Display edited post notifications in buffer. |
| | mastodon-notifications-get-favourites | Display favourite notifications in buffer. |
| | mastodon-notifications-get-follow-requests | Display follow request notifications in buffer. |
| | mastodon-notifications-get-follows | Display follow notifications in buffer. |
| @ | mastodon-notifications-get-mentions | Display mention notifications in buffer. |
| | mastodon-notifications-get-polls | Display poll notifications in buffer. |
| | mastodon-notifications-get-single-notif | Return a single notification JSON for v2 notifs. |
| | mastodon-notifications-get-statuses | Display status notifications in buffer. |
| | mastodon-notifications-get-type | Read a notification type and load its timeline. |
| C-: | mastodon-notifications-policy | A transient to set notifications policy options. |
| | mastodon-notifications-policy-update | Send updated notification policy settings. |
| | mastodon-notifications-request-accept | Accept a notification request for a user. |
| | mastodon-notifications-request-reject | Reject a notification request for a user. |
| C-S-n | mastodon-notifications-requests | Open a new buffer displaying the user's notification requests. |
| | mastodon-profile-account-bot-toggle | Toggle the bot status of your account. |
| | mastodon-profile-account-discoverable-toggle | Toggle the discoverable status of your account. |
| | mastodon-profile-account-locked-toggle | Toggle the locked status of your account. |
| | mastodon-profile-account-search | Run a statuses search QUERY for the currently viewed account. |
| | mastodon-profile-account-sensitive-toggle | Toggle the sensitive status of your account. |
| | mastodon-profile-account-view-cycle | Cycle through profile view: toots, toot sans boosts, followers, and following. |
| | mastodon-profile-add-account-to-list | Add account of current profile buffer to a list. |
| | mastodon-profile-add-private-note-to-account | Add a private note to an account. |
| | mastodon-profile-fields | A transient for setting profile fields. |
| | mastodon-profile-fields-update | Update current user profile fields. |
| A | mastodon-profile-get-toot-author | Open profile of author of toot under point. |
| | mastodon-profile-mode | Toggle mastodon profile minor mode. |
| O | mastodon-profile-my-profile | Show the profile of the currently signed in user. |
| | mastodon-profile-open-followers | Open a profile buffer showing the accounts following the current profile. |
| | mastodon-profile-open-following | Open a profile buffer showing the accounts that current profile follows. |
| | mastodon-profile-open-statuses | Open a profile showing statuses. |
| | mastodon-profile-open-statuses-no-reblogs | Open a profile buffer showing statuses without reblogs. |
| | mastodon-profile-open-statuses-no-replies | Open a profile buffer showing statuses without replies. |
| | mastodon-profile-open-statuses-only-media | Open a profile buffer showing only statuses with media. |
| C-c # | mastodon-profile-open-statuses-tagged | Prompt for a hashtag and display a profile with only statuses containing it. |
| | mastodon-profile-remove-from-followers-at-point | Prompt for a user in the item at point and remove from followers. |
| | mastodon-profile-remove-from-followers-list | Select a user from your followers and remove from followers. |
| | mastodon-profile-remove-user-from-followers | Remove a user from your followers. |
| | mastodon-profile-show-familiar-followers | Show a list of familiar followers. |
| P | mastodon-profile-show-user | Query for USER-HANDLE from current status and show that user's profile. |
| | mastodon-profile-update-display-name | Update display name for your account. |
| | mastodon-profile-update-meta-fields | Prompt for new metadata fields information and PATCH the server. |
| | mastodon-profile-update-mode | Minor mode to update user profile. |
| | mastodon-profile-update-profile-note-cancel | Cancel updating user profile and kill buffer and window. |
| U | mastodon-profile-update-user-profile-note | Fetch user's profile note and display for editing. |
| | mastodon-profile-user-profile-send-updated | Send PATCH request with the updated profile note. |
| | mastodon-profile-view-account-private-note | Display the private note about a user. |
| K | mastodon-profile-view-bookmarks | Open a new buffer displaying the user's bookmarks. |
| V | mastodon-profile-view-favourites | Open a new buffer displaying the user's favourites. |
| | mastodon-profile-view-preferences | View user preferences in another window. |
| | mastodon-search-load-link-posts | Load timeline of posts containing link at point. |
| | mastodon-search-mode | Toggle mastodon search minor mode. |
| s | mastodon-search-query | Prompt for a search QUERY and return accounts, statuses, and hashtags. |
| | mastodon-search-query-accounts-followed | Run an accounts search QUERY, limited to your followers. |
| | mastodon-search-query-cycle | Cycle through search types: accounts, hashtags, and statuses. |
| | mastodon-search-trending-links | Display a list of links trending on your instance. |
| | mastodon-search-trending-statuses | Display a list of statuses trending on your instance. |
| | mastodon-search-trending-tags | Display a list of tags trending on your instance. |
| / | mastodon-switch-to-buffer | Switch to a live mastodon buffer. |
| | mastodon-tl-announcements | Display announcements from your instance. |
| | mastodon-tl-block-domain | Read a domain and block it. |
| B | mastodon-tl-block-user | Query for USER-HANDLE from current status and block that user. |
| | mastodon-tl-click-image-or-video | Click to play video with `mpv.el'. |
| | mastodon-tl-copy-image-caption | Copy the caption of the image at point. |
| | mastodon-tl-disable-notify-user-posts | Query for USER-HANDLE and disable notifications when they post. |
| m | mastodon-tl-dm-user | Query for USER-HANDLE from current status and compose a message to that user. |
| | mastodon-tl-do-link-action | Do the action of the link at point. |
| | mastodon-tl-do-link-action-at-point | Do the action of the link at POS. |
| | mastodon-tl-enable-notify-user-posts | Query for USER-HANDLE and enable notifications when they post. |
| | mastodon-tl-filter-user-user-posts-by-language | Query for USER-HANDLE and filter display of their posts by language. |
| | mastodon-tl-fold-post | Fold post at point, if it is too long. |
| ! | mastodon-tl-fold-post-toggle | Toggle the folding status of the toot at point. |
| | mastodon-tl-follow-tag | Prompt for a tag (from post at point) and follow it. |
| W | mastodon-tl-follow-user | Query for USER-HANDLE from current status and follow that user. |
| | mastodon-tl-follow-user-by-handle | Prompt for a USER-HANDLE and follow that user. |
| | mastodon-tl-follow-user-disable-boosts | Prompt for a USER-HANDLE, and disable display of boosts in home timeline. |
| | mastodon-tl-follow-user-enable-boosts | Prompt for a USER-HANDLE, and enable display of boosts in home timeline. |
| ' | mastodon-tl-followed-tags-timeline | Open a timeline of multiple tags. |
| F | mastodon-tl-get-federated-timeline | Open federated timeline. |
| H | mastodon-tl-get-home-timeline | Open home timeline. |
| L | mastodon-tl-get-local-timeline | Open local timeline. |
| \ | mastodon-tl-get-remote-local-timeline | Prompt for an instance domain and try to display its local timeline. |
| # | mastodon-tl-get-tag-timeline | Prompt for tag and opens its timeline. |
| n | mastodon-tl-goto-next-item | Jump to next item. |
| p | mastodon-tl-goto-prev-item | Jump to previous item. |
| " | mastodon-tl-list-followed-tags | List followed tags. View timeline of tag user choses. |
| C- | mastodon-tl-mpv-play-video-at-point | Play the video or gif at point with an mpv process. |
| | mastodon-tl-mpv-play-video-from-byline | Run `mastodon-tl-mpv-play-video-at-point' on first moving image in post. |
| | mastodon-tl-mute-thread | Mute the thread displayed in the current buffer. |
| M | mastodon-tl-mute-user | Query for USER-HANDLE from current status and mute that user. |
| | mastodon-tl-next-full-image | From full image view buffer, load the toot's next image. |
| TAB, M-n | mastodon-tl-next-tab-item | Move to the next interesting item. |
| v | mastodon-tl-poll-vote | If there is a poll at point, prompt user for OPTION to vote on it. |
| | mastodon-tl-prev-full-image | From full image view buffer, load the toot's prev image. |
| S-TAB, | mastodon-tl-previous-tab-item | Move to the previous interesting item. |
| | mastodon-tl-remote-tag-timeline | Call `mastodon-tl-get-remote-local-timeline' but for a TAG timeline. |
| Z | mastodon-tl-report-to-mods | Report the author of the toot at point to your instance moderators. |
| SPC | mastodon-tl-scroll-up-command | Call `scroll-up-command', loading more toots if necessary. |
| | mastodon-tl-shr-browse-image | Browse the image under point. |
| | mastodon-tl-single-toot | View toot at point in separate buffer. |
| | mastodon-tl-some-followed-tags-timeline | Prompt for some tags, and open a timeline for them. |
| C-' | mastodon-tl-tag-group-timeline | Load a timeline of a tag group from `mastodon-tl--tags-groups'. |
| RET, T | mastodon-tl-thread | Open thread buffer for toot at point. |
| | mastodon-tl-toggle-sensitive-image | Toggle dislay of sensitive image at point. |
| | mastodon-tl-toggle-spoiler-in-thread | Toggler content warning for all posts in current thread. |
| c | mastodon-tl-toggle-spoiler-text-in-toot | Toggle the visibility of the spoiler text in the current toot. |
| | mastodon-tl-unblock-domain | Read a blocked domain and unblock it. |
| C-S-b | mastodon-tl-unblock-user | Query for USER-HANDLE from list of blocked users and unblock that user. |
| | mastodon-tl-unfilter-user-languages | Remove any language filters for USER-HANDLE. |
| | mastodon-tl-unfold-post | Unfold the toot at point if it is folded (read-more). |
| | mastodon-tl-unfollow-tag | Prompt for a followed tag, and unfollow it. |
| C-S-w | mastodon-tl-unfollow-user | Query for USER-HANDLE from current status and unfollow that user. |
| | mastodon-tl-unmute-thread | Unmute the thread displayed in the current buffer. |
| S-RET | mastodon-tl-unmute-user | Query for USER-HANDLE from list of muted users and unmute that user. |
| u, g | mastodon-tl-update | Update timeline with new toots. |
| = | mastodon-tl-view-first-full-image | From item byline, fetch load its first full image. |
| | mastodon-tl-view-full-image-at-point | Browse full-sized version of image at point in a new window. |
| | mastodon-tl-view-full-image-or-play-video | View full sized version of image at point, or try to play video. |
| | mastodon-tl-view-item-on-own-instance | Load current toot on your own instance. |
| | mastodon-tl-view-whole-thread | From a thread view, view entire thread. |
| t | mastodon-toot | Update instance with new toot. Content is captured in a new buffer. |
| C-c C-a | mastodon-toot-attach-media | Prompt for an attachment FILE with DESCRIPTION. |
| o | mastodon-toot-browse-toot-url | Browse URL of toot at point. |
| C-c C-k | mastodon-toot-cancel | Kill new-toot buffer/window. Does not POST content. |
| C-c C-v | mastodon-toot-change-visibility | Change the current visibility to the next valid value. |
| C-c ! | mastodon-toot-clear-all-attachments | Remove all attachments from a toot draft. |
| C-c C-o | mastodon-toot-clear-poll | Remove poll from toot compose buffer. |
| | mastodon-toot-copy-toot-text | Copy text of toot at point. |
| C | mastodon-toot-copy-toot-url | Copy URL of toot at point. |
| C-c C-p | mastodon-toot-create-poll | Prompt for new poll options and return as a list. |
| | mastodon-toot-delete-all-drafts | Delete all drafts. |
| D | mastodon-toot-delete-and-redraft-toot | Delete and redraft user's toot at point synchronously. |
| | mastodon-toot-delete-draft-toot | Prompt for a draft toot and delete it. |
| d | mastodon-toot-delete-toot | Delete user's toot at point synchronously. |
| | mastodon-toot-download-custom-emoji | Download `mastodon-instance-url's custom emoji. |
| | mastodon-toot-edit-media-description | Prompt for an attachment, and update its description. |
| e | mastodon-toot-edit-toot-at-point | Edit the user's toot at point. |
| | mastodon-toot-enable-custom-emoji | Add `mastodon-instance-url's custom emoji to `emojify'. |
| C-c C-e | mastodon-toot-insert-emoji | Prompt to insert an emoji. |
| . | mastodon-toot-list-boosters | List the boosters of toot at point. |
| , | mastodon-toot-list-favouriters | List the favouriters of toot at point. |
| | mastodon-toot-mode | Minor mode for composing toots. |
| | mastodon-toot-open-draft-toot | Prompt for a draft and compose a toot with it. |
| i | mastodon-toot-pin-toot-toggle | Pin or unpin user's toot at point. |
| r | mastodon-toot-reply | Reply to toot at `point'. |
| | mastodon-toot-save-draft | Save the current compose toot text as a draft. |
| C-c C-s | mastodon-toot-schedule-toot | Read a date (+ time) in the minibuffer and schedule the current toot. |
| C-c C-c | mastodon-toot-send | POST contents of new-toot buffer to fediverse instance and kill buffer. |
| C-c C-w | mastodon-toot-set-content-warning | Set a content warning for the current toot. |
| | mastodon-toot-set-default-visibility | Set the default visibility for toots on the server. |
| C-c C-l | mastodon-toot-set-toot-language | Prompt for a language and set `mastodon-toot--language'. |
| k | mastodon-toot-toggle-bookmark | Bookmark or unbookmark toot at point. |
| b | mastodon-toot-toggle-boost | Boost/unboost toot at `point'. |
| f | mastodon-toot-toggle-favourite | Favourite/unfavourite toot at `point'. |
| C-c C-n | mastodon-toot-toggle-nsfw | Toggle `mastodon-toot--content-nsfw'. |
| a | mastodon-toot-translate-toot-text | Translate text of toot at point. |
| E | mastodon-toot-view-toot-edits | View editing history of the toot at point in a popup buffer. |
| | mastodon-transient--prefix-inspect | Inspect a transient prefix's arguments and scope. |
| | mastodon-transient-choice-add | Add another poll choice if possible. |
| | mastodon-update-profile-note | Update current user profile note. |
| | mastodon-url-lookup | If a URL resembles a fediverse link, try to load in `mastodon.el'. |
| | mastodon-url-lookup-force | Call `mastodon-url-lookup' without checking if URL is fedi-like. |
| : | mastodon-user-settings | A transient for setting current user settings. |
| | mastodon-user-settings-update | Update current user settings on the server. |
| | mastodon-views-add-account-to-list | Prompt for a list and for an account, add account to list. |
| | mastodon-views-add-account-to-list-at-point | Prompt for account and add to list at point. |
| | mastodon-views-add-filter-kw | Add a keyword to filter at point. |
| | mastodon-views-add-toot-account-at-point-to-list | Prompt for a list, and add the account of the toot at point to it. |
| | mastodon-views-cancel-scheduled-toot | Cancel the scheduled toot at point. |
| | mastodon-views-copy-scheduled-toot-text | Copy the text of the scheduled toot at point. |
| | mastodon-views-create-filter | Create a filter for a word. |
| | mastodon-views-create-list | Create a new list. |
| | mastodon-views-delete-filter | Delete filter at point. |
| | mastodon-views-delete-list | Prompt for a list and delete it. |
| | mastodon-views-delete-list-at-point | Delete list at point. |
| | mastodon-views-edit-list | Prompt for a list and edit the name and replies policy. |
| | mastodon-views-edit-list-at-point | Edit list at point. |
| | mastodon-views-edit-scheduled-as-new | Edit scheduled status as new toot. |
| | mastodon-views-instance-desc-misskey | Show instance description for a misskey/firefish server. |
| | mastodon-views-remove-account-from-list | Prompt for a list, select an account and remove from list. |
| | mastodon-views-remove-account-from-list-at-point | Prompt for account and remove from list at point. |
| | mastodon-views-remove-filter-kw | Remove keyword from filter at point. |
| | mastodon-views-reschedule-toot | Reschedule the scheduled toot at point. |
| | mastodon-views-update-filter | Update filter at point. |
| | mastodon-views-update-filter-kw | Update filter keyword. |
| I | mastodon-views-view-filters | View the user's filters in a new buffer. |
| R | mastodon-views-view-follow-requests | Open a new buffer displaying the user's follow requests. |
| G | mastodon-views-view-follow-suggestions | Display a buffer of suggested accounts to follow. |
| ; | mastodon-views-view-instance-description | View the details of the instance the current post's author is on. |
| | mastodon-views-view-instance-description-brief | View brief details of the instance the current post's author is on. |
| | mastodon-views-view-list-timeline | Prompt for a list and view its timeline. |
| X | mastodon-views-view-lists | Show the user's lists in a new buffer. |
| | mastodon-views-view-own-instance | View details of your own instance. |
| | mastodon-views-view-own-instance-brief | View brief details of your own instance. |
| S | mastodon-views-view-scheduled-toots | Show the user's scheduled toots in a new buffer. |
| | mastodon-views-view-timeline-list-at-point | View timeline of list at point. |
* mastodon custom variables index
#+BEGIN_SRC emacs-lisp :results table :colnames '("Custom variable" "Description") :exports results
(let (rows)
(mapatoms
(lambda (symbol)
(when (and (string-match "^mastodon"
(symbol-name symbol))
(custom-variable-p symbol))
(let* ((doc (car (split-string
(or (get (indirect-variable symbol)
'variable-documentation)
(get symbol 'variable-documentation)
"")
"\n"))))
(push `(,symbol ,doc) rows)
rows))))
(sort rows (lambda (x y) (string-lessp (car x) (car y)))))
#+end_src
#+RESULTS:
| Custom variable | Description |
|----------------------------------------------------+------------------------------------------------------------------------------|
| mastodon-active-user | Username of the active user. |
| mastodon-auth-use-auth-source | Whether to use auth sources for user credentials. |
| mastodon-client--token-file | File path where Mastodon access tokens are stored. |
| mastodon-group-notifications | Whether to use grouped notifications. |
| mastodon-images-in-notifs | Whether to display attached images in notifications. |
| mastodon-instance-url | Base URL for the fediverse instance you want to be active. |
| mastodon-media--avatar-height | Height of the user avatar images (if shown). |
| mastodon-media--enable-image-caching | Whether images should be cached. |
| mastodon-media--hide-sensitive-media | Whether media marked as sensitive should be hidden. |
| mastodon-media--preview-max-height | Max height of any media attachment preview to be shown in timelines. |
| mastodon-mode-hook | Hook run when entering Mastodon mode. |
| mastodon-notifications-grouped-names-count | The number of notification authors to display. |
| mastodon-profile-mode-hook | Hook run after entering or leaving `mastodon-profile-mode'. |
| mastodon-profile-note-in-foll-reqs | If non-nil, show a user's profile note in follow request notifications. |
| mastodon-profile-note-in-foll-reqs-max-length | The max character length for user profile note in follow requests. |
| mastodon-profile-update-mode-hook | Hook run after entering or leaving `mastodon-profile-update-mode'. |
| mastodon-search-mode-hook | Hook run after entering or leaving `mastodon-search-mode'. |
| mastodon-tl--display-caption-not-url-when-no-media | Display an image's caption rather than URL. |
| mastodon-tl--display-media-p | A boolean value stating whether to show media in timelines. |
| mastodon-tl--enable-proportional-fonts | Nonnil to enable using proportional fonts when rendering HTML. |
| mastodon-tl--enable-relative-timestamps | Whether to show relative (to the current time) timestamps. |
| mastodon-tl--expand-content-warnings | Whether to expand content warnings by default. |
| mastodon-tl--fold-toots-at-length | Length, in characters, to fold a toot at. |
| mastodon-tl--hide-replies | Whether to hide replies from the timelines. |
| mastodon-tl--highlight-current-toot | Whether to highlight the toot at point. Uses `cursor-face' special property. |
| mastodon-tl--load-full-sized-images-in-emacs | Whether to load full-sized images inside Emacs. |
| mastodon-tl--no-fill-on-render | Non-nil to disable filling by shr.el while rendering toot body. |
| mastodon-tl--remote-local-domains | A list of domains to view the local timelines of. |
| mastodon-tl--show-avatars | Whether to enable display of user avatars in timelines. |
| mastodon-tl--show-stats | Whether to show toot stats (faves, boosts, replies counts). |
| mastodon-tl--symbols | A set of symbols (and fallback strings) to be used in timeline. |
| mastodon-tl--tag-timeline-tags | A list of up to four tags for use with `mastodon-tl-followed-tags-timeline'. |
| mastodon-tl--tags-groups | A list containing lists of up to four tags each. |
| mastodon-tl--timeline-posts-count | Number of posts to display when loading a timeline. |
| mastodon-tl-position-after-update | Defines where `point' should be located after a timeline update. |
| mastodon-toot--attachment-height | Height of the attached images preview in the toot draft buffer. |
| mastodon-toot--completion-style-for-mentions | The company completion style to use for mentions. |
| mastodon-toot--default-media-directory | The default directory when prompting for a media file to upload. |
| mastodon-toot--default-reply-visibility | Default visibility settings when replying. |
| mastodon-toot--enable-completion | Whether to enable completion of mentions and hashtags. |
| mastodon-toot--enable-custom-instance-emoji | Whether to enable your instance's custom emoji by default. |
| mastodon-toot--proportional-fonts-compose | Nonnil to enable using proportional fonts in the compose buffer. |
| mastodon-toot--use-company-for-completion | Whether to enable company for completion. |
| mastodon-toot-display-orig-in-reply-buffer | Display a copy of the toot replied to in the compose buffer. |
| mastodon-toot-mode-hook | Hook run after entering or leaving `mastodon-toot-mode'. |
| mastodon-toot-orig-in-reply-length | Length to crop toot replied to in the compose buffer to. |
| mastodon-toot-poll-use-transient | Whether to use the transient menu to create a poll. |
| mastodon-toot-timestamp-format | Format to use for timestamps. |
| mastodon-use-emojify | Whether to use emojify.el to display emojis. |
mastodon.el/mastodon.info 0000664 0000000 0000000 00000076432 15017331127 0016016 0 ustar 00root root 0000000 0000000 This is mastodon.info, produced by makeinfo version 6.8 from
mastodon.texi.
INFO-DIR-SECTION Emacs
START-INFO-DIR-ENTRY
* Mastodon: (mastodon). Client for fediverse services using the Mastodon API.
END-INFO-DIR-ENTRY
File: mastodon.info, Node: Top, Next: README, Up: (dir)
A Mastodon client
*****************
* Menu:
* README::
â The Detailed Node Listing â
README
* Installation::
* Usage::
* Dependencies::
* Network compatibility::
* Contributing::
* Supporting âmastodon.elâ: Supporting mastodonel.
* Contributors::
* Screenshots::
Installation
* ELPA::
* MELPA::
* Repo::
* Emoji::
* Discover::
Usage
* Logging in to your instance::
* Timelines::
* Composing toots::
* Other commands and account settings::
* Notifications::
* Customization::
* Commands and variables index::
* Packages related to âmastodon.elâ: Packages related to mastodonel.
* Live-updating timelines mastodon-async-mode::
* Translating toots::
* Bookmarks and âmastodon.elâ: Bookmarks and mastodonel.
Contributing
* Bug reports::
* Fixes and features::
* Coding style::
File: mastodon.info, Node: README, Prev: Top, Up: Top
1 README
********
âmastodon.elâ is an Emacs client for the ActivityPub social networks
that implement the Mastodon API. For info see joinmastodon.org
(https://joinmastodon.org/).
NB: âmastodon.elâ now ships this readme as an .info file, so if you
have it installed you should be able to browse this readme inside emacs.
âC-h iâ for info, then âm masto RETâ should load it for you.
* Menu:
* Installation::
* Usage::
* Dependencies::
* Network compatibility::
* Contributing::
* Supporting âmastodon.elâ: Supporting mastodonel.
* Contributors::
* Screenshots::
File: mastodon.info, Node: Installation, Next: Usage, Up: README
1.1 Installation
================
You can install âmastodon.elâ from ELPA, MELPA, or directly from this
repo. It is also available as a GUIX package.
* Menu:
* ELPA::
* MELPA::
* Repo::
* Emoji::
* Discover::
File: mastodon.info, Node: ELPA, Next: MELPA, Up: Installation
1.1.1 ELPA
----------
You should be able to directly install with:
âM-x package-refresh-contents RETâ
âM-x package-install RET mastodon RETâ
File: mastodon.info, Node: MELPA, Next: Repo, Prev: ELPA, Up: Installation
1.1.2 MELPA
-----------
Add âMELPAâ to your archives:
(require 'package)
(add-to-list 'package-archives
'("melpa" . "http://melpa.org/packages/") t)
Update and install:
âM-x package-refresh-contents RETâ
âM-x package-install RET mastodon RETâ
File: mastodon.info, Node: Repo, Next: Emoji, Prev: MELPA, Up: Installation
1.1.3 Repo
----------
Clone this repository and add the lisp directory to your load path.
Then, require it and go.
(add-to-list 'load-path "/path/to/mastodon.el/lisp")
(require 'mastodon)
Or, with âuse-packageâ:
(use-package mastodon
:ensure t)
The minimum Emacs version is now 28.1. But if you are running an
older version it shouldnât be very hard to get it working.
File: mastodon.info, Node: Emoji, Next: Discover, Prev: Repo, Up: Installation
1.1.4 Emoji
-----------
Since Emacs 28, it has builtin emoji support with âemoji.elâ. If you
prefer to use Emojify (https://github.com/iqbalansari/emacs-emojify),
ârequireâ it and set âmastodon-use-emojifyâ to non-nil to display emoji
in timelines and to use it when composing toots. âEmoji.elâ is the
better option, but for now only âemojifyâ supports downloading and using
custom emoji from your instance. From personal experience, âemojifyâ
also tends to result in less TOFU.
File: mastodon.info, Node: Discover, Prev: Emoji, Up: Installation
1.1.5 Discover
--------------
âmastodon-modeâ can provide a context menu for its keybindings if
Discover (https://github.com/mickeynp/discover.el) is installed. It is
not required.
if you have Discover, add the following to your Emacs init
configuration:
(require 'mastodon-discover)
(with-eval-after-load 'mastodon (mastodon-discover))
Or, with âuse-packageâ:
(use-package mastodon
:ensure t
:config
(mastodon-discover))
File: mastodon.info, Node: Usage, Next: Dependencies, Prev: Installation, Up: README
1.2 Usage
=========
* Menu:
* Logging in to your instance::
* Timelines::
* Composing toots::
* Other commands and account settings::
* Notifications::
* Customization::
* Commands and variables index::
* Packages related to âmastodon.elâ: Packages related to mastodonel.
* Live-updating timelines mastodon-async-mode::
* Translating toots::
* Bookmarks and âmastodon.elâ: Bookmarks and mastodonel.
File: mastodon.info, Node: Logging in to your instance, Next: Timelines, Up: Usage
1.2.1 Logging in to your instance
---------------------------------
You need to set 2 variables in your init file to get started:
1. âmastodon-instance-urlâ
2. âmastodon-active-userâ
(see their doc strings for details). For example If you want to post
toots as "example_user@social.instance.org", then put this in your init
file:
(setq mastodon-instance-url "https://social.instance.org"
mastodon-active-user "example_user")
Then *restart* Emacs and run âM-x mastodonâ. Make sure you are
connected to internet before you do this. If you have multiple mastodon
accounts you can activate one at a time by changing those two variables
and restarting Emacs.
If you were using mastodon.el before 2FA was implemented and the
above steps do not work, call â(mastodon-forget-all-logins)â, restart
Emacs and follow the steps again.
1. encrypted access tokens (from 2.0.0)
By default, user access tokens are now stored in the userâs auth
source file (typically â~/.authinfo.gpgâ, check the value of
âauth-sourcesâ). When you first update to 2.0.0, or if you
encounter issues due to old credentials, call
â(mastodon-forget-all-logins)â to remove the old mastodon.el
plstore, and then authenticate again. If you donât want to use the
auth source file, set âmastodon-auth-use-auth-sourceâ to nil.
Entries will instead be stored encrypted in
âmastodon-client--token-fileâ, a plstore.
If for some reason you reauthenticate, youâll need to either remove
the entry in your auth sources file, or manually update the token
in it after doing so, as mastodon.el is unable to reliably update
(or even remove) entires.
The format for a mastodon.el auth source entry is as follows:
âmachine INSTANCE login USERNAME password AUTHTOKENâ
with the token being what you copy from the browser when
authenticating. If you have âauth-source-save-behaviorâ set to
nil, youâll also need to add such an entry manually.
Finally, if you find youâre asked for your key passphrase too often
while authenticating, consider setting âepa-file-encrypt-toâ (for
auth-source encryption) and âplstore-encrypt-toâ (for plstore
encryption) to your preferred key ID.
File: mastodon.info, Node: Timelines, Next: Composing toots, Prev: Logging in to your instance, Up: Usage
1.2.2 Timelines
---------------
âM-x mastodonâ
Opens a â*mastodon-home*â buffer in the major mode and displays
toots. If your credentials are not yet saved, you will be prompted for
email and password. The app registration process will take place if
your âmastodon-token-fileâ does not contain â:client_idâ and
â:client_secretâ.
1. Keybindings
For a full list of commands and variables, see mastodon-index.org
(mastodon-index.org).
Key Action
-----------------------------------------------------------------------------------------------------------
*Help*
â?â Show discover menu of all bindings, if âdiscoverâ is available
*Timeline actions*
ânâ Go to next item (toot, notification, user)
âpâ Go to previous item (toot, notification, user)
âM-n/â Go to the next interesting thing that has an action
âM-p/â Go to the previous interesting thing that has an action
âFâ Open federated timeline (1 prefix arg: hide-replies, 2 prefix args: media only)
âHâ Open home timeline (1 prefix arg: hide-replies)
âLâ Open local timeline (1 prefix arg: hide-replies, 2 prefix args: media only)
âNâ Open notifications timeline
â@â Open mentions-only notifications timeline
âuâ Update current timeline
âTâ Open thread for toot at point
â#â Prompt for tag and open its timeline
âAâ Open author profile of toot at point
âPâ Open profile of user attached to toot at point
âOâ View own profile
âUâ update your profile bio note
â;â view instance description for toot at point
â:â view followed tags and load a tag timeline
âC-:â view timeline of all followed tags
â,â view favouriters of toot at point
â.â view boosters of toot at point
â/â switch between mastodon buffers
â\â prompt for an instance domain and view its local timeline (if poss)
âZâ report user/toot at point to instances moderators
*Other views*
âsâ search (posts, users, tags) (NB: only posts you have interacted with)
âIâ, âcâ, âdâ view, create, and delete filters
âRâ, âaâ, âjâ view/accept/reject follow requests
âGâ view follow suggestions
âVâ view your favourited toots
âKâ view bookmarked toots
âXâ view/edit/create/delete lists
âSâ view your scheduled toots
âS-:â view profile/account settings transient menu
*Toot actions*
âtâ Compose a new toot
âcâ Toggle content warning content
âbâ Boost toot under âpointâ
âfâ Favourite toot under âpointâ
âkâ toggle bookmark of toot at point
ârâ Reply to toot under âpointâ
âvâ Vote on poll at point
âCâ copy url of toot at point
âC-RETâ play video/gif at point (requires âmpvâ)
âeâ edit your toot at point
âEâ view edits of toot at point
âiâ (un)pin your toot at point
âdâ delete your toot at point, and reload current timeline
âDâ delete and redraft toot at point, preserving reply/CW/visibility
â!â toggle folding of toot at point
(âS-C-â) âWâ, âMâ, âBâ (un)follow, (un)mute, (un)block author of toot at point
*Profile view*
âC-c C-câ cycle between statuses, statuses without boosts, followers, and following
âmastodon-profile--add-account-to-listâ (see lists view)
*Notifications view*
âaâ, âjâ accept/reject follow request
âC-kâ clear notification at point
âC-c C-câ cycle between notification types
see âmastodon-notifications--get-*â functions for filtered views
*Quitting*
âqâ Quit mastodon buffer, leave window open
âQâ Quit mastodon buffer and kill window
âC-M-qâ Quit and kill all mastodon buffers
2. Toot byline legend
Marker Meaning
--------------------------------------------
â(đ)â (or I boosted this toot
â(B)â)
â(â)â (or I favourited this toot
â(F)â)
â(đ)â (or I bookmarked this toot
â(K)â)
File: mastodon.info, Node: Composing toots, Next: Other commands and account settings, Prev: Timelines, Up: Usage
1.2.3 Composing toots
---------------------
âM-x mastodon-tootâ (or âtâ from a mastodon.el buffer) opens a new
buffer/window in âtext-modeâ and âmastodon-tootâ minor mode. Enter the
contents of your toot here. âC-c C-câ sends the toot. âC-c C-kâ
cancels. Both actions kill the buffer and window. Further keybindings
are displayed in the buffer, and in the following subsection.
Replies preserve visibility status/content warnings, and include
boosters by default. If the region is active when you start a reply, it
will be yanked into the compose buffer prefixed with â>â to form a rough
reply quote.
Serverâs max toot length, with running char count, and attachment
previews, are shown.
You can download and use your instanceâs custom emoji
(âmastodon-toot--download-custom-emojiâ,
âmastodon-toot--enable-custom-emojiâ).
If you want to view some of the toot being replied to in the compose
buffer, set âmastodon-toot-display-orig-in-reply-bufferâ to non-nil.
The compose buffer uses âtext-modeâ so any configuration you have for
that mode will be enabled. If any of your existing config conflicts
with âmastodon-tootâ, you can disable it in the
âmastodon-toot-mode-hookâ. For example, the default value of that hook
is as follows:
(add-hook 'mastodon-toot-mode-hook
(lambda ()
(auto-fill-mode -1)))
1. Keybindings
Key Action
--------------------------------------------
âC-c C-câ Send toot
âC-c C-kâ Cancel toot
âC-c C-wâ Add content warning
âC-c C-vâ Change toot visibility
âC-c C-nâ Add sensitive media/nsfw flag
âC-c C-aâ Upload attachment(s)
âC-c !â Remove all attachments
âC-c C-eâ Insert emoji
âC-c C-pâ Create a poll
âC-c C-oâ Cancel poll
âC-c C-lâ Set toot language
âC-c C-sâ Schedule toot
2. Autocompletion of mentions, tags and emoji
Autocompletion of mentions, tags, and emojis is provided by
âcompletion-at-point-functionsâ (capf) backends.
âmastodon-toot--enable-completionâ is enabled by default.
To trigger completion, type a prefix followed by a few letters, â@â
for mentions, â#â for tags, and â:â for emoji (for now this only
works when using âemojify.elâ).
If you want to enable âcompany-modeâ in the toot compose buffer,
set âmastodon-toot--use-company-for-completionâ to âtâ.
(âmastodon.elâ used to run its own native company backends, but
these have been removed in favour of capfs.)
If you donât run âcompanyâ and want immediate, keyless completion,
youâll need to have another completion engine running that handles
capfs. A common combination is âconsultâ and âcorfuâ.
3. Draft toots
⢠Compose buffer text is saved as you type, kept in
âmastodon-toot-current-toot-textâ.
⢠âmastodon-toot--save-draftâ: save the current toot as a draft.
⢠âmastodon-toot--open-draft-tootâ: Open a compose buffer and
insert one of your draft toots.
⢠âmastodon-toot--delete-draft-tootâ: Delete a draft toot.
⢠âmastodon-toot--delete-all-draftsâ: Delete all your drafts.
File: mastodon.info, Node: Other commands and account settings, Next: Notifications, Prev: Composing toots, Up: Usage
1.2.4 Other commands and account settings:
------------------------------------------
In addition to âmastodonâ, the following three functions are autoloaded
and should work without first loading a âmastodon.elâ buffer:
⢠âmastodon-tootâ: Compose new toot
⢠âmastodon-notifications-getâ: View all notifications
⢠âmastodon-url-lookupâ: Attempt to load a URL in âmastodon.elâ. URL
may be at point or provided in the minibuffer.
⢠âmastodon-tl--view-instance-descriptionâ: View information about
the instance that the author of the toot at point is on.
⢠âmastodon-tl--view-own-instanceâ: View information about your own
instance.
⢠âmastodon-search--trending-tagsâ: View a list of trending hashtags
on your instance.
⢠âmastodon-search--trending-statusesâ: View a list of trending
statuses on your instance.
⢠âmastodon-search--trending-linksâ: View a list of trending links on
your instance (+ click through to a timeline of posts featuring a
given link)
⢠âmastodon-tl--add-toot-account-at-point-to-listâ: Add the account
of the toot at point to a list.
⢠âmastodon-tl--dm-userâ: Send a direct message to one of the users
at point.
⢠âmastodon-profile--add-private-note-to-accountâ: Add a private note
to another userâs account.
⢠âmastodon-profile--view-account-private-noteâ: View a private note
on a userâs account.
⢠âmastodon-profile--show-familiar-followersâ: Show a list of
âfamiliar followersâ for a given account. Familiar followers are
accounts that you follow, and that follow the account.
⢠âmastodon-tl--follow-tagâ: Follow a tag (works like following a
user)
⢠âmastodon-tl--unfollow-tagâ: Unfollow a tag
⢠âmastodon-tl--list-followed-tagsâ: View a list of tags youâre
following.
⢠âmastodon-tl--followed-tags-timelineâ: View a timeline of all your
followed tags.
⢠âmastodon-tl--some-followed-tags-timleineâ: View a timeline of
multiple tags, from your followed tags or any other.
⢠âmastodon-switch-to-bufferâ: switch between mastodon buffers.
⢠âmastodon-tl--get-remote-local-timelineâ: View a local timeline of
a remote instance.
⢠âmastodon-tl--remote-tag-timelineâ: View a tag timeline on a remote
instance.
⢠âmastodon-user-settingsâ: Launch a transient menu to update various
account settings.
File: mastodon.info, Node: Notifications, Next: Customization, Prev: Other commands and account settings, Up: Usage
1.2.5 Notifications
-------------------
Mastodon from 4.3 supports grouped notifications. These are implemented
by âmastodon.elâ but disabled by default out of consideration to users
on instances that donât support them. If you are on an instance that
implements grouped notifications, set âmastodon-group-notificationsâ to
âtâ to enable them.
File: mastodon.info, Node: Customization, Next: Commands and variables index, Prev: Notifications, Up: Usage
1.2.6 Customization
-------------------
See âM-x customize-group RET mastodonâ to view all customize options.
⢠Timeline options:
⢠Use proportional fonts
⢠Default number of posts displayed
⢠Timestamp format
⢠Relative timestamps
⢠Display user avatars
⢠Avatar image height
⢠Enable image caching
⢠Hide replies in timelines
⢠Show toot stats in byline
⢠Compose options:
⢠Completion style for mentions and tags
⢠Enable custom emoji
⢠Display toot being replied to
⢠Set default reply visibility
⢠Nofitication options:
⢠Display userâs profile note in follow requests
⢠Group notifications
File: mastodon.info, Node: Commands and variables index, Next: Packages related to mastodonel, Prev: Customization, Up: Usage
1.2.7 Commands and variables index
----------------------------------
An index of all user-facing commands and custom variables is available
here: mastodon-index.org (mastodon-index.org).
You can also hit â?â in any âmastodon.elâ buffer to see the available
bindings, or run âM-Xâ (upper-case âXâ) to view all commands in the
buffer with completion, and call one.
File: mastodon.info, Node: Packages related to mastodonel, Next: Live-updating timelines mastodon-async-mode, Prev: Commands and variables index, Up: Usage
1.2.8 Packages related to âmastodon.elâ
---------------------------------------
1. Alternative timeline layout
The incomparable Nicholas Rougier has written an alternative
timeline layout for âmastodon.elâ.
The repo is at mastodon-alt
(https://github.com/rougier/mastodon-alt).
2. Org links, archive search
toot-suite (https://codeberg.org/chrmoe/toot-suite) implements an
org link type for fediverse posts, and also provides a way to
browse an offline archive of your account.
3. Mastodon hydra
A user made a hydra for handling basic âmastodon.elâ commands.
Itâs available at
.
4. Narrow to timeline item
A simple code snippet to enable narrowing to current item in
timelines:
5. Sachacâs config goodies
The incomparable sachac has a bunch of âmastodon.elâ extensions and
goodies in their literate config, available here:
.
File: mastodon.info, Node: Live-updating timelines mastodon-async-mode, Next: Translating toots, Prev: Packages related to mastodonel, Up: Usage
1.2.9 Live-updating timelines: âmastodon-async-modeâ
----------------------------------------------------
(code taken from mastodon-future
(https://github.com/alexjgriffith/mastodon-future.el).)
Works for federated, local, and home timelines and for notifications.
Itâs a little touchy, one thing to avoid is trying to load a timeline
more than once at a time. It can go off the rails a bit, but itâs still
pretty cool. The current maintainer of âmastodon.elâ is unable to debug
or improve this feature.
To enable, it, add â(require 'mastodon-async)â to your âinit.elâ.
Then you can view a timeline with one of the commands that begin with
âmastodon-async--stream-â.
File: mastodon.info, Node: Translating toots, Next: Bookmarks and mastodonel, Prev: Live-updating timelines mastodon-async-mode, Up: Usage
1.2.10 Translating toots
------------------------
You can translate toots with âmastodon-toot--translate-toot-textâ (âaâ
in a timeline). At the moment this requires lingva.el
(https://codeberg.org/martianh/lingva.el), a little interface I wrote to
lingva.ml (https://lingva.ml), to be installed to work.
You could easily modify the simple function to use your Emacs
translator of choice (âlibretrans.elâ , âgoogle-translateâ, âbabelâ,
âgo-translateâ, etc.), you just need to fetch the tootâs content with
â(mastodon-tl--content toot)â and pass it to your translator function as
its text argument. Hereâs what âmastodon-toot--translate-toot-textâ
looks like:
(defun mastodon-toot-translate-toot-text ()
"Translate text of toot at point.
Uses `lingva.el'."
(interactive)
(let* ((toot (mastodon-tl--property 'item-json)))
(if toot
(lingva-translate nil (mastodon-tl--content toot))
(message "No toot to translate?"))))
File: mastodon.info, Node: Bookmarks and mastodonel, Prev: Translating toots, Up: Usage
1.2.11 Bookmarks and âmastodon.elâ
----------------------------------
âmastodon.elâ implements a basic bookmark record and handler.
Currently, this means that you can bookmark a post item and later load
it in thread view. This could be expanded to any item with an id, but
probably not to things like timeline views. If you want to be able to
bookmark something, open an issue and ask, as itâs trivial to expand the
bookmarking code.
File: mastodon.info, Node: Dependencies, Next: Network compatibility, Prev: Usage, Up: README
1.3 Dependencies
================
Hard dependencies (should all install with âmastodon.elâ):
⢠ârequestâ (for uploading attachments, emacs-request
(https://github.com/tkf/emacs-request))
⢠âpersistâ (for storing some settings across sessions, persist
(https://elpa.gnu.org/packages/persist.html))
⢠âtp.elâ (for transient menus, tp.el
(https://codeberg.org/martianh/tp.el))
Optional dependencies (install yourself, âmastodon.elâ can use them):
⢠âemojifyâ to use custom emoji (else we use builtin âemoji.elâ)
⢠âmpvâ and âmpv.elâ for viewing videos and gifs
⢠âlingva.elâ for translating toots
File: mastodon.info, Node: Network compatibility, Next: Contributing, Prev: Dependencies, Up: README
1.4 Network compatibility
=========================
âmastodon.elâ should work with ActivityPub servers that implement the
Mastodon API.
Apart from Mastodon itself, it is currently known to work with:
⢠Pleroma (pleroma.social (https://pleroma.social/))
⢠Akkoma (akkoma.social (https://akkoma.social/))
⢠Gotosocial (gotosocial.org (https://gotosocial.org/))
⢠Sharkey (joinsharkey.org (https://joinsharkey.org))
It does not support the non-Mastodon API servers Misskey (misskey.io
(https://misskey.io/)), Firefish (joinfirefish.org
(https://joinfirefish.org/), formerly Calkey) and Friendica, but it
should fully support displaying and interacting with posts and users on
those platforms.
If you attempt to use âmastodon.elâ with a server and run into
problems, feel free to open an issue.
File: mastodon.info, Node: Contributing, Next: Supporting mastodonel, Prev: Network compatibility, Up: README
1.5 Contributing
================
PRs, issues, feature requests, and general feedback are very welcome!
If you prefer emailing patches to the process described below, feel
free to send them on. Ideally theyâd be patches that can be applied
with âgit amâ, if you want to actually contribute a commit.
* Menu:
* Bug reports::
* Fixes and features::
* Coding style::
File: mastodon.info, Node: Bug reports, Next: Fixes and features, Up: Contributing
1.5.1 Bug reports
-----------------
1. âmastodon.elâ has bugs, as well as lots of room for improvement.
2. I receive very little feedback, so if I donât run into the bug it
often doesnât get fixed.
3. If you run into something that seems broken, first try running
âmastodon.elâ in emacs with no init file (i.e. âemacs -qâ
(instructions and code for doing this are here
(https://codeberg.org/martianh/mastodon.el/issues/300)) to see if
it also happens independently of your own config (it probably
does).
4. Else enable debug on error (âtoggle-debug-on-errorâ), make the bug
happen again, and copy the backtrace that appears.
5. Open an issue here and explain what is going on. Provide your
emacs version and what kind of server your account is on.
File: mastodon.info, Node: Fixes and features, Next: Coding style, Prev: Bug reports, Up: Contributing
1.5.2 Fixes and features
------------------------
1. Create an issue (https://codeberg.org/martianh/mastodon.el/issues)
detailing what youâd like to do.
2. Fork the repository and create a branch off of âdevelopâ.
3. Run the tests and ensure that your code doesnât break any of them.
4. Create a pull request (to develop) referencing the issue created in
step 1.
File: mastodon.info, Node: Coding style, Prev: Fixes and features, Up: Contributing
1.5.3 Coding style
------------------
⢠This library uses an unconvential double dash (â--â) between file
namespaces and function names, which contradicts normal Elisp
style. This needs to be respected until the whole library is
changed.
⢠Use âaggressive-indent-modeâ or similar to keep your code indented.
⢠Single spaces end sentences in docstrings.
⢠Thereâs no need for a blank line after the first docstring line
(one is added automatically when documentation is displayed).
File: mastodon.info, Node: Supporting mastodonel, Next: Contributors, Prev: Contributing, Up: README
1.6 Supporting âmastodon.elâ
============================
If youâd like to support continued development of âmastodon.elâ, I
accept donations via paypal: paypal.me/martianh
(https://paypal.me/martianh). If you would prefer a different payment
method, please write to me at and I can
provide IBAN or other bank account details.
I donât have a tech workerâs income, so even a small tip would help
out.
File: mastodon.info, Node: Contributors, Next: Screenshots, Prev: Supporting mastodonel, Up: README
1.7 Contributors
================
âmastodon.elâ is the work of a number of people.
Some significant contributors are:
⢠[original author]
â˘
â˘
â˘
â˘
File: mastodon.info, Node: Screenshots, Prev: Contributors, Up: README
1.8 Screenshots
===============
Hereâs a (federated) timeline:
[image src="screenshot-tl.png" ]
Hereâs a notifcations view plus a compose buffer:
[image src="screenshot-notifs+compose.png" ]
Hereâs a user settings transient (active values green, current server
values commented and, if a boolean, underlined):
[image src="screenshot-transient-1.jpg" ]
Hereâs a user profile fields transient (changed fields green, current
server values commented):
[image src="screenshot-transient-2.jpg" ]
Tag Table:
Node: Top219
Node: README1083
Node: Installation1732
Node: ELPA2021
Node: MELPA2249
Node: Repo2629
Node: Emoji3122
Node: Discover3716
Node: Usage4268
Node: Logging in to your instance4770
Ref: encrypted access tokens (from 200)5742
Node: Timelines7200
Ref: Keybindings7675
Ref: Toot byline legend12657
Node: Composing toots12966
Ref: Keybindings (1)14518
Ref: Autocompletion of mentions tags and emoji15073
Ref: Draft toots15998
Node: Other commands and account settings16469
Node: Notifications19144
Node: Customization19629
Node: Commands and variables index20517
Node: Packages related to mastodonel21036
Ref: Alternative timeline layout21289
Ref: Org links archive search21516
Ref: Mastodon hydra21735
Ref: Narrow to timeline item21919
Ref: Sachac's config goodies22126
Node: Live-updating timelines mastodon-async-mode22345
Node: Translating toots23200
Node: Bookmarks and mastodonel24383
Node: Dependencies24925
Node: Network compatibility25711
Node: Contributing26652
Node: Bug reports27148
Node: Fixes and features28059
Node: Coding style28560
Node: Supporting mastodonel29184
Node: Contributors29741
Node: Screenshots30176
End Tag Table
Local Variables:
coding: utf-8
End:
mastodon.el/mastodon.texi 0000664 0000000 0000000 00000066645 15017331127 0016041 0 ustar 00root root 0000000 0000000 \input texinfo @c -*- texinfo -*-
@c %**start of header
@setfilename mastodon.info
@settitle A Mastodon client
@documentencoding UTF-8
@documentlanguage en
@c %**end of header
@dircategory Emacs
@direntry
* Mastodon: (mastodon). Client for fediverse services using the Mastodon API.
@end direntry
@finalout
@titlepage
@title A Mastodon client
@end titlepage
@contents
@ifnottex
@node Top
@top A Mastodon client
@end ifnottex
@menu
* README::
@detailmenu
--- The Detailed Node Listing ---
README
* Installation::
* Usage::
* Dependencies::
* Network compatibility::
* Contributing::
* Supporting @samp{mastodon.el}: Supporting @samp{mastodonel}.
* Contributors::
* Screenshots::
Installation
* ELPA::
* MELPA::
* Repo::
* Emoji::
* Discover::
Usage
* Logging in to your instance::
* Timelines::
* Composing toots::
* Other commands and account settings::
* Notifications::
* Customization::
* Commands and variables index::
* Packages related to @samp{mastodon.el}: Packages related to @samp{mastodonel}.
* Live-updating timelines @samp{mastodon-async-mode}::
* Translating toots::
* Bookmarks and @samp{mastodon.el}: Bookmarks and @samp{mastodonel}.
Contributing
* Bug reports::
* Fixes and features::
* Coding style::
@end detailmenu
@end menu
@node README
@chapter README
@samp{mastodon.el} is an Emacs client for the ActivityPub social networks that
implement the Mastodon API@. For info see @uref{https://joinmastodon.org/, joinmastodon.org}.
NB: @samp{mastodon.el} now ships this readme as an .info file, so if you have it
installed you should be able to browse this readme inside emacs. @samp{C-h i} for
info, then @samp{m masto RET} should load it for you.
@menu
* Installation::
* Usage::
* Dependencies::
* Network compatibility::
* Contributing::
* Supporting @samp{mastodon.el}: Supporting @samp{mastodonel}.
* Contributors::
* Screenshots::
@end menu
@node Installation
@section Installation
You can install @samp{mastodon.el} from ELPA, MELPA, or directly from this repo.
It is also available as a GUIX package.
@menu
* ELPA::
* MELPA::
* Repo::
* Emoji::
* Discover::
@end menu
@node ELPA
@subsection ELPA
You should be able to directly install with:
@samp{M-x package-refresh-contents RET}
@samp{M-x package-install RET mastodon RET}
@node MELPA
@subsection MELPA
Add @samp{MELPA} to your archives:
@lisp
(require 'package)
(add-to-list 'package-archives
'("melpa" . "http://melpa.org/packages/") t)
@end lisp
Update and install:
@samp{M-x package-refresh-contents RET}
@samp{M-x package-install RET mastodon RET}
@node Repo
@subsection Repo
Clone this repository and add the lisp directory to your load path. Then,
require it and go.
@lisp
(add-to-list 'load-path "/path/to/mastodon.el/lisp")
(require 'mastodon)
@end lisp
Or, with @samp{use-package}:
@lisp
(use-package mastodon
:ensure t)
@end lisp
The minimum Emacs version is now 28.1. But if you are running an older
version it shouldn't be very hard to get it working.
@node Emoji
@subsection Emoji
Since Emacs 28, it has builtin emoji support with @samp{emoji.el}. If you prefer
to use @uref{https://github.com/iqbalansari/emacs-emojify, Emojify}, @samp{require} it and set @samp{mastodon-use-emojify} to non-nil to
display emoji in timelines and to use it when composing toots. @samp{Emoji.el} is
the better option, but for now only @samp{emojify} supports downloading and using
custom emoji from your instance. From personal experience, @samp{emojify} also
tends to result in less TOFU@.
@node Discover
@subsection Discover
@samp{mastodon-mode} can provide a context menu for its keybindings if @uref{https://github.com/mickeynp/discover.el, Discover}
is installed. It is not required.
if you have Discover, add the following to your Emacs init configuration:
@lisp
(require 'mastodon-discover)
(with-eval-after-load 'mastodon (mastodon-discover))
@end lisp
Or, with @samp{use-package}:
@lisp
(use-package mastodon
:ensure t
:config
(mastodon-discover))
@end lisp
@node Usage
@section Usage
@menu
* Logging in to your instance::
* Timelines::
* Composing toots::
* Other commands and account settings::
* Notifications::
* Customization::
* Commands and variables index::
* Packages related to @samp{mastodon.el}: Packages related to @samp{mastodonel}.
* Live-updating timelines @samp{mastodon-async-mode}::
* Translating toots::
* Bookmarks and @samp{mastodon.el}: Bookmarks and @samp{mastodonel}.
@end menu
@node Logging in to your instance
@subsection Logging in to your instance
You need to set 2 variables in your init file to get started:
@enumerate
@item
@samp{mastodon-instance-url}
@item
@samp{mastodon-active-user}
@end enumerate
(see their doc strings for details). For example If you want to post toots
as "example@math{_user}@@social.instance.org", then put this in your init file:
@lisp
(setq mastodon-instance-url "https://social.instance.org"
mastodon-active-user "example_user")
@end lisp
Then @strong{restart} Emacs and run @samp{M-x mastodon}. Make sure you are connected to
internet before you do this. If you have multiple mastodon accounts you
can activate one at a time by changing those two variables and restarting
Emacs.
If you were using mastodon.el before 2FA was implemented and the above
steps do not work, call @samp{(mastodon-forget-all-logins)}, restart Emacs and
follow the steps again.
@enumerate
@item
@anchor{encrypted access tokens (from 200)}encrypted access tokens (from 2.0.0)
By default, user access tokens are now stored in the user's auth source
file (typically @samp{~/.authinfo.gpg}, check the value of @samp{auth-sources}). When
you first update to 2.0.0, or if you encounter issues due to old
credentials, call @samp{(mastodon-forget-all-logins)} to remove the old
mastodon.el plstore, and then authenticate again. If you don't want to use
the auth source file, set @samp{mastodon-auth-use-auth-source} to nil. Entries
will instead be stored encrypted in @samp{mastodon-client--token-file}, a plstore.
If for some reason you reauthenticate, you'll need to either remove the
entry in your auth sources file, or manually update the token in it after
doing so, as mastodon.el is unable to reliably update (or even remove)
entires.
The format for a mastodon.el auth source entry is as follows:
@samp{machine INSTANCE login USERNAME password AUTHTOKEN}
with the token being what you copy from the browser when authenticating.
If you have @samp{auth-source-save-behavior} set to nil, you'll also need to add
such an entry manually.
Finally, if you find you're asked for your key passphrase too often while
authenticating, consider setting @samp{epa-file-encrypt-to} (for auth-source
encryption) and @samp{plstore-encrypt-to} (for plstore encryption) to your
preferred key ID@.
@end enumerate
@node Timelines
@subsection Timelines
@samp{M-x mastodon}
Opens a @samp{*mastodon-home*} buffer in the major mode and displays toots. If
your credentials are not yet saved, you will be prompted for email and
password. The app registration process will take place if your
@samp{mastodon-token-file} does not contain @samp{:client_id} and @samp{:client_secret}.
@enumerate
@item
@anchor{Keybindings}Keybindings
For a full list of commands and variables, see @uref{mastodon-index.org, mastodon-index.org}.
@multitable {aaaaaaaaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
@headitem Key
@tab Action
@item
@tab @strong{Help}
@item @samp{?}
@tab Show discover menu of all bindings, if @samp{discover} is available
@item
@tab @strong{Timeline actions}
@item @samp{n}
@tab Go to next item (toot, notification, user)
@item @samp{p}
@tab Go to previous item (toot, notification, user)
@item @samp{M-n/}
@tab Go to the next interesting thing that has an action
@item @samp{M-p/}
@tab Go to the previous interesting thing that has an action
@item @samp{F}
@tab Open federated timeline (1 prefix arg: hide-replies, 2 prefix args: media only)
@item @samp{H}
@tab Open home timeline (1 prefix arg: hide-replies)
@item @samp{L}
@tab Open local timeline (1 prefix arg: hide-replies, 2 prefix args: media only)
@item @samp{N}
@tab Open notifications timeline
@item @samp{@@}
@tab Open mentions-only notifications timeline
@item @samp{u}
@tab Update current timeline
@item @samp{T}
@tab Open thread for toot at point
@item @samp{#}
@tab Prompt for tag and open its timeline
@item @samp{A}
@tab Open author profile of toot at point
@item @samp{P}
@tab Open profile of user attached to toot at point
@item @samp{O}
@tab View own profile
@item @samp{U}
@tab update your profile bio note
@item @samp{;}
@tab view instance description for toot at point
@item @samp{:}
@tab view followed tags and load a tag timeline
@item @samp{C-:}
@tab view timeline of all followed tags
@item @samp{,}
@tab view favouriters of toot at point
@item @samp{.}
@tab view boosters of toot at point
@item @samp{/}
@tab switch between mastodon buffers
@item @samp{\}
@tab prompt for an instance domain and view its local timeline (if poss)
@item @samp{Z}
@tab report user/toot at point to instances moderators
@item
@tab @strong{Other views}
@item @samp{s}
@tab search (posts, users, tags) (NB: only posts you have interacted with)
@item @samp{I}, @samp{c}, @samp{d}
@tab view, create, and delete filters
@item @samp{R}, @samp{a}, @samp{j}
@tab view/accept/reject follow requests
@item @samp{G}
@tab view follow suggestions
@item @samp{V}
@tab view your favourited toots
@item @samp{K}
@tab view bookmarked toots
@item @samp{X}
@tab view/edit/create/delete lists
@item @samp{S}
@tab view your scheduled toots
@item @samp{S-:}
@tab view profile/account settings transient menu
@item
@tab @strong{Toot actions}
@item @samp{t}
@tab Compose a new toot
@item @samp{c}
@tab Toggle content warning content
@item @samp{b}
@tab Boost toot under @samp{point}
@item @samp{f}
@tab Favourite toot under @samp{point}
@item @samp{k}
@tab toggle bookmark of toot at point
@item @samp{r}
@tab Reply to toot under @samp{point}
@item @samp{v}
@tab Vote on poll at point
@item @samp{C}
@tab copy url of toot at point
@item @samp{C-RET}
@tab play video/gif at point (requires @samp{mpv})
@item @samp{e}
@tab edit your toot at point
@item @samp{E}
@tab view edits of toot at point
@item @samp{i}
@tab (un)pin your toot at point
@item @samp{d}
@tab delete your toot at point, and reload current timeline
@item @samp{D}
@tab delete and redraft toot at point, preserving reply/CW/visibility
@item @samp{!}
@tab toggle folding of toot at point
@item (@samp{S-C-}) @samp{W}, @samp{M}, @samp{B}
@tab (un)follow, (un)mute, (un)block author of toot at point
@item
@tab @strong{Profile view}
@item @samp{C-c C-c}
@tab cycle between statuses, statuses without boosts, followers, and following
@item
@tab @samp{mastodon-profile--add-account-to-list} (see lists view)
@item
@tab @strong{Notifications view}
@item @samp{a}, @samp{j}
@tab accept/reject follow request
@item @samp{C-k}
@tab clear notification at point
@item @samp{C-c C-c}
@tab cycle between notification types
@item
@tab see @samp{mastodon-notifications--get-*} functions for filtered views
@item
@tab @strong{Quitting}
@item @samp{q}
@tab Quit mastodon buffer, leave window open
@item @samp{Q}
@tab Quit mastodon buffer and kill window
@item @samp{C-M-q}
@tab Quit and kill all mastodon buffers
@end multitable
@item
@anchor{Toot byline legend}Toot byline legend
@multitable {aaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaa}
@headitem Marker
@tab Meaning
@item @samp{(đ)} (or @samp{(B)})
@tab I boosted this toot
@item @samp{(â)} (or @samp{(F)})
@tab I favourited this toot
@item @samp{(đ)} (or @samp{(K)})
@tab I bookmarked this toot
@end multitable
@end enumerate
@node Composing toots
@subsection Composing toots
@samp{M-x mastodon-toot} (or @samp{t} from a mastodon.el buffer) opens a new
buffer/window in @samp{text-mode} and @samp{mastodon-toot} minor mode. Enter the
contents of your toot here. @samp{C-c C-c} sends the toot. @samp{C-c C-k} cancels. Both
actions kill the buffer and window. Further keybindings are displayed in
the buffer, and in the following subsection.
Replies preserve visibility status/content warnings, and include boosters
by default. If the region is active when you start a reply, it will be
yanked into the compose buffer prefixed with @samp{>} to form a rough reply
quote.
Server's max toot length, with running char count, and attachment
previews, are shown.
You can download and use your instance's custom emoji
(@samp{mastodon-toot--download-custom-emoji},
@samp{mastodon-toot--enable-custom-emoji}).
If you want to view some of the toot being replied to in the compose
buffer, set @samp{mastodon-toot-display-orig-in-reply-buffer} to non-nil.
The compose buffer uses @samp{text-mode} so any configuration you have for that
mode will be enabled. If any of your existing config conflicts with
@samp{mastodon-toot}, you can disable it in the @samp{mastodon-toot-mode-hook}. For
example, the default value of that hook is as follows:
@lisp
(add-hook 'mastodon-toot-mode-hook
(lambda ()
(auto-fill-mode -1)))
@end lisp
@enumerate
@item
@anchor{Keybindings (1)}Keybindings
@multitable {aaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
@headitem Key
@tab Action
@item @samp{C-c C-c}
@tab Send toot
@item @samp{C-c C-k}
@tab Cancel toot
@item @samp{C-c C-w}
@tab Add content warning
@item @samp{C-c C-v}
@tab Change toot visibility
@item @samp{C-c C-n}
@tab Add sensitive media/nsfw flag
@item @samp{C-c C-a}
@tab Upload attachment(s)
@item @samp{C-c !}
@tab Remove all attachments
@item @samp{C-c C-e}
@tab Insert emoji
@item @samp{C-c C-p}
@tab Create a poll
@item @samp{C-c C-o}
@tab Cancel poll
@item @samp{C-c C-l}
@tab Set toot language
@item @samp{C-c C-s}
@tab Schedule toot
@end multitable
@item
@anchor{Autocompletion of mentions tags and emoji}Autocompletion of mentions, tags and emoji
Autocompletion of mentions, tags, and emojis is provided by
@samp{completion-at-point-functions} (capf) backends.
@samp{mastodon-toot--enable-completion} is enabled by default.
To trigger completion, type a prefix followed by a few letters, @samp{@@} for
mentions, @samp{#} for tags, and @samp{:} for emoji (for now this only works when using
@samp{emojify.el}).
If you want to enable @samp{company-mode} in the toot compose buffer, set
@samp{mastodon-toot--use-company-for-completion} to @samp{t}. (@samp{mastodon.el} used to run
its own native company backends, but these have been removed in favour of
capfs.)
If you donât run @samp{company} and want immediate, keyless completion, youâll
need to have another completion engine running that handles capfs. A
common combination is @samp{consult} and @samp{corfu}.
@item
@anchor{Draft toots}Draft toots
@itemize
@item
Compose buffer text is saved as you type, kept in
@samp{mastodon-toot-current-toot-text}.
@item
@samp{mastodon-toot--save-draft}: save the current toot as a draft.
@item
@samp{mastodon-toot--open-draft-toot}: Open a compose buffer and insert one of
your draft toots.
@item
@samp{mastodon-toot--delete-draft-toot}: Delete a draft toot.
@item
@samp{mastodon-toot--delete-all-drafts}: Delete all your drafts.
@end itemize
@end enumerate
@node Other commands and account settings
@subsection Other commands and account settings:
In addition to @samp{mastodon}, the following three functions are autoloaded and
should work without first loading a @samp{mastodon.el} buffer:
@itemize
@item
@samp{mastodon-toot}: Compose new toot
@item
@samp{mastodon-notifications-get}: View all notifications
@item
@samp{mastodon-url-lookup}: Attempt to load a URL in @samp{mastodon.el}. URL may be at
point or provided in the minibuffer.
@end itemize
@itemize
@item
@samp{mastodon-tl--view-instance-description}: View information about the
instance that the author of the toot at point is on.
@item
@samp{mastodon-tl--view-own-instance}: View information about your own
instance.
@item
@samp{mastodon-search--trending-tags}: View a list of trending hashtags on your
instance.
@item
@samp{mastodon-search--trending-statuses}: View a list of trending statuses on
your instance.
@item
@samp{mastodon-search--trending-links}: View a list of trending links on your
instance (+ click through to a timeline of posts featuring a given link)
@item
@samp{mastodon-tl--add-toot-account-at-point-to-list}: Add the account of the
toot at point to a list.
@end itemize
@itemize
@item
@samp{mastodon-tl--dm-user}: Send a direct message to one of the users at
point.
@end itemize
@itemize
@item
@samp{mastodon-profile--add-private-note-to-account}: Add a private note to
another userâs account.
@item
@samp{mastodon-profile--view-account-private-note}: View a private note on a
userâs account.
@end itemize
@itemize
@item
@samp{mastodon-profile--show-familiar-followers}: Show a list of âfamiliar
followersâ for a given account. Familiar followers are accounts that you
follow, and that follow the account.
@end itemize
@itemize
@item
@samp{mastodon-tl--follow-tag}: Follow a tag (works like following a user)
@item
@samp{mastodon-tl--unfollow-tag}: Unfollow a tag
@item
@samp{mastodon-tl--list-followed-tags}: View a list of tags you're following.
@item
@samp{mastodon-tl--followed-tags-timeline}: View a timeline of all your
followed tags.
@item
@samp{mastodon-tl--some-followed-tags-timleine}: View a timeline of multiple
tags, from your followed tags or any other.
@end itemize
@itemize
@item
@samp{mastodon-switch-to-buffer}: switch between mastodon buffers.
@end itemize
@itemize
@item
@samp{mastodon-tl--get-remote-local-timeline}: View a local timeline of a
remote instance.
@item
@samp{mastodon-tl--remote-tag-timeline}: View a tag timeline on a remote
instance.
@end itemize
@itemize
@item
@samp{mastodon-user-settings}: Launch a transient menu to update various
account settings.
@end itemize
@node Notifications
@subsection Notifications
Mastodon from 4.3 supports grouped notifications. These are implemented by
@samp{mastodon.el} but disabled by default out of consideration to users on
instances that don't support them. If you are on an instance that
implements grouped notifications, set @samp{mastodon-group-notifications} to @samp{t} to
enable them.
@node Customization
@subsection Customization
See @samp{M-x customize-group RET mastodon} to view all customize options.
@itemize
@item
Timeline options:
@itemize
@item
Use proportional fonts
@item
Default number of posts displayed
@item
Timestamp format
@item
Relative timestamps
@item
Display user avatars
@item
Avatar image height
@item
Enable image caching
@item
Hide replies in timelines
@item
Show toot stats in byline
@end itemize
@item
Compose options:
@itemize
@item
Completion style for mentions and tags
@item
Enable custom emoji
@item
Display toot being replied to
@item
Set default reply visibility
@end itemize
@item
Nofitication options:
@itemize
@item
Display user's profile note in follow requests
@item
Group notifications
@end itemize
@end itemize
@node Commands and variables index
@subsection Commands and variables index
An index of all user-facing commands and custom variables is available
here: @uref{mastodon-index.org, mastodon-index.org}.
You can also hit @samp{?} in any @samp{mastodon.el} buffer to see the available
bindings, or run @samp{M-X} (upper-case @samp{X}) to view all commands in the buffer
with completion, and call one.
@node Packages related to @samp{mastodonel}
@subsection Packages related to @samp{mastodon.el}
@enumerate
@item
@anchor{Alternative timeline layout}Alternative timeline layout
The incomparable Nicholas Rougier has written an alternative timeline
layout for @samp{mastodon.el}.
The repo is at @uref{https://github.com/rougier/mastodon-alt, mastodon-alt}.
@item
@anchor{Org links archive search}Org links, archive search
@uref{https://codeberg.org/chrmoe/toot-suite, toot-suite} implements an org link type for fediverse posts, and also provides a way to browse an offline archive of your account.
@item
@anchor{Mastodon hydra}Mastodon hydra
A user made a hydra for handling basic @samp{mastodon.el} commands. It's
available at @uref{https://holgerschurig.github.io/en/emacs-mastodon-hydra/}.
@item
@anchor{Narrow to timeline item}Narrow to timeline item
A simple code snippet to enable narrowing to current item in timelines:
@uref{http://takeonrules.com/2024/10/31/hacking-on-mastodon-emacs-package-to-narrow-viewing/}
@item
@anchor{Sachac's config goodies}Sachac's config goodies
The incomparable sachac has a bunch of @samp{mastodon.el} extensions and goodies in their literate config, available here: @uref{https://sachachua.com/dotemacs/index.html#mastodon}.
@end enumerate
@node Live-updating timelines @samp{mastodon-async-mode}
@subsection Live-updating timelines: @samp{mastodon-async-mode}
(code taken from @uref{https://github.com/alexjgriffith/mastodon-future.el, mastodon-future}.)
Works for federated, local, and home timelines and for notifications. It's
a little touchy, one thing to avoid is trying to load a timeline more than
once at a time. It can go off the rails a bit, but it's still pretty cool.
The current maintainer of @samp{mastodon.el} is unable to debug or improve this
feature.
To enable, it, add @samp{(require 'mastodon-async)} to your @samp{init.el}. Then you can
view a timeline with one of the commands that begin with
@samp{mastodon-async--stream-}.
@node Translating toots
@subsection Translating toots
You can translate toots with @samp{mastodon-toot--translate-toot-text} (@samp{a} in a
timeline). At the moment this requires @uref{https://codeberg.org/martianh/lingva.el, lingva.el}, a little interface I
wrote to @uref{https://lingva.ml, lingva.ml}, to be installed to work.
You could easily modify the simple function to use your Emacs translator
of choice (@samp{libretrans.el} , @samp{google-translate}, @samp{babel}, @samp{go-translate}, etc.),
you just need to fetch the toot's content with @samp{(mastodon-tl--content toot)}
and pass it to your translator function as its text argument. Here's what
@samp{mastodon-toot--translate-toot-text} looks like:
@lisp
(defun mastodon-toot-translate-toot-text ()
"Translate text of toot at point.
Uses `lingva.el'."
(interactive)
(let* ((toot (mastodon-tl--property 'item-json)))
(if toot
(lingva-translate nil (mastodon-tl--content toot))
(message "No toot to translate?"))))
@end lisp
@node Bookmarks and @samp{mastodonel}
@subsection Bookmarks and @samp{mastodon.el}
@samp{mastodon.el} implements a basic bookmark record and handler. Currently,
this means that you can bookmark a post item and later load it in thread
view. This could be expanded to any item with an id, but probably not to
things like timeline views. If you want to be able to bookmark something,
open an issue and ask, as it's trivial to expand the bookmarking code.
@node Dependencies
@section Dependencies
Hard dependencies (should all install with @samp{mastodon.el}):
@itemize
@item
@samp{request} (for uploading attachments, @uref{https://github.com/tkf/emacs-request, emacs-request})
@item
@samp{persist} (for storing some settings across sessions, @uref{https://elpa.gnu.org/packages/persist.html, persist})
@item
@samp{tp.el} (for transient menus, @uref{https://codeberg.org/martianh/tp.el, tp.el})
@end itemize
Optional dependencies (install yourself, @samp{mastodon.el} can use them):
@itemize
@item
@samp{emojify} to use custom emoji (else we use builtin @samp{emoji.el})
@item
@samp{mpv} and @samp{mpv.el} for viewing videos and gifs
@item
@samp{lingva.el} for translating toots
@end itemize
@node Network compatibility
@section Network compatibility
@samp{mastodon.el} should work with ActivityPub servers that implement the
Mastodon API@.
Apart from Mastodon itself, it is currently known to work with:
@itemize
@item
Pleroma (@uref{https://pleroma.social/, pleroma.social})
@item
Akkoma (@uref{https://akkoma.social/, akkoma.social})
@item
Gotosocial (@uref{https://gotosocial.org/, gotosocial.org})
@item
Sharkey (@uref{https://joinsharkey.org, joinsharkey.org})
@end itemize
It does not support the non-Mastodon API servers Misskey (@uref{https://misskey.io/, misskey.io}),
Firefish (@uref{https://joinfirefish.org/, joinfirefish.org}, formerly Calkey) and Friendica, but it should
fully support displaying and interacting with posts and users on those
platforms.
If you attempt to use @samp{mastodon.el} with a server and run into problems,
feel free to open an issue.
@node Contributing
@section Contributing
PRs, issues, feature requests, and general feedback are very welcome!
If you prefer emailing patches to the process described below, feel free
to send them on. Ideally they'd be patches that can be applied with @samp{git
am}, if you want to actually contribute a commit.
@menu
* Bug reports::
* Fixes and features::
* Coding style::
@end menu
@node Bug reports
@subsection Bug reports
@enumerate
@item
@samp{mastodon.el} has bugs, as well as lots of room for improvement.
@item
I receive very little feedback, so if I don't run into the bug it often
doesn't get fixed.
@item
If you run into something that seems broken, first try running
@samp{mastodon.el} in emacs with no init file (i.e. @samp{emacs -q} (instructions and
code for doing this are @uref{https://codeberg.org/martianh/mastodon.el/issues/300, here}) to see if it also happens independently
of your own config (it probably does).
@item
Else enable debug on error (@samp{toggle-debug-on-error}), make the bug happen
again, and copy the backtrace that appears.
@item
Open an issue here and explain what is going on. Provide your emacs
version and what kind of server your account is on.
@end enumerate
@node Fixes and features
@subsection Fixes and features
@enumerate
@item
Create an @uref{https://codeberg.org/martianh/mastodon.el/issues, issue} detailing what you'd like to do.
@item
Fork the repository and create a branch off of @samp{develop}.
@item
Run the tests and ensure that your code doesn't break any of them.
@item
Create a pull request (to develop) referencing the issue created in
step 1.
@end enumerate
@node Coding style
@subsection Coding style
@itemize
@item
This library uses an unconvential double dash (@samp{--}) between file
namespaces and function names, which contradicts normal Elisp style.
This needs to be respected until the whole library is changed.
@item
Use @samp{aggressive-indent-mode} or similar to keep your code indented.
@item
Single spaces end sentences in docstrings.
@item
There's no need for a blank line after the first docstring line (one is
added automatically when documentation is displayed).
@end itemize
@node Supporting @samp{mastodonel}
@section Supporting @samp{mastodon.el}
If you'd like to support continued development of @samp{mastodon.el}, I accept
donations via paypal: @uref{https://paypal.me/martianh, paypal.me/martianh}. If you would prefer a different
payment method, please write to me at and I
can provide IBAN or other bank account details.
I don't have a tech worker's income, so even a small tip would help out.
@node Contributors
@section Contributors
@samp{mastodon.el} is the work of a number of people.
Some significant contributors are:
@itemize
@item
@uref{https://github.com/jdenen} [original author]
@item
@uref{http://atomized.org}
@item
@uref{https://alexjgriffith.itch.io}
@item
@uref{https://github.com/hdurer}
@item
@uref{https://codeberg.org/Red_Starfish}
@end itemize
@node Screenshots
@section Screenshots
Here's a (federated) timeline:
@image{screenshot-tl,,,,png}
Here's a notifcations view plus a compose buffer:
@image{screenshot-notifs+compose,,,,png}
Here's a user settings transient (active values green, current server
values commented and, if a boolean, underlined):
@image{screenshot-transient-1,,,,jpg}
Here's a user profile fields transient (changed fields green, current
server values commented):
@image{screenshot-transient-2,,,,jpg}
@bye
mastodon.el/screenshot-notifs+compose.png 0000664 0000000 0000000 00000624261 15017331127 0021140 0 ustar 00root root 0000000 0000000 PNG
IHDR Ť 8 ďˇJć sBIT|d IDATxěÝy\W}çýĎšˇŞşzßWő˘ÖžX-o`c0Ć8Y1[e <3`^~ąĎž˙ţűYż~=żůżÉWżúUĆĆĆ (,,äłý,ŐŐŐźď}ďăk_űZJÇuŤŞŞž8t.öďB˙/""Wü(řøkšc-ĺŰGi?ŐĂ
gh?ßÜńĐCěyźó|âďăWŢşľšxľehĆ
¸ůţOóŠ_˙ ďšűvŽ[ărţĐFş˙ü˙Ąü1;ŘľřxčĎŢËö§ăĽXü%÷sńçw>ĂcĎE/K^Óg˙˙ťÁëďá{îáťăąÇăwÓ}żÁÇ?úŢwĎ[šycąłG9?>ůśĎyĚ/šzěŮł={ö°nÝ:|>'O\í$={ö,¸ýGÉŘg=z[ˇRWWÇu×]ÇĄCđűý<đŔÔÔÔĐŃŃÁßýÝßDR:Ž[UUőE;@],XÝž};ýěgšóÎ;éęꢡˇwIž@ŰŮÓôlýWÜ9ú×tŐ˝śżÎS§§´Ś{îáö[iýů7řÇ>Î+çy×ű?@ý/ă@bŇýżU÷<˙űkßá'Ď'vŰÇů7äąš{ŢŮÍcuűŰďĺí§Ąh×/x,q÷~ŕęžö3˝Ě?ţőwřŃSŻŇw'ýänN?śţEśëI\ŚŐX,ľ
â´śśŽrĘ2o*XýÜç>Ç#˝áš/˙3/đâ?
˙r÷÷SOÖŔ/ż}śż'ńţmÜüŕb˛ ŽćwwZţóO8|qŃĄ.˙âĎy&ţÝÍÉl_B9HV
T=Ďă;ßůßüć7ĹběŮłwżűÝŤźkŢČČ_ůĘW¸xń"uuuTWW/)PđMýîAy|o{§.˛Ó
?ő×ŰČv˙˙]ö ~Ö}üNnâŁ|Ő~ő´ň?cßă&ţ=oćÇźXüŕö'ŕˇ~29ó5ËĎGáíżź˛ŘöyL9HÖ¨~űŰßf˙ţřĺßü&řÄ'¸űîťŢP÷°f×uq]7í÷űŚŽNŞŠ,Źô˝ď}|ä#ţ_DDŽ6C}|ęţÓC^Â[raü?ÎEĆ ~Ąö§ŕŢżM˝f¸7ěŮ>×1EDäjFçT§ĚXŁŃčGXŤšo*éČ>óĎ\6ő×Ă<@]]żó;żĂWżúUS:Ž3ő?=[UĎ^+uđĺ×=žđqn[_IqQ
۸ýÝë§w9đ¸÷s?ăüíÔ9ęŔŁűaö`ůöŕüGď;ÜújňT¸@7˙őĺ~˙]lŤ.$ˇ ďx;iăoöÄöš)""WłÇ/}éKsŞS<Č˙ůgtĄ7˛O}ęSÔÖÖ^vęčč(őWEWWŐŐŐ|ôŁMů¸fëÖŚW˙MfUŕšV kĎ=ÄŻ}ĺA<7ýÚú⡞ű ^äsĂŻ}ťŽ_OuČH§˙˙ëÚŰ]~÷Ą˙BCä+<ř
é}䥸GyđÁ_Ě ßM|ěw÷°ľŚ Ż÷?ňG˙e˛ă×>Ę˝7l "×cŕü!ůŢ÷xŽgęMló"""Žşş:îťď>~řá+ŚűňO|üŕtuuĽt\łeË;W Ş`UDDDDDDV3óMőlÔ=ŤómSp+""""""ŕXkç:ČjqßEDDDDDDdeÍŹęŞŞŹŚEŻŹÎ\ÄČJ¸b5ŕdR""""""IşgUDDDDDD˛UÉ:
VEDDDDD$ëř BĄ ĆK˙MýĚż"""""""Ë%//OWVEDDDDD$ű(XŹŁ`UDDDDDD˛UÉ:
VEDDDDD$ë(XŹŁ`UDDDDDD˛UÉ:
VEDDDDD$ë(XŹŁ`UDDDDDD˛UÉ:
VEDDDDD$ë(XŹŁ`UDDDDDD˛UÉ:
VEDDDDD$ë(XŹŁ`UDDDDDD˛UÉ:
VEDDDDD$ë(XŹŁ`UDDDDDD˛UÉ:
VEDDDDD$ë(XŹă[íČň1AË]7GšgĽ.ĎBŘĐrĆĺG/š]íÔĽŻfkß[áđ+>žô˛Ăřj'*äZË,őĺĆJĘ~^qĽs0%%2
ËşjK÷~?ßo_îT$GÁę5Â=>ýĄ÷ĂĄ§|ú ÜôŤÜe{üÎ?ştŮŐNeĺÍ×ÇX`ŮšŰcË>WÓČŽy[#<źÇĂ?ăľĐ Ň
Vo óˇYÜŻí=š´4,EÚÓ×ßáďrweâÇ'>áówxÔeJÝŘú#üÉť/ßő7FŮS&ćđJŤ!ÔÄŁS×9+ňef
íŠ8;2hčö2˙ąŠ˙J?ćçßđńÂ2]1oŰŕ;ô]?hČ5)˝+ŤĆ˛ąÉăşz8ýjü%ˇÔcwG˝ëđÝeLŕąljňŘQo8ľ?ţŇĺk,×5$Ž9`ÄđËg}:8{ŇĽmľĺý÷E¸żÄđ?ňó/ÝŠbďă~ţčÇ×pň´Ă
Lç%Őň_%ăýúŕśe8
îłg=rwńÝłÂ2Ô-É^é]Yu-*Ŕ
'{ă/ĺW[ęčď2tëęĚҸńň=LůČj,ŰÖX ÷źË^vŮ7°iCKnÇMk,i]pyě¨ĂŮ02˝,XŞĺżźeLľË˘ź%cfÝkKZWVÝRuđ:NE㯍ąřSçYŕĹąlÚăÝ[=śUZ4tt9<óŞË˙9g&`ٸƲŽŇc]ecĺČŁ~äÄřČ-1nŹśäD
§Nť|ď×GĄv}Ýă*KnĚpú´Ëß?ërdć*<ÖmňkŰă_äë
GOťüô5ÓĄšJȲkG{7{l*łú!4n8{Áá˝>ď#>EŐąl˝.Ć{ˇzl.ˇů!2´w9ź|Äĺg-&éEÜ2őu,Vží7ĸwŁÇ
ĺÓďßtGŢÄžň7~Ĺóą{W=<6M§ďBĂK\ţĎ)ĂTöMe{ÇşJKsľeSĺĐĎüŔÄřÔí1n(ł_tůú/|ěżÇ_äąçŚw4Yę,``ĐáőV~lČáš3ÓÓynĄÇ[7ZĘ=ÖVZÖ[.>ŕ^qŹňśźĺ?C˛ő$ÍôżĺÖÝ1~uÇşKĐ3\hwč+^$3Ió|ďÝzC_ßéąąŘâMZNťüĂ.ÇgWćdŰwë\[ĚćÍíäädüc.ý7ő÷Ľ
ÜóŢ0Ť38äŔXCÄcŔuÁď@,
Lş<ôuűŁĎrďť"üĆ:6<ţ§űáĆ7G¸o
ŕÄĎ_0ř˘üĺ˝1ę\ş
wń˘C°ĘĂ1ř-Eiá˙ŐbůŘáC ĐRŘęôń
ďťMD[ŢćośŹá
_řůG
žÚ(t>¸|éű>öÍ ÇG~-ÂëI~ÔÇłO˝+ĘÎ ŘI˙ÁĎ,ˇďđ{[,Ž5ěÖÇ×[
Ł|ţ6"§_
đ˙žhĚűMX~őž0¨äř &éŻ|ÇśEššśmą%7žďh§ËăçÁó/ěu9íóřřű#źŻ
ÖŁ>ěŚÍ1޸
{î ?~ĘaŔż!ĘîŃ7ý=폡ÄĆ ˛40ˇúů8LTĆřŁűŁ\;|ďIăŽÇďą=°'~ě獧f
ő!ˇ1Ę˙sWĽÓi9ńL/ěËSËŰü-!˝ňßMĄô§^ôřŘű#ÜW/žó.?:fç[îź!ĆźD?áç?sŚëX
ĺlrb|áßFš%ńVWÁç?m(YăÄçOöşüé÷| §ţ9žL×-š&äĺĺĽ0
ŘXęË čä
`řßA| ŕúOzýÍođŠuń{*Ďěóó?:=ďđg]:-ÇrŰí1śű rÎÇo?ěçĽ*sá[ßÎáß|=ŔoýËĹĨ4Păß^7˝í3?qéIlVÇŘł&q