ld/ld-emacs
1
0
Fork 0
mirror of https://github.com/lliding/ld-emacs.git synced 2025-10-13 05:23:05 +00:00
Code Issues Packages Projects Releases Wiki Activity

First release.

Browse Source
This commit is contained in:
liding 2023-10-23 14:13:34 +08:00 committed by liding
commit 92c3e19a46
83 changed files with 13506 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
.gitattributes vendored Normal file
View File

@ -0,0 +1,6 @@
# Automatically normalize line endings (to LF) for all text-based files.
* text=auto eol=lf
# Do not modify line endings for binary files (which are sometimes auto
# detected as text files by git).
*.png binary

0
.gitignore vendored Normal file
View File

45
.gitmodules vendored Normal file
View File

@ -0,0 +1,45 @@
[submodule "site-lisp/extensions-submodule/go-mode.el"]
path = site-lisp/extensions-submodule/go-mode.el
url = git@github.com:dominikh/go-mode.el.git
[submodule "site-lisp/extensions-submodule/jsonian"]
path = site-lisp/extensions-submodule/jsonian
url = git@github.com:iwahbe/jsonian.git
[submodule "site-lisp/extensions-submodule/ace-window"]
path = site-lisp/extensions-submodule/ace-window
url = git@github.com:abo-abo/ace-window.git
[submodule "site-lisp/extensions-submodule/dash.el"]
path = site-lisp/extensions-submodule/dash.el
url = git@github.com:magnars/dash.el.git
[submodule "site-lisp/extensions-submodule/avy"]
path = site-lisp/extensions-submodule/avy
url = git@github.com:abo-abo/avy.git
[submodule "site-lisp/extensions-submodule/emacs-which-key"]
path = site-lisp/extensions-submodule/emacs-which-key
url = git@github.com:justbur/emacs-which-key.git
[submodule "site-lisp/extensions-submodule/lua-mode"]
path = site-lisp/extensions-submodule/lua-mode
url = git@github.com:immerrr/lua-mode.git
[submodule "site-lisp/extensions-submodule/markdown-mode"]
path = site-lisp/extensions-submodule/markdown-mode
url = git@github.com:jrblevin/markdown-mode.git
[submodule "site-lisp/extensions-submodule/modus-themes"]
path = site-lisp/extensions-submodule/modus-themes
url = git@github.com:protesilaos/modus-themes.git
[submodule "site-lisp/extensions-submodule/swiper"]
path = site-lisp/extensions-submodule/swiper
url = git@github.com:abo-abo/swiper.git
[submodule "site-lisp/extensions-submodule/web-mode"]
path = site-lisp/extensions-submodule/web-mode
url = git@github.com:fxbois/web-mode.git
[submodule "site-lisp/extensions-submodule/yasnippet"]
path = site-lisp/extensions-submodule/yasnippet
url = git@github.com:joaotavora/yasnippet.git
[submodule "site-lisp/extensions-submodule/multiple-cursors.el"]
path = site-lisp/extensions-submodule/multiple-cursors.el
url = git@github.com:magnars/multiple-cursors.el.git
[submodule "site-lisp/extensions-submodule/citre"]
path = site-lisp/extensions-submodule/citre
url = git@github.com:universal-ctags/citre.git
[submodule "site-lisp/extensions-submodule/company-mode"]
path = site-lisp/extensions-submodule/company-mode
url = git@github.com:company-mode/company-mode.git

661
LICENSE Normal file
View File

@ -0,0 +1,661 @@
GNU AFFERO GENERAL PUBLIC LICENSE
Version 3, 19 November 2007
Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The GNU Affero General Public License is a free, copyleft license for
software and other kinds of works, specifically designed to ensure
cooperation with the community in the case of network server software.
The licenses for most software and other practical works are designed
to take away your freedom to share and change the works. By contrast,
our General Public Licenses are 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.
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.
Developers that use our General Public Licenses protect your rights
with two steps: (1) assert copyright on the software, and (2) offer
you this License which gives you legal permission to copy, distribute
and/or modify the software.
A secondary benefit of defending all users' freedom is that
improvements made in alternate versions of the program, if they
receive widespread use, become available for other developers to
incorporate. Many developers of free software are heartened and
encouraged by the resulting cooperation. However, in the case of
software used on network servers, this result may fail to come about.
The GNU General Public License permits making a modified version and
letting the public access it on a server without ever releasing its
source code to the public.
The GNU Affero General Public License is designed specifically to
ensure that, in such cases, the modified source code becomes available
to the community. It requires the operator of a network server to
provide the source code of the modified version running there to the
users of that server. Therefore, public use of a modified version, on
a publicly accessible server, gives the public access to the source
code of the modified version.
An older license, called the Affero General Public License and
published by Affero, was designed to accomplish similar goals. This is
a different license, not a version of the Affero GPL, but Affero has
released a new version of the Affero GPL which permits relicensing under
this license.
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 Affero 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. Remote Network Interaction; Use with the GNU General Public License.
Notwithstanding any other provision of this License, if you modify the
Program, your modified version must prominently offer all users
interacting with it remotely through a computer network (if your version
supports such interaction) an opportunity to receive the Corresponding
Source of your version by providing access to the Corresponding Source
from a network server at no charge, through some standard or customary
means of facilitating copying of software. This Corresponding Source
shall include the Corresponding Source for any work covered by version 3
of the GNU General Public License that is incorporated pursuant to the
following paragraph.
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 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 work with which it is combined will remain governed by version
3 of the GNU General Public License.
14. Revised Versions of this License.
The Free Software Foundation may publish revised and/or new versions of
the GNU Affero 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 Affero 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 Affero 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 Affero General Public License can be used, that proxy's
public statement of acceptance of a version permanently authorizes you
to choose that version for the Program.
Later license versions may give you additional or different
permissions. However, no additional obligations are imposed on any
author or copyright holder as a result of your choosing to follow a
later version.
15. Disclaimer of Warranty.
THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
16. Limitation of Liability.
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.
17. Interpretation of Sections 15 and 16.
If the disclaimer of warranty and limitation of liability provided
above cannot be given local legal effect according to their terms,
reviewing courts shall apply local law that most closely approximates
an absolute waiver of all civil liability in connection with the
Program, unless a warranty or assumption of liability accompanies a
copy of the Program in return for a fee.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
state the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) <year> <name of author>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero 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 Affero General Public License for more details.
You should have received a copy of the GNU Affero General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
Also add information on how to contact you by electronic and paper mail.
If your software can interact with users remotely through a computer
network, you should also make sure that it provides a way for users to
get its source. For example, if your program is a web application, its
interface could display a "Source" link that leads users to an archive
of the code. There are many ways you could offer source, and different
solutions will be better for different programs; see section 13 for the
specific requirements.
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 AGPL, see
<https://www.gnu.org/licenses/>.

53
README.md Normal file
View File

@ -0,0 +1,53 @@
# Install elisp files
## Debian / Ubuntu
Clone this repo to home path.
Build config symlink to emacs directory:
```bash
sudo ln -s ~/ld-emacs/site-lisp /usr/share/emacs/ld
```
Copy site-start.el in emacs directory to start my config:
```bash
sudo cp ~/ld-emacs/site-start.el /usr/share/emacs/site-lisp/
```
Initialize submodules:
```plaintext
cd ~/ld-emacs && git submodule update --init --recursive
```
## Windows
Clone this repo to `C:\Users\<username>\AppData\Roaming\ld-emacs` and initialize submodules.
Put the content below to `~/.emacs.d/init.el` (to `C:\Users\<username>\AppData\Roaming\.emacs.d\init.el`).
```lisp
(load-file "~/ld-emacs/site-start.el")
```
# Install dependencies for extensions
## Debian / Ubuntu
```plaintext
# for citre (ctags frontend)
sudo apt install universal-ctags
# for counsel-rg
sudo apt install ripgrep
```
Note: Emacs will load ~/.profile for env variables at the start. According to the code in ~/.profile, emacs will not load ~/.bashrc. So if user wish to add some env variables, the code should be written to ~/.profile.
## Windows
Download Universal-ctags binary and add it to environment variable `Path`.
Download the ripgrep for windows from [ripgrep](https://github.com/BurntSushi/ripgrep) and add the .exe file to env variable `Path`.

126
site-lisp/extensions-local/auto-save.el Normal file
View File

@ -0,0 +1,126 @@
;; -*- coding: utf-8; -*-
;;; Require:
;;; Code:
(defgroup auto-save nil
"Auto save file when emacs idle."
:group 'auto-save)
(defcustom auto-save-idle 1
"The idle seconds to auto save file."
:type 'integer
:group 'auto-save)
(defcustom auto-save-silent nil
"Nothing to dirty minibuffer if this option is non-nil."
:type 'boolean
:group 'auto-save)
(defcustom auto-save-delete-trailing-whitespace nil
"Delete trailing whitespace when save if this option is non-nil.
Note, this option is non-nil, will delete all training whitespace execpet current line,
avoid delete current indent space when you programming."
:type 'boolean
:group 'auto-save)
(defvar auto-save-disable-predicates
nil "disable auto save in these case.")
;; Emacs' default auto-save is stupid to generate #foo# files!
(setq make-backup-files nil)
(setq auto-save-default nil)
(setq create-lockfiles nil)
(defun auto-save-buffers ()
(interactive)
(let ((autosave-buffer-list))
(ignore-errors
(save-current-buffer
(dolist (buf (buffer-list))
(set-buffer buf)
(when (and
;; Buffer associate with a filename?
(buffer-file-name)
;; Buffer is modifiable?
(buffer-modified-p)
;; Yassnippet is not active?
(or (not (boundp 'yas--active-snippets))
(not yas--active-snippets))
;; Company is not active?
(or (not (boundp 'company-candidates))
(not company-candidates))
;; Corfu is not active?
(or (not (boundp 'corfu--total))
(zerop corfu--total))
;; Org-capture is not active?
(not (eq (buffer-base-buffer (get-buffer (concat "CAPTURE-" (buffer-name))))
buf))
;; tell auto-save don't save
(not (seq-some (lambda (predicate)
(funcall predicate))
auto-save-disable-predicates)))
(push (buffer-name) autosave-buffer-list)
(if auto-save-silent
;; `inhibit-message' can shut up Emacs, but we want
;; it doesn't clean up echo area during saving
(with-temp-message ""
(let ((inhibit-message t))
(basic-save-buffer)))
(basic-save-buffer))
))
;; Tell user when auto save files.
(unless auto-save-silent
(cond
;; It's stupid tell user if nothing to save.
((= (length autosave-buffer-list) 1)
(message "# Saved %s" (car autosave-buffer-list)))
((> (length autosave-buffer-list) 1)
(message "# Saved %d files: %s"
(length autosave-buffer-list)
(mapconcat 'identity autosave-buffer-list ", ")))))
))))
(defun auto-save-delete-trailing-whitespace-except-current-line ()
(interactive)
(when auto-save-delete-trailing-whitespace
(let ((begin (line-beginning-position))
(end (point)))
(save-excursion
(when (< (point-min) begin)
(save-restriction
(narrow-to-region (point-min) (1- begin))
(delete-trailing-whitespace)))
(when (> (point-max) end)
(save-restriction
(narrow-to-region end (point-max))
(delete-trailing-whitespace)))))))
(defvar auto-save-timer nil)
(defun auto-save-set-timer ()
"Set the auto-save timer.
Cancel any previous timer."
(auto-save-cancel-timer)
(setq auto-save-timer
(run-with-idle-timer auto-save-idle t 'auto-save-buffers)))
(defun auto-save-cancel-timer ()
(when auto-save-timer
(cancel-timer auto-save-timer)
(setq auto-save-timer nil)))
(defun auto-save-enable ()
(interactive)
(auto-save-set-timer)
(add-hook 'before-save-hook 'auto-save-delete-trailing-whitespace-except-current-line)
)
(defun auto-save-disable ()
(interactive)
(auto-save-cancel-timer)
(remove-hook 'before-save-hook 'auto-save-delete-trailing-whitespace-except-current-line)
)
(provide 'auto-save)
;;; auto-save.el ends here

533
site-lisp/extensions-local/cmake-mode.el Normal file
View File

@ -0,0 +1,533 @@
;;; cmake-mode.el --- major-mode for editing CMake sources
;; Package-Requires: ((emacs "24.1"))
;; Package-Version: 20220823.1201
;; Package-Commit: 5936d4f2adeec64e0ff748b2c6c34f0436b19a97
; Distributed under the OSI-approved BSD 3-Clause License. See accompanying
; file Copyright.txt or https://cmake.org/licensing for details.
;------------------------------------------------------------------------------
;;; Commentary:
;; Provides syntax highlighting and indentation for CMakeLists.txt and
;; *.cmake source files.
;;
;; Add this code to your .emacs file to use the mode:
;;
;; (setq load-path (cons (expand-file-name "/dir/with/cmake-mode") load-path))
;; (require 'cmake-mode)
;------------------------------------------------------------------------------
;;; Code:
;;
;; cmake executable variable used to run cmake --help-command
;; on commands in cmake-mode
;;
;; cmake-command-help Written by James Bigler
;;
(require 'rst)
(require 'rx)
(defcustom cmake-mode-cmake-executable "cmake"
"*The name of the cmake executable.
This can be either absolute or looked up in $PATH. You can also
set the path with these commands:
(setenv \"PATH\" (concat (getenv \"PATH\") \";C:\\\\Program Files\\\\CMake 2.8\\\\bin\"))
(setenv \"PATH\" (concat (getenv \"PATH\") \":/usr/local/cmake/bin\"))"
:type 'file
:group 'cmake)
;; Keywords
(defconst cmake-keywords-block-open '("BLOCK" "IF" "MACRO" "FOREACH" "ELSE" "ELSEIF" "WHILE" "FUNCTION"))
(defconst cmake-keywords-block-close '("ENDBLOCK" "ENDIF" "ENDFOREACH" "ENDMACRO" "ELSE" "ELSEIF" "ENDWHILE" "ENDFUNCTION"))
(defconst cmake-keywords
(let ((kwds (append cmake-keywords-block-open cmake-keywords-block-close nil)))
(delete-dups kwds)))
;; Regular expressions used by line indentation function.
;;
(defconst cmake-regex-blank "^[ \t]*$")
(defconst cmake-regex-comment "#.*")
(defconst cmake-regex-paren-left "(")
(defconst cmake-regex-paren-right ")")
(defconst cmake-regex-closing-parens-line (concat "^[[:space:]]*\\("
cmake-regex-paren-right
"+\\)[[:space:]]*$"))
(defconst cmake-regex-argument-quoted
(rx ?\" (* (or (not (any ?\" ?\\)) (and ?\\ anything))) ?\"))
(defconst cmake-regex-argument-unquoted
(rx (or (not (any space "()#\"\\\n")) (and ?\\ nonl))
(* (or (not (any space "()#\\\n")) (and ?\\ nonl)))))
(defconst cmake-regex-token
(rx-to-string `(group (or (regexp ,cmake-regex-comment)
?\( ?\)
(regexp ,cmake-regex-argument-unquoted)
(regexp ,cmake-regex-argument-quoted)))))
(defconst cmake-regex-indented
(rx-to-string `(and bol (* (group (or (regexp ,cmake-regex-token) (any space ?\n)))))))
(defconst cmake-regex-block-open
(rx-to-string `(and symbol-start (or ,@(append cmake-keywords-block-open
(mapcar 'downcase cmake-keywords-block-open))) symbol-end)))
(defconst cmake-regex-block-close
(rx-to-string `(and symbol-start (or ,@(append cmake-keywords-block-close
(mapcar 'downcase cmake-keywords-block-close))) symbol-end)))
(defconst cmake-regex-close
(rx-to-string `(and bol (* space) (regexp ,cmake-regex-block-close)
(* space) (regexp ,cmake-regex-paren-left))))
(defconst cmake-regex-token-paren-left (concat "^" cmake-regex-paren-left "$"))
(defconst cmake-regex-token-paren-right (concat "^" cmake-regex-paren-right "$"))
;------------------------------------------------------------------------------
;; Line indentation helper functions
(defun cmake-line-starts-inside-string ()
"Determine whether the beginning of the current line is in a string."
(save-excursion
(beginning-of-line)
(let ((parse-end (point)))
(goto-char (point-min))
(nth 3 (parse-partial-sexp (point) parse-end))
)
)
)
(defun cmake-find-last-indented-line ()
"Move to the beginning of the last line that has meaningful indentation."
(let ((point-start (point))
region)
(forward-line -1)
(setq region (buffer-substring-no-properties (point) point-start))
(while (and (not (bobp))
(or (looking-at cmake-regex-blank)
(cmake-line-starts-inside-string)
(not (and (string-match cmake-regex-indented region)
(= (length region) (match-end 0))))))
(forward-line -1)
(setq region (buffer-substring-no-properties (point) point-start))
)
)
)
;------------------------------------------------------------------------------
;;
;; Indentation increment.
;;
(defcustom cmake-tab-width 2
"Number of columns to indent cmake blocks"
:type 'integer
:group 'cmake)
;;
;; Line indentation function.
;;
(defun cmake-indent ()
"Indent current line as CMake code."
(interactive)
(unless (cmake-line-starts-inside-string)
(if (bobp)
(cmake-indent-line-to 0)
(let (cur-indent)
(save-excursion
(beginning-of-line)
(let ((point-start (point))
(closing-parens-only (looking-at cmake-regex-closing-parens-line))
(case-fold-search t) ;; case-insensitive
token)
;; Search back for the last indented line.
(cmake-find-last-indented-line)
;; Start with the indentation on this line.
(setq cur-indent (current-indentation))
(if closing-parens-only
(let ((open-parens 0))
(while (re-search-forward cmake-regex-token point-start t)
(setq token (match-string 0))
(cond
((string-match cmake-regex-token-paren-left token)
(setq open-parens (+ open-parens 1)))
((string-match cmake-regex-token-paren-right token)
(setq open-parens (- open-parens 1)))))
;; Don't outdent if last indented line has open parens
(unless (> open-parens 0)
(setq cur-indent (- cur-indent cmake-tab-width))))
;; Skip detailed analysis if last indented line is a 'closing
;; parens only line'
(unless (looking-at cmake-regex-closing-parens-line)
;; Search forward counting tokens that adjust indentation.
(while (re-search-forward cmake-regex-token point-start t)
(setq token (match-string 0))
(when (or (string-match cmake-regex-token-paren-left token)
(and (string-match cmake-regex-block-open token)
(looking-at (concat "[ \t]*" cmake-regex-paren-left))))
(setq cur-indent (+ cur-indent cmake-tab-width)))
(when (string-match cmake-regex-token-paren-right token)
(setq cur-indent (- cur-indent cmake-tab-width)))
))
(goto-char point-start)
;; If next token closes the block, decrease indentation
(when (looking-at cmake-regex-close)
(setq cur-indent (- cur-indent cmake-tab-width))
)
)
)
)
;; Indent this line by the amount selected.
(cmake-indent-line-to (max cur-indent 0))
)
)
)
)
(defun cmake-point-in-indendation ()
(string-match "^[ \\t]*$" (buffer-substring (point-at-bol) (point))))
(defun cmake-indent-line-to (column)
"Indent the current line to COLUMN.
If point is within the existing indentation it is moved to the end of
the indentation. Otherwise it retains the same position on the line"
(if (cmake-point-in-indendation)
(indent-line-to column)
(save-excursion (indent-line-to column))))
;------------------------------------------------------------------------------
;;
;; Helper functions for buffer
;;
(defun cmake-unscreamify-buffer ()
"Convert all CMake commands to lowercase in buffer."
(interactive)
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^\\([ \t]*\\)\\_<\\(\\(?:\\w\\|\\s_\\)+\\)\\_>\\([ \t]*(\\)" nil t)
(replace-match
(concat
(match-string 1)
(downcase (match-string 2))
(match-string 3))
t))
)
)
;------------------------------------------------------------------------------
;;
;; Navigation / marking by function or macro
;;
(defconst cmake--regex-defun-start
(rx line-start
(zero-or-more space)
(or "function" "macro")
(zero-or-more space)
"("))
(defconst cmake--regex-defun-end
(rx line-start
(zero-or-more space)
"end"
(or "function" "macro")
(zero-or-more space)
"(" (zero-or-more (not-char ")")) ")"))
(defun cmake-beginning-of-defun ()
"Move backward to the beginning of a CMake function or macro.
Return t unless search stops due to beginning of buffer."
(interactive)
(when (not (region-active-p))
(push-mark))
(let ((case-fold-search t))
(when (re-search-backward cmake--regex-defun-start nil 'move)
t)))
(defun cmake-end-of-defun ()
"Move forward to the end of a CMake function or macro.
Return t unless search stops due to end of buffer."
(interactive)
(when (not (region-active-p))
(push-mark))
(let ((case-fold-search t))
(when (re-search-forward cmake--regex-defun-end nil 'move)
(forward-line)
t)))
(defun cmake-mark-defun ()
"Mark the current CMake function or macro.
This puts the mark at the end, and point at the beginning."
(interactive)
(cmake-end-of-defun)
(push-mark nil :nomsg :activate)
(cmake-beginning-of-defun))
;------------------------------------------------------------------------------
;;
;; Keyword highlighting regex-to-face map.
;;
(defconst cmake-font-lock-keywords
`((,(rx-to-string `(and symbol-start
(or ,@cmake-keywords
,@(mapcar #'downcase cmake-keywords))
symbol-end))
. font-lock-keyword-face)
(,(rx symbol-start (group (+ (or word (syntax symbol)))) (* blank) ?\()
1 font-lock-function-name-face)
(,(rx "${" (group (+(any alnum "-_+/."))) "}")
1 font-lock-variable-name-face t)
)
"Highlighting expressions for CMake mode.")
;------------------------------------------------------------------------------
(defun cmake--syntax-propertize-until-bracket-close (syntax)
;; This function assumes that a previous search has matched the
;; beginning of a bracket_comment or bracket_argument and that the
;; second capture group has matched the equal signs between the two
;; opening brackets
(let* ((mb (match-beginning 2))
(me (match-end 2))
(cb (format "]%s]" (buffer-substring mb me))))
(save-match-data
(if (search-forward cb end 'move)
(progn
(setq me (match-end 0))
(put-text-property
(1- me)
me
'syntax-table
(string-to-syntax syntax)))
(setq me end)))
(put-text-property
(match-beginning 1)
me
'syntax-multiline
t)))
(defconst cmake--syntax-propertize-function
(syntax-propertize-rules
("\\(#\\)\\[\\(=*\\)\\["
(1
(prog1 "!" (cmake--syntax-propertize-until-bracket-close "!"))))
("\\(\\[\\)\\(=*\\)\\["
(1
(prog1 "|" (cmake--syntax-propertize-until-bracket-close "|"))))))
;; Syntax table for this mode.
(defvar cmake-mode-syntax-table nil
"Syntax table for CMake mode.")
(or cmake-mode-syntax-table
(setq cmake-mode-syntax-table
(let ((table (make-syntax-table)))
(modify-syntax-entry ?\( "()" table)
(modify-syntax-entry ?\) ")(" table)
(modify-syntax-entry ?# "<" table)
(modify-syntax-entry ?\n ">" table)
(modify-syntax-entry ?$ "'" table)
table)))
;;
;; User hook entry point.
;;
(defvar cmake-mode-hook nil)
;;------------------------------------------------------------------------------
;; Mode definition.
;;
;;;###autoload
(define-derived-mode cmake-mode prog-mode "CMake"
"Major mode for editing CMake source files."
; Setup font-lock mode.
(set (make-local-variable 'font-lock-defaults) '(cmake-font-lock-keywords))
; Setup indentation function.
(set (make-local-variable 'indent-line-function) 'cmake-indent)
; Setup comment syntax.
(set (make-local-variable 'comment-start) "#")
;; Setup syntax propertization
(set (make-local-variable 'syntax-propertize-function) cmake--syntax-propertize-function)
(add-hook 'syntax-propertize-extend-region-functions #'syntax-propertize-multiline nil t))
;; Default cmake-mode key bindings
(define-key cmake-mode-map "\e\C-a" #'cmake-beginning-of-defun)
(define-key cmake-mode-map "\e\C-e" #'cmake-end-of-defun)
(define-key cmake-mode-map "\e\C-h" #'cmake-mark-defun)
; Help mode starts here
;;;###autoload
(defun cmake-command-run (type &optional topic buffer)
"Runs the command cmake with the arguments specified. The
optional argument topic will be appended to the argument list."
(interactive "s")
(let* ((bufname (if buffer buffer (concat "*CMake" type (if topic "-") topic "*")))
(buffer (if (get-buffer bufname) (get-buffer bufname) (generate-new-buffer bufname)))
(command (concat cmake-mode-cmake-executable " " type " " topic))
;; Turn of resizing of mini-windows for shell-command.
(resize-mini-windows nil)
)
(shell-command command buffer)
(save-selected-window
(select-window (display-buffer buffer 'not-this-window))
(cmake-mode)
(read-only-mode 1)
(view-mode 1))
)
)
;;;###autoload
(defun cmake-command-run-help (type &optional topic buffer)
"`cmake-command-run' but rendered in `rst-mode'."
(interactive "s")
(let* ((bufname (if buffer buffer (concat "*CMake" type (if topic "-") topic "*")))
(buffer (if (get-buffer bufname) (get-buffer bufname) (generate-new-buffer bufname)))
(command (concat cmake-mode-cmake-executable " " type " " topic))
;; Turn of resizing of mini-windows for shell-command.
(resize-mini-windows nil)
)
(shell-command command buffer)
(save-selected-window
(select-window (display-buffer buffer 'not-this-window))
(rst-mode)
(read-only-mode 1)
(view-mode 1))
)
)
;;;###autoload
(defun cmake-help-list-commands ()
"Prints out a list of the cmake commands."
(interactive)
(cmake-command-run-help "--help-command-list")
)
(defvar cmake-commands '() "List of available topics for --help-command.")
(defvar cmake-help-command-history nil "Command read history.")
(defvar cmake-modules '() "List of available topics for --help-module.")
(defvar cmake-help-module-history nil "Module read history.")
(defvar cmake-variables '() "List of available topics for --help-variable.")
(defvar cmake-help-variable-history nil "Variable read history.")
(defvar cmake-properties '() "List of available topics for --help-property.")
(defvar cmake-help-property-history nil "Property read history.")
(defvar cmake-help-complete-history nil "Complete help read history.")
(defvar cmake-string-to-list-symbol
'(("command" cmake-commands cmake-help-command-history)
("module" cmake-modules cmake-help-module-history)
("variable" cmake-variables cmake-help-variable-history)
("property" cmake-properties cmake-help-property-history)
))
(defun cmake-get-list (listname)
"If the value of LISTVAR is nil, run cmake --help-LISTNAME-list
and store the result as a list in LISTVAR."
(let ((listvar (car (cdr (assoc listname cmake-string-to-list-symbol)))))
(if (not (symbol-value listvar))
(let ((temp-buffer-name "*CMake Temporary*"))
(save-window-excursion
(cmake-command-run-help (concat "--help-" listname "-list") nil temp-buffer-name)
(with-current-buffer temp-buffer-name
; FIXME: Ignore first line if it is "cmake version ..." from CMake < 3.0.
(set listvar (split-string (buffer-substring-no-properties (point-min) (point-max)) "\n" t)))))
(symbol-value listvar)
))
)
(require 'thingatpt)
(defun cmake-symbol-at-point ()
(let ((symbol (symbol-at-point)))
(and (not (null symbol))
(symbol-name symbol))))
(defun cmake-help-type (type)
(let* ((default-entry (cmake-symbol-at-point))
(history (car (cdr (cdr (assoc type cmake-string-to-list-symbol)))))
(input (completing-read
(format "CMake %s: " type) ; prompt
(cmake-get-list type) ; completions
nil ; predicate
t ; require-match
default-entry ; initial-input
history
)))
(if (string= input "")
(error "No argument given")
input))
)
;;;###autoload
(defun cmake-help-command ()
"Prints out the help message for the command the cursor is on."
(interactive)
(cmake-command-run-help "--help-command" (cmake-help-type "command") "*CMake Help*"))
;;;###autoload
(defun cmake-help-module ()
"Prints out the help message for the module the cursor is on."
(interactive)
(cmake-command-run-help "--help-module" (cmake-help-type "module") "*CMake Help*"))
;;;###autoload
(defun cmake-help-variable ()
"Prints out the help message for the variable the cursor is on."
(interactive)
(cmake-command-run-help "--help-variable" (cmake-help-type "variable") "*CMake Help*"))
;;;###autoload
(defun cmake-help-property ()
"Prints out the help message for the property the cursor is on."
(interactive)
(cmake-command-run-help "--help-property" (cmake-help-type "property") "*CMake Help*"))
;;;###autoload
(defun cmake-help ()
"Queries for any of the four available help topics and prints out the appropriate page."
(interactive)
(let* ((default-entry (cmake-symbol-at-point))
(command-list (cmake-get-list "command"))
(variable-list (cmake-get-list "variable"))
(module-list (cmake-get-list "module"))
(property-list (cmake-get-list "property"))
(all-words (append command-list variable-list module-list property-list))
(input (completing-read
"CMake command/module/variable/property: " ; prompt
all-words ; completions
nil ; predicate
t ; require-match
default-entry ; initial-input
'cmake-help-complete-history
)))
(if (string= input "")
(error "No argument given")
(if (member input command-list)
(cmake-command-run-help "--help-command" input "*CMake Help*")
(if (member input variable-list)
(cmake-command-run-help "--help-variable" input "*CMake Help*")
(if (member input module-list)
(cmake-command-run-help "--help-module" input "*CMake Help*")
(if (member input property-list)
(cmake-command-run-help "--help-property" input "*CMake Help*")
(error "Not a know help topic.") ; this really should not happen
))))))
)
;;;###autoload
(progn
(add-to-list 'auto-mode-alist '("CMakeLists\\.txt\\'" . cmake-mode))
(add-to-list 'auto-mode-alist '("\\.cmake\\'" . cmake-mode)))
; This file provides cmake-mode.
(provide 'cmake-mode)
;;; cmake-mode.el ends here

528
site-lisp/extensions-local/company-ctags.el Normal file
View File

@ -0,0 +1,528 @@
;;; company-ctags.el --- Fastest company-mode completion backend for ctags -*- lexical-binding: t -*-
;; Copyright (C) 2019,2020 Chen Bin
;; Author: Chen Bin <chenbin.sh@gmail.com>
;; URL: https://github.com/redguardtoo/company-ctags
;; Version: 0.0.7
;; Keywords: convenience
;; Package-Requires: ((emacs "25.1") (company "0.9.0"))
;; This file is NOT part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library completes code using tags file created by Ctags.
;; It uses a much faster algorithm optimized for ctags.
;; It takes only 9 seconds to load 300M tags file which is created by
;; scanning the Linux Kernel code v5.3.1.
;; After initial loading, this library will respond immediately
;; when new tags file is created.
;;
;; Usage:
;;
;; Step 0, Make sure `company-mode' is already set up
;; See http://company-mode.github.io/ for details.
;;
;; Step 1, insert below code into your configuration,
;;
;; (with-eval-after-load 'company
;; (company-ctags-auto-setup))
;;
;; Step 2, Use Ctags to create tags file and enjoy.
;;
;; Tips:
;;
;; - Turn on `company-ctags-support-etags' to support tags
;; file created by etags. But it will increase initial loading time.
;;
;; - Set `company-ctags-extra-tags-files' to load extra tags files,
;;
;; (setq company-ctags-extra-tags-files '("$HOME/TAGS" "/usr/include/TAGS"))
;;
;; - Set `company-ctags-fuzzy-match-p' to fuzzy match the candidates.
;; The input could match any part of the candidate instead of the beginning of
;; the candidate.
;;
;; - Set `company-ctags-ignore-case' to ignore case when fetching candidates
;;
;; - Use rusty-tags to generate tags file for Rust programming language.
;; Add below code into ~/.emacs,
;; (setq company-ctags-tags-file-name "rusty-tags.emacs")
;;
;; - Make sure CLI program diff is executable on Windows.
;; It's optional but highly recommended. It can speed up tags file updating.
;; This package uses diff through variable `diff-command'.
;;
;; - `company-ctags-debug-info' for debugging.
;;
;;; Code:
(require 'find-file)
(require 'company nil t)
(require 'cl-lib)
(require 'subr-x)
(defgroup company-ctags nil
"Completion backend for ctags."
:group 'company)
(defcustom company-ctags-use-main-table-list t
"Always search `tags-table-list' if set.
If this is disabled, `company-ctags' will try to find the one table for each
buffer automatically."
:type '(choice (const :tag "off" nil)
(const :tag "on" t)))
(defcustom company-ctags-ignore-case nil
"Non-nil to ignore case in completion candidates."
:type 'boolean
:package-version '(company . "0.7.3"))
(defcustom company-ctags-extra-tags-files nil
"List of extra tags files which are loaded only once.
A typical format is,
(\"./TAGS\" \"/usr/include/TAGS\" \"$PROJECT/*/include/TAGS\")
Environment variables can be inserted between slashes (`/').
They will be replaced by their definitions. If a variable does
not exist, it is replaced (silently) with an empty string."
:type '(repeat 'string))
(defcustom company-ctags-quiet nil
"Be quiet and do not notify user tags file status."
:type 'boolean)
(defcustom company-ctags-support-etags nil
"Support tags file created by etags.
If t, it increases the loading time."
:type 'boolean)
(defcustom company-ctags-everywhere nil
"Non-nil to offer completions in comments and strings.
Set it to t or to a list of major modes."
:type '(choice (const :tag "Off" nil)
(const :tag "Any supported mode" t)
(repeat :tag "Some major modes"
(symbol :tag "Major mode")))
:package-version '(company . "0.9.0"))
(defcustom company-ctags-check-tags-file-interval 30
"The interval (seconds) to check tags file.
Default value is 30 seconds."
:type 'integer)
(defcustom company-ctags-tags-file-name "TAGS"
"The name of tags file."
:type 'string)
(defcustom company-ctags-tag-name-valid-characters
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ$#@%_!*&1234567890"
"The characters of tag name. It's used for partition algorithm."
:type 'string)
(defcustom company-ctags-fuzzy-match-p nil
"If t, fuzzy match the candidates.
The input could match any part of the candidate instead of the beginning of
the candidate."
:type 'boolean)
(defvar company-ctags-modes
'(prog-mode
c-mode
objc-mode
c++-mode
java-mode
jde-mode
pascal-mode
perl-mode
python-mode
lua-mode
web-mode))
(defvar company-backends) ; avoid compiling warning
(defvar-local company-ctags-buffer-table-internal nil)
(defvar company-ctags-tags-file-caches nil
"The cached tags files.")
(defvar company-ctags-cached-candidates nil
"The cached candidates searched with certain prefix.")
(defconst company-ctags-fast-pattern
"\177\\([^\177\001\n]+\\)\001"
"Pattern to extract tag name created by Ctags only.")
(defconst company-ctags-slow-pattern
"\\([^\f\t\n\r()=,; ]*\\)[\f\t\n\r()=,; ]*\177\\\(?:\\([^\n\001]+\\)\001\\)?"
"Pattern to extract tag name created by Ctags/Etags.")
(defun company-ctags-find-table ()
"Find tags file."
(let* ((file (expand-file-name
company-ctags-tags-file-name
(locate-dominating-file (or buffer-file-name
default-directory)
company-ctags-tags-file-name))))
(when (and file (file-regular-p file))
(list file))))
(defun company-ctags-buffer-table ()
"Find buffer table."
(or (and company-ctags-use-main-table-list tags-table-list)
(or company-ctags-buffer-table-internal
(setq company-ctags-buffer-table-internal
(company-ctags-find-table)))))
(defun company-ctags-char-in-string-p (character string)
"Test if CHARACTER is in STRING."
(let (rlt (i 0) (len (length string)))
(while (and (not rlt) (< i len))
(setq rlt (eq (elt string i) character))
(setq i (1+ i)))
rlt))
(defun company-ctags-tag-name-character-p (character)
"Test if CHARACTER is in `company-ctags-tag-name-valid-characters'."
(company-ctags-char-in-string-p character
company-ctags-tag-name-valid-characters))
(defmacro company-ctags-push-tagname (tagname tagname-dict)
"Push TAGNAME into TAGNAME-DICT."
`(let ((c (elt ,tagname 0)))
(when (company-ctags-tag-name-character-p c)
(push ,tagname (gethash c ,tagname-dict)))))
(defun company-ctags-n-items (n tagnames)
"Return first N items of TAGNAMES."
(cond
((<= (length tagnames) n)
tagnames)
(t
(let (rlt (i 0))
(while (< i n)
(push (nth i tagnames) rlt)
(setq i (1+ i)))
(push " ..." rlt)
(nreverse rlt)))))
;;;###autoload
(defun company-ctags-debug-info ()
"Print all debug information."
(interactive)
(let* ((caches company-ctags-tags-file-caches)
(keys (hash-table-keys caches)))
(message "* cache contents")
(dolist (k keys)
(let* ((h (gethash k caches))
(timestamp (plist-get h :timestamp))
(filesize (plist-get h :filesize))
(dict (plist-get h :tagname-dict))
(dict-keys (hash-table-keys dict)))
(message "** key=%s timestamp=%s filesize=%s\n" k timestamp filesize)
(dolist (dk dict-keys)
(let* ((items (company-ctags-n-items 4 (gethash dk dict))))
(when (> (length items) 0)
(message " %s: %s" (string dk) items))))))))
(defun company-ctags-init-tagname-dict ()
"Initialize tagname dict."
(let* ((i 0)
(dict (make-hash-table))
(len (length company-ctags-tag-name-valid-characters)))
(while (< i len)
(puthash (elt company-ctags-tag-name-valid-characters i) '() dict)
(setq i (1+ i)))
dict))
(defun company-ctags-parse-tags (text &optional dict)
"Extract tag names from TEXT.
DICT is the existing lookup dictionary contains tag names.
If it's nil, return a dictionary, or else return the existing dictionary."
(let* ((start 0)
(case-fold-search company-ctags-ignore-case))
(unless dict (setq dict (company-ctags-init-tagname-dict)))
;; Code inside the loop should be optimized.
;; Please avoid calling lisp function inside the loop.
(cond
(company-ctags-support-etags
;; slow algorithm, need support both explicit and implicit tags name
(while (string-match company-ctags-slow-pattern text start)
(cond
((match-beginning 2)
;; There is an explicit tag name.
(company-ctags-push-tagname (substring text (match-beginning 2) (match-end 2))
dict))
(t
;; No explicit tag name. Backtrack a little,
;; and look for the implicit one.
(company-ctags-push-tagname (substring text (match-beginning 1) (match-end 1))
dict)))
(setq start (+ 4 (match-end 0)))))
(t
;; fast algorithm, support explicit tags name only
(while (string-match company-ctags-fast-pattern text start)
(company-ctags-push-tagname (substring text (match-beginning 1) (match-end 1))
dict)
(setq start (+ 4 (match-end 0))))))
dict))
(defun company-ctags-all-completions (string collection)
"Search match to STRING in COLLECTION to see if it begins with STRING.
If `company-ctags-fuzzy-match-p' is t, check if the match contains STRING."
(let ((case-fold-search company-ctags-ignore-case))
(cond
(company-ctags-fuzzy-match-p
(let* (rlt)
;; code should be efficient in side the this loop
(dolist (c collection)
(if (string-match string c) (push c rlt)))
rlt))
(t
(all-completions string collection)))))
(defun company-ctags-fetch-by-first-char (c prefix tagname-dict)
"Fetch candidates by first character C of PREFIX from TAGNAME-DICT."
(let* ((rlt (company-ctags-all-completions prefix (gethash c tagname-dict))))
(when company-ctags-ignore-case
(let (c2 (offset (- ?a ?A)))
(cond
((company-ctags-char-in-string-p c "abcdefghijklmnopqrstuvwxyz")
(setq c2 (- c offset)))
((company-ctags-char-in-string-p c "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
(setq c2 (+ c offset))))
(when c2
(setq rlt (nconc rlt (company-ctags-all-completions prefix (gethash c2 tagname-dict)))))))
rlt))
(defun company-ctags-all-candidates (prefix tagname-dict)
"Search for partial match to PREFIX in TAGNAME-DICT."
(cond
(company-ctags-fuzzy-match-p
(let* ((keys (hash-table-keys tagname-dict))
rlt)
;; search all hash tables
;; don't care the first character of prefix
(dolist (c keys)
(setq rlt (nconc rlt (company-ctags-fetch-by-first-char c prefix tagname-dict))))
rlt))
(t
(company-ctags-fetch-by-first-char (elt prefix 0) prefix tagname-dict))))
(defun company-ctags-load-tags-file (file static-p &optional force no-diff-prog)
"Load tags from FILE.
If STATIC-P is t, the corresponding tags file is read only once.
If FORCE is t, tags file is read without `company-ctags-tags-file-caches'.
If NO-DIFF-PROG is t, do NOT use diff on tags file.
This function return t if any tag file is reloaded."
(let* (raw-content
(file-info (and company-ctags-tags-file-caches
(gethash file company-ctags-tags-file-caches)))
(use-diff (and (not no-diff-prog)
file-info
(plist-get file-info :raw-content)
(executable-find diff-command)))
tagname-dict
reloaded)
(when (or force
(not file-info)
(and
;; the tags file is static and is already read into cache
;; so don't read it again
;; (not (plist-get file-info :static-p))
;; time to expire cache from tags file
(> (- (float-time (current-time))
(plist-get file-info :timestamp))
company-ctags-check-tags-file-interval)
;; When generating new tags file, file size could be
;; temporarily smaller than cached file size.
;; Don't reload tags file until new tags file is bigger.
(> (nth 7 (file-attributes file))
(plist-get file-info :filesize))))
;; Read file content
(setq reloaded t)
(cond
(use-diff
;; actually don't change raw-content attached to file-info
(setq raw-content (plist-get file-info :raw-content))
;; use diff to find the new tags
(let (diff-output)
(with-temp-buffer
(insert (plist-get file-info :raw-content))
;; when process finished, replace temp buffer with program output
(call-process-region (point-min) (point-max) diff-command t t nil "-ab" file "-")
(setq diff-output (buffer-string)))
;; compare old and new tags file, extract tag names from diff output which
;; should be merged with old tag names
(setq tagname-dict
(company-ctags-parse-tags diff-output
(plist-get file-info :tagname-dict)))))
(t
(unless company-ctags-quiet (message "Please be patient when loading %s" file))
(setq raw-content (with-temp-buffer
(insert-file-contents file)
(buffer-string)))
;; collect all tag names
(setq tagname-dict (company-ctags-parse-tags raw-content))
(unless company-ctags-quiet (message "%s is loaded." file))))
;; initialize hash table if needed
(unless company-ctags-tags-file-caches
(set 'company-ctags-tags-file-caches (make-hash-table :test #'equal)))
;; finalize tags file info
(puthash file
;; if the tags file is read only once, it will never be updated
;; by `diff-command', so don't need store original raw content
;; of tags file in order to save memory.
(list :raw-content (unless static-p raw-content)
:tagname-dict tagname-dict
:static-p static-p
:timestamp (float-time (current-time))
:filesize (nth 7 (file-attributes file)))
company-ctags-tags-file-caches))
reloaded))
(defun company-ctags--test-cached-candidates (prefix)
"Test PREFIX in `company-ctags-cached-candidates'."
(let* ((cands company-ctags-cached-candidates)
(key (plist-get cands :key))
(keylen (length key))
(case-fold-search company-ctags-ignore-case))
;; prefix is "hello" and cache's prefix "ell"
(and (>= (length prefix) keylen)
(if company-ctags-fuzzy-match-p (string-match key prefix)
;; key is the beginning of prefix
(string= (substring prefix 0 keylen) key)))))
(defun company-ctags--candidates (prefix)
"Get candidate with PREFIX."
(when (and prefix (> (length prefix) 0))
(let* ((file (and tags-file-name (file-truename tags-file-name)))
(completion-ignore-case company-ctags-ignore-case)
(all-tags-files (mapcar (lambda (f)
(file-truename f))
(delete-dups (append (if file (list file))
(company-ctags-buffer-table)))))
(extra-tags-files (ff-list-replace-env-vars company-ctags-extra-tags-files))
rlt)
;; load tags files, maybe
(dolist (f all-tags-files)
(when (and f (file-exists-p f))
(when (company-ctags-load-tags-file f
nil ; primary tags file, not static
nil
nil)
;; invalidate cached candidates if any tags file is reloaded
(setq company-ctags-cached-candidates nil))))
(when extra-tags-files
(dolist (f extra-tags-files)
(when (and f (file-exists-p f))
;; tags file in `company-ctags-extra-tags-files' is read only once.
(company-ctags-load-tags-file f
t ; static tags file, read only once
nil
nil))))
(cond
;; re-use cached candidates
((and (not company-ctags-fuzzy-match-p)
company-ctags-cached-candidates
(company-ctags--test-cached-candidates prefix))
(let* ((cands (plist-get company-ctags-cached-candidates :cands)))
(setq rlt (company-ctags-all-completions prefix cands))))
;; search candidates through tags files
(t
(dolist (f (nconc all-tags-files extra-tags-files))
(let* ((cache (gethash f company-ctags-tags-file-caches))
(tagname-dict (plist-get cache :tagname-dict)))
(when tagname-dict
(setq rlt (append rlt (company-ctags-all-candidates prefix tagname-dict))))))
;; fuzzy algorithm don't use caching algorithm
(unless company-ctags-fuzzy-match-p
(setq company-ctags-cached-candidates
;; clone the rlt into cache
(list :key prefix :cands (mapcar 'identity rlt))))))
;; cleanup
(if rlt (delete-dups rlt)))))
;;;###autoload
(defun company-ctags (command &optional arg &rest ignored)
"Completion backend of for ctags. Execute COMMAND with ARG and IGNORED."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-ctags))
(prefix (and (apply #'derived-mode-p company-ctags-modes)
(or (eq t company-ctags-everywhere)
(apply #'derived-mode-p company-ctags-everywhere)
(not (company-in-string-or-comment)))
(company-ctags-buffer-table)
(or (company-grab-symbol) 'stop)))
(candidates (company-ctags--candidates arg))
(location (let ((tags-table-list (company-ctags-buffer-table)))
(when (fboundp 'find-tag-noselect)
(save-excursion
(let ((buffer (find-tag-noselect arg)))
(cons buffer (with-current-buffer buffer (point))))))))
(ignore-case company-ctags-ignore-case)))
;;;###autoload
(defun company-ctags-replace-backend (backends)
"Replace `company-etags' with `company-ctags' in BACKENDS."
(let* (rlt)
(dolist (b backends)
(cond
((eq b 'company-etags)
(push 'company-ctags rlt))
((listp b)
(let* (children)
(dolist (c b)
(cond
((eq c 'company-etags)
(push 'company-ctags children))
(t
(push c children))))
(push (nreverse children) rlt)))
(t
(push b rlt))))
(nreverse rlt)))
;;;###autoload
(defun company-ctags-auto-setup ()
"Set up `company-backends'."
(setq company-backends
(company-ctags-replace-backend company-backends)))
(provide 'company-ctags)
;;; company-ctags.el ends here

87
site-lisp/extensions-local/dired-display-buffer.el Normal file
View File

@ -0,0 +1,87 @@
;; -*- coding: utf-8; -*-
;;; Require:
;;; Code:
(defcustom dired-display-buffer-switch-window t
"Switch focus to the newly created buffer window. nil to disable."
:type 'boolean
)
(defun ld-display-buffer (buffer-or-name alist direction &optional size pixelwise)
"BUFFER: The buffer that will be displayed.
ALIST: See the doc-string of `display-buffer' for more information.
DIRECTION: Must use one of these symbols: 'left 'right 'below 'above
SIZE: See the doc-string for `split-window'.
PIXELWISE: See the doc-string for `split-window'.
There are three possibilities:
- (1) If a window on the frame already displays the target buffer,
then just reuse the same window.
- (2) If there is already a window in the specified direction in relation
to the selected window, then display the target buffer in said window.
- (3) If there is no window in the specified direction, then create one
in that direction and display the target buffer in said window."
(let* ((buffer
(if (bufferp buffer-or-name)
buffer-or-name
(get-buffer buffer-or-name)))
(window
(cond
((get-buffer-window buffer (selected-frame)))
((window-in-direction direction))
(t
(split-window (selected-window) size direction pixelwise)))))
;; (window--display-buffer buffer window 'window alist display-buffer-mark-dedicated)
(window--display-buffer buffer window 'window alist)
(if dired-display-buffer-switch-window
(select-window window))
))
(defun dired-display-buffer (&optional direction alist)
"Display a dired-mode buffer or a file underneath point in a dired-mode buffer."
(interactive)
(let* ((file-or-dir (or (and (eq major-mode 'dired-mode) (dired-get-file-for-visit))
(read-directory-name "Directory: ")))
(buffer (find-file-noselect file-or-dir))
(direction
(if direction
direction
(let ((char (read-char-exclusive (concat
"["
(propertize "l" 'face '(:foreground "red"))
"]"
(propertize "eft" 'face '(:foreground "blue"))
" | ["
(propertize "r" 'face '(:foreground "red"))
"]"
(propertize "ight" 'face '(:foreground "blue"))
" | ["
(propertize "a" 'face '(:foreground "red"))
"]"
(propertize "bove" 'face '(:foreground "blue"))
" | ["
(propertize "b" 'face '(:foreground "red"))
"]"
(propertize "elow" 'face '(:foreground "blue"))))))
(cond
((eq char ?l)
'left)
((eq char ?r)
'right)
((eq char ?a)
'above)
((eq char ?b)
'below)
;;; FIXME: @lawlist may add a loop similar to `org-capture'
;;; whereby a new `read-char-exclusive' will be initiated if
;;; a user did not initially choose a valid option (l/r/a/b).
(t
(let ((debug-on-quit nil)
(msg (concat "dired-display-buffer: "
"You did not select l/r/a/b "
"-- exiting.")))
(signal 'quit `(,msg)))))))))
(ld-display-buffer buffer alist direction)))
(provide 'dired-display-buffer)
;;; dired-display-buffer.el ends here

273
site-lisp/extensions-local/dired-hacks-utils.el Normal file
View File

@ -0,0 +1,273 @@
;;; dired-hacks-utils.el --- Utilities and helpers for dired-hacks collection
;; Copyright (C) 2014-2015 Matúš Goljer
;; Author: Matúš Goljer <matus.goljer@gmail.com>
;; Maintainer: Matúš Goljer <matus.goljer@gmail.com>
;; Keywords: files
;; Version: 0.0.1
;; Created: 14th February 2014
;; Package-Requires: ((dash "2.5.0"))
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Utilities and helpers for `dired-hacks' collection of dired
;; improvements.
;; This package also provides these interactive functions:
;; * `dired-hacks-next-file' - go to next file, skipping empty and non-file lines
;; * `dired-hacks-previous-file' - go to previous file, skipping empty
;; and non-file lines
;; * `dired-utils-format-information-line-mode' - Format the information
;; (summary) line file sizes to be human readable (e.g. 1GB instead of 1048576).
;; See https://github.com/Fuco1/dired-hacks for the entire collection
;;; Code:
(require 'dash)
(require 'dired)
(defgroup dired-hacks ()
"Collection of useful dired additions."
:group 'dired
:prefix "dired-hacks-")
(defcustom dired-hacks-file-size-formatter #'file-size-human-readable
"The function used to format file sizes.
See `dired-utils-format-file-sizes'."
:type 'function
:group 'dired-hacks)
(defcustom dired-hacks-datetime-regexp
"\\sw\\sw\\sw....\\(?:[0-9][0-9]:[0-9][0-9]\\|.[0-9]\\{4\\}\\)"
"A regexp matching the date/time in the dired listing.
It is used to determine where the filename starts. It should
*not* match any characters after the last character of the
timestamp. It is assumed that the timestamp is preceded and
followed by at least one space character. You should only use
shy groups (prefixed with ?:) because the first group is used by
the font-lock to determine what portion of the name should be
colored."
:type 'regexp
:group 'dired-hacks)
(defalias 'dired-utils--string-trim
(if (and (require 'subr-x nil t)
(fboundp 'string-trim))
#'string-trim
(lambda (string)
(let ((s string))
(when (string-match "\\`[ \t\n\r]+" s)
(setq s (replace-match "" t t s)))
(when (string-match "[ \t\n\r]+\\'" s)
(setq s (replace-match "" t t s)))
s)))
"Trim STRING of trailing whitespace.
\(fn STRING)")
(defun dired-utils-get-filename (&optional localp)
"Like `dired-get-filename' but never signal an error.
Optional arg LOCALP with value `no-dir' means don't include
directory name in result."
(dired-get-filename localp t))
(defun dired-utils-get-all-files (&optional localp)
"Return all files in this dired buffer as a list.
LOCALP has same semantics as in `dired-get-filename'."
(save-excursion
(goto-char (point-min))
(let (r)
(while (= 0 (forward-line))
(--when-let (dired-utils-get-filename localp)
(push it r)))
(nreverse r))))
(defconst dired-utils-file-attributes-keywords
'(:isdir :nlinks :uid :gid :atime :mtime :ctime :size :modes :gidchg :inode :devnum)
"List of keywords to map with `file-attributes'.")
(defconst dired-utils-info-keywords
`(:name :issym :target ,@dired-utils-file-attributes-keywords)
"List of keywords available for `dired-utils-get-info'.")
(defun dired-utils--get-keyword-info (keyword)
"Get file information about KEYWORD."
(let ((filename (dired-utils-get-filename)))
(cl-case keyword
(:name filename)
(:isdir (file-directory-p filename))
(:issym (and (file-symlink-p filename) t))
(:target (file-symlink-p filename))
(t
(nth (-elem-index keyword dired-utils-file-attributes-keywords)
(file-attributes filename))))))
(defun dired-utils-get-info (&rest keywords)
"Query for info about the file at point.
KEYWORDS is a list of attributes to query.
When querying for one attribute, its value is returned. When
querying for more than one, a list of results is returned.
The available keywords are listed in
`dired-utils-info-keywords'."
(let ((attributes (mapcar 'dired-utils--get-keyword-info keywords)))
(if (> (length attributes) 1)
attributes
(car attributes))))
(defun dired-utils-goto-line (filename)
"Go to line describing FILENAME in listing.
Should be absolute file name matched against
`dired-get-filename'."
(goto-char (point-min))
(let (stop)
(while (and (not stop)
(= (forward-line) 0))
(when (equal filename (dired-utils-get-filename))
(setq stop t)
(dired-move-to-filename)))
stop))
(defun dired-utils-match-filename-regexp (filename alist)
"Match FILENAME against each car in ALIST and return first matched cons.
Each car in ALIST is a regular expression.
The matching is done using `string-match-p'."
(let (match)
(--each-while alist (not match)
(when (string-match-p (car it) filename)
(setq match it)))
match))
(defun dired-utils-match-filename-extension (filename alist)
"Match FILENAME against each car in ALIST and return first matched cons.
Each car in ALIST is a string representing file extension
*without* the delimiting dot."
(let (done)
(--each-while alist (not done)
(when (string-match-p (concat "\\." (regexp-quote (car it)) "\\'") filename)
(setq done it)))
done))
(defun dired-utils-format-information-line ()
"Format the disk space on the Dired information line."
(save-excursion
(goto-char (point-min))
(forward-line)
(let ((inhibit-read-only t)
(limit (line-end-position)))
(while (re-search-forward "\\(?:directory\\|available\\) \\(\\<[0-9]+$\\>\\)" nil t)
(replace-match
(save-match-data
(propertize (dired-utils--string-trim
(funcall dired-hacks-file-size-formatter
(* 1024 (string-to-number (match-string 1))) t))
'invisible 'dired-hide-details-information))
t nil nil 1)))))
;;; Predicates
(defun dired-utils-is-file-p ()
"Return non-nil if the line at point is a file or a directory."
(dired-utils-get-filename 'no-dir))
(defun dired-utils-is-dir-p ()
"Return non-nil if the line at point is a directory."
(--when-let (dired-utils-get-filename)
(file-directory-p it)))
;;; Interactive
;; TODO: add wrap-around option
(defun dired-hacks-next-file (&optional arg)
"Move point to the next file.
Optional prefix ARG says how many lines to move; default is one
line."
(interactive "p")
(unless arg (setq arg 1))
(if (< arg 0)
(dired-hacks-previous-file (- arg))
(--dotimes arg
(forward-line)
(while (and (or (not (dired-utils-is-file-p))
(get-text-property (point) 'invisible))
(= (forward-line) 0))))
(if (not (= (point) (point-max)))
(dired-move-to-filename)
(forward-line -1)
(dired-move-to-filename)
nil)))
(defun dired-hacks-previous-file (&optional arg)
"Move point to the previous file.
Optional prefix ARG says how many lines to move; default is one
line."
(interactive "p")
(unless arg (setq arg 1))
(if (< arg 0)
(dired-hacks-next-file (- arg))
(--dotimes arg
(forward-line -1)
(while (and (or (not (dired-utils-is-file-p))
(get-text-property (point) 'invisible))
(= (forward-line -1) 0))))
(if (not (= (point) (point-min)))
(dired-move-to-filename)
(dired-hacks-next-file)
nil)))
(defun dired-hacks-compare-files (file-a file-b)
"Test if two files FILE-A and FILE-B are the (probably) the same."
(interactive (let ((other-dir (dired-dwim-target-directory)))
(list (read-file-name "File A: " default-directory (car (dired-get-marked-files)) t)
(read-file-name "File B: " other-dir (with-current-buffer (cdr (assoc other-dir dired-buffers))
(car (dired-get-marked-files))) t))))
(let ((md5-a (with-temp-buffer
(shell-command (format "md5sum %s" file-a) (current-buffer))
(buffer-string)))
(md5-b (with-temp-buffer
(shell-command (format "md5sum %s" file-b) (current-buffer))
(buffer-string))))
(message "%s%sFiles are %s." md5-a md5-b
(if (equal (car (split-string md5-a))
(car (split-string md5-b)))
"probably the same" "different"))))
(define-minor-mode dired-utils-format-information-line-mode
"Toggle formatting of disk space in the Dired information line."
:group 'dired-utils
:lighter ""
(if dired-utils-format-information-line-mode
(add-hook 'dired-after-readin-hook #'dired-utils-format-information-line)
(remove-hook 'dired-after-readin-hook #'dired-utils-format-information-line)))
(provide 'dired-hacks-utils)
;;; dired-hacks-utils.el ends here

356
site-lisp/extensions-local/dired-narrow.el Normal file
View File

@ -0,0 +1,356 @@
;;; dired-narrow.el --- Live-narrowing of search results for dired
;; Copyright (C) 2014-2015 Matúš Goljer
;; Author: Matúš Goljer <matus.goljer@gmail.com>
;; Maintainer: Matúš Goljer <matus.goljer@gmail.com>
;; Version: 0.0.1
;; Created: 14th February 2014
;; Package-Requires: ((dash "2.7.0") (dired-hacks-utils "0.0.1"))
;; Keywords: files
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This package provides live filtering of files in dired buffers. In
;; general, after calling the respective narrowing function you type a
;; filter string into the minibuffer. After each change the changes
;; automatically reflect in the buffer. Typing C-g will cancel the
;; narrowing and restore the original view, typing RET will exit the
;; live filtering mode and leave the dired buffer in the narrowed
;; state. To bring it back to the original view, you can call
;; `revert-buffer' (usually bound to `g').
;; During the filtering process, several special functions are
;; available. You can customize the binding by changing
;; `dired-narrow-map'.
;; * `dired-narrow-next-file' (<down> or C-n) - move the point to the
;; next file
;; * `dired-narrow-previous-file' (<up> or C-p) - move the point to the
;; previous file
;; * `dired-narrow-enter-directory' (<right> or C-j) - descend into the
;; directory under point and immediately go back to narrowing mode
;; You can customize what happens after exiting the live filtering
;; mode by customizing `dired-narrow-exit-action'.
;; These narrowing functions are provided:
;; * `dired-narrow'
;; * `dired-narrow-regexp'
;; * `dired-narrow-fuzzy'
;; You can also create your own narrowing functions quite easily. To
;; define new narrowing function, use `dired-narrow--internal' and
;; pass it an apropriate filter. The filter should take one argument
;; which is the filter string from the minibuffer. It is then called
;; at each line that describes a file with point at the beginning of
;; the file name. If the filter returns nil, the file is removed from
;; the view. As an inspiration, look at the built-in functions
;; mentioned above.
;; See https://github.com/Fuco1/dired-hacks for the entire collection.
;;; Code:
(require 'dash)
(require 'dired-hacks-utils)
(require 'delsel)
(defgroup dired-narrow ()
"Live-narrowing of search results for dired."
:group 'dired-hacks
:prefix "dired-narrow-")
(defvar dired-narrow-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "<up>") 'dired-narrow-previous-file)
(define-key map (kbd "<down>") 'dired-narrow-next-file)
(define-key map (kbd "<right>") 'dired-narrow-enter-directory)
(define-key map (kbd "C-p") 'dired-narrow-previous-file)
(define-key map (kbd "C-n") 'dired-narrow-next-file)
(define-key map (kbd "C-j") 'dired-narrow-enter-directory)
(define-key map (kbd "C-g") 'minibuffer-keyboard-quit)
(define-key map (kbd "RET") 'exit-minibuffer)
(define-key map (kbd "<return>") 'exit-minibuffer)
map)
"Keymap used while `dired-narrow' is reading the pattern.")
(defcustom dired-narrow-exit-action 'ignore
"Function to call after exiting minibuffer.
Function takes no argument and is called with point over the file
we should act on."
:type '(choice (const :tag "Open file under point" dired-narrow-find-file)
(function :tag "Use custom function."))
:group 'dired-narrow)
(defcustom dired-narrow-exit-when-one-left nil
"If there is only one file left while narrowing,
exit minibuffer and call `dired-narrow-exit-action'."
:type 'boolean
:group 'dired-narrow)
(defcustom dired-narrow-enable-blinking t
"If non-nil, highlight the chosen file shortly.
Only works when `dired-narrow-exit-when-one-left' is non-nil."
:type 'boolean
:group 'dired-narrow)
(defcustom dired-narrow-blink-time 0.2
"How many seconds should a chosen file be highlighted."
:type 'number
:group 'dired-narrow)
(defface dired-narrow-blink
'((t :background "#eadc62"
:foreground "black"))
"The face used to highlight a chosen file
when `dired-narrow-exit-when-one-left' and `dired-narrow-enable-blinking' are true."
:group 'dired-narrow)
;; Utils
;; this is `gnus-remove-text-with-property'
(defun dired-narrow--remove-text-with-property (prop)
"Delete all text in the current buffer with text property PROP."
(let ((start (point-min))
end)
(unless (get-text-property start prop)
(setq start (next-single-property-change start prop)))
(while start
(setq end (text-property-any start (point-max) prop nil))
(delete-region start (or end (point-max)))
(setq start (when end
(next-single-property-change start prop))))))
(defvar dired-narrow-filter-function 'identity
"Filter function used to filter the dired view.")
(defvar dired-narrow--current-file nil
"Value of point just before exiting minibuffer.")
(defun dired-narrow--update (filter)
"Make the files not matching the FILTER invisible.
Return the count of visible files that are left after update."
(let ((inhibit-read-only t)
(visible-files-cnt 0))
(save-excursion
(goto-char (point-min))
;; TODO: we might want to call this only if the filter gets less
;; specialized.
(dired-narrow--restore)
(while (dired-hacks-next-file)
(if (funcall dired-narrow-filter-function filter)
(progn
(setq visible-files-cnt (1+ visible-files-cnt))
(when (fboundp 'dired-insert-set-properties)
(dired-insert-set-properties (line-beginning-position) (1+ (line-end-position)))))
(put-text-property (line-beginning-position) (1+ (line-end-position)) :dired-narrow t)
(put-text-property (line-beginning-position) (1+ (line-end-position)) 'invisible :dired-narrow))))
(unless (dired-hacks-next-file)
(dired-hacks-previous-file))
(unless (dired-utils-get-filename)
(dired-hacks-previous-file))
visible-files-cnt))
(defun dired-narrow--restore ()
"Restore the invisible files of the current buffer."
(let ((inhibit-read-only t))
(remove-list-of-text-properties (point-min) (point-max)
'(invisible :dired-narrow))
(when (fboundp 'dired-insert-set-properties)
(dired-insert-set-properties (point-min) (point-max)))))
(defun dired-narrow--blink-current-file ()
(let* ((beg (line-beginning-position))
(end (line-end-position))
(overlay (make-overlay beg end)))
(overlay-put overlay 'face 'dired-narrow-blink)
(redisplay)
(sleep-for dired-narrow-blink-time)
(discard-input)
(delete-overlay overlay)))
;; Live filtering
(defvar dired-narrow-buffer nil
"Dired buffer we are currently filtering.")
(defvar dired-narrow--minibuffer-content ""
"Content of the minibuffer during narrowing.")
(defun dired-narrow--minibuffer-setup ()
"Set up the minibuffer for live filtering."
(when dired-narrow-buffer
(add-hook 'post-command-hook 'dired-narrow--live-update nil :local)))
(add-hook 'minibuffer-setup-hook 'dired-narrow--minibuffer-setup)
(defun dired-narrow--live-update ()
"Update the dired buffer based on the contents of the minibuffer."
(when dired-narrow-buffer
(let ((current-filter (minibuffer-contents-no-properties))
visible-files-cnt)
(with-current-buffer dired-narrow-buffer
(setq visible-files-cnt
(unless (equal current-filter dired-narrow--minibuffer-content)
(dired-narrow--update current-filter)))
(setq dired-narrow--minibuffer-content current-filter)
(setq dired-narrow--current-file (dired-utils-get-filename))
(set-window-point (get-buffer-window (current-buffer)) (point))
(when (and dired-narrow-exit-when-one-left
visible-files-cnt
(= visible-files-cnt 1))
(when dired-narrow-enable-blinking
(dired-narrow--blink-current-file))
(exit-minibuffer))))))
(defun dired-narrow--internal (filter-function)
"Narrow a dired buffer to the files matching a filter.
The function FILTER-FUNCTION is called on each line: if it
returns non-nil, the line is kept, otherwise it is removed. The
function takes one argument, which is the current filter string
read from minibuffer."
(let ((dired-narrow-buffer (current-buffer))
(dired-narrow-filter-function filter-function)
(disable-narrow nil))
(unwind-protect
(progn
(dired-narrow-mode 1)
(add-to-invisibility-spec :dired-narrow)
(setq disable-narrow (read-from-minibuffer
(pcase dired-narrow-filter-function
('dired-narrow--regexp-filter
"Regex Filter:\s")
('dired-narrow--fuzzy-filter
"Fuzzy Filter:\s")
(_ "Filter:\s"))
nil dired-narrow-map))
(let ((inhibit-read-only t))
(dired-narrow--remove-text-with-property :dired-narrow))
;; If the file no longer exists, we can't do anything, so
;; set to nil
(unless (dired-utils-goto-line dired-narrow--current-file)
(setq dired-narrow--current-file nil)))
(with-current-buffer dired-narrow-buffer
(unless disable-narrow (dired-narrow-mode -1))
(remove-from-invisibility-spec :dired-narrow)
(dired-narrow--restore))
(when (and disable-narrow
dired-narrow--current-file
dired-narrow-exit-action)
(funcall dired-narrow-exit-action))
(cond
((equal disable-narrow "dired-narrow-enter-directory")
(dired-narrow--internal filter-function))))))
;; Interactive
(defun dired-narrow--regexp-filter (filter)
(condition-case nil
(string-match-p filter (dired-utils-get-filename 'no-dir))
;; Return t if your regexp is incomplete/has errors, thus
;; filtering nothing until you fix the regexp.
(invalid-regexp t)))
;;;###autoload
(defun dired-narrow-regexp ()
"Narrow a dired buffer to the files matching a regular expression."
(interactive)
(dired-narrow--internal 'dired-narrow--regexp-filter))
(defun dired-narrow--string-filter (filter)
(let ((words (split-string filter " ")))
(--all? (save-excursion (search-forward it (line-end-position) t)) words)))
(defun dired-narrow-next-file ()
"Move point to the next file."
(interactive)
(with-current-buffer dired-narrow-buffer
(dired-hacks-next-file)))
(defun dired-narrow-previous-file ()
"Move point to the previous file."
(interactive)
(with-current-buffer dired-narrow-buffer
(dired-hacks-previous-file)))
(defun dired-narrow-find-file ()
"Run `dired-find-file' or any remapped action on file under point."
(interactive)
(let ((function (or (command-remapping 'dired-find-file)
'dired-find-file)))
(funcall function)))
(defun dired-narrow-enter-directory ()
"Descend into directory under point and initiate narrowing."
(interactive)
(let ((inhibit-read-only t))
(erase-buffer)
(insert "dired-narrow-enter-directory"))
(exit-minibuffer))
;;;###autoload
(defun dired-narrow ()
"Narrow a dired buffer to the files matching a string.
If the string contains spaces, then each word is matched against
the file name separately. To succeed, all of them have to match
but the order does not matter.
For example \"foo bar\" matches filename \"bar-and-foo.el\"."
(interactive)
(dired-narrow--internal 'dired-narrow--string-filter))
(defun dired-narrow--fuzzy-filter (filter)
(re-search-forward
(mapconcat 'regexp-quote
(mapcar 'char-to-string (string-to-list filter))
".*")
(line-end-position) t))
;;;###autoload
(defun dired-narrow-fuzzy ()
"Narrow a dired buffer to the files matching a fuzzy string.
A fuzzy string is constructed from the filter string by inserting
\".*\" between each letter. This is then matched as regular
expression against the file name."
(interactive)
(dired-narrow--internal 'dired-narrow--fuzzy-filter))
(define-minor-mode dired-narrow-mode
"Minor mode for indicating when narrowing is in progress."
:lighter " dired-narrow")
(defun dired-narrow--disable-on-revert ()
"Disable `dired-narrow-mode' after revert."
(dired-narrow-mode -1))
(add-hook 'dired-after-readin-hook 'dired-narrow--disable-on-revert)
(provide 'dired-narrow)
;;; dired-narrow.el ends here

784
site-lisp/extensions-local/dired-subtree.el Normal file
View File

@ -0,0 +1,784 @@
;;; dired-subtree.el --- Insert subdirectories in a tree-like fashion
;; Copyright (C) 2014-2015 Matúš Goljer
;; Author: Matúš Goljer <matus.goljer@gmail.com>
;; Maintainer: Matúš Goljer <matus.goljer@gmail.com>
;; Keywords: files
;; Version: 0.0.1
;; Created: 25th February 2014
;; Package-Requires: ((dash "2.5.0") (dired-hacks-utils "0.0.1"))
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Introduction
;; ------------
;; The basic command to work with subdirectories in dired is `i',
;; which inserts the subdirectory as a separate listing in the active
;; dired buffer.
;; This package defines function `dired-subtree-insert' which instead
;; inserts the subdirectory directly below its line in the original
;; listing, and indent the listing of subdirectory to resemble a
;; tree-like structure (somewhat similar to tree(1) except the pretty
;; graphics). The tree display is somewhat more intuitive than the
;; default "flat" subdirectory manipulation provided by `i'.
;; There are several presentation options and faces you can customize
;; to change the way subtrees are displayed.
;; You can further remove the unwanted lines from the subtree by using
;; `k' command or some of the built-in "focusing" functions, such as
;; `dired-subtree-only-*' (see list below).
;; If you have the package `dired-filter', you can additionally filter
;; the subtrees with global or local filters.
;; A demo of basic functionality is available on youtube:
;; https://www.youtube.com/watch?v=z26b8HKFsNE
;; Interactive functions
;; ---------------------
;; Here's a list of available interactive functions. You can read
;; more about each one by using the built-in documentation facilities
;; of emacs. It is adviced to place bindings for these into a
;; convenient prefix key map, for example C-,
;; * `dired-subtree-insert'
;; * `dired-subtree-remove'
;; * `dired-subtree-toggle'
;; * `dired-subtree-cycle'
;; * `dired-subtree-revert'
;; * `dired-subtree-narrow'
;; * `dired-subtree-up'
;; * `dired-subtree-down'
;; * `dired-subtree-next-sibling'
;; * `dired-subtree-previous-sibling'
;; * `dired-subtree-beginning'
;; * `dired-subtree-end'
;; * `dired-subtree-mark-subtree'
;; * `dired-subtree-unmark-subtree'
;; * `dired-subtree-only-this-file'
;; * `dired-subtree-only-this-directory'
;; If you have package `dired-filter', additional command
;; `dired-subtree-apply-filter' is available.
;; See https://github.com/Fuco1/dired-hacks for the entire collection.
;;; Code:
(require 'dired-hacks-utils)
(require 'dash)
(require 'cl-lib)
(defgroup dired-subtree ()
"Insert subdirectories in a tree-like fashion."
:group 'dired-hacks
:prefix "dired-subtree-")
(defcustom dired-subtree-line-prefix " "
"A prefix put into each nested subtree.
The prefix is repeated \"depth\" times.
Alternatively, it can be a function taking one argument---the
depth---that creates the prefix."
:type '(choice string function)
:group 'dired-subtree)
(defcustom dired-subtree-line-prefix-face 'parents
"Specifies how the prefix is fontified."
:type '(radio
(const :tag "No face applied" nil)
(const :tag "Inherit from current subtree" subtree)
(const :tag "Inherit from all parents" parents))
:group 'dired-subtree)
(defcustom dired-subtree-use-backgrounds t
"When non-nil, add a background face to a subtree listing."
:type 'boolean
:group 'dired-subtree)
(defcustom dired-subtree-after-insert-hook ()
"Hook run at the end of `dired-subtree-insert'."
:type 'hook
:group 'dired-subtree)
(defcustom dired-subtree-after-remove-hook ()
"Hook run at the end of `dired-subtree-remove'."
:type 'hook
:group 'dired-subtree)
(defcustom dired-subtree-cycle-depth 3
"Default depth expanded by `dired-subtree-cycle'."
:type 'natnum
:group 'dired-subtree)
(defcustom dired-subtree-ignored-regexp
(concat "^" (regexp-opt vc-directory-exclusion-list) "$")
"Matching directories will not be expanded in `dired-subtree-cycle'."
:type 'regexp
:group 'dired-subtree)
(defgroup dired-subtree-faces ()
"Faces used in `dired-subtree'."
:group 'dired-subtree)
(defface dired-subtree-depth-1-face
'((t (:background "#252e30")))
"Background for depth 1 subtrees"
:group 'dired-subtree-faces)
(defface dired-subtree-depth-2-face
'((t (:background "#232a2b")))
"Background for depth 2 subtrees"
:group 'dired-subtree-faces)
(defface dired-subtree-depth-3-face
'((t (:background "#212627")))
"Background for depth 3 subtrees"
:group 'dired-subtree-faces)
(defface dired-subtree-depth-4-face
'((t (:background "#1e2223")))
"Background for depth 4 subtrees"
:group 'dired-subtree-faces)
(defface dired-subtree-depth-5-face
'((t (:background "#1c1d1e")))
"Background for depth 5 subtrees"
:group 'dired-subtree-faces)
(defface dired-subtree-depth-6-face
'((t (:background "#1a191a")))
"Background for depth 6 subtrees"
:group 'dired-subtree-faces)
(defvar dired-subtree-overlays nil
"Subtree overlays in this buffer.")
(make-variable-buffer-local 'dired-subtree-overlays)
;;; Overlay manipulation
;; Maybe we should abstract the overlay-foo into some subtree
;; functions instead!!!
(defun dired-subtree--remove-overlay (ov)
"Remove dired-subtree overlay OV."
(setq dired-subtree-overlays
(--remove (equal it ov) dired-subtree-overlays))
(delete-overlay ov))
(defun dired-subtree--remove-overlays (ovs)
"Remove dired-subtree overlays OVS."
(mapc 'dired-subtree--remove-overlay ovs))
(defun dired-subtree--cleanup-overlays ()
"Remove the `nil' values from `dired-subtree-overlays'."
(setq dired-subtree-overlays
(--remove (not (overlay-buffer it)) dired-subtree-overlays)))
(defun dired-subtree--get-all-ovs ()
"Get all dired-subtree overlays in this buffer."
(--filter (overlay-get it 'dired-subtree-depth) (overlays-in (point-min) (point-max))))
(defun dired-subtree--get-all-ovs-at-point (&optional p)
"Get all dired-subtree overlays at point P."
(setq p (or p (point)))
(--filter (overlay-get it 'dired-subtree-depth) (overlays-at (point))))
(defun dired-subtree--get-ovs-in (&optional beg end)
"Get all dired-subtree overlays between BEG and END.
BEG and END default to the region spanned by overlay at point."
(when (not beg)
(let ((ov (dired-subtree--get-ov)))
(setq beg (overlay-start ov))
(setq end (overlay-end ov))))
(--filter (and (overlay-get it 'dired-subtree-depth)
(>= (overlay-start it) beg)
(<= (overlay-end it) end))
(overlays-in (point-min) (point-max))))
(defun dired-subtree--get-ov (&optional p)
"Get the parent subtree overlay at point."
(setq p (or p (point)))
(car (--sort (> (overlay-get it 'dired-subtree-depth)
(overlay-get other 'dired-subtree-depth))
(dired-subtree--get-all-ovs-at-point p))))
(defun dired-subtree--get-depth (ov)
"Get subtree depth."
(or (and ov (overlay-get ov 'dired-subtree-depth)) 0))
;;; helpers
(defvar dired-subtree-preserve-properties '(dired-subtree-filter)
"Properties that should be preserved between read-ins.")
(defun dired-subtree--after-readin (&optional subtrees)
"Insert the SUBTREES again after dired buffer has been reverted.
If no SUBTREES are specified, use `dired-subtree-overlays'."
(-when-let (subtrees-to-process (or subtrees dired-subtree-overlays))
(let* ((ovs-by-depth (--sort (< (car it) (car other))
(--group-by (overlay-get it 'dired-subtree-depth)
subtrees-to-process)))
(sorted-ovs (--map (cons (car it)
(--map (-cons* it
(overlay-get it 'dired-subtree-name)
(-map (lambda (x) (cons x (overlay-get it x)))
dired-subtree-preserve-properties)) (cdr it)))
ovs-by-depth)))
;; (depth (path1 ov1 (prop1 . value1) (prop2 . value2)) (path2 ...))
(--each sorted-ovs
(--each (cdr it)
(when (dired-utils-goto-line (cadr it))
(dired-subtree--remove-overlay (car it))
(dired-subtree-insert)
(let ((ov (dired-subtree--get-ov)))
(--each (cddr it)
(overlay-put ov (car it) (cdr it)))
(dired-subtree--filter-subtree ov))))))))
(defun dired-subtree--after-insert ()
"After inserting the subtree, setup dired-details/dired-hide-details-mode."
(if (fboundp 'dired-insert-set-properties)
(let ((inhibit-read-only t)
(ov (dired-subtree--get-ov)))
(dired-insert-set-properties (overlay-start ov) (overlay-end ov)))
(when (featurep 'dired-details)
(dired-details-delete-overlays)
(dired-details-activate))))
(add-hook 'dired-after-readin-hook 'dired-subtree--after-readin)
(add-hook 'dired-subtree-after-insert-hook 'dired-subtree--after-insert)
(defun dired-subtree--unmark ()
"Unmark a file without moving point."
(save-excursion (dired-unmark 1)))
(defun dired-subtree--dired-line-is-directory-or-link-p ()
"Return non-nil if line under point is a directory or symlink"
;; We've replaced `file-directory-p' with the regexp test to
;; speed up filters over TRAMP. So long as dired/ls format
;; doesn't change, we're good.
;; 'd' for directories, 'l' for potential symlinks to directories.
(save-excursion (beginning-of-line) (looking-at "..[dl]")))
(defun dired-subtree--is-expanded-p ()
"Return non-nil if directory under point is expanded."
(save-excursion
(when (dired-utils-get-filename)
(let ((depth (dired-subtree--get-depth (dired-subtree--get-ov))))
(dired-next-line 1)
(< depth (dired-subtree--get-depth (dired-subtree--get-ov)))))))
(defmacro dired-subtree-with-subtree (&rest forms)
"Run FORMS on each file in this subtree."
(declare (debug (body)))
`(save-excursion
(dired-subtree-beginning)
,@forms
(while (dired-subtree-next-sibling)
,@forms)))
;;;; Interactive
;;;###autoload
(defun dired-subtree-narrow ()
"Narrow the buffer to this subtree."
(interactive)
(-when-let (ov (dired-subtree--get-ov))
(narrow-to-region (overlay-start ov)
(overlay-end ov))))
;;; Navigation
;; make the arguments actually do something
;;;###autoload
(defun dired-subtree-up (&optional arg)
"Jump up one directory."
(interactive "p")
(-when-let (ov (dired-subtree--get-ov))
(goto-char (overlay-start ov))
(dired-previous-line 1)))
;;;###autoload
(defun dired-subtree-down (&optional arg)
"Jump down one directory."
(interactive "p")
(-when-let* ((p (point))
(ov (car (--sort
(< (overlay-start it)
(overlay-start other))
(--remove
(< (overlay-start it) p)
(dired-subtree--get-all-ovs))))))
(goto-char (overlay-start ov))
(dired-move-to-filename)))
;;;###autoload
(defun dired-subtree-next-sibling (&optional arg)
"Go to the next sibling."
(interactive "p")
(let ((current-ov (dired-subtree--get-ov)))
(dired-next-line 1)
(let ((new-ov (dired-subtree--get-ov)))
(cond
((not (dired-utils-is-file-p))
nil)
((< (dired-subtree--get-depth current-ov)
(dired-subtree--get-depth new-ov))
(goto-char (overlay-end new-ov))
(dired-move-to-filename)
t)
((> (dired-subtree--get-depth current-ov)
(dired-subtree--get-depth new-ov))
;; add option to either go to top or stay at the end
(dired-previous-line 1)
nil)
(t t)))))
;;;###autoload
(defun dired-subtree-previous-sibling (&optional arg)
"Go to the previous sibling."
(interactive "p")
(let ((current-ov (dired-subtree--get-ov)))
(dired-previous-line 1)
(let ((new-ov (dired-subtree--get-ov)))
(cond
;; this will need better handlign if we have inserted
;; subdirectories
((not (dired-utils-is-file-p))
nil)
((< (dired-subtree--get-depth current-ov)
(dired-subtree--get-depth new-ov))
(goto-char (overlay-start new-ov))
(dired-previous-line 1)
t)
((> (dired-subtree--get-depth current-ov)
(dired-subtree--get-depth new-ov))
;; add option to either go to top or stay at the end
(dired-next-line 1)
nil)
(t t)))))
;;;###autoload
(defun dired-subtree-beginning ()
"Go to the first file in this subtree."
(interactive)
(let ((ov (dired-subtree--get-ov)))
(if (not ov)
;; do something when not in subtree
t
(goto-char (overlay-start ov))
(dired-move-to-filename))))
;;;###autoload
(defun dired-subtree-end ()
"Go to the first file in this subtree."
(interactive)
(let ((ov (dired-subtree--get-ov)))
(if (not ov)
;; do something when not in subtree
t
(goto-char (overlay-end ov))
(dired-previous-line 1))))
;;; Marking
;;;###autoload
(defun dired-subtree-mark-subtree (&optional all)
"Mark all files in this subtree.
With prefix argument mark all the files in subdirectories
recursively."
(interactive "P")
(save-excursion
(if all
(let ((beg (save-excursion
(dired-subtree-beginning)
(point)))
(end (save-excursion
(dired-subtree-end)
(point))))
(dired-mark-files-in-region
(progn (goto-char beg) (line-beginning-position))
(progn (goto-char end) (line-end-position))))
(dired-subtree-beginning)
(save-excursion (dired-mark 1))
(while (dired-subtree-next-sibling)
(save-excursion (dired-mark 1))))))
;;;###autoload
(defun dired-subtree-unmark-subtree (&optional all)
"Unmark all files in this subtree.
With prefix argument unmark all the files in subdirectories
recursively."
(interactive)
(let ((dired-marker-char ? ))
(dired-subtree-mark-subtree all)))
;;; Insertion/deletion
;;;###autoload
(defun dired-subtree-revert ()
"Revert the subtree.
This means reinserting the content of this subtree and all its
children."
(interactive)
(let ((inhibit-read-only t)
(file-name (dired-utils-get-filename)))
(-when-let* ((ov (dired-subtree--get-ov))
(ovs (dired-subtree--get-ovs-in)))
(dired-subtree-up)
(delete-region (overlay-start ov) (overlay-end ov))
(dired-subtree--after-readin ovs)
(when file-name
(dired-utils-goto-line file-name)))))
(defun dired-subtree--readin (dir-name)
"Read in the directory.
Return a string suitable for insertion in `dired' buffer."
(with-temp-buffer
(insert-directory dir-name dired-listing-switches nil t)
(delete-char -1)
(goto-char (point-min))
(delete-region
(progn (beginning-of-line) (point))
(progn (forward-line
(if (save-excursion
(forward-line 1)
(end-of-line)
(looking-back "\\."))
3 1)) (point)))
(insert " ")
(while (= (forward-line) 0)
(insert " "))
(delete-char -2)
(buffer-string)))
;;;###autoload
(defun dired-subtree-insert ()
"Insert subtree under this directory."
(interactive)
(when (and (dired-subtree--dired-line-is-directory-or-link-p)
(not (dired-subtree--is-expanded-p)))
(let* ((dir-name (dired-get-filename nil))
(listing (dired-subtree--readin (file-name-as-directory dir-name)))
beg end)
(read-only-mode -1)
(move-end-of-line 1)
;; this is pretty ugly, I'm sure it can be done better
(save-excursion
(insert listing)
(setq end (+ (point) 2)))
(newline)
(setq beg (point))
(let ((inhibit-read-only t))
(remove-text-properties (1- beg) beg '(dired-filename)))
(let* ((ov (make-overlay beg end))
(parent (dired-subtree--get-ov (1- beg)))
(depth (or (and parent (1+ (overlay-get parent 'dired-subtree-depth)))
1))
(face (intern (format "dired-subtree-depth-%d-face" depth))))
(when dired-subtree-use-backgrounds
(overlay-put ov 'face face))
;; refactor this to some function
(overlay-put ov 'line-prefix
(if (stringp dired-subtree-line-prefix)
(if (not dired-subtree-use-backgrounds)
(apply 'concat (-repeat depth dired-subtree-line-prefix))
(cond
((eq nil dired-subtree-line-prefix-face)
(apply 'concat
(-repeat depth dired-subtree-line-prefix)))
((eq 'subtree dired-subtree-line-prefix-face)
(concat
dired-subtree-line-prefix
(propertize
(apply 'concat
(-repeat (1- depth) dired-subtree-line-prefix))
'face face)))
((eq 'parents dired-subtree-line-prefix-face)
(concat
dired-subtree-line-prefix
(apply 'concat
(--map
(propertize dired-subtree-line-prefix
'face
(intern (format "dired-subtree-depth-%d-face" it)))
(number-sequence 1 (1- depth))))))))
(funcall dired-subtree-line-prefix depth)))
(overlay-put ov 'dired-subtree-name dir-name)
(overlay-put ov 'dired-subtree-parent parent)
(overlay-put ov 'dired-subtree-depth depth)
(overlay-put ov 'evaporate t)
(push ov dired-subtree-overlays))
(goto-char beg)
(dired-move-to-filename)
(read-only-mode 1)
(when (bound-and-true-p dired-filter-mode) (dired-filter-mode 1))
(run-hooks 'dired-subtree-after-insert-hook))))
;;;###autoload
(defun dired-subtree-remove ()
"Remove subtree at point."
(interactive)
(-when-let* ((ov (dired-subtree--get-ov))
(ovs (dired-subtree--get-ovs-in
(overlay-start ov)
(overlay-end ov))))
(let ((inhibit-read-only t))
(dired-subtree-up)
(delete-region (overlay-start ov)
(overlay-end ov))
(dired-subtree--remove-overlays ovs)))
(run-hooks 'dired-subtree-after-remove-hook))
;;;###autoload
(defun dired-subtree-toggle ()
"Insert subtree at point or remove it if it was not present."
(interactive)
(if (dired-subtree--is-expanded-p)
(progn
(dired-next-line 1)
(dired-subtree-remove)
;; #175 fixes the case of the first line in dired when the
;; cursor jumps to the header in dired rather then to the
;; first file in buffer
(when (bobp)
(dired-next-line 1)))
(save-excursion (dired-subtree-insert))))
(defun dired-subtree--insert-recursive (depth max-depth)
"Insert full subtree at point."
(save-excursion
(let ((name (dired-get-filename nil t)))
(when (and name (file-directory-p name)
(<= depth (or max-depth depth))
(or (= 1 depth)
(not (string-match-p dired-subtree-ignored-regexp
(file-name-nondirectory name)))))
(if (dired-subtree--is-expanded-p)
(dired-next-line 1)
(dired-subtree-insert))
(dired-subtree-end)
(dired-subtree--insert-recursive (1+ depth) max-depth)
(while (dired-subtree-previous-sibling)
(dired-subtree--insert-recursive (1+ depth) max-depth))))))
(defvar dired-subtree--cycle-previous nil
"Remember previous action for `dired-subtree-cycle'")
;;;###autoload
(defun dired-subtree-cycle (&optional max-depth)
"Org-mode like cycle visibility:
1) Show subtree
2) Show subtree recursively (if previous command was cycle)
3) Remove subtree
Numeric prefix will set max depth"
(interactive "P")
(save-excursion
(cond
;; prefix - show subtrees up to max-depth
(max-depth
(when (dired-subtree--is-expanded-p)
(dired-next-line 1)
(dired-subtree-remove))
(dired-subtree--insert-recursive 1 (if (integerp max-depth) max-depth nil))
(setq dired-subtree--cycle-previous :full))
;; if directory is not expanded, expand one level
((not (dired-subtree--is-expanded-p))
(dired-subtree-insert)
(setq dired-subtree--cycle-previous :insert))
;; hide if previous command was not cycle or tree was fully expanded
((or (not (eq last-command 'dired-subtree-cycle))
(eq dired-subtree--cycle-previous :full))
(dired-next-line 1)
(dired-subtree-remove)
(setq dired-subtree--cycle-previous :remove))
(t
(dired-subtree--insert-recursive 1 dired-subtree-cycle-depth)
(setq dired-subtree--cycle-previous :full)))))
(defun dired-subtree--filter-up (keep-dir kill-siblings)
(save-excursion
(let (ov)
(save-excursion
(while (dired-subtree-up))
(dired-next-line 1)
(dired-subtree-mark-subtree t))
(if keep-dir
(dired-subtree-unmark-subtree)
(dired-subtree--unmark))
(while (and (dired-subtree-up)
(> (dired-subtree--get-depth (dired-subtree--get-ov)) 0))
(if (not kill-siblings)
(dired-subtree--unmark)
(dired-subtree--unmark)
(let ((here (point)))
(dired-subtree-with-subtree
(when (and (dired-subtree--is-expanded-p)
(/= (point) here))
(dired-subtree--unmark)
(save-excursion
(dired-next-line 1)
(dired-subtree-unmark-subtree t)))))))
(dired-do-kill-lines)
(dired-subtree--cleanup-overlays))))
;;;###autoload
(defun dired-subtree-only-this-file (&optional arg)
"Remove all the siblings on the route from this file to the top-most directory.
With ARG non-nil, do not remove expanded directories in parents."
(interactive "P")
(dired-subtree--filter-up nil arg))
;;;###autoload
(defun dired-subtree-only-this-directory (&optional arg)
"Remove all the siblings on the route from this directory to the top-most directory.
With ARG non-nil, do not remove expanded directories in parents."
(interactive "P")
(dired-subtree--filter-up t arg))
;;; filtering
(defun dired-subtree--filter-update-bs (ov)
"Update the local filter list.
This function assumes that `dired-filter-stack' is dynamically
bound to relevant value."
(let* ((filt (dired-filter--describe-filters))
(before-str (if (equal filt "") nil (concat " Local filters: " filt "\n"))))
(overlay-put ov 'before-string before-str)))
(defun dired-subtree--filter-subtree (ov)
"Run the filter for this subtree.
It is only safe to call this from readin.
This depends on `dired-filter' package."
(when (featurep 'dired-filter)
(let ((dired-filter-stack (overlay-get ov 'dired-subtree-filter)))
(save-restriction
(widen)
(dired-subtree-narrow)
(dired-filter--expunge)
(dired-subtree--filter-update-bs ov)))))
;;;###autoload
(defun dired-subtree-apply-filter ()
"Push a local filter for this subtree.
This depends on `dired-filter' package.
It works exactly the same as global dired filters, only
restricted to a subtree. The global filter is also applied to
the subtree. The filter action is read from `dired-filter-map'."
(interactive)
(when (featurep 'dired-filter)
(-when-let (ov (dired-subtree--get-ov))
(let ((dired-filter-stack (overlay-get ov 'dired-subtree-filter))
(glob (current-global-map))
(loc (current-local-map))
cmd)
(cl-flet ((dired-filter--update
()
(save-restriction
(overlay-put ov 'dired-subtree-filter dired-filter-stack)
(widen)
(dired-subtree-revert)
(dired-subtree--filter-update-bs ov))))
(unwind-protect
(progn
(use-global-map dired-filter-map)
(use-local-map nil)
(setq cmd (key-binding (read-key-sequence "Choose filter action: "))))
(use-global-map glob)
(use-local-map loc))
(let ((p (point))
(beg (overlay-start ov))
(current-file (dired-utils-get-filename)))
(unwind-protect
(call-interactively cmd)
(unless (dired-utils-goto-line current-file)
(goto-char beg)
(forward-line)
(goto-char (min p (1- (overlay-end (dired-subtree--get-ov)))))
(dired-move-to-filename)))))))))
;;; Here we redefine a couple of functions from dired.el to make them
;;; subtree-aware
;; If the point is in a subtree, we need to provide a proper
;; directory, not the one that would come from `dired-subdir-alist'.
(defun dired-current-directory (&optional localp)
"Return the name of the subdirectory to which this line belongs.
This returns a string with trailing slash, like `default-directory'.
Optional argument means return a file name relative to `default-directory'."
(let ((here (point))
(alist (or dired-subdir-alist
;; probably because called in a non-dired buffer
(error "No subdir-alist in %s" (current-buffer))))
elt dir)
(while alist
(setq elt (car alist)
dir (car elt)
;; use `<=' (not `<') as subdir line is part of subdir
alist (if (<= (dired-get-subdir-min elt) here)
nil ; found
(cdr alist))))
;; dired-subdir: modify dir here if we are in a "subtree" view
(-when-let (parent (dired-subtree--get-ov))
(setq dir (concat (overlay-get parent 'dired-subtree-name) "/")))
;; end
(if localp
(dired-make-relative dir default-directory)
dir)))
;; Since the tree-inserted directory is not in the dired-subdir-alist,
;; we need to guard against nil.
(defun dired-get-subdir ()
;;"Return the subdir name on this line, or nil if not on a headerline."
;; Look up in the alist whether this is a headerline.
(save-excursion
(let ((cur-dir (dired-current-directory)))
(beginning-of-line) ; alist stores b-o-l positions
(and (zerop (- (point)
(or (dired-get-subdir-min
(assoc cur-dir
dired-subdir-alist))
0))) ;; dired-subtree: return zero if current
;; dir is not in `dired-subdir-alist'.
cur-dir))))
(provide 'dired-subtree)
;;; dired-subtree.el ends here

126
site-lisp/extensions-local/echo-keys.el Normal file
View File

@ -0,0 +1,126 @@
;; -*- coding: utf-8; -*-
;;; Require:
(require 'cl-lib)
;;; Code:
(defcustom echo-keys-last-record nil
"Last command processed by 'echo-keys'."
:type 'string
:group 'echo-keys)
(defcustom echo-keys-last-record-count 0
"Number of times the `echo-keys-last-record` command was repeated."
:type 'integer
:group 'echo-keys)
(defcustom echo-key-window-width 40
"Default width of the *echo-keys* window."
:type 'integer
:group 'echo-keys)
(defcustom echo-key-password-protection nil
"Temporarily disable echo key for password input."
:type 'boolean
:group 'echo-keys)
(defcustom echo-key-coallesce-repeats t
"If 't', show <key> <command> [<echo-keys-last-record-count> times].
If 'nil', show <key> <commands> n lines."
:type 'boolean
:group 'echo-keys)
(defun echo-keys ()
(let ((deactivate-mark deactivate-mark)
(keys (this-command-keys)))
(when (and keys
(not (eq (current-buffer) (get-buffer "*echo-keys*")))
(not echo-key-password-protection))
(save-excursion
(with-current-buffer (get-buffer-create "*echo-keys*")
(goto-char (point-max))
(if (eql this-command 'self-insert-command)
(let ((desc (key-description keys)))
(if (= 1 (length desc))
(insert desc)
(insert " " desc " "))
(setf echo-keys-last-record this-command
echo-keys-last-record-count 1))
(if (and echo-key-coallesce-repeats
(eql echo-keys-last-record this-command))
(progn
(incf echo-keys-last-record-count)
;; update the last line
(forward-line -1)
(if (= 2 echo-keys-last-record-count)
(progn
(end-of-line)
(insert (format " [%d times]" echo-keys-last-record-count)))
(save-match-data
(when (re-search-forward " \\[\\([0-9]+\\) times\\]" nil t)
(delete-region (match-beginning 1) (match-end 1))
(goto-char (match-beginning 1))
(insert (format "%d" echo-keys-last-record-count)))))
(forward-line 1))
(progn
(insert (if (eq 'self-insert-command echo-keys-last-record)
"\n"
"")
(format "%-12s %s\n"
(key-description keys)
this-command))
(setf echo-keys-last-record this-command
echo-keys-last-record-count 1))))
(dolist (window (window-list))
(when (eq (window-buffer window) (current-buffer))
(with-selected-window window
;; We need to use both to get the effect.
(set-window-point window (point))
(end-of-buffer)))))))))
(defun toggle-echo-keys ()
"Toggle displaying the *echo-key* buffer."
(interactive)
(if (member 'echo-keys (default-value 'pre-command-hook))
(let ((echo-buffer (get-buffer "*echo-keys*")))
(remove-hook 'pre-command-hook 'echo-keys)
(dolist (window (window-list))
(when (eq (window-buffer window) echo-buffer)
(delete-window window))))
(progn
(delete-other-windows)
(split-window nil (- (window-width) echo-key-window-width) t)
(other-window 1)
(switch-to-buffer (get-buffer-create "*echo-keys*"))
(unless (eq major-mode 'echo-keys-mode)
(echo-keys-mode))
(toggle-truncate-lines +1)
(set-window-dedicated-p (selected-window) t)
(other-window 1)
(add-hook 'pre-command-hook 'echo-keys))))
(defadvice echo-key--read-passwd--disable (before read-passwd)
(message "echo-key--read-passwd--disable")
(setf echo-key-password-protection t))
(defadvice echo-key--read-passwd--enable (after read-passwd)
(message "echo-key--read-passwd--enable")
(setf echo-key-password-protection nil))
(defun echo-keys-clean ()
"Erase the `*echo-keys*' buffer."
(interactive)
(with-current-buffer "*echo-keys*"
(erase-buffer)))
(defvar echo-keys-mode-map
(let ((ek-mode-map (make-sparse-keymap)))
(define-key ek-mode-map (kbd "C-c e e") #'toggle-echo-keys)
(define-key ek-mode-map (kbd "C-c e c") #'echo-keys-clean)
ek-mode-map))
(define-derived-mode echo-keys-mode fundamental-mode "Echo-keys"
"Major mode for echo-keys.")
(provide 'echo-keys)
;;; echo-keys.el ends here.

21
site-lisp/extensions-local/evals.el Normal file
View File

@ -0,0 +1,21 @@
;; -*- coding: utf-8; -*-
;;; Require:
;;; Code:
(defun ld-eval-elisp-to-next-line ()
"Replace the preceding sexp with its value."
(interactive)
(let ((value (eval (elisp--preceding-sexp))))
(newline-and-indent)
(insert (format "%S" value))))
(defun ld-eval-elisp-and-replace ()
"Replace the preceding sexp with its value."
(interactive)
(let ((value (eval (elisp--preceding-sexp))))
(backward-kill-sexp)
(insert (format "%S" value))))
(provide 'evals)
;;; evals.el ends here

81
site-lisp/extensions-local/force-indent.el Normal file
View File

@ -0,0 +1,81 @@
;; -*- coding: utf-8; -*-
;;; Require:
;;; Code:
;; use variable 'tab-width' value as indent size
(defun force-indent-line ()
(let (col)
(save-excursion
(back-to-indentation)
(setq col (+ (current-column) tab-width))
(indent-line-to col))
(when (< (current-column) col)
(back-to-indentation))))
(defun indent-line ()
(interactive)
(let ((bt (save-excursion
(back-to-indentation)
(current-column))))
(cond
((< (current-column) bt)
(back-to-indentation))
((looking-at "\\s-*\n")
(let ((col (save-excursion
(forward-line -1)
(back-to-indentation)
(current-column))))
(if (< (current-column) col)
(indent-line-to col)
(force-indent-line))))
(t
(force-indent-line)))))
(defun un-indent-line ()
(interactive)
(let (col)
(save-excursion
(back-to-indentation)
(setq col (- (current-column) tab-width))
(when (>= col 0)
(indent-line-to col)))))
(defun indent-region (start stop)
(interactive "r")
(setq stop (copy-marker stop))
(goto-char start)
(while (< (point) stop)
(unless (and (bolp) (eolp))
(force-indent-line))
(forward-line 1)))
(defun un-indent-region (start stop)
(interactive "r")
(setq stop (copy-marker stop))
(goto-char start)
(while (< (point) stop)
(unless (and (bolp) (eolp))
(un-indent-line))
(forward-line 1)))
(defun ld-indent ()
(interactive)
(if (use-region-p)
(save-excursion
(indent-region (region-beginning) (region-end))
(setq deactivate-mark nil))
(indent-line)))
(defun ld-un-indent ()
(interactive)
(if (use-region-p)
(save-excursion
(un-indent-region (region-beginning) (region-end))
(setq deactivate-mark nil))
(un-indent-line)))
(provide 'force-indent)
;;; force-indent.el ends here

93
site-lisp/extensions-local/frame-restore.el Normal file
View File

@ -0,0 +1,93 @@
;;; frame-restore.el --- save/restore frame size&position at shutdown/startup
;; Copyright (C) 2002 by Free Software Foundation, Inc.
;; Author: Patrick Anderson
;; Version: 1.3
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;; ChangeLog
;; 1.3: simplified install (now just copy one line to .emacs, and eval the next)
;; 1.3: added checks for running in terminal
;; 1.3: added checks for running on non-w32
;; 1.2: added font save/restore
;; 1.1: added more descriptive, correct installation docs
;;;installation:
;;1. put this file in your load path and add to your .emacs file (as the last thing) (without the semicolon):
;;(require 'frame-restore)
;;2. now evaluate the next line (don't uncomment it) [by putting the cursor at the end and pressing C-xC-e]
;;(progn (require 'desktop) (customize-set-variable 'desktop-enable t) (desktop-save "~/") (require 'frame-restore))
;;3. now change your font using S-down-mouse-1, adjust your frame size, then shutdown/restart emacs to test.
;;once installed, i never have problems, but before that, it seems possible to get into strange states. if that happens try:
;;1. shutdown emacs
;;2. delete .emacs.desktop
;;3. restart
;;4. follow normal install
;;since the font is stored here, don't also store it through a customization of the 'default' face. you may customize that face, just make sure the "Font Family" attribute box is unchecked.
;;;Code:
(require 'cl-lib)
;this must be global - as that is how desktop-globals-to-save works
;(defvar final-frame-params '((frame-parameter (selected-frame) 'font) 50 50 150 50 nil)) ;font, left, top, width, height, maximized
(defvar final-frame-params '("-adobe-courier-medium-r-normal--*-120-*-*-m-*-iso8859-1" 50 50 150 50 nil)) ;font, left, top, width, height, maximized
(if window-system
(add-hook 'after-init-hook
'(lambda()
"this is executed as emacs is coming up - _after_ final-frame-params have been read from `.emacs.desktop'."
(when desktop-enable
(desktop-load-default)
(desktop-read)
;;now size and position frame according to the values read from disk
(set-default-font (first final-frame-params)) ;do font first - as it will goof with the frame size
(set-frame-size (selected-frame) (fourth final-frame-params) (fifth final-frame-params))
(set-frame-position (selected-frame) (max (eval (second final-frame-params)) 0) (max (eval (third final-frame-params)) 0))
(if (sixth final-frame-params)
(if (eq window-system 'w32)
(w32-send-sys-command ?\xf030)
;else, do X something
))))))
(if window-system
(add-hook 'desktop-save-hook
'(lambda()
(let ((maximized (listp (frame-parameter (selected-frame) 'left))))
"this hook sets the fram size/pos vars before `desktop.el' writes them out to disk"
(if (eq window-system 'w32)
(w32-send-sys-command ?\xf120) ;restore the frame (so we can save the 'restored' size/pos)
;else, do X something
)
;;prepend our vars to the save list so `desktop.el' will save them out to disk
(setq desktop-globals-to-save (cons 'final-frame-params
desktop-globals-to-save))
(setq final-frame-params
(list
(frame-parameter (selected-frame) 'font)
(frame-parameter (selected-frame) 'left) ;x
(frame-parameter (selected-frame) 'top) ;y
(frame-width) ;width
(frame-height) ;height
maximized))))) ;if this frame param is a list, we're probably maximized (not guaranteed)
)
(provide 'frame-restore)
;;; frame-restore.el ends here

141
site-lisp/extensions-local/goto-last-change.el Normal file
View File

@ -0,0 +1,141 @@
;;; goto-last-change.el --- Move point through buffer-undo-list positions
;; Copyright © 2003 Kevin Rodgers
;; Author: Kevin Rodgers <ihs_4664@yahoo.com>
;; Created: 17 Jun 2003
;; Version: $Revision: 1.2 $
;; Keywords: convenience
;; RCS: $Id: goto-last-change.el,v 1.2 2003/07/30 17:43:47 kevinr Exp kevinr $
;; Contributors:
;; Attila Lendvai <attila.lendvai@gmail.com> (line distance and auto marks)
;; 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 2 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, write to the Free
;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
;; MA 02111-1307 USA
;;; Commentary:
;; After installing goto-last-change.el in a `load-path' directory and
;; compiling it with `M-x byte-compile-file', load it with
;; (require 'goto-last-change)
;; or autoload it with
;; (autoload 'goto-last-change "goto-last-change"
;; "Set point to the position of the last change." t)
;;
;; You may also want to bind a key to `M-x goto-last-change', e.g.
;; (global-set-key "\C-x\C-\\" 'goto-last-change)
;; goto-last-change.el was written in response to to the following:
;;
;; From: Dan Jacobson <jidanni@jidanni.org>
;; Newsgroups: gnu.emacs.bug
;; Subject: function to go to spot of last change
;; Date: Sun, 15 Jun 2003 00:15:08 +0000 (UTC)
;; Sender: news <news@main.gmane.org>
;; Message-ID: <mailman.7910.1055637181.21513.bug-gnu-emacs@gnu.org>
;; NNTP-Posting-Host: monty-python.gnu.org
;;
;;
;; Why of course, a function to get the user to the spot of last changes
;; in the current buffer(s?), that's what emacs must lack.
;;
;; How many times have you found yourself mosying [<-not in spell
;; checker!?] thru a file when you wonder, where the heck was I just
;; editing? Well, the best you can do is hit undo, ^F, and undo again,
;; to get back. Hence the "burning need" for the additional function,
;; which you might name the-jacobson-memorial-function, due to its brilliance.
;; --
;; http://jidanni.org/ Taiwan(04)25854780
;;; Code:
(provide 'goto-last-change)
(or (fboundp 'last) ; Emacs 20
(require 'cl)) ; Emacs 19
(defvar goto-last-change-undo nil
"The `buffer-undo-list' entry of the previous \\[goto-last-change] command.")
(make-variable-buffer-local 'goto-last-change-undo)
;;;###autoload
(defun goto-last-change (&optional mark-point minimal-line-distance)
"Set point to the position of the last change.
Consecutive calls set point to the position of the previous change.
With a prefix arg (optional arg MARK-POINT non-nil), set mark so \
\\[exchange-point-and-mark]
will return point to the current position."
(interactive "P")
;; (unless (buffer-modified-p)
;; (error "Buffer not modified"))
(when (eq buffer-undo-list t)
(error "No undo information in this buffer"))
(when mark-point
(push-mark))
(unless minimal-line-distance
(setq minimal-line-distance 10))
(let ((position nil)
(undo-list (if (and (eq this-command last-command)
goto-last-change-undo)
(cdr (memq goto-last-change-undo buffer-undo-list))
buffer-undo-list))
undo)
(while (and undo-list
(or (not position)
(eql position (point))
(and minimal-line-distance
;; The first invocation always goes to the last change, subsequent ones skip
;; changes closer to (point) then minimal-line-distance.
(memq last-command '(goto-last-change
goto-last-change-with-auto-marks))
(< (count-lines (min position (point-max)) (point))
minimal-line-distance))))
(setq undo (car undo-list))
(cond ((and (consp undo) (integerp (car undo)) (integerp (cdr undo)))
;; (BEG . END)
(setq position (cdr undo)))
((and (consp undo) (stringp (car undo))) ; (TEXT . POSITION)
(setq position (abs (cdr undo))))
((and (consp undo) (eq (car undo) t))) ; (t HIGH . LOW)
((and (consp undo) (null (car undo)))
;; (nil PROPERTY VALUE BEG . END)
(setq position (cdr (last undo))))
((and (consp undo) (markerp (car undo)))) ; (MARKER . DISTANCE)
((integerp undo)) ; POSITION
((null undo)) ; nil
(t (error "Invalid undo entry: %s" undo)))
(setq undo-list (cdr undo-list)))
(cond (position
(setq goto-last-change-undo undo)
(goto-char (min position (point-max))))
((and (eq this-command last-command)
goto-last-change-undo)
(setq goto-last-change-undo nil)
(error "No further undo information"))
(t
(setq goto-last-change-undo nil)
(error "Buffer not modified")))))
(defun goto-last-change-with-auto-marks (&optional minimal-line-distance)
"Calls goto-last-change and sets the mark at only the first invocations
in a sequence of invocations."
(interactive "P")
(goto-last-change (not (or (eq last-command 'goto-last-change-with-auto-marks)
(eq last-command t)))
minimal-line-distance))
;; (global-set-key "\C-x\C-\\" 'goto-last-change)
;;; goto-last-change.el ends here

124
site-lisp/extensions-local/goto-line-preview.el Normal file
View File

@ -0,0 +1,124 @@
;;; goto-line-preview.el --- Preview line when executing `goto-line` command -*- lexical-binding: t; -*-
;; Copyright (C) 2019-2023 Shen, Jen-Chieh
;; Created date 2019-03-01 14:53:00
;; Author: Shen, Jen-Chieh <jcs090218@gmail.com>
;; URL: https://github.com/emacs-vs/goto-line-preview
;; Version: 0.1.1
;; Package-Requires: ((emacs "25"))
;; Keywords: convenience line navigation
;; This file is NOT part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; Preview line when executing `goto-line` command.
;;
;;; Code:
(defgroup goto-line-preview nil
"Preview line when executing `goto-line` command."
:prefix "goto-line-preview-"
:group 'convenience
:group 'tools
:link '(url-link :tag "Repository" "https://github.com/emacs-vs/goto-line-preview"))
(defcustom goto-line-preview-before-hook nil
"Hooks run before `goto-line-preview' is run."
:group 'goto-line-preview
:type 'hook)
(defcustom goto-line-preview-after-hook nil
"Hooks run after `goto-line-preview' is run."
:group 'goto-line-preview
:type 'hook)
(defvar goto-line-preview--prev-window nil
"Record down the previous window before we do preivew display.")
(defvar goto-line-preview--prev-line-num nil
"Record down the previous line number before we do preivew display.")
(defvar goto-line-preview--relative-p nil
"Flag to see if this command relative.")
(defun goto-line-preview--do (line-num)
"Do goto LINE-NUM."
(save-selected-window
(select-window goto-line-preview--prev-window)
(goto-char (point-min))
(forward-line (1- line-num))))
(defun goto-line-preview--do-preview ()
"Do the goto line preview action."
(save-selected-window
(when goto-line-preview--prev-window
(let ((line-num-str (thing-at-point 'line)))
(select-window goto-line-preview--prev-window)
(if line-num-str
(let ((line-num (string-to-number line-num-str)))
(when goto-line-preview--relative-p
(setq line-num (+ goto-line-preview--prev-line-num line-num)))
(unless (zerop line-num) (goto-line-preview--do line-num)))
(goto-line-preview--do goto-line-preview--prev-line-num))))))
;;;###autoload
(defun goto-line-preview ()
"Preview goto line."
(interactive)
(let ((goto-line-preview--prev-window (selected-window))
(window-point (window-point))
(goto-line-preview--prev-line-num (line-number-at-pos))
jumped)
(run-hooks 'goto-line-preview-before-hook)
(unwind-protect
(setq jumped (read-number
(let ((lines (line-number-at-pos (point-max))))
(format (if goto-line-preview--relative-p
"[%d] Goto line relative: (%d to %d) "
"[%d] Goto line: (%d to %d) ")
goto-line-preview--prev-line-num
(max 0 (min 1 lines))
lines))))
(if jumped
(with-current-buffer (window-buffer goto-line-preview--prev-window)
(unless (region-active-p) (push-mark window-point)))
(set-window-point goto-line-preview--prev-window window-point))
(run-hooks 'goto-line-preview-after-hook))))
;;;###autoload
(defun goto-line-preview-relative ()
"Preview goto line relative."
(interactive)
(let ((goto-line-preview--relative-p t))
(goto-line-preview)))
;;;###autoload
(define-obsolete-function-alias 'goto-line-preview-goto-line 'goto-line-preview "0.1.1")
(defun goto-line-preview--minibuffer-setup ()
"Locally set up preview hooks for this minibuffer command."
(when (memq this-command '(goto-line-preview
goto-line-preview-goto-line
goto-line-preview-relative))
(add-hook 'post-command-hook #'goto-line-preview--do-preview nil t)))
(add-hook 'minibuffer-setup-hook 'goto-line-preview--minibuffer-setup)
(provide 'goto-line-preview)
;;; goto-line-preview.el ends here

312
site-lisp/extensions-local/highlight-indentation.el Normal file
View File

@ -0,0 +1,312 @@
;;; highlight-indentation.el --- Minor modes for highlighting indentation
;; Author: Anton Johansson <anton.johansson@gmail.com> - http://antonj.se
;; Created: Dec 15 23:42:04 2010
;; Version: 0.7.0
;; URL: https://github.com/antonj/Highlight-Indentation-for-Emacs
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 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.
;;
;;; Commentary:
;; Customize `highlight-indentation-face', and
;; `highlight-indentation-current-column-face' to suit your theme.
;;; Code:
(defgroup highlight-indentation nil
"Highlight Indentation"
:prefix "highlight-indentation-"
:group 'basic-faces)
(defface highlight-indentation-face
;; Fringe has non intrusive color in most color-themes
'((t :inherit fringe))
"Basic face for highlighting indentation guides."
:group 'highlight-indentation)
(defcustom highlight-indentation-offset
(if (and (boundp 'standard-indent) standard-indent) standard-indent 2)
"Default indentation offset, used if no other can be found from
major mode. This value is always used by
`highlight-indentation-mode' if set buffer local. Set buffer
local with `highlight-indentation-set-offset'"
:type 'integer
:group 'highlight-indentation)
(defcustom highlight-indentation-blank-lines nil
"Show indentation guides on blank lines. Experimental.
Known issues:
- Doesn't work well with completion popups that use overlays
- Overlays on blank lines sometimes aren't cleaned up or updated perfectly
Can be refreshed by scrolling
- Not yet implemented for highlight-indentation-current-column-mode
- May not work perfectly near the bottom of the screen
- Point appears after indent guides on blank lines"
:type 'boolean
:group 'highlight-indentation)
(defvar highlight-indentation-overlay-priority 1)
(defvar highlight-indentation-current-column-overlay-priority 2)
(defconst highlight-indentation-hooks
'((after-change-functions (lambda (start end length)
(highlight-indentation-redraw-region
start end
'highlight-indentation-overlay
'highlight-indentation-put-overlays-region))
t t)
(window-scroll-functions (lambda (win start)
(highlight-indentation-redraw-window
win
'highlight-indentation-overlay
'highlight-indentation-put-overlays-region
start))
nil t)))
(defun highlight-indentation-get-buffer-windows (&optional all-frames)
"Return a list of windows displaying the current buffer."
(get-buffer-window-list (current-buffer) 'no-minibuf all-frames))
(defun highlight-indentation-delete-overlays-buffer (overlay)
"Delete all overlays in the current buffer."
(save-restriction
(widen)
(highlight-indentation-delete-overlays-region (point-min) (point-max) overlay)))
(defun highlight-indentation-delete-overlays-region (start end overlay)
"Delete overlays between START and END."
(mapc #'(lambda (o)
(if (overlay-get o overlay) (delete-overlay o)))
(overlays-in start end)))
(defun highlight-indentation-redraw-window (win overlay func &optional start)
"Redraw win starting from START."
(highlight-indentation-redraw-region (or start (window-start win)) (window-end win t) overlay func))
(defun highlight-indentation-redraw-region (start end overlay func)
"Erase and read overlays between START and END."
(save-match-data
(save-excursion
(let ((inhibit-point-motion-hooks t)
(start (save-excursion (goto-char start) (beginning-of-line) (point)))
(end (save-excursion (goto-char end) (line-beginning-position 2))))
(highlight-indentation-delete-overlays-region start end overlay)
(funcall func start end overlay)))))
(defun highlight-indentation-redraw-all-windows (overlay func &optional all-frames)
"Redraw the all windows showing the current buffer."
(dolist (win (highlight-indentation-get-buffer-windows all-frames))
(highlight-indentation-redraw-window win overlay func)))
(defun highlight-indentation-put-overlays-region (start end overlay)
"Place overlays between START and END."
(goto-char end)
(let (o ;; overlay
(last-indent 0)
(last-char 0)
(pos (point))
(loop t))
(while (and loop
(>= pos start))
(save-excursion
(beginning-of-line)
(let ((c 0)
(cur-column (current-column)))
(while (and (setq c (char-after))
(integerp c)
(not (= 10 c)) ;; newline
(= 32 c)) ;; space
(when (= 0 (% cur-column highlight-indentation-offset))
(let ((p (point)))
(setq o (make-overlay p (+ p 1))))
(overlay-put o overlay t)
(overlay-put o 'priority highlight-indentation-overlay-priority)
(overlay-put o 'face 'highlight-indentation-face))
(forward-char)
(setq cur-column (current-column)))
(when (and highlight-indentation-blank-lines
(integerp c)
(or (= 10 c)
(= 13 c)))
(when (< cur-column last-indent)
(let ((column cur-column)
(s nil)
(show t)
num-spaces)
(while (< column last-indent)
(if (>= 0
(setq num-spaces
(%
(- last-indent column)
highlight-indentation-offset)))
(progn
(setq num-spaces (1- highlight-indentation-offset))
(setq show t))
(setq show nil))
(setq s (cons (concat
(if show
(propertize " "
'face
'highlight-indentation-face)
"")
(make-string num-spaces 32))
s))
(setq column (+ column num-spaces (if show 1 0))))
(setq s (apply 'concat (reverse s)))
(let ((p (point)))
(setq o (make-overlay p p)))
(overlay-put o overlay t)
(overlay-put o 'priority highlight-indentation-overlay-priority)
(overlay-put o 'after-string s))
(setq cur-column last-indent)))
(setq last-indent (* highlight-indentation-offset
(ceiling (/ (float cur-column)
highlight-indentation-offset))))))
(when (= pos start)
(setq loop nil))
(forward-line -1) ;; previous line
(setq pos (point)))))
(defun highlight-indentation-guess-offset ()
"Get indentation offset of current buffer."
(cond ((and (eq major-mode 'python-mode) (boundp 'python-indent))
python-indent)
((and (eq major-mode 'python-mode) (boundp 'py-indent-offset))
py-indent-offset)
((and (eq major-mode 'python-mode) (boundp 'python-indent-offset))
python-indent-offset)
((and (eq major-mode 'ruby-mode) (boundp 'ruby-indent-level))
ruby-indent-level)
((and (eq major-mode 'scala-mode) (boundp 'scala-indent:step))
scala-indent:step)
((and (eq major-mode 'scala-mode) (boundp 'scala-mode-indent:step))
scala-mode-indent:step)
((and (or (eq major-mode 'scss-mode) (eq major-mode 'css-mode)) (boundp 'css-indent-offset))
css-indent-offset)
((and (eq major-mode 'nxml-mode) (boundp 'nxml-child-indent))
nxml-child-indent)
((and (eq major-mode 'coffee-mode) (boundp 'coffee-tab-width))
coffee-tab-width)
((and (eq major-mode 'js-mode) (boundp 'js-indent-level))
js-indent-level)
((and (eq major-mode 'js2-mode) (boundp 'js2-basic-offset))
js2-basic-offset)
((and (fboundp 'derived-mode-class) (eq (derived-mode-class major-mode) 'sws-mode) (boundp 'sws-tab-width))
sws-tab-width)
((and (eq major-mode 'web-mode) (boundp 'web-mode-markup-indent-offset))
web-mode-markup-indent-offset) ; other similar vars: web-mode-{css-indent,scripts}-offset
((and (eq major-mode 'web-mode) (boundp 'web-mode-html-offset)) ; old var
web-mode-html-offset)
((and (local-variable-p 'c-basic-offset) (boundp 'c-basic-offset))
c-basic-offset)
((and (eq major-mode 'yaml-mode) (boundp 'yaml-indent-offset))
yaml-indent-offset)
((and (eq major-mode 'elixir-mode) (boundp 'elixir-smie-indent-basic))
elixir-smie-indent-basic)
(t
(default-value 'highlight-indentation-offset))))
;;;###autoload
(define-minor-mode highlight-indentation-mode
"Highlight indentation minor mode highlights indentation based on spaces"
:lighter " ||"
(when (not highlight-indentation-mode) ;; OFF
(highlight-indentation-delete-overlays-buffer 'highlight-indentation-overlay)
(dolist (hook highlight-indentation-hooks)
(remove-hook (car hook) (nth 1 hook) (nth 3 hook))))
(when highlight-indentation-mode ;; ON
(when (not (local-variable-p 'highlight-indentation-offset))
(set (make-local-variable 'highlight-indentation-offset)
(highlight-indentation-guess-offset)))
;; Setup hooks
(dolist (hook highlight-indentation-hooks)
(apply 'add-hook hook))
(highlight-indentation-redraw-all-windows 'highlight-indentation-overlay
'highlight-indentation-put-overlays-region)))
;;;###autoload
(defun highlight-indentation-set-offset (offset)
"Set indentation offset locally in buffer, will prevent
highlight-indentation from trying to guess indentation offset
from major mode"
(interactive
(if (and current-prefix-arg (not (consp current-prefix-arg)))
(list (prefix-numeric-value current-prefix-arg))
(list (read-number "Indentation offset: "))))
(set (make-local-variable 'highlight-indentation-offset) offset)
(when highlight-indentation-mode
(highlight-indentation-mode)))
;;; This minor mode will highlight the indentation of the current line
;;; as a vertical bar (grey background color) aligned with the column of the
;;; first character of the current line.
(defface highlight-indentation-current-column-face
;; Fringe has non intrusive color in most color-themes
'((t (:background "black")))
"Basic face for highlighting indentation guides."
:group 'highlight-indentation)
(defconst highlight-indentation-current-column-hooks
'((post-command-hook (lambda ()
(highlight-indentation-redraw-all-windows 'highlight-indentation-current-column-overlay
'highlight-indentation-current-column-put-overlays-region)) nil t)))
(defun highlight-indentation-current-column-put-overlays-region (start end overlay)
"Place overlays between START and END."
(let (o ;; overlay
(last-indent 0)
(indent (save-excursion (back-to-indentation) (current-column)))
(pos start))
(goto-char start)
;; (message "doing it %d" indent)
(while (< pos end)
(beginning-of-line)
(while (and (integerp (char-after))
(not (= 10 (char-after))) ;; newline
(= 32 (char-after))) ;; space
(when (= (current-column) indent)
(setq pos (point)
last-indent pos
o (make-overlay pos (+ pos 1)))
(overlay-put o overlay t)
(overlay-put o 'priority highlight-indentation-current-column-overlay-priority)
(overlay-put o 'face 'highlight-indentation-current-column-face))
(forward-char))
(forward-line) ;; Next line
(setq pos (point)))))
;;;###autoload
(define-minor-mode highlight-indentation-current-column-mode
"Highlight Indentation minor mode displays a vertical bar
corresponding to the indentation of the current line"
:lighter " |"
(when (not highlight-indentation-current-column-mode) ;; OFF
(highlight-indentation-delete-overlays-buffer 'highlight-indentation-current-column-overlay)
(dolist (hook highlight-indentation-current-column-hooks)
(remove-hook (car hook) (nth 1 hook) (nth 3 hook))))
(when highlight-indentation-current-column-mode ;; ON
(when (not (local-variable-p 'highlight-indentation-offset))
(set (make-local-variable 'highlight-indentation-offset)
(highlight-indentation-guess-offset)))
;; Setup hooks
(dolist (hook highlight-indentation-current-column-hooks)
(apply 'add-hook hook))
(highlight-indentation-redraw-all-windows 'highlight-indentation-current-column-overlay
'highlight-indentation-current-column-put-overlays-region)))
(provide 'highlight-indentation)
;;; highlight-indentation.el ends here

157
site-lisp/extensions-local/highlight-parentheses.el Normal file
View File

@ -0,0 +1,157 @@
;;; highlight-parentheses.el --- highlight surrounding parentheses
;;
;; Copyright (C) 2007 Nikolaj Schumacher
;;
;; Author: Nikolaj Schumacher <bugs * nschum de>
;; Version: 1.0
;; Keywords: faces, matching
;; URL: http://nschum.de/src/emacs/highlight-parentheses/
;; Compatibility: GNU Emacs 22.x
;;
;; This file is NOT part of GNU Emacs.
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; 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, write to the Free Software
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
;;
;;; Commentary:
;;
;; Add the following to your .emacs file:
;; (require 'highlight-parentheses)
;;
;; Enable `highlight-symbol-mode'.
;;
;;; Changes Log:
;;
;; 2007-07-30 (1.0)
;; Added background highlighting and faces.
;;
;; 2007-05-15 (0.9.1)
;; Support for defcustom. Changed from vector to list.
;;
;; 2007-04-26 (0.9)
;; Initial Release.
;;
;;; Code:
(eval-when-compile (require 'cl))
(defgroup highlight-parentheses nil
"Highlight surrounding parentheses"
:group 'faces
:group 'matching)
(defvar hl-paren-overlays nil
"This buffers currently active overlays.")
(make-variable-buffer-local 'hl-paren-overlays)
(defcustom hl-paren-colors
'("firebrick1" "IndianRed4" "IndianRed")
"*List of colors for the highlighted parentheses.
The list starts with the the inside parentheses and moves outwards."
:type '(repeat color)
:group 'highlight-parentheses)
(defcustom hl-paren-background-colors nil
"*List of colors for the background highlighted parentheses.
The list starts with the the inside parentheses and moves outwards."
:type '(repeat color)
:group 'highlight-parentheses)
(defface hl-paren-face nil
"*Face used for highlighting parentheses.
Color attributes might be overriden by `hl-paren-colors' and
`hl-paren-background-colors'."
:group 'highlight-parentheses)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar hl-paren-last-point 0
"The last point for which parentheses were highlighted.
This is used to prevent analyzing the same context over and over.")
(make-variable-buffer-local 'hl-paren-last-point)
(defun hl-paren-highlight ()
"Highlight the parentheses around point."
(unless (= (point) hl-paren-last-point)
(save-excursion
(let ((pos (point))
(match-pos (point))
(level -1)
(max (1- (length hl-paren-overlays))))
(while (and match-pos (< level max))
(setq match-pos
(when (setq pos (cadr (syntax-ppss pos)))
(ignore-errors (scan-sexps pos 1))))
(when match-pos
(hl-paren-put-overlay (cl-incf level) pos 'hl-paren-face)
(hl-paren-put-overlay (cl-incf level) (1- match-pos) 'hl-paren-face)))
(while (< level max)
(hl-paren-put-overlay (cl-incf level) nil nil))))
(setq hl-paren-last-point (point))))
(defun hl-paren-put-overlay (n pos face)
"Move or create the N'th overlay so its shown at POS."
(let ((ov (elt hl-paren-overlays n)) end)
(if (null pos)
(when ov
(delete-overlay ov)
(aset hl-paren-overlays n nil))
(if (atom pos)
(setq end (1+ pos))
(setq end (cdr pos))
(setq pos (car pos)))
(if ov
(move-overlay ov pos end)
(let ((face-attributes (face-attr-construct face))
(color-value (nth (/ n 2) hl-paren-colors))
(background-value (nth (/ n 2) hl-paren-background-colors)))
(when color-value
(let ((attribute (memq :foreground face-attributes)))
(if attribute
(setcar (cdr attribute) color-value)
(push color-value face-attributes)
(push :foreground face-attributes))))
(when background-value
(let ((attribute (memq :background face-attributes)))
(if attribute
(setcar (cdr attribute) background-value)
(push background-value face-attributes)
(push :background face-attributes))))
(setq ov (make-overlay pos end))
(aset hl-paren-overlays n ov)
(overlay-put ov 'face face-attributes))))))
;;;###autoload
(define-minor-mode highlight-parentheses-mode
"Minor mode to highlight the surrounding parentheses."
:init-value nil
:lighter " hl-p"
:keymap nil
(if highlight-parentheses-mode
(progn
(setq hl-paren-overlays
(make-vector (* 2 (max (length hl-paren-colors)
(length hl-paren-background-colors))) nil))
(add-hook 'post-command-hook 'hl-paren-highlight nil t))
(let (ov)
(dotimes (i (length hl-paren-overlays))
(when (setq ov (elt hl-paren-overlays i))
(delete-overlay ov))))
(kill-local-variable 'hl-paren-overlays)
(kill-local-variable 'hl-paren-point)
(remove-hook 'post-command-hook 'hl-paren-highlight t)))
(provide 'highlight-parentheses)
;;; highlight-parentheses.el ends here

49
site-lisp/extensions-local/lazy-load.el Normal file
View File

@ -0,0 +1,49 @@
;; -*- coding: utf-8; -*-
;;; Require:
;;; Code:
(defun lazy-load-global-keys (key-alist filename &optional key-prefix)
(lazy-load-set-keys key-alist nil key-prefix)
(dolist (element key-alist)
(setq fun (cdr element))
(autoload fun filename nil t)))
(defun lazy-load-local-keys (key-alist keymap filename &optional key-prefix)
(lazy-load-set-keys key-alist keymap key-prefix)
(dolist (element key-alist)
(setq fun (cdr element))
(autoload fun filename nil t)))
(defun lazy-load-set-keys (key-alist &optional keymap key-prefix)
"This function is to little type when define key binding.
`KEYMAP' is a add keymap for some binding, default is `current-global-map'.
`KEY-ALIST' is a alist contain main-key and command.
`KEY-PREFIX' is a add prefix for some binding, default is nil."
(let (key def)
(or keymap (setq keymap (current-global-map)))
(if key-prefix
(setq key-prefix (concat key-prefix " "))
(setq key-prefix ""))
(dolist (element key-alist)
(setq key (car element))
(setq def (cdr element))
(cond ((stringp key) (setq key (read-kbd-macro (concat key-prefix key))))
((vectorp key) nil)
(t (signal 'wrong-type-argument (list 'array key))))
(define-key keymap key def))))
(defun lazy-load-unset-keys (key-list &optional keymap)
"This function is to little type when unset key binding.
`KEYMAP' is add keymap for some binding, default is `current-global-map'
`KEY-LIST' is list contain key."
(let (key)
(or keymap (setq keymap (current-global-map)))
(dolist (key key-list)
(cond ((stringp key) (setq key (read-kbd-macro (concat key))))
((vectorp key) nil)
(t (signal 'wrong-type-argument (list 'array key))))
(define-key keymap key nil))))
(provide 'lazy-load)
;;; lazy-load.el ends here

72
site-lisp/extensions-local/ld-buffer-operations.el Normal file
View File

@ -0,0 +1,72 @@
;; -*- coding: utf-8; -*-
;;; Require:
;;; Code:
(defun ld-indent-buffer ()
"Automatic format current buffer."
(interactive)
(cond
((derived-mode-p 'python-mode)
(message "Don't indent python buffer. It will mess up the code syntax."))
((derived-mode-p 'yaml-mode)
(message "Don't indent yaml buffer. It will mess up the code syntax."))
(t
(save-excursion
(indent-region (point-min) (point-max) nil)
(delete-trailing-whitespace)
(untabify (point-min) (point-max))))))
; ---
(defun ld-rename-file-and-buffer ()
"Rename current buffer and if the buffer is visiting a file, rename it too."
(interactive)
(let ((filename (buffer-file-name)))
(if (not (and filename (file-exists-p filename)))
(rename-buffer (read-from-minibuffer "New name: " (buffer-name)))
(let* ((new-name (read-file-name "New name: " (file-name-directory filename)))
(containing-dir (file-name-directory new-name)))
(make-directory containing-dir t)
(cond
((vc-backend filename) (vc-rename-file filename new-name))
(t
(rename-file filename new-name t)
(set-visited-file-name new-name t t)))))))
; ---
(defun ld-delete-file-and-buffer ()
"Kill the current buffer and deletes the file it is visiting."
(interactive)
(let ((filename (buffer-file-name)))
(when filename
(if (vc-backend filename)
(vc-delete-file filename)
(when (y-or-n-p (format "Sure to delete %s? " filename))
(delete-file filename delete-by-moving-to-trash)
(message "Deleted file %s" filename)
(kill-buffer))))))
; ---
(defun ld-revert-buffer-no-confirm ()
"Revert buffer without confirmation."
(interactive)
(revert-buffer :ignore-auto :noconfirm))
; ---
(defun ld-unmark-all-buffers ()
"Unmark all have marked buffers."
(interactive)
(let ((current-element (current-buffer)))
(save-excursion
(dolist (element (buffer-list))
(set-buffer element)
(deactivate-mark)))
(switch-to-buffer current-element)
(deactivate-mark)))
(provide 'ld-buffer-operations)
;;; ld-buffer-operations.el ends here

38
site-lisp/extensions-local/ld-delete-block.el Normal file
View File

@ -0,0 +1,38 @@
;; -*- coding: utf-8; -*-
;;; Require:
(require 'subword)
;;; Code:
(defun ld-delete-one-block-forward ()
(interactive)
(if (eobp)
(message "End of buffer")
(let* ((syntax-move-point
(save-excursion
(skip-syntax-forward (string (char-syntax (char-after))))
(point)
))
(subword-move-point
(save-excursion
(subword-forward)
(point))))
(kill-region (point) (min syntax-move-point subword-move-point)))))
(defun ld-delete-one-block-backward ()
(interactive)
(if (bobp)
(message "Beginning of buffer")
(let* ((syntax-move-point
(save-excursion
(skip-syntax-backward (string (char-syntax (char-before))))
(point)
))
(subword-move-point
(save-excursion
(subword-backward)
(point))))
(kill-region (point) (max syntax-move-point subword-move-point)))))
(provide 'ld-delete-block)
;;; ld-delete-block.el ends here

14
site-lisp/extensions-local/ld-file-operations.el Normal file
View File

@ -0,0 +1,14 @@
;; -*- coding: utf-8; -*-
;;; Require:
;;; Code:
(defun ld-find-file-in-root (file)
"Find file with root."
(interactive "fFind file as sudo: ")
(require 'tramp)
(tramp-cleanup-all-connections)
(find-file (concat "/sudo:root@localhost:" file)))
(provide 'ld-file-operations)
;;; ld-file-operations.el ends here

39
site-lisp/extensions-local/ld-goto-cursor-stack.el Normal file
View File

@ -0,0 +1,39 @@
;; -*- coding: utf-8; -*-
;;; Require:
;;; Code:
(defvar ld-cursor-position-stack nil
"Cursor position stack.")
(defun ld-cursor-position-1-store ()
"Remember current position and setup."
(interactive)
(point-to-register 8)
(message "Have remember one position"))
(defun ld-cursor-position-1-jump ()
"Jump to latest position and setup."
(interactive)
(let ((tmp (point-marker)))
(jump-to-register 8)
(set-register 8 tmp))
(message "Have back to remember position"))
(defun ld-cursor-position-stack-push ()
"Push current point in stack."
(interactive)
(message "Location marked.")
(setq ld-cursor-position-stack (cons (list (current-buffer) (point)) ld-cursor-position-stack)))
(defun ld-cursor-position-stack-pop ()
"Pop point from stack."
(interactive)
(if (null ld-cursor-position-stack)
(message "Stack is empty.")
(switch-to-buffer (caar ld-cursor-position-stack))
(goto-char (cadar ld-cursor-position-stack))
(setq ld-cursor-position-stack (cdr ld-cursor-position-stack))))
(provide 'ld-goto-cursor-stack)
;;; ld-goto-cursor-stack.el ends here

30
site-lisp/extensions-local/ld-goto-simple.el Normal file
View File

@ -0,0 +1,30 @@
;; -*- coding: utf-8; -*-
;;; Require:
;;; Code:
(defun ld-goto-column (number)
"Untabify, and go to a column NUMBER within the current line (0 is beginning of the line)."
(interactive "nColumn number: ")
(move-to-column number t))
; ---
(defun ld-goto-percent-text (percent)
"Move the cursor to the character,
which is <percent>% far from the top character."
(interactive "n(text) Goto percent: ")
(goto-char (/ (* percent (point-max)) 100)))
; ---
(defun ld-goto-percent-line (percent)
"Move the cursor to the line,
which is <percent>% far from the top line."
(interactive "n(line) Goto percent: ")
(goto-line (/ (* percent (count-lines (point-min) (point-max)))
100)))
(provide 'ld-goto-simple)
;;; ld-goto-simple.el ends here

106
site-lisp/extensions-local/ld-org-publish-project-desc.el Normal file
View File

@ -0,0 +1,106 @@
;; -*- coding: utf-8; -*-
;;; Require:
;;; Code:
(setq
org-publish-project-alist
(let* ((ld-site-path "~/Documents/ld_org_article/")
(ld-site-pub-path "~/Public/ld_org_article_publish/")
(get-content (lambda (x)
(with-temp-buffer
(insert-file-contents (concat ld-site-path x))
(buffer-string))))
(ld-site-postamble (funcall get-content "template/postamble.html"))
(ld-site-preamble (funcall get-content "template/preamble.html"))
(ld-site-head (funcall get-content "template/head.html")))
`(
("blog"
:base-directory ,(concat ld-site-path "article/blog/")
:base-extension "org"
:publishing-directory ,(concat ld-site-pub-path "article/blog/")
:publishing-function org-html-publish-to-html
:recursive t
:headline-levels 4
:auto-sitemap t
:sitemap-filename "sitemap-index.org"
:sitemap-title "blog"
:html-doctype "html5"
:html-head ,ld-site-head
:html-preamble ,ld-site-preamble
:html-postamble ,ld-site-postamble
;; :htmlized-source t
:with-toc t
)
("wiki"
:base-directory ,(concat ld-site-path "article/wiki/")
:base-extension "org"
:publishing-directory ,(concat ld-site-pub-path "article/wiki/")
:publishing-function org-html-publish-to-html
:recursive t
:headline-levels 4
:auto-sitemap t
:sitemap-filename "sitemap-index.org"
:sitemap-title "wiki"
:html-doctype "html5"
:html-head ,ld-site-head
:html-preamble ,ld-site-preamble
:html-postamble ,ld-site-postamble
;; :htmlized-source t
:with-toc t
)
("translation"
:base-directory ,(concat ld-site-path "article/translation/")
:base-extension "org"
:publishing-directory ,(concat ld-site-pub-path "article/translation/")
:publishing-function org-html-publish-to-html
:recursive t
:headline-levels 4
:auto-sitemap t
:sitemap-filename "sitemap-index.org"
:sitemap-title "translation"
:html-doctype "html5"
:html-head ,ld-site-head
:html-preamble ,ld-site-preamble
:html-postamble ,ld-site-postamble
;; :htmlized-source t
:with-toc t
)
("site"
:base-directory ,(concat ld-site-path "article/site/")
:base-extension "org"
:publishing-directory ,(concat ld-site-pub-path "article/site/")
:publishing-function org-html-publish-to-html
:recursive t
:headline-levels 4
:html-doctype "html5"
:html-head ,ld-site-head
:html-preamble ,ld-site-preamble
:html-postamble ,ld-site-postamble
;; :htmlized-source t
:with-toc nil
)
("static"
:base-directory ,(concat ld-site-path "article_static/")
;; :base-extension "css\\|js\\|ico\\|png\\|jpg\\|gif\\|zip\\|7z\\|rar\\|pdf"
:base-extension ".*"
:publishing-directory ,(concat ld-site-pub-path "/article_static")
:publishing-function org-publish-attachment
:recursive t
)
("all" :components ("blog" "wiki" "site" "translation" "static"))
)))
(provide 'ld-org-publish-project-desc)
;;; ld-org-publish-project-desc.el ends here

109
site-lisp/extensions-local/ld-text-operations.el Normal file
View File

@ -0,0 +1,109 @@
;; -*- coding: utf-8; -*-
;;; Require:
;;; Code:
; --- move lines
(defun ld-move-text-internal (arg)
(cond
((and mark-active transient-mark-mode)
(if (> (point) (mark))
(exchange-point-and-mark))
(let ((column (current-column))
(text (delete-and-extract-region (point) (mark))))
(forward-line arg)
(move-to-column column t)
(set-mark (point))
(insert text)
(exchange-point-and-mark)
(setq deactivate-mark nil)))
(t
(beginning-of-line)
(when (or (> arg 0) (not (bobp)))
(forward-line)
(when (or (< arg 0) (not (eobp)))
(transpose-lines arg))
(forward-line -1)))))
(defun ld-move-text-down (arg)
"Move region (transient-mark-mode active) or current line
arg lines down."
(interactive "*p")
(ld-move-text-internal arg))
(defun ld-move-text-up (arg)
"Move region (transient-mark-mode active) or current line
arg lines up."
(interactive "*p")
(ld-move-text-internal (- arg)))
; --- duplicate line
(defun ld-get-positions-of-line-or-region ()
"Return positions (beg . end) of the current line or region."
(let (beg end)
(if (and mark-active (> (point) (mark)))
(exchange-point-and-mark))
(setq beg (line-beginning-position))
(if mark-active
(exchange-point-and-mark))
(setq end (line-end-position))
(cons beg end)))
(defun ld-duplicate-current-line-or-region (arg)
"Duplicates the current line or region ARG times.
If there's no region, the current line will be duplicated. However, if
there's a region, all lines that region covers will be duplicated."
(interactive "p")
(pcase-let* ((origin (point))
(`(,beg . ,end) (ld-get-positions-of-line-or-region))
(region (buffer-substring-no-properties beg end)))
(dotimes (_i arg)
(goto-char end)
(unless (use-region-p)
(newline))
(insert region)
(setq end (point)))
(goto-char (+ origin (* (length region) arg) arg))))
(defun ld-duplicate-and-comment-current-line-or-region (arg)
"Duplicates and comments the current line or region ARG times.
If there's no region, the current line will be duplicated. However, if
there's a region, all lines that region covers will be duplicated."
(interactive "p")
(pcase-let* ((origin (point))
(`(,beg . ,end) (ld-get-positions-of-line-or-region))
(region (buffer-substring-no-properties beg end)))
(comment-or-uncomment-region beg end)
(setq end (line-end-position))
(dotimes (_ arg)
(goto-char end)
(unless (use-region-p)
(newline))
(insert region)
(setq end (point)))
(goto-char (+ origin (* (length region) arg) arg))))
; ---
(defun ld-delete-current-line ()
"Delete (not kill) the current line."
(interactive)
(save-excursion
(delete-region
(progn (forward-visible-line 0) (point))
(progn (forward-visible-line 1) (point)))))
; ---
(defun ld-mark-line ()
"Mark one whole line, similar to `mark-paragraph'."
(interactive)
(beginning-of-line)
(if mark-active
(exchange-point-and-mark)
(push-mark nil nil t))
(forward-line)
(exchange-point-and-mark))
(provide 'ld-text-operations)
;;; ld-text-operations.el ends here

22
site-lisp/extensions-local/ld-toggle-one-window.el Normal file
View File

@ -0,0 +1,22 @@
;; -*- coding: utf-8; -*-
;;; Require:
;;; Code:
(defvar ld-toggle-one-window-config-of-window nil
"The window configuration used for `toggle-one-window'.")
(defun ld-toggle-one-window ()
"Toggle between window layout and one window."
(interactive)
(if (equal (length (cl-remove-if #'window-dedicated-p (window-list))) 1)
(if toggle-one-window-config-of-window
(progn
(set-window-configuration toggle-one-window-config-of-window)
(setq toggle-one-window-config-of-window nil))
(message "No other windows exist."))
(setq toggle-one-window-config-of-window (current-window-configuration))
(delete-other-windows)))
(provide 'ld-toggle-one-window)
;;; ld-toggle-one-window.el ends here

167
site-lisp/extensions-local/ld-tools.el Normal file
View File

@ -0,0 +1,167 @@
;; -*- coding: utf-8; -*-
;;; Require:
;;; Code:
(defun insert-line-number (beg end &optional start-line)
"Insert line numbers into buffer."
(interactive "r")
(save-excursion
(let ((max (count-lines beg end))
(line (or start-line 1))
(counter 1))
(goto-char beg)
(while (<= counter max)
(insert (format "%0d " line))
(beginning-of-line 2)
(cl-incf line)
(cl-incf counter)))))
(defun insert-line-number+ ()
"Insert line number into buffer."
(interactive)
(if mark-active
(insert-line-number (region-beginning) (region-end) (read-number "Start line: "))
(insert-line-number (point-min) (point-max))))
(defun strip-blank-lines()
"Strip all blank lines in select area of buffer,
if not select any area, then strip all blank lines of buffer."
(interactive)
(strip-regular-expression-string "^[ \t]*\n")
(message "Blanks line striped. ^_^"))
(defun strip-line-number()
"Strip all line number in select area of buffer,
if not select any area, then strip all line number of buffer."
(interactive)
(strip-regular-expression-string "^[0-9]+ ")
(message "Line number striped. ^_^"))
(defun strip-regular-expression-string (regular-expression)
"Strip all string that match REGULAR-EXPRESSION in select area of buffer.
If not select any area, then strip current buffer"
(interactive)
(let ((begin (point-min))
(end (point-max)))
(if mark-active
(setq begin (region-beginning)
end (region-end)))
(save-excursion
(goto-char end)
(while (and (> (point) begin)
(re-search-backward regular-expression nil t))
(replace-match "" t t)))))
(defun indent-comment-buffer ()
"Indent comment of buffer."
(interactive)
(indent-comment-region (point-min) (point-max)))
(defun indent-comment-region (start end)
"Indent region."
(interactive "r")
(save-excursion
(setq end (copy-marker end))
(goto-char start)
(while (< (point) end)
(if (comment-search-forward end t)
(comment-indent)
(goto-char end)))))
(defun capitalize-one-char (arg)
"Change the letter pointed by the cursor to uppercase."
(interactive "P")
(upcase-region (point) (+ (point) (or arg 1)))
(forward-char (or arg 1)))
(defun lowercase-one-char (arg)
"Change the letter pointed by the cursor to lowercase."
(interactive "P")
(downcase-region (point) (+ (point) (or arg 1)))
(forward-char (or arg 1)))
(defun delete-chars-hungry-forward (&optional reverse)
"Delete chars forward use `hungry' style.
Optional argument REVERSE default is delete forward, if reverse is non-nil delete backward."
(delete-region
(point)
(progn
(if reverse
(skip-chars-backward " \t\n\r")
(skip-chars-forward " \t\n\r"))
(point))))
(defun delete-chars-hungry-backward ()
"Delete chars backward use `hungry' style."
(delete-chars-hungry-forward t))
(defun reverse-chars-in-region (start end)
"Reverse the region character by character without reversing lines."
(interactive "r")
(let ((str (buffer-substring start end)))
(delete-region start end)
(dolist (line (split-string str "\n"))
(let ((chars (mapcar (lambda (c)
(or (matching-paren c)
c))
(reverse (append line nil)))))
(when chars
(apply 'insert chars))
(newline)))))
(defun underline-line-with (char)
"Insert some char below at current line."
(interactive "cType one char: ")
(save-excursion
(let ((length (- (point-at-eol) (point-at-bol))))
(end-of-line)
(insert "\n")
(insert (make-string length char)))))
(defun prettyfy-string (string &optional after)
"Strip starting and ending whitespace and pretty `STRING'.
Replace any chars after AFTER with '...'.
Argument STRING the string that need pretty."
(let ((replace-map (list
(cons "^[ \t]*" "")
(cons "[ \t]*$" "")
(cons (concat "^\\(.\\{"
(or (number-to-string after) "10")
"\\}\\).*")
"\\1..."))))
(dolist (replace replace-map)
(when (string-match (car replace) string)
(setq string (replace-match (cdr replace) nil nil string))))
string))
(defun forward-button-with-line-begin ()
"Move to next button with line begin."
(interactive)
(call-interactively 'forward-button)
(while (not (bolp))
(call-interactively 'forward-button)))
(defun backward-button-with-line-begin ()
"Move to previous button with line begin."
(interactive)
(call-interactively 'backward-button)
(while (not (bolp))
(call-interactively 'backward-button)))
(defun only-comment-p ()
"Return t if current line only contains comment. Otherwise return nil."
(interactive)
(save-excursion
(beginning-of-line)
(if (search-forward comment-start (line-end-position) t)
(progn
(backward-char (length comment-start))
(equal (point)
(progn
(back-to-indentation)
(point))))
nil)))
(provide 'ld-tools)
;;; ld-tools.el ends here

2228
site-lisp/extensions-local/neotree.el Normal file
View File

File diff suppressed because it is too large Load Diff

42
site-lisp/extensions-local/scroll-next-window.el Normal file
View File

@ -0,0 +1,42 @@
;; -*- coding: utf-8; -*-
;;; Require:
;;; Code:
;'up' to see previous content
;'down' to see further content
(defun scroll-next-window-up ()
(interactive)
(scroll-next-window-internal "up"))
(defun scroll-next-window-down ()
(interactive)
(scroll-next-window-internal "down"))
(defun scroll-next-window-up-line ()
(interactive)
(scroll-next-window-internal "up" 1))
(defun scroll-next-window-down-line ()
(interactive)
(scroll-next-window-internal "down" 1))
(defun scroll-next-window-internal (direction &optional line)
(save-excursion
;; Switch to next window.
(other-window 1)
;; Do scroll operation.
(ignore-errors
(if (string-equal direction "up")
(if line
(scroll-up line)
(scroll-up))
(if line
(scroll-down line)
(scroll-down))))
;; Switch back to current window.
(other-window -1)
))
(provide 'scroll-next-window)
;;; scroll-next-window.el ends here

4653
site-lisp/extensions-local/undo-tree.el Normal file
View File

File diff suppressed because it is too large Load Diff

1
site-lisp/extensions-submodule/ace-window Submodule

@ -0,0 +1 @@
Subproject commit 77115afc1b0b9f633084cf7479c767988106c196

1
site-lisp/extensions-submodule/avy Submodule

@ -0,0 +1 @@
Subproject commit be612110cb116a38b8603df367942e2bb3d9bdbe

1
site-lisp/extensions-submodule/citre Submodule

@ -0,0 +1 @@
Subproject commit c617acef3dc2a88aaffa42a515ce7dbaba98228a

1
site-lisp/extensions-submodule/company-mode Submodule

@ -0,0 +1 @@
Subproject commit 9c12b02620ed8a7ae5369fc90217f1c730e48fa6

1
site-lisp/extensions-submodule/dash.el Submodule

@ -0,0 +1 @@
Subproject commit 6db80c711ce947f6c6fa11e5c2257fff2c79d139

1
site-lisp/extensions-submodule/emacs-which-key Submodule

@ -0,0 +1 @@
Subproject commit 4d20bc852545a2e602f59084a630f888542052b1

1
site-lisp/extensions-submodule/go-mode.el Submodule

@ -0,0 +1 @@
Subproject commit 8dce1e3ba1cdc34a856ad53c8421413cfe33660e

1
site-lisp/extensions-submodule/jsonian Submodule

@ -0,0 +1 @@
Subproject commit 22bd5e20a653595b901ccfdc8780a0038755984d

1
site-lisp/extensions-submodule/lua-mode Submodule

@ -0,0 +1 @@
Subproject commit d074e4134b1beae9ed4c9b512af741ca0d852ba3

1
site-lisp/extensions-submodule/markdown-mode Submodule

@ -0,0 +1 @@
Subproject commit 141f9a05d121f60fe5e411c0ad114e3d3216c9ad

1
site-lisp/extensions-submodule/modus-themes Submodule

@ -0,0 +1 @@
Subproject commit 642cc5f8358fd1f2911792a4bbed160d24e9b01b

1
site-lisp/extensions-submodule/multiple-cursors.el Submodule

@ -0,0 +1 @@
Subproject commit 234806c832994cadedb42596fe235e91bbd59e8c

1
site-lisp/extensions-submodule/swiper Submodule

@ -0,0 +1 @@
Subproject commit 8c30f4cab5948aa8d942a3b2bbf5fb6a94d9441d

1
site-lisp/extensions-submodule/web-mode Submodule

@ -0,0 +1 @@
Subproject commit df57cd0beea9c6bdc64259bd11bde0c076a64cc9

1
site-lisp/extensions-submodule/yasnippet Submodule

@ -0,0 +1 @@
Subproject commit 52a1c5031912243c791c55e0fe345d04f219b507

10
site-lisp/init-config/init-ace-window.el Normal file
View File

@ -0,0 +1,10 @@
;;; Require
(require 'ace-window)
;;; Code:
;; 0-9 by default
(setq aw-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l))
(provide 'init-ace-window)
;;; init-ace-window.el ends here

14
site-lisp/init-config/init-auto-save.el Normal file
View File

@ -0,0 +1,14 @@
;; -*- coding: utf-8; -*-
;;; Require:
(require 'auto-save)
;;; Code:
;; auto save after n second(s)
;; (setq auto-save-idle 1)
(setq auto-save-delete-trailing-whitespace t)
(setq auto-save-silent t)
(auto-save-enable)
(provide 'init-auto-save)
;;; init-auto-save.el ends here

19
site-lisp/init-config/init-avy.el Normal file
View File

@ -0,0 +1,19 @@
;;; Require
(require 'avy)
;;; Code:
;; Home row only (the default).
(setq avy-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l))
;; Any lower-case letter a-z.
; (setq avy-keys (number-sequence ?a ?z))
;; Any lower-case letter or number. Numbers are specified in the keyboard
;; number-row order, so that the candidate following '9' will be '0'.
; (setq avy-keys (nconc (number-sequence ?a ?z)
; (number-sequence ?1 ?9)
; '(?0)))
(provide 'init-avy)
;;; init-avy.el ends here

10
site-lisp/init-config/init-citre.el Normal file
View File

@ -0,0 +1,10 @@
;;; Require
(require 'citre)
(require 'citre-config)
;;; Code:
;; (remove-hook 'find-file-hook #'citre-auto-enable-citre-mode)
(provide 'init-citre)
;;; init-citre.el ends here

34
site-lisp/init-config/init-coding-system.el Normal file
View File

@ -0,0 +1,34 @@
;; -*- coding: utf-8; -*-
;;; Require:
;;; Code:
(set-language-environment 'UTF-8)
(set-default-coding-systems 'utf-8)
(set-buffer-file-coding-system 'utf-8)
(set-file-name-coding-system 'utf-8)
(set-keyboard-coding-system 'utf-8)
(set-next-selection-coding-system 'utf-8)
(set-terminal-coding-system 'utf-8)
(when *win64*
(set-next-selection-coding-system 'utf-16-le)
(set-selection-coding-system 'utf-16-le)
(set-clipboard-coding-system 'utf-16-le))
(when (or *linux* *unix* *is-a-mac*)
(set-clipboard-coding-system 'utf-8)
(set-selection-coding-system 'utf-8))
;; the final one will be selected first
(prefer-coding-system 'cp950)
(prefer-coding-system 'gb2312)
(prefer-coding-system 'cp936)
(prefer-coding-system 'gb18030)
(prefer-coding-system 'utf-16)
(prefer-coding-system 'utf-8-dos)
(prefer-coding-system 'utf-8-unix)
(provide 'init-coding-system)
;;; init-coding-system ends here

13
site-lisp/init-config/init-company-mode.el Normal file
View File

@ -0,0 +1,13 @@
;;; Require
(require 'company)
(require 'company-ctags)
;;; Code:
(global-company-mode)
(with-eval-after-load 'company
(company-ctags-auto-setup))
(provide 'init-company-mode)
;;; init-company-mode.el ends here

23
site-lisp/init-config/init-dired.el Normal file
View File

@ -0,0 +1,23 @@
;; -*- coding: utf-8; -*-
;;; Require:
(require 'dired-display-buffer)
(require 'dired-narrow)
(require 'dired-subtree)
;;; Code:
(setq dired-listing-switches "-alh1v --group-directories-first")
;; dired-subtree
(setq dired-subtree-line-prefix " ")
(setq dired-subtree-cycle-depth 3) ;; default `3'
(setq dired-subtree-use-backgrounds nil) ;; default `t'
;; (set-face-attribute 'dired-subtree-depth-1-face nil :background "#ced9db")
;; (set-face-attribute 'dired-subtree-depth-2-face nil :background "#bbc9cc")
;; (set-face-attribute 'dired-subtree-depth-3-face nil :background "#a7babe")
;; (set-face-attribute 'dired-subtree-depth-4-face nil :background "#94aaaf")
;; (set-face-attribute 'dired-subtree-depth-5-face nil :background "#809ba2")
;; (set-face-attribute 'dired-subtree-depth-6-face nil :background "#6c8b93")
(provide 'init-dired)
;;; init-dired.el ends here

149
site-lisp/init-config/init-generic.el Normal file
View File

@ -0,0 +1,149 @@
;; -*- coding: utf-8; -*-
;;; Require:
;;; Code:
(setq package-archives
'(("gnu" . "http://elpa.emacs-china.org/gnu/")
("melpa" . "http://elpa.emacs-china.org/melpa/")))
;; disable some bars
(if window-system
(progn
(tool-bar-mode -1)
(menu-bar-mode -1)
(scroll-bar-mode -1))
(menu-bar-mode -1))
;; map Win key and Hyper key to Super and Hyper for emacs on Windows.
(when *win64*
(setq w32-pass-lwindow-to-system nil)
(setq w32-lwindow-modifier 'super) ; Left Windows key
(setq w32-pass-rwindow-to-system nil)
(setq w32-rwindow-modifier 'super) ; Right Windows key
(w32-register-hot-key [s-])
;; (setq w32-pass-apps-to-system nil)
(setq w32-apps-modifier 'hyper) ; Menu/App key
(w32-register-hot-key [H-]))
;; Restore emacs session.
;(setq initial-buffer-choice t)
;(run-with-timer 1 nil #'(lambda () (bury-buffer)))
;; turn on word-wrap in all buffers
(global-visual-line-mode t)
(setq word-wrap-by-category t) ;; enhanced CJK word wrap since Emacs28
;; line number and column number
(global-display-line-numbers-mode t) ;; show line numbers in every mode
(column-number-mode t) ;; show column number
; Line numbers are not displayed when large files are used.
(setq line-number-display-limit large-file-warning-threshold)
(setq line-number-display-limit-width 1000)
;; parentheses config
(show-paren-mode t) ;; show bracket pairing
(electric-pair-mode t) ;; automatic completion of parentheses
;; highlight current line
(global-hl-line-mode t)
;; auto reload file content
(global-auto-revert-mode t)
;; delete selected text when input on it
(delete-selection-mode t)
;; record recently opened files
(recentf-mode 1)
(setq recentf-max-menu-items 25)
(setq recentf-max-saved-items 25)
;; treat OneWord or one_word as one word
(global-subword-mode t)
;; disable cursor blink
(blink-cursor-mode -1)
;; decompress a file when open it
(auto-compression-mode t)
;; disable the ring bell
(setq ring-bell-function 'ignore)
;; set `text-mode' as default major-mode
(setq default-major-mode 'text-mode)
;; use Posix format for time string
(setq system-time-locale "C")
;; replace yes/no with y/n
;; but since emacs 28 user can use (use-short-answers t) to do it
(fset 'yes-or-no-p 'y-or-n-p)
;; do not show welcome page
(setq inhibit-startup-screen t)
;; use single space as sentence end, default is two
(setq sentence-end-double-space nil)
;; make key prompt faster
(setq echo-keystrokes 0.1)
;; increase IO performance
(setq process-adaptive-read-buffering nil)
(setq read-process-output-max (* 1024 1024))
;; scrolling config
(setq scroll-margin 3
scroll-conservatively 101
auto-window-vscroll nil)
;; clean scratch buffer content
; a non-clean scratch buffer will disturb session restore
(setq initial-scratch-message "")
;; exit emacs without confirmation to kill running processes
(setq confirm-kill-processes nil)
;; resize frame in pixel
(setq frame-resize-pixelwise t)
;; show a big square when cursor is on 'tab'
(setq x-stretch-cursor t)
;; delete duplicate minibuffer history
(setq history-delete-duplicates t)
;; allow scroll in isearch
(setq isearch-allow-scroll t)
;; don't ask me when close emacs with running process
(defadvice save-buffers-kill-emacs (around no-query-kill-emacs activate)
"Prevent annoying \"Active processes exist\" query when you quit Emacs."
(cl-flet ((process-list ())) ad-do-it))
;; don't ask when kill process buffer
(setq kill-buffer-query-functions
(remq 'process-kill-buffer-query-function
kill-buffer-query-functions))
;; (setq byte-compile-warnings
;; (quote (
;; ;; 显示的警告
;; free-vars ;不在当前范围的引用变量
;; unresolved ;不知道的函数
;; callargs ;函数调用的参数和定义的不匹配
;; obsolete ;荒废的变量和函数
;; noruntime ;函数没有定义在运行时期
;; interactive-only ;正常不被调用的命令
;; make-local ;调用 `make-variable-buffer-local' 可能会不正确的
;; mapcar ;`mapcar' 调用
;; ;;
;; ;; 抑制的警告
;; (not redefine) ;重新定义的函数 (比如参数数量改变)
;; (not cl-functions) ;`CL' 包中的运行时调用的函数
;; )))
(provide 'init-generic)
;;; init-generic.el ends here

11
site-lisp/init-config/init-highlight-parentheses.el Normal file
View File

@ -0,0 +1,11 @@
;; -*- coding: utf-8; -*-
;;; Require:
(require 'highlight-parentheses)
;;; Code:
(setq hl-paren-colors '("DarkOrange" "DeepSkyBlue" "DarkRed"))
(add-hook 'find-file-hook 'highlight-parentheses-mode t)
(provide 'init-highlight-parentheses)
;;; init-highlight-parentheses.el ends here

59
site-lisp/init-config/init-indent.el Normal file
View File

@ -0,0 +1,59 @@
;; -*- coding: utf-8; -*-
;;; Require:
;;; Code:
(setq-default indent-tabs-mode nil)
(setq-default tab-width 4)
(defun adjust-languages-indent (n)
(setq-local tab-width n)
(when (or (derived-mode-p 'c-mode))
(setq-local c-basic-offset n))
(when (or (derived-mode-p 'js-mode)
(derived-mode-p 'js2-mode)
(derived-mode-p 'web-mode))
(setq-local javascript-indent-level n)
(setq-local js-indent-level n)
(setq-local js2-basic-offset n)
(setq-local css-indent-offset n)
(setq-local web-mode-attr-indent-offset n)
(setq-local web-mode-attr-value-indent-offset n)
(setq-local web-mode-code-indent-offset n)
(setq-local web-mode-css-indent-offset n)
(setq-local web-mode-markup-indent-offset n)
(setq-local web-mode-sql-indent-offset n)
))
(dolist (hook (list 'c-mode-hook
'c++-mode-hook
'java-mode-hook
'haskell-mode-hook
'asm-mode-hook
'sh-mode-hook
'haskell-cabal-mode-hook
'ruby-mode-hook
'qml-mode-hook
'scss-mode-hook
'python-mode-hook
))
(add-hook hook #'(lambda ()
(adjust-languages-indent 4)
)))
(dolist (hook (list 'lua-mode-hook
'org-mode-hook
'js-mode-hook
'web-mode-hook
'yaml-mode-hook
))
(add-hook hook #'(lambda ()
(adjust-languages-indent 2)
)))
(provide 'init-indent)
;;; init-indent.el ends here

92
site-lisp/init-config/init-mode.el Normal file
View File

@ -0,0 +1,92 @@
;; -*- coding: utf-8; -*-
;;; Require:
(require 'jsonian)
(require 'lua-mode)
;;; Code:
;; bind ext to a specific mode
(defun add-to-alist (alist-var elt-cons &optional no-replace)
"Add to the value of ALIST-VAR an element ELT-CONS if it isn't there yet.
If an element with the same car as the car of ELT-CONS is already present,
replace it with ELT-CONS unless NO-REPLACE is non-nil; if a matching
element is not already present, add ELT-CONS to the front of the alist.
The test for presence of the car of ELT-CONS is done with `equal'."
(let ((existing-element (assoc (car elt-cons) (symbol-value alist-var))))
(if existing-element
(or no-replace
(rplacd existing-element (cdr elt-cons)))
(set alist-var (cons elt-cons (symbol-value alist-var)))))
(symbol-value alist-var))
(dolist (elt-cons '(
("\\.org\\'" . org-mode)
("\\.stumpwmrc\\'" . lisp-mode)
("\\.jl\\'" . lisp-mode)
("\\.asdf\\'" . lisp-mode)
("\\.markdown" . markdown-mode)
("\\.md" . markdown-mode)
("\\.inc\\'" . asm-mode)
("\\.py\\'" . python-mode)
("SConstruct". python-mode)
("\\.lua\\'" . lua-mode)
("\\.json\\'" . jsonian-mode)
("\\.go\\'" . go-mode)
("\\.css\\'" . css-mode)
("\\.wxss\\'" . css-mode)
("\\.pdf\\'" . pdf-view-mode)
("\\.ts\\'" . typescript-mode)
("\\.tsx\\'" . typescript-mode)
("\\.js.erb\\'" . web-mode)
("\\.js\\'" . web-mode)
("\\.wxs\\'" . web-mode)
("\\.vue" . web-mode)
("\\.wxml" . web-mode)
("\\.blade\\.php\\'" . web-mode)
("\\.phtml\\'" . web-mode)
("\\.tpl\\.php\\'" . web-mode)
("\\.jsp\\'" . web-mode)
("\\.mustache\\'" . web-mode)
("\\.djhtml\\'" . web-mode)
("\\.html?\\'" . web-mode)
("\\.jsx\\'" . web-mode)
;; ("\\.rs$" . rust-mode)
("CMakeLists\\.txt\\'" . cmake-mode)
("\\.cmake\\'" . cmake-mode)
))
(add-to-alist 'auto-mode-alist elt-cons))
;;; Mode load.
(autoload 'cmake-mode "cmake-mode")
(autoload 'css-mode "css-mode")
(autoload 'go-mode "go-mode")
(autoload 'jsonian-mode "jsonian-mode")
(autoload 'lua-mode "lua-mode")
(setq lua-indent-level 2)
(autoload 'markdown-mode "markdown-mode")
(autoload 'python-mode "init-python")
(autoload 'web-mode "web-mode")
;; (autoload 'rust-mode "rust-mode")
(provide 'init-mode)
;;; init-mode.el ends here

12
site-lisp/init-config/init-neotree.el Normal file
View File

@ -0,0 +1,12 @@
;; -*- coding: utf-8; -*-
;;; Require:
(require 'neotree)
;;; Code:
(setq neo-theme 'ascii)
(setq neo-show-hidden-files t)
(setq neo-window-width 40)
(provide 'init-neotree)
;;; init-neotree.el ends here

37
site-lisp/init-config/init-org-todo.el Normal file
View File

@ -0,0 +1,37 @@
;; -*- coding: utf-8; -*-
;;; Require:
(require 'org)
;;; Code:
(setq org-agenda-files '("~/Documents/ld_org_todo"))
(setq org-capture-templates
'(
("t" "todo" entry
(file+datetree "~/Documents/ld_org_todo/todo.org")
"* TODO [#C] %?\n\n%i"
:empty-lines 1 :tree-type month)
("w" "waiting" entry
(file+datetree "~/Documents/ld_org_todo/waiting.org")
"* TODO [#C] %?"
:empty-lines 1 :tree-type month)
))
(setq org-refile-targets
'(
("~/Documents/ld_org_todo/todo.org" :maxlevel . 4)
("~/Documents/ld_org_todo/waiting.org" :maxlevel . 4)
(nil :maxlevel . 4)
))
(setq org-use-fast-todo-selection t)
(setq org-todo-keywords '((sequence "TODO(t)" "DOING(i)"
"|" "DONE(d)" "ABORTED(a)")))
(setq org-todo-keyword-faces '(("TODO" . "red")
("DOING" . "blue")
("DONE" . "forest green")
("ABORTED" . "gray")))
(provide 'init-org-todo)
;;; init-org-todo.el ends here.

233
site-lisp/init-config/init-org.el Normal file
View File

@ -0,0 +1,233 @@
;; -*- coding: utf-8; -*-
;;; Require:
(require 'org)
(require 'ox-publish)
;;; Code:
(defun ld-org-update-lastupdate-property ()
"If '#+LASTUPDATE' is in org file, update it to the current date/time."
(when (eq major-mode 'org-mode)
(save-excursion
(widen)
(goto-char (point-min))
(when (re-search-forward "^#\\+LASTUPDATE:" (point-max) t)
(progn
(setq lastupdate-point (point))
(if (not (equal lastupdate-point (line-end-position)))
(delete-region lastupdate-point (line-end-position)))
(insert (format-time-string " %Y/%m/%d %H:%M")))))))
(add-hook 'before-save-hook #'ld-org-update-lastupdate-property)
(setq org-startup-indented nil) ;; enable org-indent-mode at start, default nil.
(setq org-goto-auto-isearch nil)
(setq org-support-shift-select t)
(setq org-use-sub-superscripts '{})
(setq org-export-with-sub-superscripts '{})
;; If it is not nil, strings below will be interpreted in exporting as
;; Org HTML LaTeX UTF-8
;; -----+----------+--------+-------
;; \- &shy; \-
;; -- &ndash; -- –
;; --- &mdash; --- —
;; ... &hellip; \ldots …
(setq org-export-with-special-strings nil)
;; (set-face-attribute 'org-level-1 nil
;; :background "#fdf0ff"
;; :foreground "#000000"
;; :overline "#bcbcbc"
;; :bold t
;; :height 1.3)
;; (set-face-attribute 'org-level-2 nil
;; :foreground "#8f0075"
;; :overline "#bcbcbc"
;; :bold t
;; :height 1.1)
;; (set-face-attribute 'org-level-3 nil
;; :foreground "#093060"
;; :weight 'semi-bold)
;; (set-face-attribute 'org-level-4 nil
;; :foreground "#184034"
;; :weight 'semi-bold)
;; (set-face-attribute 'org-level-5 nil
;; :foreground "#61284f"
;; :weight 'semi-bold)
;; (set-face-attribute 'org-level-6 nil
;; :foreground "#3f3000"
;; :weight 'semi-bold)
;; (set-face-attribute 'org-level-7 nil
;; :foreground "#5f0000"
;; :weight 'semi-bold)
;; (set-face-attribute 'org-level-8 nil
;; :foreground "#541f4f"
;; :weight 'semi-bold)
;; (set-face-attribute 'org-block-begin-line nil
;; :background "#f0f0f0"
;; :foreground "#505050"
;; :extend t)
;; (set-face-attribute 'org-block nil
;; :background "#f8f8f8"
;; :foreground "#000000"
;; :extend t
;; )
;; (set-face-attribute 'org-block-end-line nil
;; :background "#f0f0f0"
;; :foreground "#505050"
;; :extend t)
;; (set-face-attribute 'org-code nil
;; :background "#f0f0f0"
;; :foreground "#005a5f"
;; :extend t)
;; (set-face-attribute 'org-verbatim nil
;; :background "#f0f0f0"
;; :foreground "#8f0075"
;; :extend t)
(defun ld-org-custom-html-src-block (src-block _contents info)
"Transcode a SRC-BLOCK element from Org to HTML.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information.
MAKE FINAL HTML TO BE COMPATIBLE WITH highlight.js"
(if (org-export-read-attribute :attr_html src-block :textarea)
(org-html--textarea-block src-block)
(let ((lang (org-element-property :language src-block))
(caption (org-export-get-caption src-block))
(code (org-html-format-code src-block info))
(label (let ((lbl (and (org-element-property :name src-block)
(org-export-get-reference src-block info))))
(if lbl (format " id=\"%s\"" lbl) ""))))
(if (not lang) (format "<pre class=\"example\"%s>\n%s</pre>" label code)
(format
"<div class=\"org-src-container\">\n%s%s\n</div>"
(if (not caption) ""
(format "<label class=\"org-src-name\">%s</label>"
(org-export-data caption info)))
(format "\n<pre class=\"src src-%s\"%s><code class=\"language-%s\">%s</code></pre>"
lang label lang code))))))
(advice-add 'org-html-src-block :override 'ld-org-custom-html-src-block)
(defun ld-org-custom-html-format-list-item (contents type checkbox info
&optional term-counter-id
headline)
"Format a list item into HTML."
(let ((class (if checkbox
(format " class=\"%s\""
(symbol-name checkbox)) ""))
(checkbox (concat (org-html-checkbox checkbox info)
(and checkbox " ")))
(br (org-html-close-tag "br" nil info))
(extra-newline (if (and (org-string-nw-p contents) headline) "\n" "")))
(concat
(pcase type
(`ordered
(let* ((counter term-counter-id)
(extra (if counter (format " value=\"%s\"" counter) "")))
(concat
(format "<li%s%s>" class extra)
(when headline (concat headline br)))))
(`unordered
(let* ((id term-counter-id)
(extra (if id (format " id=\"%s\"" id) "")))
(concat
(format "<li%s%s>" class extra)
(when headline (concat headline br)))))
(`descriptive
(let* ((term term-counter-id))
(setq term (or term "(no term)"))
;; Check-boxes in descriptive lists are associated to tag.
(concat (format "<dt%s>%s</dt>"
class (concat checkbox term))
"<dd><p>"))))
(unless (eq type 'descriptive) checkbox)
extra-newline
(and (org-string-nw-p contents) (org-trim contents))
extra-newline
(pcase type
(`ordered "</li>")
(`unordered "</li>")
(`descriptive "</p></dd>")))))
(advice-add 'org-html-format-list-item :override 'ld-org-custom-html-format-list-item)
(defun ld-org-export-publish()
"Publish org and then generate sitemap.xml file."
(interactive)
;; import project settings
(require 'ld-org-publish-project-desc)
;; publish site
(org-publish-all)
;; create sitemap for search engine
(let (
;; FULL PATH to doc root. MUST end with a slash.
(ld-site-pub-path-article-root "~/Public/ld_org_article_publish/article/")
;; file name of sitemap file, relative to webroot.
;; file name format: <sitemap-file-name>.xml
(ld-site-sitemap-file-name "sitemap.xml")
;; site domain name
(ld-site-domain-name "lishouzhong.com")
;; gzip it or not. t for true, nil for false.
(ld-site-sitemap-gzip-it-p nil))
(print (concat "begin: " (format-time-string "%Y-%m-%dT%T")))
;; rename file to backup ~ if already exist
(let (f1 f2)
(setq f1 (concat ld-site-pub-path-article-root ld-site-sitemap-file-name))
(setq f2 (concat f1 ".gz"))
(when (file-exists-p f1)
(rename-file f1 (concat f1 "~") t))
(when (file-exists-p f2)
(rename-file f2 (concat f2 "~") t)))
;; create sitemap buffer
(let (article-file-path sitemap-buffer)
(setq article-file-path
(concat ld-site-pub-path-article-root ld-site-sitemap-file-name))
(setq sitemap-buffer (find-file article-file-path))
(erase-buffer)
(set-buffer-file-coding-system 'unix)
(insert "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
<urlset xmlns=\"http://www.sitemaps.org/schemas/sitemap/0.9\">")
(require 'find-lisp)
(let ((process-sitemap-content
(lambda (article-file-path dest-buffer)
(when (not (string-match "/zzz" article-file-path)) ; dir/file starting with zzz are not public
(with-temp-buffer
(insert-file-contents article-file-path nil nil nil t)
(goto-char 1)
(when (not (search-forward "<meta http-equiv=\"refresh\"" nil "noerror"))
(with-current-buffer dest-buffer
(insert "<url><loc>")
(insert (concat
"http://"
ld-site-domain-name
"/"
(substring article-file-path
(length (expand-file-name ld-site-pub-path-article-root)))))
(insert "</loc></url>\n"))))))))
(mapc
(lambda (x) (funcall process-sitemap-content x sitemap-buffer))
(find-lisp-find-files ld-site-pub-path-article-root "\\.html$")))
(insert "</urlset>")
(save-buffer)
(when ld-site-sitemap-gzip-it-p
(shell-command (concat "gzip " article-file-path))))
(print (concat "finished: " (format-time-string "%Y-%m-%dT%T")))))
(provide 'init-org)
;;; init-org.el ends here

45
site-lisp/init-config/init-proxy.el Normal file
View File

@ -0,0 +1,45 @@
;; -*- coding: utf-8; -*-
;;; Require
;;; Code:
(defun proxy-socks-show ()
"Show SOCKS proxy."
(interactive)
(when (fboundp 'cadddr)
(if (bound-and-true-p socks-noproxy)
(message "Current SOCKS%d proxy is %s:%d"
(cadddr socks-server) (cadr socks-server) (caddr socks-server))
(message "No SOCKS proxy"))))
(defun proxy-socks-enable ()
"Enable SOCKS proxy."
(interactive)
(require 'socks)
(setq url-gateway-method 'socks
socks-noproxy '("localhost")
socks-server '("Default server" "127.0.0.1" 10800 5))
(setenv "all_proxy" "socks5://127.0.0.1:10800")
(proxy-socks-show))
(defun proxy-socks-disable ()
"Disable SOCKS proxy."
(interactive)
(require 'socks)
(setq url-gateway-method 'native
socks-noproxy nil)
(setenv "all_proxy" "")
(proxy-socks-show))
(defun proxy-socks-toggle ()
"Toggle SOCKS proxy."
(interactive)
(require 'socks)
(if (bound-and-true-p socks-noproxy)
(proxy-socks-disable)
(proxy-socks-enable)))
;; (proxy-socks-enable)
(provide 'init-proxy)
;;; init-proxy.el ends here

51
site-lisp/init-config/init-session.el Normal file
View File

@ -0,0 +1,51 @@
;; -*- coding: utf-8; -*-
;;; Require:
(require 'auto-save)
;;; Code:
(setq desktop-load-locked-desktop t) ; don't popup dialog ask user, load anyway
(setq desktop-restore-frames nil) ; don't restore any frame
(defun kill-unused-buffers ()
(interactive)
(ignore-errors
(save-excursion
(dolist (buf (buffer-list))
(set-buffer buf)
(when (and (string-prefix-p "*" (buffer-name)) (string-suffix-p "*" (buffer-name)))
(kill-buffer buf))
))))
(defun emacs-session-restore ()
"Restore emacs session."
(interactive)
(ignore-errors
;; Kill other windows.
(delete-other-windows)
;; Kill unused buffers.
(kill-unused-buffers)
;; Restore session.
(desktop-read "~/.emacs.d/")
))
(defun emacs-session-save (&optional arg)
"Save emacs session."
(interactive "p")
(ignore-errors
(if (equal arg 4)
;; Kill all buffers if with prefix argument.
(mapc 'kill-buffer (buffer-list))
;; Kill unused buffers.
(kill-unused-buffers)
;; Save all buffers before exit.
(auto-save-buffers))
;; Save session.
(make-directory "~/.emacs.d/" t)
(desktop-save "~/.emacs.d/")
;; Exit emacs.
(kill-emacs)))
(provide 'init-session)
;;; init-session.el ends here

256
site-lisp/init-config/init-shortcut.el Normal file
View File

@ -0,0 +1,256 @@
;; -*- coding: utf-8; -*-
;;; There are 3 sections:
;;; - unset keys
;;; - extensions
;;; - extensions-local
;;; - shortcut on built-in function
;;; ------------ unset keys
; originally
; 'C-i' is TAB
; 'C-r' is isearch-backward
(lazy-load-unset-keys
'("C-z" "C-\\" "C-'" "C-i" "C-r"))
;;; ------------ extensions
;; ------ ace-window
(lazy-load-global-keys
'(
("M-o" . ace-window)
)
"init-ace-window")
;; ------ avy
(lazy-load-global-keys
'(
("M-g c" . avy-goto-char)
("M-g w" . avy-goto-word-1)
("M-g s" . avy-goto-word-0)
("M-g l l" . avy-goto-line)
("M-g j" . avy-next)
("M-g k" . avy-prev)
)
"init-avy")
;; ------ citre
(lazy-load-global-keys
'(
("C-x c c" . citre-mode)
("C-x c j" . citre-jump)
("C-x c J" . citre-jump-back)
("C-x c p" . citre-ace-peek)
("C-x c u" . citre-update-this-tags-file)
)
"init-citre")
;; ------ theme
(lazy-load-global-keys
'(
("<f5>" . ld-modus-themes-toggle)
)
"init-theme")
;; ------ multiple cursors
(lazy-load-global-keys
'(
("C-M-." . mc/mark-next-like-this)
("C-M-," . mc/unmark-next-like-this)
("M-<" . mc/mark-previous-like-this)
("M->" . mc/unmark-previous-like-this)
("C-M-<" . mc/edit-beginnings-of-lines)
("M-<mouse-1>" . mc/add-cursor-on-click)
)
"multiple-cursors")
;; ------ swiper
(lazy-load-set-keys
'(
("C-s" . swiper-isearch)
("C-c s" . counsel-rg)
))
;;; ------------ extensions-local
(lazy-load-set-keys
'(
;; dired-display-buffer
("o" . dired-display-buffer)
;; dired-narrow
("/" . dired-narrow)
;; dired-subtree
("<tab>" . dired-subtree-cycle)
("SPC" . dired-subtree-toggle)
("C-p" . dired-subtree-previous-sibling)
("C-n" . dired-subtree-next-sibling)
("r" . dired-subtree-revert)
)
dired-mode-map)
(lazy-load-global-keys
'(
("C-c e e" . toggle-echo-keys)
("C-c e c" . echo-keys-clean)
)
"echo-keys") ;show every pressed keys
(lazy-load-global-keys
'(
("C-c x e" . ld-eval-elisp-to-next-line)
)
"evals") ;execute code
(lazy-load-global-keys
'(
("C-<" . ld-un-indent)
("C->" . ld-indent)
)
"force-indent") ;control 4 spaces indent manually
(lazy-load-global-keys
'(
("C-c \\" . goto-last-change)
)
"goto-last-change")
(lazy-load-global-keys
'(
("M-g l p" . goto-line-preview)
)
"goto-line-preview")
(lazy-load-global-keys
'(
("C-c m h a" . highlight-indentation-mode)
("C-c m h c" . highlight-indentation-current-column-mode)
)
"highlight-indentation")
(lazy-load-global-keys
'(
("C-r i" . ld-indent-buffer)
("C-r r" . ld-rename-file-and-buffer)
("C-r d" . ld-delete-file-and-buffer)
("C-r e" . ld-revert-buffer-no-confirm)
("C-i r" . ld-find-file-in-root) ; open file with root by sudo
)
"ld-buffer-operations")
(lazy-load-global-keys
'(
("C-;" . ld-cursor-position-1-store) ;store cursor position
("C-'" . ld-cursor-position-1-jump) ;jump to cursor position
("C-c ," . ld-cursor-position-stack-push) ;push cursor position to stack
("C-c ." . ld-cursor-position-stack-pop) ;pop corsor position from stack
)
"ld-goto-cursor-stack")
(lazy-load-global-keys
'(
("M-N" . ld-delete-one-block-backward)
("M-M" . ld-delete-one-block-forward)
)
"ld-delete-block") ;delete a block (eg. a word) forward and backward
(lazy-load-global-keys
'(
("C-i r" . ld-find-file-in-root) ; open file with root by sudo
)
"ld-file-operations")
(lazy-load-global-keys
'(
("M-g l p" . ld-goto-percent-line)
("M-g t p" . ld-goto-percent-text)
("M-g t c" . ld-goto-column)
)
"ld-goto-simple")
(lazy-load-global-keys
'(
("M-p" . ld-move-text-up)
("M-n" . ld-move-text-down)
("C-c l d" . ld-duplicate-current-line-or-region)
("C-c l D" . ld-duplicate-and-comment-current-line-or-region)
("C-c l k" . ld-delete-current-line)
("C-c m l" . ld-mark-line)
)
"ld-text-operations")
(lazy-load-global-keys
'(
("C-c w t" . ld-toggle-one-window)
)
"ld-toggle-one-window") ;maxmize current window and size back
(lazy-load-global-keys
'(("C-x j" . neotree-toggle))
"init-neotree")
(lazy-load-global-keys
'(
("M-j" . watch-next-window-up-line) ; 'up' to see previous content
("M-k" . watch-next-window-down-line) ; 'down' to see further content
("M-J" . watch-next-window-up)
("M-K" . watch-next-window-down)
)
"scroll-next-window")
(lazy-load-global-keys
'(
("<f4>" . emacs-session-save)
)
"init-session")
;;; ------------ shortcut on built-in function
;; ------ org related
(lazy-load-set-keys
'(
("C-c o c" . org-capture)
("C-c o a" . org-agenda)
("C-c o l r" . org-list-repair)
))
;; ------ move cursors in current buffer
(lazy-load-set-keys
'(
("M-g b k" . beginning-of-buffer)
("M-g b j" . end-of-buffer)
("M-g h j" . forward-paragraph)
("M-g h k" . backward-paragraph)
("M-g l y" . backward-up-list) ;向左跳出 LIST
("M-g l o" . up-list) ;向右跳出 LIST
("M-g l u" . backward-down-list) ;向左跳进 LIST
("M-g l i" . down-list) ;向右跳进 LIST
("M-g f a" . beginning-of-defun) ;函数开头
("M-g f e" . end-of-defun) ;函数末尾
))
;; ------ other
(lazy-load-set-keys
'(
("C-z r" . global-hl-line-mode)
("C-z l" . display-line-numbers-mode)
("M--" . text-scale-decrease)
("M-=" . text-scale-increase)
("M-," . bury-buffer)
("M-." . unbury-buffer)
("C-c m m" . set-mark-command) ; replace C-Space for Chinese input method
("M-;" . comment-dwim)
("C-c r" . recentf-open-files)
))
(provide 'init-shortcut)
;;; init-shortcut.el ends here

34
site-lisp/init-config/init-swiper.el Normal file
View File

@ -0,0 +1,34 @@
;; -*- coding: utf-8; -*-
;;; Require:
(require 'ivy)
(require 'counsel)
(require 'swiper)
;;; Code:
(setq ivy-use-virtual-buffers t)
(setq ivy-initial-inputs-alist nil)
(setq ivy-count-format "(%d/%d) ")
;; Map commands to their minimum required input length.
;; That is the number of characters prompted for before fetching
;; candidates. The special key t is used as a fallback.
(setq ivy-more-chars-alist '((t . 2)))
(ivy-mode 1)
(setq counsel-rg-base-command
`("rg"
"--max-columns" "0"
"--with-filename"
"--no-heading"
"--line-number"
"--color" "never"
"%s"
,@(and (memq system-type '(ms-dos windows-nt))
(list "--path-separator" "/" "."))))
(counsel-mode 1)
(provide 'init-swiper)
;; init-swiper.el ends here

82
site-lisp/init-config/init-theme.el Normal file
View File

@ -0,0 +1,82 @@
;; -*- coding: utf-8; -*-
;;; Require:
(require 'modus-themes)
;;; Code:
;; font
(when (and window-system *win64*)
(let ((default-font (font-spec :name "Sarasa Fixed SC"))
(cn-font (font-spec :name "Sarasa Fixed SC")))
(set-face-attribute 'default nil :font default-font :height 116)
(dolist (charset '(kana han symbol cjk-misc bopomofo))
(set-fontset-font t charset cn-font)))
(set-face-font 'fixed-pitch "Sarasa Fixed SC"))
;; theme
;; In all of the following, WEIGHT is a symbol such as `semibold',
;; `light', `bold', or anything mentioned in `modus-themes-weights'.
(setq modus-themes-italic-constructs t
modus-themes-bold-constructs nil
modus-themes-mixed-fonts t
modus-themes-variable-pitch-ui nil
modus-themes-custom-auto-reload t
modus-themes-disable-other-themes t
;; Options for `modus-themes-prompts' are either nil (the
;; default), or a list of properties that may include any of those
;; symbols: `italic', `WEIGHT'
modus-themes-prompts '(italic bold)
;; The `modus-themes-completions' is an alist that reads two
;; keys: `matches', `selection'. Each accepts a nil value (or
;; empty list) or a list of properties that can include any of
;; the following (for WEIGHT read further below):
;;
;; `matches' :: `underline', `italic', `WEIGHT'
;; `selection' :: `underline', `italic', `WEIGHT'
modus-themes-completions
'((matches . (extrabold))
(selection . (semibold italic text-also)))
modus-themes-org-blocks 'gray-background ; {nil,'gray-background,'tinted-background}
;; The `modus-themes-headings' is an alist: read the manual's
;; node about it or its doc string. Basically, it supports
;; per-level configurations for the optional use of
;; `variable-pitch' typography, a height value as a multiple of
;; the base font size (e.g. 1.5), and a `WEIGHT'.
modus-themes-headings
'((1 . (variable-pitch 1.5))
(2 . (1.3))
(agenda-date . (1.3))
(agenda-structure . (variable-pitch light 1.8))
(t . (1.1))))
(defun ld-modus-operandi ()
"Light theme."
(interactive)
;; load theme firstly and then do user customization
;; otherwise modus-themes will override the face user had assigned
(load-theme 'modus-operandi :no-confirm))
(defun ld-modus-vivendi-tinted ()
"Dark theme."
(interactive)
;; load theme firstly and then do user customization
;; otherwise modus-themes will override the face user had assigned
(load-theme 'modus-vivendi-tinted :no-confirm))
(defun ld-modus-themes-toggle ()
(interactive)
(if (eq (car custom-enabled-themes) 'modus-operandi)
(ld-modus-vivendi-tinted)
(ld-modus-operandi)))
;; active light theme
(if window-system
(ld-modus-operandi)
(ld-modus-vivendi-tinted))
(provide 'init-theme)
;;; init-theme.el ends here

14
site-lisp/init-config/init-time.el Normal file
View File

@ -0,0 +1,14 @@
;; -*- coding: utf-8; -*-
;;; Require:
;;; Code:
(setq display-time-day-and-date t)
(setq display-time-format "%Y/%m/%d %H:%M")
(setq display-time-24hr-format t)
(display-time-mode 1)
(display-time)
(provide 'init-time)
;;; init-time.el ends here

19
site-lisp/init-config/init-undo-tree.el Normal file
View File

@ -0,0 +1,19 @@
;; -*- coding: utf-8; -*-
;;; Require:
(require 'undo-tree)
;;; Code:
(global-undo-tree-mode)
;; ;; --- undo-tree
;; (lazy-load-local-keys
;; '(
;; ("C-/" . undo-tree-undo)
;; ("C-?" . undo-tree-redo)
;; )
;; undo-tree-map
;; "undo-tree")
(provide 'init-undo-tree)
;;; init-undo-tree.el ends here

17
site-lisp/init-config/init-which-key.el Normal file
View File

@ -0,0 +1,17 @@
;; -*- coding: utf-8; -*-
;;; Require:
(require 'which-key)
;;; Code:
(setq which-key-show-early-on-C-h t)
(setq which-key-idle-delay 10000)
(setq which-key-idle-secondary-delay 0.05)
(setq which-key-max-description-length nil) ;; show entire key name
(which-key-mode)
(which-key-setup-side-window-bottom)
(provide 'init-which-key)
;;; init-which-key.el ends here

17
site-lisp/init-config/init-yasnippet.el Normal file
View File

@ -0,0 +1,17 @@
;; -*- coding: utf-8; -*-
;;; Require:
(require 'yasnippet)
;;; Code:
(setq yas-snippet-dirs (list (concat ld-emacs-root-dir "/snippets")))
(yas-global-mode 1)
;; Disable yasnippet mode on some mode.
(dolist (hooks (list
'term-mode-hook
))
(add-hook hooks #'(lambda () (yas-minor-mode -1))))
(provide 'init-yasnippet)
;;; init-yasnippet.el ends here

46
site-lisp/init-config/init.el Normal file
View File

@ -0,0 +1,46 @@
;;; -*- coding: utf-8-unix; lexical-binding: t; -*-
(let (
;; Make startup faster by reducing the frequency of garbage collection.
;; default (* 800 1000) bytes
(gc-cons-threshold most-positive-fixnum)
;; default 0.1
(gc-cons-percentage 0.6))
;; keep frame size
(setq frame-inhibit-implied-resize t)
;; from local extensions
;; firstly loaded part
(require 'init-theme)
(require 'lazy-load)
(require 'init-generic)
(require 'ld-tools)
(require 'init-auto-save)
(require 'init-coding-system)
(require 'init-company-mode)
(require 'init-dired)
(require 'init-highlight-parentheses)
(require 'init-indent)
(require 'init-mode)
(require 'init-org-todo)
(require 'init-org)
(require 'init-proxy)
(require 'init-swiper)
(require 'init-time)
(require 'init-undo-tree)
(require 'init-which-key)
(require 'init-yasnippet)
;; restore session
(require 'init-session)
(emacs-session-restore)
;; finally load other plugins dynamically
(require 'init-shortcut)
)
(provide 'init)
;;; init.el ends here

6
site-lisp/snippets/lua-mode/function Normal file
View File

@ -0,0 +1,6 @@
# -*- mode: snippet -*-
# name: function
# key: fun
# --
function ${1: fun_name}()
end

8
site-lisp/snippets/org-mode/bloghead Normal file
View File

@ -0,0 +1,8 @@
# -*- mode: snippet -*-
# name: bloghead
# key: bh
# --
#+TITLE:
#+DATE:
#+LASTUPDATE:

7
site-lisp/snippets/org-mode/notehead Normal file
View File

@ -0,0 +1,7 @@
# -*- mode: snippet -*-
# name: notehead
# key: nh
# --
#+TITLE:
#+LASTUPDATE:

6
site-lisp/snippets/sh-mode/bang Normal file
View File

@ -0,0 +1,6 @@
# -*- mode: snippet -*-
# name: bang
# key: !
# --
#!/usr/bin/env bash
$0

5
site-lisp/snippets/snippet-mode/cont Normal file
View File

@ -0,0 +1,5 @@
# -*- mode: snippet -*-
# name: cont
# key: cont
# --
# contributor: `user-full-name`

5
site-lisp/snippets/snippet-mode/elisp Normal file
View File

@ -0,0 +1,5 @@
# -*- mode: snippet -*-
# name: elisp
# key: `
# --
\`$0\`

6
site-lisp/snippets/snippet-mode/field Normal file
View File

@ -0,0 +1,6 @@
# name : ${ ... } field
# contributor : joaotavora
# key : $f
# key: field
# --
\${${1:${2:n}:}$3${4:\$(${5:lisp-fn})}\}$0

5
site-lisp/snippets/snippet-mode/group Normal file
View File

@ -0,0 +1,5 @@
# -*- mode: snippet -*-
# name: group
# key: group
# --
# group : ${1:group}

6
site-lisp/snippets/snippet-mode/mirror Normal file
View File

@ -0,0 +1,6 @@
# name : ${n:$(...)} mirror
# key : $m
# contributor : joaotavora
# key: mirror
# --
\${${2:n}:${4:\$(${5:reflection-fn})}\}$0

13
site-lisp/snippets/snippet-mode/vars Normal file
View File

@ -0,0 +1,13 @@
# -*- mode: snippet -*-
# name : Snippet header
# contributor : joaotavora
# key: vars
# --
# name : $1${2:
# key : ${3:trigger-key}}${4:
# keybinding : ${5:keybinding}}${6:
# expand-env : (${7:})}
# contributor : $6
# key: vars
# --
$0

51
site-start.el Normal file
View File

@ -0,0 +1,51 @@
(require 'cl-lib)
(defun add-subdirs-to-load-path (search-dir)
(interactive)
(let* ((dir (file-name-as-directory search-dir)))
(dolist (subdir
;; 过滤出不必要的目录，提升Emacs启动速度
(cl-remove-if
#'(lambda (subdir)
(or
;; 不是目录的文件都移除
(not (file-directory-p (concat dir subdir)))
;; 父目录、 语言相关和版本控制目录都移除
(member subdir '("." ".."
"dist" "node_modules" "__pycache__"
"RCS" "CVS" "rcs" "cvs" ".git" ".github"))))
(directory-files dir)))
(let ((subdir-path (concat dir (file-name-as-directory subdir))))
;; 目录下有 .el .so .dll 文件的路径才添加到 `load-path' 中，提升Emacs启动速度
(when (cl-some #'(lambda (subdir-file)
(and (file-regular-p (concat subdir-path subdir-file))
;; .so .dll 文件指非Elisp语言编写的Emacs动态库
(member (file-name-extension subdir-file) '("el" "so" "dll"))))
(directory-files subdir-path))
;; 注意：add-to-list 函数的第三个参数必须为 t ，表示加到列表末尾
;; 这样Emacs会从父目录到子目录的顺序搜索Elisp插件，顺序反过来会导致Emacs无法正常启动
(add-to-list 'load-path subdir-path t))
;; 继续递归搜索子目录
(add-subdirs-to-load-path subdir-path)))))
;; get emacs version and operating system type
(defvar *emacs27* (>= emacs-major-version 27))
(defvar *is-a-mac* (eq system-type 'darwin))
(defvar *win64* (eq system-type 'windows-nt))
(defvar *cygwin* (eq system-type 'cygwin))
(defvar *linux* (or (eq system-type 'gnu/linux) (eq system-type 'linux)))
(defvar *unix* (or *linux*
(eq system-type 'usg-unix-v)
(eq system-type 'berkeley-unix)))
(defvar ld-emacs-root-dir (file-truename "~/ld-emacs/site-lisp"))
(if *win64*
(add-subdirs-to-load-path ld-emacs-root-dir))
(if *linux*
(add-subdirs-to-load-path "/usr/share/emacs/ld"))
(require 'init)