pax_global_header00006660000000000000000000000064132242016270014511gustar00rootroot0000000000000052 comment=f18720ff5cd963a0bf6fc0e41293e50c0172b8ae bbdb3-3.2/000077500000000000000000000000001322420162700123315ustar00rootroot00000000000000bbdb3-3.2/.gitignore000066400000000000000000000003601322420162700143200ustar00rootroot00000000000000*.elc *.info /lisp/bbdb-loaddefs.el /lisp/bbdb-site.el /lisp/bbdb-pkg.el /lisp/TAGS /doc/bbdb.pdf /doc/bbdb.t2p/ /doc/texinfo.tex /doc/dir Makefile Makefile.in /autom4te.cache/ /config.* /configure /aclocal.m4 /install-sh /INSTALL /missing bbdb3-3.2/AUTHORS000066400000000000000000000042051322420162700134020ustar00rootroot00000000000000Many people have contributed code included in BBDB. Abhi Yerra Adam C. Finnefrock Alex Schroeder Albert L. Ting Barak A. Pearlmutter Robert Widhopf-Fenk Boris Goldowsky : bbdb-print.el David Carlton Christopher Kline Colin Rafferty Soren Dayton Didier Verna Brian Edmonds Christian Egli Dave Love Greg Troxel Gijs Hillenius Dirk Grunwald : bbdb-print.el Hrvoje Niksic Ivan Kanis : bbdb-ispell Jack Repenning : bbdb-mhe.el Simon Josefsson Jeff Bigler Jeff Mincy Jim Blandy Jim Blandy Jochen Küpper John Heidemann : bbdb-snarf.el Jamie Zawinski Kees de Bruin Karl Fogel Fritz Knabe : bbdb-mhe.el Kousik Nandy Carsten Leonhardt Luigi Semenzato : bbdb-print.el Marco Walther Stefan Monnier Jean-Yves Perrier Jens-Ulrik Holger Petersen Philip Hudson Leo Liu Sam Steingold Seth Golub Matt Simmons SL Baur Kevin Davidson : bbdb-pgp.el Todd Kaufmann : bbdb-mhe.el Tom Tromey Teodor Zlatanov Waider Christoph Wedler Roland Winkler Steve Youngs ShengHuo Zhu Local Variables: coding: utf-8 End: bbdb3-3.2/COPYING000066400000000000000000001045131322420162700133700ustar00rootroot00000000000000 GNU GENERAL PUBLIC LICENSE Version 3, 29 June 2007 Copyright (C) 2007 Free Software Foundation, Inc. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The GNU General Public License is a free, copyleft license for software and other kinds of works. The licenses for most software and other practical works are designed to take away your freedom to share and change the works. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change all versions of a program--to make sure it remains free software for all its users. We, the Free Software Foundation, use the GNU General Public License for most of our software; it applies also to any other work released this way by its authors. You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for them if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs, and that you know you can do these things. To protect your rights, we need to prevent others from denying you these rights or asking you to surrender the rights. Therefore, you have certain responsibilities if you distribute copies of the software, or if you modify it: responsibilities to respect the freedom of others. For example, if you distribute copies of such a program, whether gratis or for a fee, you must pass on to the recipients the same freedoms that you received. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. Developers that use the GNU GPL protect your rights with two steps: (1) assert copyright on the software, and (2) offer you this License giving you legal permission to copy, distribute and/or modify it. For the developers' and authors' protection, the GPL clearly explains that there is no warranty for this free software. For both users' and authors' sake, the GPL requires that modified versions be marked as changed, so that their problems will not be attributed erroneously to authors of previous versions. Some devices are designed to deny users access to install or run modified versions of the software inside them, although the manufacturer can do so. This is fundamentally incompatible with the aim of protecting users' freedom to change the software. The systematic pattern of such abuse occurs in the area of products for individuals to use, which is precisely where it is most unacceptable. Therefore, we have designed this version of the GPL to prohibit the practice for those products. If such problems arise substantially in other domains, we stand ready to extend this provision to those domains in future versions of the GPL, as needed to protect the freedom of users. Finally, every program is threatened constantly by software patents. States should not allow patents to restrict development and use of software on general-purpose computers, but in those that do, we wish to avoid the special danger that patents applied to a free program could make it effectively proprietary. To prevent this, the GPL assures that patents cannot be used to render the program non-free. The precise terms and conditions for copying, distribution and modification follow. TERMS AND CONDITIONS 0. Definitions. "This License" refers to version 3 of the GNU General Public License. "Copyright" also means copyright-like laws that apply to other kinds of works, such as semiconductor masks. "The Program" refers to any copyrightable work licensed under this License. Each licensee is addressed as "you". "Licensees" and "recipients" may be individuals or organizations. To "modify" a work means to copy from or adapt all or part of the work in a fashion requiring copyright permission, other than the making of an exact copy. The resulting work is called a "modified version" of the earlier work or a work "based on" the earlier work. A "covered work" means either the unmodified Program or a work based on the Program. To "propagate" a work means to do anything with it that, without permission, would make you directly or secondarily liable for infringement under applicable copyright law, except executing it on a computer or modifying a private copy. Propagation includes copying, distribution (with or without modification), making available to the public, and in some countries other activities as well. To "convey" a work means any kind of propagation that enables other parties to make or receive copies. Mere interaction with a user through a computer network, with no transfer of a copy, is not conveying. An interactive user interface displays "Appropriate Legal Notices" to the extent that it includes a convenient and prominently visible feature that (1) displays an appropriate copyright notice, and (2) tells the user that there is no warranty for the work (except to the extent that warranties are provided), that licensees may convey the work under this License, and how to view a copy of this License. If the interface presents a list of user commands or options, such as a menu, a prominent item in the list meets this criterion. 1. Source Code. The "source code" for a work means the preferred form of the work for making modifications to it. "Object code" means any non-source form of a work. A "Standard Interface" means an interface that either is an official standard defined by a recognized standards body, or, in the case of interfaces specified for a particular programming language, one that is widely used among developers working in that language. The "System Libraries" of an executable work include anything, other than the work as a whole, that (a) is included in the normal form of packaging a Major Component, but which is not part of that Major Component, and (b) serves only to enable use of the work with that Major Component, or to implement a Standard Interface for which an implementation is available to the public in source code form. A "Major Component", in this context, means a major essential component (kernel, window system, and so on) of the specific operating system (if any) on which the executable work runs, or a compiler used to produce the work, or an object code interpreter used to run it. The "Corresponding Source" for a work in object code form means all the source code needed to generate, install, and (for an executable work) run the object code and to modify the work, including scripts to control those activities. However, it does not include the work's System Libraries, or general-purpose tools or generally available free programs which are used unmodified in performing those activities but which are not part of the work. For example, Corresponding Source includes interface definition files associated with source files for the work, and the source code for shared libraries and dynamically linked subprograms that the work is specifically designed to require, such as by intimate data communication or control flow between those subprograms and other parts of the work. The Corresponding Source need not include anything that users can regenerate automatically from other parts of the Corresponding Source. The Corresponding Source for a work in source code form is that same work. 2. Basic Permissions. All rights granted under this License are granted for the term of copyright on the Program, and are irrevocable provided the stated conditions are met. This License explicitly affirms your unlimited permission to run the unmodified Program. The output from running a covered work is covered by this License only if the output, given its content, constitutes a covered work. This License acknowledges your rights of fair use or other equivalent, as provided by copyright law. You may make, run and propagate covered works that you do not convey, without conditions so long as your license otherwise remains in force. You may convey covered works to others for the sole purpose of having them make modifications exclusively for you, or provide you with facilities for running those works, provided that you comply with the terms of this License in conveying all material for which you do not control copyright. Those thus making or running the covered works for you must do so exclusively on your behalf, under your direction and control, on terms that prohibit them from making any copies of your copyrighted material outside their relationship with you. Conveying under any other circumstances is permitted solely under the conditions stated below. Sublicensing is not allowed; section 10 makes it unnecessary. 3. Protecting Users' Legal Rights From Anti-Circumvention Law. No covered work shall be deemed part of an effective technological measure under any applicable law fulfilling obligations under article 11 of the WIPO copyright treaty adopted on 20 December 1996, or similar laws prohibiting or restricting circumvention of such measures. When you convey a covered work, you waive any legal power to forbid circumvention of technological measures to the extent such circumvention is effected by exercising rights under this License with respect to the covered work, and you disclaim any intention to limit operation or modification of the work as a means of enforcing, against the work's users, your or third parties' legal rights to forbid circumvention of technological measures. 4. Conveying Verbatim Copies. You may convey verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice; keep intact all notices stating that this License and any non-permissive terms added in accord with section 7 apply to the code; keep intact all notices of the absence of any warranty; and give all recipients a copy of this License along with the Program. You may charge any price or no price for each copy that you convey, and you may offer support or warranty protection for a fee. 5. Conveying Modified Source Versions. You may convey a work based on the Program, or the modifications to produce it from the Program, in the form of source code under the terms of section 4, provided that you also meet all of these conditions: a) The work must carry prominent notices stating that you modified it, and giving a relevant date. b) The work must carry prominent notices stating that it is released under this License and any conditions added under section 7. This requirement modifies the requirement in section 4 to "keep intact all notices". c) You must license the entire work, as a whole, under this License to anyone who comes into possession of a copy. This License will therefore apply, along with any applicable section 7 additional terms, to the whole of the work, and all its parts, regardless of how they are packaged. This License gives no permission to license the work in any other way, but it does not invalidate such permission if you have separately received it. d) If the work has interactive user interfaces, each must display Appropriate Legal Notices; however, if the Program has interactive interfaces that do not display Appropriate Legal Notices, your work need not make them do so. A compilation of a covered work with other separate and independent works, which are not by their nature extensions of the covered work, and which are not combined with it such as to form a larger program, in or on a volume of a storage or distribution medium, is called an "aggregate" if the compilation and its resulting copyright are not used to limit the access or legal rights of the compilation's users beyond what the individual works permit. Inclusion of a covered work in an aggregate does not cause this License to apply to the other parts of the aggregate. 6. Conveying Non-Source Forms. You may convey a covered work in object code form under the terms of sections 4 and 5, provided that you also convey the machine-readable Corresponding Source under the terms of this License, in one of these ways: a) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by the Corresponding Source fixed on a durable physical medium customarily used for software interchange. b) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by a written offer, valid for at least three years and valid for as long as you offer spare parts or customer support for that product model, to give anyone who possesses the object code either (1) a copy of the Corresponding Source for all the software in the product that is covered by this License, on a durable physical medium customarily used for software interchange, for a price no more than your reasonable cost of physically performing this conveying of source, or (2) access to copy the Corresponding Source from a network server at no charge. c) Convey individual copies of the object code with a copy of the written offer to provide the Corresponding Source. This alternative is allowed only occasionally and noncommercially, and only if you received the object code with such an offer, in accord with subsection 6b. d) Convey the object code by offering access from a designated place (gratis or for a charge), and offer equivalent access to the Corresponding Source in the same way through the same place at no further charge. You need not require recipients to copy the Corresponding Source along with the object code. If the place to copy the object code is a network server, the Corresponding Source may be on a different server (operated by you or a third party) that supports equivalent copying facilities, provided you maintain clear directions next to the object code saying where to find the Corresponding Source. Regardless of what server hosts the Corresponding Source, you remain obligated to ensure that it is available for as long as needed to satisfy these requirements. e) Convey the object code using peer-to-peer transmission, provided you inform other peers where the object code and Corresponding Source of the work are being offered to the general public at no charge under subsection 6d. A separable portion of the object code, whose source code is excluded from the Corresponding Source as a System Library, need not be included in conveying the object code work. A "User Product" is either (1) a "consumer product", which means any tangible personal property which is normally used for personal, family, or household purposes, or (2) anything designed or sold for incorporation into a dwelling. In determining whether a product is a consumer product, doubtful cases shall be resolved in favor of coverage. For a particular product received by a particular user, "normally used" refers to a typical or common use of that class of product, regardless of the status of the particular user or of the way in which the particular user actually uses, or expects or is expected to use, the product. A product is a consumer product regardless of whether the product has substantial commercial, industrial or non-consumer uses, unless such uses represent the only significant mode of use of the product. "Installation Information" for a User Product means any methods, procedures, authorization keys, or other information required to install and execute modified versions of a covered work in that User Product from a modified version of its Corresponding Source. The information must suffice to ensure that the continued functioning of the modified object code is in no case prevented or interfered with solely because modification has been made. If you convey an object code work under this section in, or with, or specifically for use in, a User Product, and the conveying occurs as part of a transaction in which the right of possession and use of the User Product is transferred to the recipient in perpetuity or for a fixed term (regardless of how the transaction is characterized), the Corresponding Source conveyed under this section must be accompanied by the Installation Information. But this requirement does not apply if neither you nor any third party retains the ability to install modified object code on the User Product (for example, the work has been installed in ROM). The requirement to provide Installation Information does not include a requirement to continue to provide support service, warranty, or updates for a work that has been modified or installed by the recipient, or for the User Product in which it has been modified or installed. Access to a network may be denied when the modification itself materially and adversely affects the operation of the network or violates the rules and protocols for communication across the network. Corresponding Source conveyed, and Installation Information provided, in accord with this section must be in a format that is publicly documented (and with an implementation available to the public in source code form), and must require no special password or key for unpacking, reading or copying. 7. Additional Terms. "Additional permissions" are terms that supplement the terms of this License by making exceptions from one or more of its conditions. Additional permissions that are applicable to the entire Program shall be treated as though they were included in this License, to the extent that they are valid under applicable law. If additional permissions apply only to part of the Program, that part may be used separately under those permissions, but the entire Program remains governed by this License without regard to the additional permissions. When you convey a copy of a covered work, you may at your option remove any additional permissions from that copy, or from any part of it. (Additional permissions may be written to require their own removal in certain cases when you modify the work.) You may place additional permissions on material, added by you to a covered work, for which you have or can give appropriate copyright permission. Notwithstanding any other provision of this License, for material you add to a covered work, you may (if authorized by the copyright holders of that material) supplement the terms of this License with terms: a) Disclaiming warranty or limiting liability differently from the terms of sections 15 and 16 of this License; or b) Requiring preservation of specified reasonable legal notices or author attributions in that material or in the Appropriate Legal Notices displayed by works containing it; or c) Prohibiting misrepresentation of the origin of that material, or requiring that modified versions of such material be marked in reasonable ways as different from the original version; or d) Limiting the use for publicity purposes of names of licensors or authors of the material; or e) Declining to grant rights under trademark law for use of some trade names, trademarks, or service marks; or f) Requiring indemnification of licensors and authors of that material by anyone who conveys the material (or modified versions of it) with contractual assumptions of liability to the recipient, for any liability that these contractual assumptions directly impose on those licensors and authors. All other non-permissive additional terms are considered "further restrictions" within the meaning of section 10. If the Program as you received it, or any part of it, contains a notice stating that it is governed by this License along with a term that is a further restriction, you may remove that term. If a license document contains a further restriction but permits relicensing or conveying under this License, you may add to a covered work material governed by the terms of that license document, provided that the further restriction does not survive such relicensing or conveying. If you add terms to a covered work in accord with this section, you must place, in the relevant source files, a statement of the additional terms that apply to those files, or a notice indicating where to find the applicable terms. Additional terms, permissive or non-permissive, may be stated in the form of a separately written license, or stated as exceptions; the above requirements apply either way. 8. Termination. You may not propagate or modify a covered work except as expressly provided under this License. Any attempt otherwise to propagate or modify it is void, and will automatically terminate your rights under this License (including any patent licenses granted under the third paragraph of section 11). However, if you cease all violation of this License, then your license from a particular copyright holder is reinstated (a) provisionally, unless and until the copyright holder explicitly and finally terminates your license, and (b) permanently, if the copyright holder fails to notify you of the violation by some reasonable means prior to 60 days after the cessation. Moreover, your license from a particular copyright holder is reinstated permanently if the copyright holder notifies you of the violation by some reasonable means, this is the first time you have received notice of violation of this License (for any work) from that copyright holder, and you cure the violation prior to 30 days after your receipt of the notice. Termination of your rights under this section does not terminate the licenses of parties who have received copies or rights from you under this License. If your rights have been terminated and not permanently reinstated, you do not qualify to receive new licenses for the same material under section 10. 9. Acceptance Not Required for Having Copies. You are not required to accept this License in order to receive or run a copy of the Program. Ancillary propagation of a covered work occurring solely as a consequence of using peer-to-peer transmission to receive a copy likewise does not require acceptance. However, nothing other than this License grants you permission to propagate or modify any covered work. These actions infringe copyright if you do not accept this License. Therefore, by modifying or propagating a covered work, you indicate your acceptance of this License to do so. 10. Automatic Licensing of Downstream Recipients. Each time you convey a covered work, the recipient automatically receives a license from the original licensors, to run, modify and propagate that work, subject to this License. You are not responsible for enforcing compliance by third parties with this License. An "entity transaction" is a transaction transferring control of an organization, or substantially all assets of one, or subdividing an organization, or merging organizations. If propagation of a covered work results from an entity transaction, each party to that transaction who receives a copy of the work also receives whatever licenses to the work the party's predecessor in interest had or could give under the previous paragraph, plus a right to possession of the Corresponding Source of the work from the predecessor in interest, if the predecessor has it or can get it with reasonable efforts. You may not impose any further restrictions on the exercise of the rights granted or affirmed under this License. For example, you may not impose a license fee, royalty, or other charge for exercise of rights granted under this License, and you may not initiate litigation (including a cross-claim or counterclaim in a lawsuit) alleging that any patent claim is infringed by making, using, selling, offering for sale, or importing the Program or any portion of it. 11. Patents. A "contributor" is a copyright holder who authorizes use under this License of the Program or a work on which the Program is based. The work thus licensed is called the contributor's "contributor version". A contributor's "essential patent claims" are all patent claims owned or controlled by the contributor, whether already acquired or hereafter acquired, that would be infringed by some manner, permitted by this License, of making, using, or selling its contributor version, but do not include claims that would be infringed only as a consequence of further modification of the contributor version. For purposes of this definition, "control" includes the right to grant patent sublicenses in a manner consistent with the requirements of this License. Each contributor grants you a non-exclusive, worldwide, royalty-free patent license under the contributor's essential patent claims, to make, use, sell, offer for sale, import and otherwise run, modify and propagate the contents of its contributor version. In the following three paragraphs, a "patent license" is any express agreement or commitment, however denominated, not to enforce a patent (such as an express permission to practice a patent or covenant not to sue for patent infringement). To "grant" such a patent license to a party means to make such an agreement or commitment not to enforce a patent against the party. If you convey a covered work, knowingly relying on a patent license, and the Corresponding Source of the work is not available for anyone to copy, free of charge and under the terms of this License, through a publicly available network server or other readily accessible means, then you must either (1) cause the Corresponding Source to be so available, or (2) arrange to deprive yourself of the benefit of the patent license for this particular work, or (3) arrange, in a manner consistent with the requirements of this License, to extend the patent license to downstream recipients. "Knowingly relying" means you have actual knowledge that, but for the patent license, your conveying the covered work in a country, or your recipient's use of the covered work in a country, would infringe one or more identifiable patents in that country that you have reason to believe are valid. If, pursuant to or in connection with a single transaction or arrangement, you convey, or propagate by procuring conveyance of, a covered work, and grant a patent license to some of the parties receiving the covered work authorizing them to use, propagate, modify or convey a specific copy of the covered work, then the patent license you grant is automatically extended to all recipients of the covered work and works based on it. A patent license is "discriminatory" if it does not include within the scope of its coverage, prohibits the exercise of, or is conditioned on the non-exercise of one or more of the rights that are specifically granted under this License. You may not convey a covered work if you are a party to an arrangement with a third party that is in the business of distributing software, under which you make payment to the third party based on the extent of your activity of conveying the work, and under which the third party grants, to any of the parties who would receive the covered work from you, a discriminatory patent license (a) in connection with copies of the covered work conveyed by you (or copies made from those copies), or (b) primarily for and in connection with specific products or compilations that contain the covered work, unless you entered into that arrangement, or that patent license was granted, prior to 28 March 2007. Nothing in this License shall be construed as excluding or limiting any implied license or other defenses to infringement that may otherwise be available to you under applicable patent law. 12. No Surrender of Others' Freedom. If conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot convey a covered work so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not convey it at all. For example, if you agree to terms that obligate you to collect a royalty for further conveying from those to whom you convey the Program, the only way you could satisfy both those terms and this License would be to refrain entirely from conveying the Program. 13. Use with the GNU Affero General Public License. Notwithstanding any other provision of this License, you have permission to link or combine any covered work with a work licensed under version 3 of the GNU Affero General Public License into a single combined work, and to convey the resulting work. The terms of this License will continue to apply to the part which is the covered work, but the special requirements of the GNU Affero General Public License, section 13, concerning interaction through a network will apply to the combination as such. 14. Revised Versions of this License. The Free Software Foundation may publish revised and/or new versions of the GNU General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies that a certain numbered version of the GNU General Public License "or any later version" applies to it, you have the option of following the terms and conditions either of that numbered version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the GNU General Public License, you may choose any version ever published by the Free Software Foundation. If the Program specifies that a proxy can decide which future versions of the GNU General Public License can be used, that proxy's public statement of acceptance of a version permanently authorizes you to choose that version for the Program. Later license versions may give you additional or different permissions. However, no additional obligations are imposed on any author or copyright holder as a result of your choosing to follow a later version. 15. Disclaimer of Warranty. THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. Limitation of Liability. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 17. Interpretation of Sections 15 and 16. If the disclaimer of warranty and limitation of liability provided above cannot be given local legal effect according to their terms, reviewing courts shall apply local law that most closely approximates an absolute waiver of all civil liability in connection with the Program, unless a warranty or assumption of liability accompanies a copy of the Program in return for a fee. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively state the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . Also add information on how to contact you by electronic and paper mail. If the program does terminal interaction, make it output a short notice like this when it starts in an interactive mode: Copyright (C) This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, your program's commands might be different; for a GUI interface, you would use an "about box". You should also get your employer (if you work as a programmer) or school, if any, to sign a "copyright disclaimer" for the program, if necessary. For more information on this, and how to apply and follow the GNU GPL, see . The GNU General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. But first, please read . bbdb3-3.2/ChangeLog000066400000000000000000002734731322420162700141230ustar00rootroot000000000000002018-01-06 Roland Winkler * configure.ac: Increase version number to 3.2. 2018-01-06 Roland Winkler * bbdb-tex.el (bbdb-tex-alist, bbdb-tex-address-layout): Declare defcustom type. 2018-01-06 Roland Winkler * bbdb-vm-aux.el: Don't require VM when compiled. 2018-01-06 Stefan Monnier * bbdb-vm.el: Don't require VM when compiled. Trim the list of required packages from VM. * bbdb-gnus.el (bbdb-insinuate-gnus): * bbdb-vm.el (bbdb-insinuate-vm): Use defalias. 2018-01-06 Roland Winkler * lisp/bbdb-gnus.el, lisp/bbdb-gnus-aux.el: Split from lisp/bbdb-gnus.el. * lisp/bbdb-vm.el, lisp/bbdb-vm-aux.el: Split from lisp/bbdb-vm.el. * lisp/Makefile.am, lisp/makefile-temp: Update accordingly. 2017-12-24 Roland Winkler * README: Update for elpa.git. 2017-11-17 Stefan Monnier Prepare BBDB for elpa.git. * lisp/bbdb-anniv.el, lisp/bbdb-com.el, lisp/bbdb-ispell.el: * lisp/bbdb-message.el, lisp/bbdb-mhe.el, lisp/bbdb-migrate.el: * lisp/bbdb-mu4e.el, lisp/bbdb-mua.el, lisp/bbdb-pgp.el: * lisp/bbdb-rmail.el, lisp/bbdb-site.el.in, lisp/bbdb-snarf.el: * lisp/bbdb-tex.el, lisp/bbdb-wl.el, lisp/bbdb.el: Update copyright notice. Follow conventions for comments. Use declare-function. Provide arg WHEN for define-obsolete-function-alias and define-obsolete-variable-alias. * lisp/bbdb-site.el.in (bbdb-version-date): Remove. (bbdb-tex-path): Use more flexible default. * lisp/bbdb.el (bbdb-parse-records): Use function bbdb-version. (bbdb-version): Use version header if variable bbdb-version is not set sensibly. * README, NEWS, TODO, tex/bbdb.sty, doc/bbdb.texi: Update copyright notice. 2017-10-17 Roland Winkler * lisp/bbdb.el (bbdb-parse-records): Bug fix, hash record after checking for duplicates. 2017-10-11 Roland Winkler * configure.ac: Use it. * lisp/bbdb.el: Mention new mailing list bbdb-user@nongnu.org. 2017-10-11 Roland Winkler * lisp/bbdb.el (bbdb-parse-records): Query before migrating BBDB to new format. (bbdb-delete-record-internal, bbdb-insert-record-internal) (bbdb-overwrite-record-internal): Barf if buffer is read-only. 2017-10-11 Roland Winkler * lisp/bbdb-com.el (bbdb-search, bbdb-split-maybe): Fix docstring. (bbdb-read-record): Fix calling sequence for calls to set record. 2017-08-09 Roland Winkler * lisp/bbdb-migrate.el (bbdb-migrate-uuid-xfield): New variable. 2017-08-09 Roland Winkler New field uuid. Make creation-date and timestamp immutable. * lisp/bbdb.el (bbdb-create-hook, bbdb-change-hook): Use defcustom. (bbdb-merge-records-function): New variable. (bbdb-layout-alist): Omit uuid. (bbdb-xfields-sort-order, bbdb-merge-xfield-function-alist): Ignore creation-date and timestamp. (bbdb-file-format): Bump to 9. (bbdb-record-type): Include uuid, creation-date and timestamp. (bbdb-uuid-table): New variable. (bbdb-timestamp, bbdb-creation-date): Declare obsolete. (bbdb-uuid): New function. (bbdb-hash-record): Hash uuid. (bbdb-record-field, bbdb-record-set-field, bbdb-buffer) (bbdb-display-record-one-line, bbdb-display-record-multi-line) (bbdb-display-record): Handle uuid, creation-date and timestamp. (bbdb-change-record): Use uuid. * lisp/bbdb-com.el (bbdb-search): Use keywords for args. Handle uuid, creation-date and timestamp. New option :bool. (bbdb, bbdb-search-name, bbdb-search-organization) (bbdb-search-address, bbdb-search-mail, bbdb-search-phone) (bbdb-search-xfields, bbdb-mail-aliases, bbdb-get-mail-aliases): Change accordingly. (bbdb-compare-records): Compare any fields. (bbdb-timestamp-older, bbdb-timestamp-newer, bbdb-creation-older) (bbdb-creation-newer): Fix interactive spec. (bbdb-creation-no-change): Use bbdb-record-timestamp. (bbdb-read-record): Use bbdb-empty-record. (bbdb-create): Fix call of bbdb-change-record. (bbdb-split-maybe): New function. (bbdb-create-internal): Use keywords for args. (bbdb-edit-field, bbdb-edit-foo, bbdb-merge-records): Handle uuid, creation-date and timestamp. (bbdb-delete-records): Ignore records not known to BBDB. * lisp/bbdb-snarf.el (bbdb-snarf) * lisp/bbdb-mua.el (bbdb-annotate-message): Fix call of bbdb-change-record. * lisp/bbdb-migrate.el (bbdb-migration-features): Remove. (bbdb-peel-the-onion): Merge with bbdb-migrate. (bbdb-migrate): Handle format 9. (bbdb-migrate-alist): Rename from bbdb-migration-spec. (bbdb-migrate-record-lambda): Merge with bbdb-migrate-lambda. (bbdb-migrate-lambda): Rename from bbdb-migrate-versions-lambda. (bbdb-migrate-postcode-to-string): Rename from bbdb-migrate-postcodes-to-strings. Simplify. (bbdb-migrate-dates): Rename from bbdb-migrate-change-dates. Simplify. (bbdb-migrate-add-country): Rename from bbdb-migrate-add-country-field. (bbdb-undocumented-variables): Handle byte-obsolete-variable. 2017-07-25 Roland Winkler * Makefile.am: Fix rule BBDB_ELPA_FILES. (Bug#51563) 2017-07-25 Roland Winkler * lisp/bbdb-tex.el: Improve documentation. 2017-07-25 Roland Winkler * lisp/bbdb-tex.el (bbdb-tex): Bug fix. (Bug#51564) 2017-07-21 Roland Winkler * lisp/bbdb.el (bbdb-split): Fix previous patch. 2017-07-21 Roland Winkler * lisp/bbdb.el (bbdb-split): Use arg TRIM of split-string with emacs-version >= 24.4. 2017-07-19 Roland Winkler * lisp/bbdb-tex.el (bbdb-tex): Allow empty space when calling \usepackage. 2017-07-19 Roland Winkler * tex/bbdb.sty: Use \RequirePackage. 2017-07-19 Roland Winkler * lisp/bbdb-tex.el (bbdb-tex-alist): Improve docstring. 2017-07-03 Roland Winkler Use LaTeX for TeXing BBDB. * lisp/bbdb-tex.el: Replacement for lisp/bbdb-print.el. * lisp/bbdb-site.el.in (bbdb-tex-path): Renamed from bbdb-print-tex-path. Allow new value t. * lisp/bbdb.el (bbdb-utilities-tex): Renamed from bbdb-utilities-print. (bbdb-separator-alist): New element tex-name. Fix docstring. * lisp/makefile-temp, lisp/Makefile.am: Use bbdb-tex. * tex/bbdb-print-brief.tex, tex/bbdb-cols.tex, tex/bbdb-print.tex: Removed. * tex/bbdb.sty: New file. * tex/Makefile.am: Update accordingly. 2017-01-31 Roland Winkler * README: Really discontinue support for GNU Emacs 23. 2017-01-30 Barak A. Pearlmutter * TODO: Extend feature wishlist. 2017-01-30 Barak A. Pearlmutter * README: Add pointer to emacs wiki upgrade page. 2017-01-30 Roland Winkler * README, lisp/bbdb-site.el.in: Discontinue support for GNU Emacs 23. 2017-01-28 Roland Winkler * lisp/bbdb-anniv.el (bbdb-anniv-diary-entries): Propertize the strings passed to diary-add-to-list. (bbdb-anniv-goto-entry): New function used as diary-goto-entry-function. 2017-01-28 Roland Winkler * lisp/bbdb-anniv.el (bbdb-anniv-diary-entries): Use cl-flet. 2017-01-28 Roland Winkler * lisp/bbdb-anniv.el: Use lexical binding. * lisp/bbdb-anniv.el (bbdb-anniv-diary-entries): Use lexical environment for eval. 2017-01-28 Roland Winkler Discontinue support for old GNU Emacs 23. * lisp/bbdb.el (bbdb-buffer, bbdb-revert): * lisp/bbdb-com.el (bbdb-complete-mail): Update accordingly. 2017-01-28 Roland Winkler Update copyright year in all files. 2016-10-02 Roland Winkler * lisp/bbdb-com.el, lisp/bbdb-gnus.el, lisp/bbdb-ispell.el: * lisp/bbdb-message.el, lisp/bbdb-mhe.el, lisp/bbdb-migrate.el: * lisp/bbdb-mu4e.el, lisp/bbdb-mua.el, lisp/bbdb-pgp.el: * lisp/bbdb-print.el, lisp/bbdb-rmail.el, lisp/bbdb-sc.el: * lisp/bbdb-site.el.in, lisp/bbdb-snarf.el, lisp/bbdb-vm.el: * lisp/bbdb-wl.el, lisp/bbdb.el: Use lexical binding. * lisp/bbdb.el (bbdb-alist-with-header): Start name of unused variables with underscore. (bbdb-display-record-multi-line, bbdb-display-records): Remove unused variable. * lisp/bbdb-com.el (bbdb-omit-record): * lisp/bbdb-snarf.el (bbdb-snarf-surrounding-space) (bbdb-snarf-empty-lines): * lisp/bbdb-migrate.el (bbdb-undocumented-variables): Start name of unused variables with underscore. * lisp/bbdb-mua.el (bbdb-get-address-components): * lisp/bbdb-print.el (bbdb-print-record): Remove unused variable. * lisp/bbdb-gnus.el: Autoload message-make-domain. (bbdb/gnus-score-as-text): Start name of unused variables with underscore. 2016-07-20 Roland Winkler * lisp/bbdb.el (bbdb-display-record-one-line) * lisp/bbdb-snarf.el (bbdb-snarf-label, bbdb-snarf-phone-nanp): Use 2nd arg of looking-back. 2016-07-20 Roland Winkler Update copyright year in all files. 2016-07-20 Roland Winkler * lisp/bbdb-mua.el (bbdb-mua-mode-alist): Add support for mu4e-compose-mode and notmuch-message-mode which are derived from message-mode. 2016-07-20 Roland Winkler * m4/emacs_wl.m4: New file * configure.ac: Use it. * NEWS, README: Document support for Wanderlust 2016-07-20 David Maus Add basic support for Wanderlust. * lisp/Makefile.am, lisp/makefile-temp: Support Wanderlust. * lisp/bbdb-mua.el (bbdb-mua-mode-alist, bbdb-mua) (bbdb-message-header, bbdb-mua-update-records, bbdb-mua-wrapper): Add support for Wanderlust. (bbdb-mua-auto-update-init): Add wanderlust to list of auto-update muas. * lisp/bbdb.el (bbdb-init-forms): Add support for Wanderlust. * lisp/bbdb-wl.el: New file. 2016-07-20 Marco Wahl * lisp/bbdb-com.el (bbdb-omit-record): Fix arg list of bbdb-redisplay-record. 2016-07-20 Roland Winkler Make bbdb-hashtable a proper hash table. * lisp/bbdb.el (bbdb-hashtable): Use make-hash-table. (bbdb-puthash, bbdb-gethash, bbdb-remhash, bbdb-buffer) * lisp/bbdb-com.el (bbdb-completion-predicate) (bbdb-completing-read-records, bbdb-complete-mail): Use it. 2016-07-20 Roland Winkler * lisp/bbdb.el (bbdb-add-to-list): Remove. (bbdb-pushnew, bbdb-pushnewq, bbdb-pushnewt): New macros. (bbdb-record-set-xfield, bbdb-record-set-field) (bbdb-merge-concat-remove-duplicates, bbdb-parse-records) (bbdb-change-record) * lisp/bbdb-com.el (bbdb-mail-aliases, bbdb-get-mail-aliases) (bbdb-add-mail-alias) * lisp/bbdb-mua.el (bbdb-update-records): Use them. 2015-11-14 Roland Winkler * lisp/bbdb.el (bbdb-auto-revert, bbdb-dedicated-window) (bbdb-default-domain, bbdb-mua-pop-up) (bbdb-horiz-pop-up-window-size, bbdb-xfields-sort-order) (bbdb-mua-summary-unification-list, bbdb-mail-avoid-redundancy) * lisp/bbdb-snarf.el (bbdb-snarf-address-us-country) (bbdb-snarf-address-eu-country) * lisp/bbdb-anniv.el (bbdb-anniv-alist) * lisp/bbdb-vm.el (bbdb/vm-virtual-real-folders) * lisp/bbdb-gnus.el (bbdb/gnus-score-default) (bbdb/gnus-split-myaddr-regexp, bbdb/gnus-split-private-field) (bbdb/gnus-split-public-field) * lisp/bbdb-sc.el (bbdb-sc-update-attrib-p): Fix defcustom. 2015-11-08 Roland Winkler Add new snarfing rule eu for many continental European countries. Improve snarfing algorithm. * lisp/bbdb-snarf.el (bbdb-snarf-rule-alist): Add new rule eu. (bbdb-snarf-phone-nanp-regexp, bbdb-snarf-postcode-us-regexp) (bbdb-snarf-url-regexp): Improve regexp. Use first subexpression. (bbdb-snarf-mail-regexp): New variable. (bbdb-snarf-mail): Use it. (bbdb-snarf-address-us-country): New variable. (bbdb-snarf-address-us): Use it. Check whether we actually snarfed an address. (bbdb-snarf-phone-eu-regexp, bbdb-snarf-postcode-eu-regexp) (bbdb-snarf-address-eu-country): New variables. (bbdb-snarf-label): Use save-match-data. (bbdb-snarf-phone-nanp): Use save-match-data. Reverse order of snarfed phone numbers. (bbdb-snarf-phone-eu, bbdb-snarf-address-eu): New functions. 2015-11-08 Roland Winkler Simplify re-sorting of records when a record has been changed. Re-display re-sorted records. * lisp/bbdb.el (bbdb-need-to-sort): Removed. (bbdb-record-set-name): Simplify accordingly. (bbdb-record-set-sortkey): Always evaluate new sortkey. (bbdb-record-sortkey): Simplify accordingly. (bbdb-change-record): Sort records if we have a new sort key. (bbdb-redisplay-record-globally): Rename from bbdb-maybe-update-display. New optional arg sort. (bbdb-delete-record-internal, bbdb-insert-record-internal): Do not unset sort key. (bbdb-display-records): Put point at beginning of buffer. (bbdb-redisplay-record): New optional arg sort. Throw error if record was not displayed previously. (bbdb-sort-records): Clarify status message. Redisplay sorted records. * lisp/bbdb-com.el (bbdb-fix-records): Sort records. (bbdb-create, bbdb-create-internal, bbdb-merge-records): Use nil for unused second arg of bbdb-change-record. (bbdb-edit-field, bbdb-transpose-fields): Do not worry about re-sorting records. * lisp/bbdb-mua.el (bbdb-annotate-message): Use nil for unused second arg of bbdb-change-record. 2015-09-10 Roland Winkler * lisp/bbdb-anniv.el, lisp/bbdb-mu4e.el, lisp/bbdb-print.el: * lisp/bbdb-snarf.el, lisp/bbdb-com.el, lisp/bbdb-message.el: * lisp/bbdb-mua.el, lisp/bbdb-rmail.el, lisp/bbdb-gnus.el: * lisp/bbdb-mhe.el, lisp/bbdb-pgp.el, lisp/bbdb-sc.el: * lisp/bbdb-vm.el, lisp/bbdb-ispell.el, lisp/bbdb-migrate.el: * lisp/bbdb-site.el.in, lisp/bbdb.el: Conform to Emacs Lisp package format convention. (Bug#45910) 2015-09-10 Roland Winkler * lisp/bbdb.el (bbdb-separator-alist): Use two newline characters to separate records. 2015-09-07 Roland Winkler * lisp/bbdb-com.el (bbdb-search-changed): Fix docstring. 2015-09-07 Roland Winkler * lisp/bbdb-com.el (bbdb-delete-field-or-record): Use delete for phone and address fields. 2015-09-07 Roland Winkler * lisp/bbdb-com.el (bbdb-copy-records-as-kill): Fix docstring. Delete unused local variable marker. 2015-09-07 Roland Winkler * lisp/bbdb-com.el (bbdb-copy-fields-as-kill): New command. * lisp/bbdb.el (bbdb-separator-alist, bbdb-mode-map): Update accordingly. 2015-05-23 Eric Abrahamsen * lisp/bbdb.el (bbdb-record-set-field, bbdb-parse-records): Use equal for comparison when populating lists of labels. 2015-05-22 Roland Winkler Add basic support for mu4e mailer. * NEWS, README: Update accordingly. * m4/emacs_mu4e.m4: New file. * configure.ac: Use it. * lisp/bbdb-mu4e.el: New file. * lisp/Makefile.am, lisp/makefile-temp: Compile it. * lisp/bbdb.el (bbdb-init-forms): Add entry for mu4e. (bbdb-initialize): Update docstring. * lisp/bbdb-mua.el: Define mu4e~view-buffer-name. (bbdb-mua-mode-alist): Add element for mu4e. (bbdb-mua): Update docstring. (bbdb-mua-update-records, bbdb-mua-wrapper): Handle mu4e. 2015-05-22 Roland Winkler Remove variables bbdb/MUA-update-records-p. * lisp/bbdb-mua.el (bbdb-update-records): Rely only on arg update-p. * lisp/bbdb-gnus.el (bbdb/gnus-update-records-p): Remove. * lisp/bbdb-message.el (bbdb/mail-update-records-p) (bbdb/message-update-records-p): Remove. * lisp/bbdb-mh.el (bbdb/mh-update-records-p): Remove. * lisp/bbdb-rmail.el (bbdb/rmail-update-records-p): Remove. * lisp/bbdb-vm.el (bbdb/vm-update-records-p): Remove. * README, NEWS: Update accordingly. 2015-05-22 Roland Winkler Handle prefix command bbdb-do-all-records more robustly. * lisp/bbdb.el (bbdb-do-all-records): New variable. (bbdb-modeline-info): Add two new slots. (bbdb-mode): Use them. * lisp/bbdb-com.el (bbdb-prefix-message): New function. (bbdb-do-all-records, bbdb-do-records): Use variable bbdb-do-all-records. (bbdb-append-display-p): Update displayed message. (bbdb-append-display): Use bbdb-prefix-message. (bbdb-search-invert): Ditto. Simplify. 2015-05-22 Roland Winkler * lisp/bbdb.el (bbdb-redisplay-record): Display an undisplayed record only if we do not want to delete it. (bbdb-maybe-update-display): Only consider records that are already displayed. Improve docstring. 2015-05-22 Roland Winkler Update copyright year in all files. 2014-08-30 Roland Winkler * lisp/bbdb-print.el (bbdb-print-require): Improve docstring. 2014-08-30 Roland Winkler * lisp/bbdb-print.el (bbdb-print): Clarify prompt for file name. Issue message on what to do with TeX file. 2014-08-30 Roland Winkler * lisp/bbdb-print.el (bbdb-print-record): Handle xfields the value of which are sexps. 2014-08-09 Roland Winkler * lisp/bbdb-snarf.el (bbdb-snarf): Always install and display the new record. 2014-08-01 Roland Winkler * lisp/bbdb-com.el (bbdb-mail-alias-list): New function. (bbdb-add-mail-alias): Handle multiple records via * prefix. Allow addition or deletion of multiple aliases per record. Fix docstring. 2014-08-01 Roland Winkler * lisp/makefile-temp: Fix previous change. 2014-07-22 Roland Winkler * lisp/Makefile.am: Do not load init files or site files for byte compilation (Bug#42482). Use long options. * lisp/makefile-temp: Ditto. New variable emacs_compile. 2014-05-15 Roland Winkler * lisp/bbdb.el (bbdb-redisplay-record): Delete record from bbdb-records if record is undisplayed. * lisp/bbdb-com.el (bbdb-omit-record): Simplify. Handle records at beginning and end of bbdb-buffer properly. 2014-05-15 Roland Winkler Fix and improve previous patch. * lisp/bbdb.el (bbdb-update-unchanged-records): Renamed from bbdb-save-unchanged-records. (bbdb-with-print-loadably): Put at beginning of bbdb.el. (bbdb-change-record): Return record only if we updated it. * lisp/bbdb-com.el (bbdb-touch-records): Use bbdb-update-unchanged-records. (bbdb-insert-field, bbdb-edit-field): Issue message if record remained unchanged. 2014-05-12 Roland Winkler * lisp/bbdb.el (bbdb-change-record): If an editing command did not change a record compared to its value in bbdb-buffer, do not call bbdb-change-hook and do not save it. (bbdb-save-unchanged-records): New internal variable. * lisp/bbdb-com.el (bbdb-touch-records): New command. 2014-05-12 Roland Winkler * lisp/makefile-temp: Create bbdb-pkg.el from bbdb-pkg.el.in. 2014-05-06 Roland Winkler Do not treat bbdb-change-hook special when inside bbdb-notice-mail-hook or bbdb-notice-record-hook. * lisp/bbdb.el (bbdb-notice-mail-hook, bbdb-notice-record-hook): Update docstring. (bbdb-notice-hook-pending): Remove. (bbdb-change-record): Always call bbdb-change-hook if a record was changed. * lisp/bbdb-mua.el (bbdb-update-records, bbdb-annotate-message): Change accordingly. 2014-05-06 Roland Winkler Allow arbitrary lisp expressions as values of xfields. * lisp/bbdb.el (bbdb-record-type): Update accordingly. (bbdb-string-trim): New optional arg null. (bbdb-record-xfield-intern): Return xfield value unmodified if it is not a string. (bbdb-record-xfield-string): New function. (bbdb-record-xfield-split): Throw error if xfield value is not a string. (bbdb-record-set-xfield, bbdb-record-set-field) (bbdb-merge-xfield, bbdb-display-record-one-line) (bbdb-display-record-multi-line) * lisp/bbdb-com.el (bbdb-search, bbdb-read-field) (bbdb-edit-field, bbdb-read-xfield): Allow xfield values that are not a string. (bbdb-add-mail-alias): Simplify. 2014-05-06 Roland Winkler * lisp/bbdb.el (bbdb-parse-postcode): Finish immediately if one test succeeds. 2014-04-27 Roland Winkler * configure.ac: Increase BBDB version number to 3.1.2. * NEWS: Update for release. 2014-04-12 Roland Winkler Be more careful that empty strings do not pollute the data base. * lisp/bbdb.el (bbdb-list-strings): New function. (bbdb-record-set-field): Use it. (bbdb-record-set-xfield): Clean up. * lisp/bbdb-com.el (bbdb-fix-records): New command. (bbdb-read-organization, bbdb-complete-mail): Check emacs version properly. 2014-04-12 Roland Winkler Check type of record data structures more carefully. * lisp/bbdb.el (bbdb-check-type): Simplify. New arg `extended'. * lisp/bbdb-com.el (bbdb-create-internal): Bug fix. 2014-04-12 Barak A. Pearlmutter * lisp/Makefile.am: Include makefile-temp in distribution. 2014-04-12 Roland Winkler * lisp/bbdb-site.el.in: Be more verbose about what we want. 2014-04-12 Roland Winkler * lisp/makefile-temp: Obey proper dependencies. Clean up. 2014-04-12 Roland Winkler * lisp/bbdb-vm.el, m4/emacs_vm.m4: Require vm-autoloads. 2014-04-12 Roland Winkler * lisp/bbdb.el (bbdb-separator-alist): Treat AKAs consistent with other fields. 2014-03-11 Barak A. Pearlmutter Generate lisp/bbdb-site.el via lisp/Makefile as pkgdatadir is only known at "make" time. * configure.ac: Remove lisp/bbdb-site.el from autoconfig files. Increase BBDB version number to 3.1.1 * lisp/Makefile.am: Generate lisp/bbdb-site.el. * lisp/bbdb-site.el.in: Initialize bbdb-print-tex-path with a placeholder for pkgdatadir. 2014-03-11 Barak A. Pearlmutter * Makefile.am: Install files COPYING, ChangeLog, AUTHORS, NEWS, README, and TODO in the doc directory. * doc/Makefile.am: Install bbdb.pdf in the doc directory. 2014-03-11 Barak A. Pearlmutter * m4/package_date.m4: Use "date -u" if "date --rfc-3339" fails. 2014-02-28 Roland Winkler * configure.ac: Increase BBDB version number to 3.1. * README: Update accordingly. Fix typos. * Makefile.am: Include autogen.sh in distribution. * lisp/Makefile.am: Include lisp/bbdb-pkg.el in distribution. * lisp/makefile-temp: Include lisp/bbdb-pkg.el. 2014-02-28 Roland Winkler Do not use `prompt' in a non-emacs sense. * lisp/bbdb.el: Do not autoload bbdb-search and bbdb-search-prompt when compiling. (bbdb-auto-revert, bbdb-silent, bbdb-default-domain) (bbdb-default-area-code, bbdb-offer-to-create) (bbdb-update-records-address): Fix docstring. * lisp/bbdb-com.el (bbdb-search-read): Renamed from bbdb-search-prompt. (bbdb, bbdb-search-name, bbdb-search-organization) (bbdb-search-address, bbdb-search-mail, bbdb-search-phone) (bbdb-search-xfields): Change accordingly. (bbdb-read-record, bbdb-create, bbdb-completing-read-records): Fix docstring. (bbdb-read-field): Renamed from bbdb-prompt-for-new-field. Use arg flag instead of current-prefix-arg. Add docstring. (bbdb-insert-field): Change accordingly. Fix docstring. (bbdb-edit-foo): Change accordingly. * lisp/bbdb-mua.el (bbdb-query-create): Renamed from bbdb-prompt-for-create. (bbdb-update-records) * lisp/bbdb.el (bbdb-insert-field-menu): Change accordingly. 2014-02-28 Roland Winkler * lisp/bbdb.el: Do not autoload bbdb-search and bbdb-search-prompt when compiling. (bbdb-address-format-list, bbdb-buffer, bbdb-revert-buffer) * lisp/bbdb-com.el (bbdb-complete-mail): Fix docstring. 2014-02-17 Roland Winkler * lisp/bbdb-mua.el (bbdb-update-records): If value of arg update-p is a function, evaluate it repeatedly as many times as needed. 2014-02-16 Roland Winkler * lisp/bbdb-mua.el (bbdb-update-records): Bug fix for previous commit. Allow value of update-p being create, too. 2014-02-15 Roland Winkler * lisp/bbdb-mua.el (bbdb-update-records): Always evaluate arg update-p twice if its value is a function. 2014-01-23 Roland Winkler * lisp/bbdb.el (bbdb-puthash, bbdb-record-set-xfield) (bbdb-record-set-field, bbdb-parse-records, bbdb-change-record): Bugfix, make 'eq the 4th arg of add-to-list. 2014-01-23 Stefan Monnier * lisp/bbdb.el (bbdb-read-string): In minibuffer-local-completion-map remove the binding of SPC to minibuffer-complete-word and of ? to minibuffer-completion-help. 2014-01-12 Roland Winkler * lisp/bbdb.el (bbdb-pop-up-window-simple): New function. (bbdb-pop-up-window): Use it. Make sure the *BBDB* buffer exists. Use display-buffer as an alternative to pop-up-buffer if the *BBDB* buffer is not selected. Use the tallest window even if bbdb-pop-up-window-size is 1.0. (bbdb-pop-up-window-size): Fix docstring accordingly. * lisp/bbdb-com.el (bbdb-complete-mail-cleanup): Do not call bbdb-pop-up-window before we created for sure the *BBDB* buffer. 2014-01-12 Roland Winkler Provide auto completion for streets and postcodes known to BBDB. * lisp/bbdb.el (bbdb-street-list, bbdb-postcode-list): New internal variables. (bbdb-record-set-xfield, bbdb-parse-records) * lisp/bbdb-com.el (bbdb-record-edit-address) (bbdb-edit-address-default): Use them. 2014-01-08 Roland Winkler * lisp/bbdb.el (bbdb-canonical-hosts, bbdb-canonicalize-mail-1) (bbdb-message-clean-name-default): Move here from bbdb-mua.el. 2014-01-08 Roland Winkler Provide auto completion for cities, states and countries known to BBDB. * lisp/bbdb.el (bbdb-city-list, bbdb-state-list) (bbdb-country-list): New internal variables. (bbdb-add-to-list): New function. (bbdb-puthash, bbdb-merge-concat-remove-duplicates) (bbdb-change-record): Use add-to-list. (bbdb-record-set-xfield, bbdb-parse-records): Use add-to-list and bbdb-add-to-list. Collect cities, states and countries known to BBDB. * lisp/bbdb-com.el (bbdb-record-edit-address) (bbdb-edit-address-default): Provide auto completion for cities, states and countries. 2014-01-03 Roland Winkler Update copyright year in all files. 2014-01-03 Roland Winkler Avoid hard-coded references to xfield notes. * lisp/bbdb.el (bbdb-default-xfield, bbdb-edit-foo) (bbdb-annotate-field, bbdb-mua-edit-field): New variables. (bbdb-auto-notes-rules): Fix docstring. * lisp/bbdb-com.el (bbdb-edit-foo): New command. (bbdb-search, bbdb-read-record): Use bbdb-default-xfield. (bbdb-insert-field): Do not handle initial value. (bbdb-prompt-for-new-field): Replace arg init by arg record to handle initial value here. * lisp/bbdb.el (bbdb-insert-field-menu): Change accordingly. * lisp/bbdb-mua.el (bbdb-annotate-record): Use bbdb-annotate-field. Allow empty strings for removing an xfield. (bbdb-mua-annotate-field-interactive): New function. (bbdb-mua-annotate-sender, bbdb-mua-annotate-recipients): Use it. New optional arg field. (bbdb-mua-edit-field-interactive, bbdb-mua-edit-field) (bbdb-mua-edit-field-sender, bbdb-mua-edit-field-recipients): Use variable bbdb-mua-edit-field. (bbdb-mua-edit-field-recipients): Use bbdb-default-xfield. * lisp/bbdb-snarf.el (bbdb-snarf-notes): Use bbdb-default-xfield. 2014-01-03 Roland Winkler After editing always update display in all BBDB buffers. * lisp/bbdb.el (bbdb-delete-record-internal): Rename optional arg remhash to completely. Undisplay record if non-nil. (bbdb-maybe-update-display): Update record in all BBDB buffers. (bbdb-change-record): Call it. (bbdb-redisplay-records): Remove. (bbdb-undisplay-records): New optional arg all-buffers. (bbdb-revert-buffer): Use it. * lisp/bbdb-com.el (bbdb-insert-field, bbdb-transpose-fields) (bbdb-delete-field-or-record, bbdb-delete-records) (bbdb-merge-records, bbdb-sort-addresses, bbdb-sort-phones) (bbdb-sort-xfields, bbdb-add-mail-alias) * lisp/bbdb-mua.el (bbdb-mua-edit-field): Do not call bbdb-maybe-update-display. * README: update accordingly. 2014-01-03 Roland Winkler Clean up supercite support. * lisp/bbdb.el (bbdb-utilities-sc): New custom group (bbdb-initialize): Update docstring. * lisp/bbdb-sc.el: Update doc. (bbdb-sc-attribution-field): Rename from bbdb/sc-attribution-field, keeping the old name as obsolete alias. (bbdb-sc-update-records-p): New variable. (bbdb-sc-update-attrib-p): Rename from bbdb/sc-replace-attr-p. (bbdb-sc-last-attrib): Rename from bbdb/sc-last-attribution. Make it internal variable. (bbdb-sc-set-attrib): Rename from bbdb/sc-set-attr, keeping the old name as obsolete alias. (bbdb-sc-update-from): Rename from bbdb/sc-default, keeping the old name as obsolete alias. 2014-01-03 Roland Winkler Overhaul lisp/bbdb-pgp.el for BBDB 3. * lisp/bbdb-pgp.el (bbdb-pgp-field): Rename from bbdb/pgp-field. (bbdb-pgp-default): Rename from bbdb/pgp-default-action. (bbdb-pgp-ranked-actions, bbdb-pgp-headers) (bbdb-pgp-method-alist): New variables. (bbdb/pgp-quiet): Obsolete. (bbdb-pgp-method): Rename from bbdb/pgp-method. Include support for PGP-auto format. (bbdb-read-xfield-pgp-mail): New function. (bbdb-pgp): Rename from bbdb/pgp-sign. Make it a command. Consider all message recipients in bbdb-pgp-headers. Use bbdb-pgp-ranked-actions, bbdb-pgp-headers, and bbdb-pgp-method-alist. * lisp/bbdb.el (bbdb-utilities-pgp): New custom group (bbdb-init-forms): Add init form for bbdb-pgp. (bbdb-initialize): Update docstring accordingly. * lisp/Makefile.am, lisp/makefile-temp: Support lisp/bbdb-pgp.el. 2014-01-03 Gijs Hillenius * lisp/bbdb-pgp.el: Adapt for BBDB 3. Remove outdated mailcrypt interface. (bbdb/pgp-method): New default mml-pgpmime. (bbdb/pgp-get-pgp): Use bbdb-message-search and bbdb-record-field. 2014-01-03 Kevin Davidson * lisp/bbdb-pgp.el: New file (taken from BBDB 2). 2014-01-03 Roland Winkler More flexible editing of xfields. * lisp/bbdb.el (bbdb-read-string): Rename optional arg default to init. New optional arg require-match. * lisp/bbdb-com.el (bbdb-read-organization) (bbdb-record-edit-address, bbdb-completing-read-mails): Rename optional arg default to init. (bbdb-insert-field): Simplify. (bbdb-read-xfield): New function. (bbdb-prompt-for-new-field, bbdb-edit-field): Use it. 2014-01-03 Roland Winkler * lisp/bbdb.el (bbdb-init-forms): Add init form for anniv. (bbdb-initialize): Update docstring accordingly. * lisp/bbdb-anniv.el: Update doc accordingly. 2014-01-03 Roland Winkler Clean up handling of redundant email addresses. * lisp/bbdb.el (bbdb-ignore-redundant-mails): Rename from bbdb-canonicalize-redundant-mails, keeping the latter as obsolete alias. (bbdb-add-mails, bbdb-canonicalize-mail-function): Fix docstring. * lisp/bbdb-com.el (bbdb-mail-redundant-re): New function (bbdb-delete-redundant-mails): Move here from lisp/bbdb-mua.el. Merge with command bbdb-delete-duplicate-mails and make the latter an obsolete alias. New optional args query and update. * lisp/bbdb-mua.el (bbdb-annotate-message): Use bbdb-mail-redundant-re and bbdb-delete-redundant-mails. (bbdb-mail-redundant-p): Remove. (bbdb-canonical-hosts): Update docstring. 2014-01-03 Roland Winkler Check more carefully/frequently that BBDB is editable. * lisp/bbdb.el (bbdb-editable): Move here from lisp/bbdb-com.el. Revert BBDB buffer if possible. * lisp/bbdb.el (bbdb-record-set-field) * lisp/bbdb-com.el (bbdb-read-record, bbdb-create-internal) (bbdb-merge-records, bbdb-sort-addresses, bbdb-sort-phones) (bbdb-sort-xfields) * lisp/bbdb-snarf.el (bbdb-snarf): Check that BBDB is editable. * lisp/bbdb-mua.el (bbdb-update-records): Obey bbdb-read-only. (bbdb-annotate-message): Ignore bbdb-read-only. (bbdb-auto-notes): Check that BBDB is editable. 2014-01-03 Roland Winkler * lisp/bbdb.el (bbdb-check-name, bbdb-extract-address-components): Fix docstring. * lisp/bbdb-com.el (bbdb-search-duplicates): Fix warning message. Sort records. * lisp/bbdb-mua.el (bbdb-auto-notes) (bbdb-mua-update-interactive-p): Fix docstring. 2014-01-03 Roland Winkler Display records for messages more flexibly. * lisp/bbdb-mua.el (bbdb-update-records, bbdb-mua-update-records): New optional arg sort. (bbdb-mua-display-records): New optional arg all. (bbdb-mua-display-all-records): New command. (bbdb-mua-display-all-recipients): Renamed from bbdb-display-all-recipients. 2014-01-03 Roland Winkler Handle new records more carefully. * lisp/bbdb.el (bbdb-empty-record): New function. (bbdb-change-record): Use bbdb-create-hook. Fix docstring. (bbdb-insert-record-internal, bbdb-overwrite-record-internal): Fix docstring. * lisp/bbdb-com.el (bbdb-create): Do not use bbdb-create-hook. (bbdb-create-internal): Make arg name optional and allow a nil value. Check validity of arguments only if new arg check is non-nil. (bbdb-merge-records): Return record. * lisp/bbdb-mua.el (bbdb-annotate-message): Use bbdb-empty-record. Handle case that arg create-p is a function. Do not use bbdb-create-hook. * lisp/bbdb-snarf.el (bbdb-snarf): Use bbdb-empty-record. Return record. Do not use bbdb-create-hook. 2014-01-03 Roland Winkler * lisp/bbdb-snarf.el (bbdb-snarf-rule-interactive): Use symbol-name. 2013-11-16 Roland Winkler * configure.ac: Increase BBDB version number to 3.0.50. 2013-11-16 Christian Egli * Makefile.am: New target elpa. * lisp/bbdb-pkg.el.in: New file for elpa. * configure.ac, .gitignore: Handle it. * lisp/Makefile.am: Define CLEANFILES and EXTRA_DIST. 2013-11-16 Roland Winkler * m4/package_date.m4: Use git log. 2013-11-16 Roland Winkler * lisp/bbdb-sc.el: Fix documentation. (bbdb/sc-consult-attr): Do not use car. (Bug#40398) 2013-11-16 Roland Winkler * lisp/bbdb.el (bbdb-field-menu): Use format. Call bbdb-browse-url for url xfields. (bbdb-mouse-menu): Use format. 2013-11-16 Roland Winkler * lisp/bbdb.el (bbdb-mua-update-interactive-p): Clarify doc string. 2013-11-16 Roland Winkler * lisp/bbdb.el (bbdb-file): Use locate-user-emacs-file. 2013-11-16 Roland Winkler * lisp/bbdb-com.el (bbdb-complete-mail): Only complete inside a syntactically correct mail header. 2013-10-06 Roland Winkler * lisp/makefile-temp: Add commentary. Copy bbdb-site.el.in to bbdb-site.el. Clean up. * README: Clean up. 2013-07-28 Roland Winkler * doc/bbdb.texi: Add @dircategory and @direntry. (Bug#38794) 2013-07-28 Roland Winkler * m4/package_date.m4: Use more robust output redirection. (Bug#39579) 2013-07-28 Roland Winkler * m4/emacs_vm.m4: Fix typo. 2013-07-28 Roland Winkler * m4/emacs_vm.m4: Define conditional VM unconditionally. 2013-07-27 Roland Winkler * m4/emacs_vm.m4, m4/package_date.m4: New files. * configure.ac: Use them. Use brackets for AC_PREREQ. Define macro directory. Use Automake options -Wall and gnu. * autgogen.sh: Simplify. Use option --force. * lisp/bbdb-site.el.in: Renamed from lisp/bbdb-version.el.in. Define bbdb-print-tex-path. * lisp/bbdb.el, lisp/bbdb-print.el, lisp/Makefile.am: Update accordingly. * .gitignore: Cover more files. * INSTALL: Remove. Merge with README. * README: Update accordingly. 2013-07-18 Roland Winkler Clean up usage of automake and autoconf. * lisp/bbdb-version.el.in: New file. * lisp/bbdb.el, lisp/Makefile.am: Use it. * configure.ac: Use AC_CONFIG_SRCDIR. Require Automake 1.13. Test for presence of Emacs. Configure lisp/bbdb-version.el. * .gitignore: Ignore aclocal.m4, doc/texinfo.tex, install-sh, lisp/bbdb-version.el, and missing. * aclocal.m4, install-sh: Removed. 2013-07-17 Roland Winkler Use Automake. (Thanks to Christian Egli ) * Makefile.am, lisp/Makefile.am, doc/Makefile.am, tex/Makefile.am, autogen.sh, AUTHORS, NEWS: New files. * Makefile.in, lisp/Makefile.in, doc/Makefile.in, tex/Makefile.in: Removed. * configure.ac: Use automake. * INSTALL: Update accordingly. * .gitignore: Ignore Makefile.in. * lisp/bbdb-print.el (bbdb-print-tex-path): New variable. (bbdb-print): Use it. 2013-07-07 Roland Winkler * lisp/bbdb-mua.el (bbdb-mua-auto-update): Use bbdb-pop-up-layout. 2013-07-07 Roland Winkler * lisp/bbdb.el (bbdb-buffer): Simplify. Avoid creating auto-save files for bbdb-file till it contains at least one record. * lisp/bbdb.el (bbdb-revert-buffer): Handle the case that we did not yet create bbdb-file. 2013-07-07 Roland Winkler * lisp/bbdb.el (bbdb-update-records-p): Fix docstring. 2013-05-26 Roland Winkler * configure.ac: Remove option --enable-developer. * lisp/Makefile.in, lisp/makefile-temp: Remove HUSHMAKE and PUSHPATH. Use emacs options --quick and --directory. 2013-05-26 Roland Winkler * aclocal.m4: Convert VM path to absolute and canonicalize it. Use more verbose error message. 2013-05-26 Roland Winkler Use new function bbdb-extract-address-components which honors bbdb-message-clean-name-function and bbdb-canonicalize-mail-function. * lisp/bbdb.el (bbdb-clean-address-components) (bbdb-extract-address-components): New functions. (bbdb-decompose-bbdb-address): Renamed from bbdb-extract-address-components. (bbdb-puthash-mail): Use it. * lisp/bbdb-com.el (bbdb-message-search): Do nothing if both args are nil. (bbdb-complete-mail, bbdb-complete-mail-cleanup): Use bbdb-extract-address-components. * lisp/bbdb-mua.el (bbdb-get-address-components) (bbdb-mua-summary-unify, bbdb-mua-summary-mark): Use bbdb-extract-address-components. (bbdb-canonicalize-mail): Remove. * lisp/bbdb-snarf.el (bbdb-snarf-name-mail) (bbdb-snarf-mail-address): Use bbdb-extract-address-components. * lisp/bbdb-sc.el (bbdb/sc-consult-attr, bbdb/sc-default): Use bbdb-extract-address-components. * lisp/bbdb-vm.el (vm-summary-function-B): Simplify. (bbdb/vm-alternate-full-name): Use bbdb-extract-address-components. 2013-04-21 Leo Liu * lisp/bbdb-mua.el (bbdb-mua-summary-mark): Do not call bbdb-mua-summary-mark-field as a function if it is not a function. 2013-04-13 Roland Winkler * lisp/bbdb.el (bbdb-utilities-snarf): New custom group. * lisp/bbdb-snarf.el: New file. * lisp/Makefile.in, lisp/makefile-temp: Compile it. 2013-04-13 Roland Winkler * lisp/bbdb-com.el (bbdb-merge-records): Fix docstring. Merge also affixes. Do not enforce multi-line layout for display. 2013-04-13 Roland Winkler * lisp/bbdb.el (bbdb-format-address-default, bbdb-format-address): Allow city, postcode, state, and country to be nil. 2013-04-13 Roland Winkler * lisp/bbdb.el (bbdb-hash-record, bbdb-change-record): Fix docstring. 2013-04-13 Roland Winkler * lisp/bbdb.el (bbdb-new-mails-primary): Change default to query. 2013-04-13 Roland Winkler * lisp/bbdb-mua.el (bbdb-mua-summary-unify) (bbdb-mua-summary-mark): Allow bbdb-mua-summary-mark-field to be a function. * lisp/bbdb.el (bbdb-mua-summary-mark-field): Fix docstring. 2013-04-13 Roland Winkler * lisp/bbdb.el (bbdb-extract-address-components): New function. (bbdb-puthash-mail): Use it. * lisp/bbdb-com.el (bbdb-dwim-mail): Use it. 2013-04-13 Roland Winkler * lisp/bbdb-com.el (bbdb-complete-mail): Simplify. Do not throw error messages that prevent other completion functions to take over. 2013-04-13 Roland Winkler * lisp/bbdb-vm.el (bbdb/vm-auto-folder-field) (bbdb/vm-virtual-folder-field, bbdb/vm-auto-folder) (bbdb/vm-auto-add-label-list, bbdb/vm-auto-add-label-field): Fix docstring. (bbdb/vm-virtual-folder): Check more carefully whether vm-virtual-folder-alist contains already what we want to add. Fix docstring. 2013-04-13 Roland Winkler * lisp/bbdb-sc.el (bbdb/sc-attribution-field): Fix docstring. 2013-04-13 Roland Winkler * tex/Makefile.in: Acknowledge DESTDIR. 2013-02-16 Roland Winkler * lisp/bbdb.el (bbdb-mail-name-format, bbdb-mail-name): New user variables. * lisp/bbdb-com.el (bbdb-dwim-mail): Use them. Always quote the name part of a mail address if necessary. (bbdb-quoted-string-syntax-table): New internal variable. (bbdb-complete-mail): Use it to find starting point for completion. Before proper cycling, reformat the original mail address to match an element of dwim-completions. Use completion-ignore-case instead of downcase. Do not use trimmed pattern. Issue warning message if attempting to create a *Completions* buffer with GNU Emacs older than 23.2. Use the default value of completion-list-insert-choice-function to locally bind this variable. (bbdb-complete-mail-cleanup): New arg beg. Use indent-relative. * lisp/bbdb-print.el (bbdb-print-name-format, bbdb-print-name): New user variables. (bbdb-print-record): Use them, 2013-02-16 Roland Winkler * lisp/bbdb-com.el (bbdb-mail-yank): Bind case-fold-search to t. 2013-02-15 Roland Winkler * lisp/bbdb-com.el (bbdb-delete-field-or-record): Handle multiple records. 2013-02-15 Roland Winkler * lisp/bbdb.el (bbdb-delete-record-internal) (bbdb-insert-record-internal, bbdb-overwrite-record-internal): Use inhibit-quit. 2013-02-15 Roland Winkler * lisp/bbdb.el (bbdb-changed-records, bbdb-hashtable): Doc fix. 2013-02-15 Roland Winkler * lisp/bbdb.el (bbdb-modified): Removed. (bbdb-buffer, bbdb-after-save, bbdb-delete-record-internal) (bbdb-insert-record-internal, bbdb-overwrite-record-internal) (bbdb-sort-records): Do not set bbdb-modified. (bbdb-mode): Use buffer-modified-p. 2013-02-02 Roland Winkler * lisp/bbdb.el (bbdb-mail-user-agent): Use non-nil default taken from mail-user-agent. (bbdb-lastname-re, bbdb-lastname-suffix-re): New user variables. (bbdb-divide-name): Use them. Pass first and last name through bbdb-string-trim. * lisp/bbdb-mua.el (bbdb-canonicalize-mail): Always pass mail through bbdb-string-trim. (bbdb-canonicalize-mail-1): Always pass mail through bbdb-string-trim. (bbdb-canonical-hosts): Use regxp-opt instead of regexp-quote. (bbdb-message-clean-name-default): Re-arrange clean-up steps. Use substring-no-properties. 2013-01-20 Roland Winkler * aclocal.m4: Do not throw an error if tex_dir does not exist. 2013-01-20 Roland Winkler * doc/Makefile.in, tex/Makefile.in: Provide the DESTDIR variable. (Bug#38124) 2013-01-13 Roland Winkler * lisp/bbdb.el (bbdb-parse-records): Set bbdb-xfield-labels-list and bbdb-organization-list to nil only once. 2013-01-13 Roland Winkler Update copyright year in all files. 2013-01-13 Roland Winkler * lisp/bbdb.el (bbdb-organization-list): New variable. (bbdb-record-set-field): Use it. Update bbdb-phone-label-list, bbdb-address-label-list, and bbdb-xfield-label-list. ((bbdb-set-xfield-labels): Removed (bbdb-record-set-xfield): Set bbdb-xfield-labels-list explicitly. (bbdb-label-completion-list): Removed. (bbdb-parse-records): Do not set bbdb-phone-label-list and bbdb-address-label-list in a circular way. Set bbdb-organization-list. * lisp/bbdb-com.el: Require crm. (bbdb-crm-local-completion-map): New variable. (bbdb-read-organization): New function. (bbdb-read-record, bbdb-prompt-for-new-field): Use it. Directly use bbdb-phone-label-list and bbdb-address-label-list. Do not call bbdb-set-xfield-labels, which was redundant. (bbdb-edit-field): Use bbdb-read-organization and bbdb-record-field. (bbdb-record-edit-address): Use bbdb-address-label-list directly. (bbdb-record-edit-phone): Use bbdb-phone-label-list directly. 2012-12-30 Roland Winkler * configure.ac: Option --with-tex-dir renamed from --with-texmf-dir. 2012-12-30 Roland Winkler * lisp/bbdb-sc.el: New file * lisp/Makefile.in, lisp/makefile-temp, lisp/bbdb.el (bbdb-init-forms, bbdb-initialize): Use it. 2012-12-30 Roland Winkler * INSTALL: List all BBDB configure options. * aclocal.m4, tex/Makefile.in: Option --with-tex-dir renamed from --with-texmf-dir. 2012-12-30 Roland Winkler * lisp/bbdb-gnus.el: Do not use eval-and-compile. (bbdb/gnus-split-myaddr-regexp): Do not use obsolete variable gnus-local-domain. (bbdb/gnus-split-private-field, bbdb/gnus-split-public-field): Fix docstring. * lisp/bbdb-vm.el, lisp/bbdb-message.el, lisp/bbdb-mhe.el: Do not use eval-and-compile. 2012-12-30 Roland Winkler * lisp/bbdb.el (bbdb-mua-summary-unification-list) (bbdb-mua-summary-mark-field, bbdb-mua-summary-mark) (bbdb-mua-summary-unify-format-letter) (bbdb-mua-summary-mark-format-letter): New user variables. * lisp/bbdb-mua.el (bbdb-mua-summary-unify) (bbdb-mua-summary-mark): New functions. * lisp/bbdb-gnus.el (bbdb/gnus-summary-mark-known-posters) (bbdb/gnus-mark-known-posters) (bbdb/gnus-summary-known-poster-mark) (bbdb/gnus-summary-show-bbdb-names) (bbdb/gnus-header-show-bbdb-names) (bbdb/gnus-summary-prefer-bbdb-data) (bbdb/gnus-summary-prefer-real-names) (bbdb/gnus-header-prefer-real-names) (bbdb/gnus-summary-user-format-letter) (bbdb/gnus-summary-in-bbdb-format-letter) (bbdb/gnus-message-marker-field, bbdb/gnus-summary-get-sender) (bbdb/gnus-summary-sender-in-bbdb): Removed. (bbdb-insinuate-gnus): Use bbdb-mua-summary-unify and bbdb-mua-summary-mark. 2012-12-27 Roland Winkler * lisp/bbdb-mua.el (bbdb-mua-wrapper): Add edebug support. Suggested by Leo . * lisp/bbdb-gnus (bbdb-insinuate-gnus): Fix keybindings for gnus-article-mode. Suggested by Leo . * lisp/bbdb-com.el (bbdb-grab-url): Fail early if no URL at point. Suggested by Leo . 2012-12-26 Roland Winkler * lisp/bbdb-com.el (bbdb-complete-mail): Check every record from the completion list for each possible completion. 2012-12-26 Roland Winkler * lisp/bbdb.el (bbdb-dedicated-window): New user variable. (bbdb-mua-pop-up): Renamed from bbdb-message-pop-up. Doc fix. (bbdb-mua-pop-up-window-size): New variable. (bbdb-pop-up-window-size): Doc fix. Allow value t. (bbdb-pop-up-window): Use it. Simplify. Use display-buffer-record-window / set-window-dedicated-p so that the BBDB window is popped up such that quit-window can delete it. Suggested by Martin Rudalics. (bbdb-display-records): Clean up. * lisp/bbdb-mua.el (bbdb-mua-mode-alist): New variable. (bbdb-mua): Use it. (bbdb-mua-window-p): New function. (bbdb-mua-display-records, bbdb-mua-edit-field) (bbdb-mua-auto-update): Use it. 2012-12-25 Roland Winkler * lisp/bbdb-vm.el: (bbdb/vm-auto-add-label-list) (bbdb/vm-auto-add-label-field): Doc fix. (bbdb/vm-auto-add-label): Doc fix and cleanup. 2012-12-25 Roland Winkler * README: Minor docfix. 2012-12-25 Roland Winkler * lisp/bbdb.el, lisp/bbdb-com.el, lisp/bbdb-mua.el: * lisp/bbdb-print.el, lisp/bbdb-anniv.el, lisp/bbdb-ispell.el: * lisp/bbdb-migrate.el, lisp/bbdb-vm.el, lisp/bbdb-gnus.el: For the user-defined fields of a record replace the generic internal name `notes' by `xfield'. * lisp/bbdb.el (bbdb-layout-alist, bbdb-name-format, bbdb-image) (bbdb-default-domain, bbdb-auto-notes-rules) (bbdb-mail-alias-field, bbdb-name-face-alist, bbdb-record-type) (bbdb-timestamp, bbdb-creation-date) (bbdb-display-name-organization): Doc fix. (bbdb-xfields-sort-order): Renamed from bbdb-notes-sort-order (bbdb-merge-xfield-function-alist): Renamed from bbdb-merge-notes-function-alist (bbdb-xfield-label-list): Renamed from bbdb-notes-label-list. (bbdb-record-xfields): Renamed from bbdb-record-Notes. (bbdb-record-set-xfields): Renamed from bbdb-record-set-Notes. (bbdb-record-xfield): Renamed from bbdb-record-note. (bbdb-record-set-xfield): Renamed from bbdb-record-set-note. (bbdb-record-xfield-intern): Renamed from bbdb-record-note-intern. (bbdb-record-xfield-split): Renamed from bbdb-record-note-split (bbdb-set-xfield-labels): Renamed from bbdb-set-notes-labels (bbdb-merge-xfield): Renamed from bbdb-merge-note. * lisp/bbdb-com.el (bbdb-search, bbdb, bbdb-compare-records) (bbdb-create-internal, bbdb-edit-field): Doc fix. (bbdb-search-xfields): Renamed from bbdb-search-notes. (bbdb-message-search): Make search more robust. (bbdb-sort-xfields): Renamed from bbdb-sort-notes. 2012-12-25 Roland Winkler * lisp/bbdb.el (bbdb-parse-records): If multiple records have the same name, hash all these records. (bbdb-allow-duplicates): Doc fix. 2012-09-23 Roland Winkler Add more complete support for mail entries containing RFC-822 addresses such as "John Smith " in the record of Johnathan Smith. * lisp/bbdb.el (bbdb-defstruct): Doc fix. Improve doc string of functions defined via this macro. (bbdb-cache-mail-aka, bbdb-cache-mail-canon): New elements of bbdb-record-cache. (bbdb-record-mail-aka, bbdb-record-mail-canon): New functions. (bbdb-hash-p): New function. (bbdb-gethash): Use it. (bbdb-puthash-mail): New function. (bbdb-hash-record): Use it. (bbdb-record-field): Renamed from bbdb-record-get-field. New field values mail-canon, mail-aka and aka-all. Doc fix. (bbdb-record-get-field): Obsolete function alias. (bbdb-record-set-field): Doc fix. Update hash for mail entries such as "John Smith ". (bbdb-delete-record-internal): Use canonical mail addresses and all AKAs when cleaning up the hash. * lisp/bbdb-com.el (bbdb-search): Use bbdb-record-field. (bbdb-search-duplicates): Use bbdb-record-mail-canon. (bbdb-message-search): Simplify. (bbdb-edit-field): Doc fix. (bbdb-ident-point, bbdb-transpose-fields) (bbdb-delete-field-or-record): Use bbdb-record-field. (bbdb-completion-predicate): Use bbdb-hash-p. (bbdb-complete-mail): Compare with all AKAs. A plain message search should be sufficient. * lisp/bbdb-mual.el (bbdb-annotate-message): Compare with canonical mail addresses. * lisp/bbdb-ispell.el (bbdb-ispell-export): Use bbdb-record-field. * README: Notes for BBDB lisp hackers added. 2012-09-23 Roland Winkler * lisp/bbdb.el (bbdb-mua-auto-update-p): Doc fix. (bbdb-message-pop-up): Change default to t. * lisp/bbdb-mua.el (bbdb-mua-auto-update) (bbdb-mua-auto-update-init): Doc fix. (bbdb-mua-auto-update): Simplify. * README: Clarify usage of bbdb-mua-auto-update. 2012-09-09 Roland Winkler Provide unified scheme for customizing how BBDB analyzes messages. * lisp/bbdb.el (bbdb-add-name): Renamed from bbdb-accept-name-mismatch. (bbdb-add-aka): Renamed from bbdb-use-alternate-names. (bbdb-new-mails-primary): Renamed from bbdb-new-mails-always-primary. (bbdb-add-name, bbdb-add-aka, bbdb-add-mails) (bbdb-new-mails-primary): Unify set of allowed values. (bbdb-add-job, bbdb-eval-spec): New functions. (bbdb-mode): Update docstring. * lisp/bbdb-com.el (bbdb-merge-records): Use bbdb-add-aka. * lisp/bbdb-mua.el (bbdb-annotate-message): Use bbdb-add-name, bbdb-add-aka, bbdb-add-mails, and bbdb-new-mails-primary. 2012-09-08 Roland Winkler * lisp/bbdb-mua.el (bbdb-message-header): Use gnus-fetch-original-field so that bbdb-select-message does not get fooled by an apparent absence of some headers. 2012-09-07 Roland Winkler * lisp/bbdb.el (bbdb-accept-name-mismatch): Allow value being a regexp or function. * lisp/bbdb-mua.el (bbdb-annotate-message): Use these new values. 2012-09-01 Roland Winkler * lisp/bbdb-mua.el (bbdb-mua-edit-field): Bug fix. 2012-09-01 Roland Winkler * lisp/bbdb.el (bbdb-record-set-field): Bug fix. 2012-09-01 Roland Winkler * lisp/bbdb.el (bbdb-with-print-loadably): New macro. (bbdb-insert-record-internal, bbdb-overwrite-record-internal) (bbdb-sort-records): Use it. 2012-08-11 Roland Winkler * lisp/bbdb-com.el (bbdb-complete-mail-cleanup): New function. (bbdb-complete-mail): Use it. In particular, clean up also when using *Completions* buffer. 2012-08-11 Roland Winkler Remove electric mode that was not providing any new functionality to BBDB. Also see GNU Emacs Bug#11983. * lisp/bbdb.el (bbdb-electric, bbdb-inside-electric-display) (bbdb-quit-window, bbdb-electric-display-records) (bbdb-electric-throw, bbdb-quit-window) (bbdb-display-records-internal): Remove. (bbdb-display-records): Remove arg electric. Merge with bbdb-display-records-internal. (bbdb-redisplay-records): Use bbdb-display-records. * lisp/bbdb-com.el (bbdb-mail, bbdb-mail-address, bbdb-info): Remove electricity. (bbdb-mail-abbrev-expand-hook): Use bbdb-display-records. * lisp/bbdb-mua.el (bbdb-mua-display-records) (bbdb-mua-auto-update): Use bbdb-display-records. 2012-08-09 Roland Winkler Remove message cache that was broken. There were two problems with it. The cache did not distinguish between records associated with the senders and recipients. So if a call of bbdb-mua-display-sender was followed by, say, a call of bbdb-mua-display-recipients the second call also returned the senders. Second, the cache used assq to identify message keys to operate fast. Yet most MUAs only provide strings as message keys. * lisp/bbdb.el (bbdb-message-all-addresses) (bbdb-notice-mail-hook, bbdb-notice-record-hook): Fix docstring. (bbdb-message-caching, bbdb-message-cache): Remove. (bbdb-buffer): Remove cache flushing. * lisp/bbdb-mua.el (bbdb-update-records): Remove arg msg-key. Remove caching of records. (bbdb-message-get-cache, bbdb-message-set-cache) (bbdb-message-rem-cache): Remove. (bbdb-mua-update-records): Remove arg msg-key from calls of bbdb-update-records. 2012-08-07 Roland Winkler * lisp/bbdb-com.el (bbdb-complete-mail): Use quit-window instead of current-window-configuration and set-window-configuration. * lisp/bbdb.el (bbdb-complete-mail-saved-window-config): Remove. 2012-08-06 Roland Winkler * lisp/bbdb-com.el (bbdb-complete-mail): Revert 2012-07-06 change. 2012-08-05 Roland Winkler * lisp/bbdb-mua.el (bbdb-annotate-message): Simplify. 2012-08-05 Roland Winkler * lisp/bbdb.el (bbdb-suppress-changed-records-recording): Remove. (bbdb-puthash, bbdb-gethash, bbdb-remhash): Ignore keys that are empty strings or nil. (bbdb-hash-record): Explicitly hash name. (bbdb-change-record, bbdb-delete-record-internal) (bbdb-insert-record-internal, bbdb-overwrite-record-internal): Operate on hash table and bbdb-changed-records list only when necessary. * lisp/bbdb-com.el (bbdb-delete-records): Remove record from hash table. (bbdb-merge-records): Do not add new-record to the list of changed records, which is done already by bbdb-change-record. 2012-08-05 Roland Winkler * lisp/bbdb-com.el (bbdb-complete-mail): Do not call quit-window. Instead, rely on set-window-configuration that it does what we want. 2012-08-01 Roland Winkler * lisp/bbdb-com.el (bbdb-merge-records): Improve interactive call and docstring. 2012-08-01 Roland Winkler * lisp/bbdb.el (bbdb-allow-duplicates, bbdb-hash-update) (bbdb-record-set-field): Fix docstring. * lisp/bbdb-com.el (bbdb-merge-records): Do not through an error when merging the old and new record results in duplicate AKAs and email addresses. 2012-07-31 Roland Winkler * lisp/bbdb-com.el (bbdb-complete-mail): When a single record matches, analyze more carefully which mail address to use. Cycle even if the record contains only one mail address, yet bbdb-dwim-mail gives us something different from what we have. Search correctly for RFC 822 addresses containing a full name. 2012-07-20 Roland Winkler * lisp/bbdb-mua.el (bbdb-annotate-message): Simplify. Create new record if update-p has not value update. 2012-07-20 Roland Winkler * lisp/bbdb.el (bbdb-gethash): Allow value of t for arg predicate. 2012-07-20 Sam Steingold * lisp/bbdb-com.el (bbdb-message-search): Allow args name or mail to be nil. 2012-07-19 Roland Winkler * lisp/bbdb.el: Simplify previous patch. (bbdb-electric-execute, bbdb-electric-quit, bbdb-electric-quit): Remove. (bbdb-display-records): Simplify. (bbdb-electric-display-records): Fix docstring. Simplify. Remove optional args select and horiz-p that interfere with Electric-pop-up-window. 2012-07-18 Roland Winkler * lisp/bbdb.el (bbdb-electric-display-records): Fix previous patch. 2012-07-18 Roland Winkler * lisp/bbdb.el: Autoload bbdb-search and bbdb-search-prompt. (bbdb-display-records): Make records a required arg. Do not redefine keys. Pass optional args to bbdb-electric-display-records. (bbdb-electric-display-records): New optional args layout, append, select, and horiz-p. Make it a command. Redefine SPC key temporarily. Simplify. 2012-07-17 Roland Winkler * lisp/bbdb.el (bbdb-mua-update-interactive-p) (bbdb-mua-auto-update-p, bbdb-update-records-p): Update docstring. (bbdb-canonicalize-mail-function): Update docstring. (bbdb-message-caching): Use default nil till caching is fixed. (bbdb-cache-deleted-p, bbdb-cache-set-deleted-p) (bbdb-record-deleted-p, bbdb-record-set-deleted-p): Removed. (bbdb-display-name-organization): Use memq. * lisp/bbdb-mua.el (bbdb-mua, bbdb-message-header): Use memq. (bbdb-get-address-components): Allow mail to be nil. Use member-ignore-case. (bbdb-update-records): New value update for arg update-p. Use memq. (bbdb-message-get-cache): Simplify. (bbdb-message-set-cache): Remove old value from cache. (bbdb-annotate-message): New value update for arg update-p. Operate on all records found by bbdb-message-search. Return list of records. Use member-ignore-case. (bbdb-mua-update-records): Use memq. (bbdb-auto-notes): Use member-ignore-case and assoc-string. * lisp/bbdb-com.el (bbdb-read-name, bbdb-insert-field): Use memq. (bbdb-complete-mail): Use member-ignore-case. * lisp/bbdb-message.el (bbdb/message-update-records-p) * lisp/bbdb-rmail.el (bbdb/rmail-update-records-p) * lisp/bbdb-mhe.el (bbdb/mh-update-records-p) * lisp/bbdb-gnus.el (bbdb/gnus-update-records-p) * lisp/bbdb-vm.el (bbdb/vm-update-records-p): Update docstring. * lisp/bbdb-print.el (bbdb-print-record): Do not use bbdb-record-deleted-p. * README: Update usage of update-p. 2012-07-12 Roland Winkler * lisp/bbdb-mua.el (bbdb-get-address-components) (bbdb-message-get-cache, bbdb-message-set-cache) (bbdb-message-rem-cache, bbdb-mua-annotate-sender) (bbdb-mua-annotate-recipients, bbdb-mua-edit-field) (bbdb-canonical-hosts, bbdb-canonicalize-mail-1) (bbdb-mail-redundant-p, bbdb-delete-redundant-mails) (bbdb-message-clean-name-default): Fix docstring. 2012-07-09 Roland Winkler * lisp/bbdb-mua.el (bbdb-mua-annotate-sender) (bbdb-mua-annotate-recipients, bbdb-mua-edit-field) (bbdb-mua-edit-field-sender, bbdb-mua-edit-field-recipients): New arg update-p. (bbdb-mua-edit-field-interactive): Handle arg update-p. 2012-07-08 Roland Winkler * lisp/bbdb-mua.el (bbdb-update-records): Fix previous patch. 2012-07-08 Roland Winkler * lisp/bbdb-mua.el (bbdb-update-records): Make records a list ordered like address-list. 2012-07-06 Roland Winkler * lisp/bbdb-com.el (bbdb-complete-mail): Use window-live-p. 2012-07-06 Roland Winkler * lisp/bbdb-mua.el (bbdb-mua-edit-field): Revert previous change. Do not use hard-coded bindings for user variables. 2012-07-06 Sam Steingold * lisp/bbdb-com.el (bbdb-complete-mail): Use `quit-window' instead of `bury-buffer' to get rid of *Completions*. 2012-07-06 Sam Steingold * lisp/bbdb-mua.el (bbdb-mua-edit-field): Edit THE record for THE sender, not all the relevant records. 2012-07-03 Roland Winkler * lisp/bbdb.el (bbdb-record-name, bbdb-record-name-lf): Fix docstring. * lisp/bbdb-com.el (bbdb-search): Also search last_first names. Fix docstring. (bbdb-message-search): Fix docstring. 2012-07-01 Sam Steingold * lisp/bbdb-mua.el (bbdb-get-address-components): name may be nil. 2012-07-01 Sam Steingold * .gitignore: ignore Makefiles and configure files; bbdb-autoloads.el -> bbdb-loaddefs.el. 2012-06-24 Sam Steingold * lisp/bbdb-mua.el (bbdb-update-records): Use bbdb-message-search instead of bbdb-search when `update-p' is `search' so that all senders are displayed. * lisp/bbdb-mua.el (bbdb-annotate-message): Do not offer to replace the name if it is already an AKA. * lisp/bbdb.el (bbdb-label-completion-list): Use symbol-value instead of eval for symbols. * lisp/bbdb-mua.el (bbdb-update-records): Ditto. 2012-06-24 Philip Hudson * lisp/bbdb.el (bbdb-read-only, bbdb-initialize-hook) (bbdb-mode-hook, bbdb-layout-alist, bbdb-case-fold-search) (bbdb-message-caching, bbdb-complete-mail-allow-cycling) (bbdb-after-save-hook, bbdb-completion-display-record) (bbdb-update-records-address, bbdb-warn, bbdb-split, bbdb-concat) (bbdb-read-string, bbdb-current-record, bbdb-debug) (bbdb-timestamp, bbdb-creation-date, bbdb-gethash) (bbdb-hash-record, bbdb-record-name, bbdb-record-name-lf) (bbdb-record-sortkey, bbdb-record-set-sortkey, bbdb-record-marker) (bbdb-record-set-marker, bbdb-record-deleted-p) (bbdb-record-set-deleted-p, bbdb-merge-concat) (bbdb-merge-string-least, bbdb-merge-string-most) (bbdb-phone-string, bbdb-error-retry, bbdb-display-list) (bbdb-display-record-one-line, bbdb-display-record-multi-line) (bbdb-display-records, bbdb-display-records-internal) (bbdb-redisplay-record, bbdb-pop-up-window) (bbdb-electric-display-records, bbdb-electric-throw) (bbdb-electric-quit, bbdb-quit-window, bbdb-mouse-menu, bbdb-save) (bbdb-offer-to-create bbdb-lastname-suffixes) (bbdb-update-records-p, bbdb-new-mails-always-primary): Fix docstring. (bbdb-mail-user-agent): Untabify. 2012-06-24 Roland Winkler Update copyright notices. * lisp/bbdb.el (bbdb-allow-duplicates): Rename from bbdb-no-duplicates to match the unchanged docstring of this variable. (bbdb-record-Notes): Rename from bbdb-record-notes to avoid name clashes. (bbdb-puthash): Do not hash empty strings. (bbdb-gethash): New arg predicate. (bbdb-check-name): New function. (bbdb-record-set-name): For args first and last allow new value t. Use bbdb-check-name. (bbdb-record-name, bbdb-record-name-lf): Use it. (bbdb-record-set-field): Use it. Simplify. (bbdb-label-completion-default, bbdb-data-completion-list) (bbdb-data-completion-default): Remove unused function. (bbdb-buffer): Handle here that bbdb-file might have changed on disk and auto-save file could be newer than bbdb-file instead of bbdb-records doing this. (bbdb-revert-buffer): Fix docstring. Use prefix arg as in revert-buffer. Use variable bbdb-buffer instead of function bbdb-buffer to avoid recursion. (bbdb-parse-records): Rename from bbdb-parse-internal. Add docstring. Do not polute buffer-undo-list when reading bbdb-file. Use unwind-protect. Merge with bbdb-parse-frobnicate. Handle bbdb-allow-duplicates properly. (bbdb-with-db-buffer): Add docstring. (bbdb-display-record-one-line, bbdb-display-record-multi-line): Simplify. (bbdb-pop-up-window): Fix docstring. (bbdb-sendmail-menu): Add docstring. (bbdb-electric-quit): Rename from bbdb-electric-done. (bbdb-electric-display-records): Simplify. * lisp/bbdb-com.el (bbdb-editable): Fix docstring. Check more carefully without reverting. (bbdb-message-search): Use bbdb-buffer. (bbdb-read-record): Use bbdb-buffer and bbdb-check-name. (bbdb-create-internal): Fix docstring. Use bbdb-check-name. (bbdb-edit-field): Merge with bbdb-record-edit-name. (bbdb-record-edit-name): Remove. (bbdb-completion-predicate): Bug fix. (bbdb-complete-mail): Use bbdb-buffer and bbdb-completion-predicate. (bbdb-search-duplicates, bbdb-message-search) (bbdb-create-internal): Use arg predicate of bbdb-gethash. * lisp/bbdb.el (bbdb-gethash): New arg predicate. (bbdb-check-name, bbdb-record-set-field, bbdb-parse-records) Use it. * lisp/bbdb-com.el (bbdb-search-duplicates, bbdb-message-search) (bbdb-create-internal): Use it. * lisp/bbdb-mua.el (bbdb-message-get-cache): Use bbdb-buffer. * lisp/bbdb.el (bbdb-message-clean-name-function) (bbdb-message-mail-as-name): New variables. * lisp/bbdb-mua.el (bbdb-get-address-components) (bbdb-annotate-message): Use them. (bbdb-message-clean-name-default): Rename from bbdb-message-clean-name. Clean names properly, too. * tex/Makefile.in (install-TeX): Bug fix (Bug#108041). 2012-01-02 Sam Steingold * lisp/bbdb.el (bbdb-auto-notes-rules): Use :set keyword to reset `bbdb-auto-notes-rules-expanded' when `bbdb-auto-notes-rules' is set. 2012-01-02 Roland Winkler * lisp/bbdb-anniv.el (bbdb-anniv-list): Clarify docstring. 2012-01-02 Roland Winkler * lisp/bbdb.el: Do not use custom-loads for bbdb-mua.el and bbdb-com.el. Use symbols for custom-loads. (bbdb-utilities-ispell): Group renamed and moved here from bbdb-ispell.el. (bbdb-utilities-print): Group renamed from bbdb-print. (bbdb-utilities-dialing): Group renamed from bbdb-dialing. * lisp/bbdb-ispell.el, lisp/bbdb-print.el: Updated accordingly. 2011-12-18 Roland Winkler * lisp/bbdb-anniv.el (bbdb-anniv-diary-entries): Remove leading and trailing whitespace in text properly. 2011-12-18 Roland Winkler * lisp/Makefile.in: Do not create backup file for bbdb-loaddefs.el. 2011-12-18 Roland Winkler * lisp/bbdb-anniv.el (bbdb-anniv-alist): New format specification `%t'. (bbdb-anniv-diary-entries): Use it. Handle diary's backup forms in a better way. 2011-12-11 Roland Winkler * INSTALL, Makefile.in, aclocal.m4, configure.ac, install-sh: * lisp/Makefile.in, doc/Makefil.in, doc/bbdb.texi: * doc/doclicense.texi, doc/gpl.texi, tex/Makefile.in: * tex/bbdb-cols.tex, tex/bbdb-print-brief.tex, tex/bbdb-print.tex: New files. * lisp/makefile-temp: Renamed from lisp/Makefile. * README: Updated. * lisp/bbdb-ispell.el: Header updated. Prefix bbdb-spell replaced by bbdb-ispell. (bbdb-ispell): New custom group. (bbdb-ispell-dictionary-list): Renamed from bbdb-spell-dictionary. (bbdb-ispell-field-list): Renamed from bbdb-spell-field. (bbdb-ispell-export): Merged with bbdb-spell-add-word. (bbdb-ispell-collect-words): Renamed from bbdb-spell-export-field. Merged with bbdb-spell-append-word. 2011-12-11 Ivan Kanis * lisp/bbdb-ispell.el: New file 2011-11-27 Roland Winkler * README: Updated. * lisp/bbdb.el: Revert change from 2011-10-11. Loading bbdb-autoloads.el is sufficient. * lisp/Makefile: It no longer supports VM by default, but you need to enable it. 2011-11-27 Leo * lisp/bbdb.el (bbdb-image-suffixes): Fix typo. 2011-11-20 Roland Winkler * README: Updated. * lisp/bbdb.el (bbdb-message-try-all-headers) (bbdb-user-mail-address-re): Clarify doc string. (bbdb-defstruct): Do not update bbdb-mail-aliases-need-rebuilt. (bbdb-record-set-note): Update bbdb-mail-aliases-need-rebuilt. (bbdb-record-set-name): Update name in cache and hash. (bbdb-record-unset-name): Removed (obsolete). (bbdb-hash-update): New function. (bbdb-record-set-field): Use it. (bbdb-records): Initiate variable bbdb-records. (bbdb-parse-internal): Use bbdb-goto-first-record. (bbdb-goto-first-record): Move backward only if we found a first record. * lisp/bbdb-com.el (bbdb-insert-field) (bbdb-delete-field-or-record): Use bbdb-record-set-field. (bbdb-edit-field): New optional arg value. Handle affix, organization, mail, aka, and note fields directly. (bbdb-record-edit-affix, bbdb-record-edit-organziation) (bbdb-record-edit-mail, bbdb-record-edit-aka) (bbdb-record-edit-note): Removed. * lisp/bbdb.el (bbdb-mail-avoid-redundancy) Renamed from bbdb-mail-allow-redundancy. * lisp/bbdb-com.el (bbdb-dwim-mail): Update it accordingly. * lisp/bbdb.el (bbdb-update-records-p): Change default to less agressive `search'. (bbdb-mua-auto-update-p): New variable * lisp/bbdb-mua.el (bbdb-mua-auto-update): Use it. (bbdb-update-records): Resolve arg update-p up to two times. * lisp/bbdb-message.el (bbdb/message-update-records-p) * lisp/bbdb-rmail.el (bbdb/rmail-update-records-p) * lisp/bbdb-gnus.el (bbdb/gnus-update-records-p) * lisp/bbdb-mhe.el (bbdb/mh-update-records-p) * lisp/bbdb-vm.el (bbdb/vm-update-records-p): Doc fix. * lisp/bbdb-mua.el (bbdb-annotate-record): Convert annotation into list if field is affix, organization, mail or aka. (bbdb-mua-edit-field-interactive): New function. (bbdb-mua-edit-field): New command. (bbdb-mua-edit-field-sender, bbdb-mua-edit-field-recipients): Use it. * lisp/bbdb.el (bbdb-image, bbdb-image-path, bbdb-image-suffixes): New variables. (bbdb-display-name-organization): Use them to display images for BBDB records. Suggested by Ivan Kanis . * lisp/bbdb-migrate.el (bbdb-undocumented-variables): New command. 2011-10-11 Teodor Zlatanov * lisp/bbdb.el: Autoload `bbdb-insinuate-gnus' from bbdb-gnus.el so `bbdb-initialize' won't throw an error when passed 'gnus. Ditto 'message, 'rmail, 'vm, and 'mh-e. 2011-10-10 Roland Winkler * lisp/bbdb.el (bbdb-name-format, bbdb-read-name-format) (bbdb-name-face-alist): New user variables. (bbdb-record-name-lf): New function. (bbdb-display-name-organization): Use bbdb-name-format for customizable display of name. Use note field name-face for customizable font-locking of name of a record. (bbdb-layout-list): Omit name-format and name-face for multi-line and pop-up-multi-line format. (bbdb-separator-alist): New default values for name-first-last and name-last-first. (bbdb-record-set-name): Use them. * lisp/bbdb-com.el (bbdb-read-name): New function. (bbdb-read-record, bbdb-record-edit-name): Use it. New optional arg first-and-last. * lisp/bbdb.el: (bbdb-merge-notes-function): Removed (obsolete). (bbdb-record-type): New internal variable. (bbdb-check-type): Moved here from lisp/bbdb-com.el. Use the pseudo-code of bbdb-record-type. (bbdb-record-get-field, bbdb-merge-concat) (bbdb-merge-concat-remove-duplicates, bbdb-merge-string-least) (bbdb-merge-string-most, bbdb-merge-lists, bbdb-divide-name) (bbdb-parse-postcode): Moved here from lisp/bbdb-com.el. (bbdb-merge-note): Rewrite. (bbdb-record-set-field): Moved here from lisp/bbdb-com.el. New optional args check and merge. (bbdb-record-note-intern): New function. (bbdb-record-set-note): Throw error if the name of a note field equals the name of any other record field. (bbdb-parse-frobnicate): Include all note fields in bbdb-notes-label-list. * lisp/bbdb-com.el (bbdb-create-internal): Use bbdb-check-type. (bbdb-merge-records-internal): Removed (merged with bbdb-merge-records). (bbdb-merge-records): Use bbdb-record-set-field. * lisp/bbdb-mua.el (bbdb-annotate-record): Renamed from bbdb-annotate-note. Use bbdb-record-set-field. * lisp/bbdb.el (bbdb-initialize): Do not require bbdb-autoloads. * lisp/bbdb.el (bbdb-phone-string): Fix error message. * lisp/bbdb.el (bbdb-error-retry): Use progn. * lisp/bbdb.el (bbdb-message-try-all-headers): New user variable. * lisp/bbdb-mua.el (bbdb-get-address-components): Use it. * lisp/bbdb-print.el (bbdb-print): Do not use \catcode. 2011-09-22 Leo * lisp/bbdb.el (bbdb-pop-up-window): Remove Gnus-specific code which is not required anymore by recent versions of Gnus. 2011-09-21 Leo * lisp/bbdb-com.el (bbdb-browse-url): Fix usage of prefix arg. 2011-09-19 Leo * lisp/bbdb-com.el (bbdb-add-mail-alias): Fix completion list used in interactive calls for deleting an alias. 2011-09-19 Roland Winkler * lisp/bbdb.el (bbdb-mode-map): Use / as search prefix. 2011-09-19 Abhi Yerra * lisp/bbdb.el (bbdb-dial-function): New variable. (bbdb-sound-player, bbdb-sound-files, bbdb-modem-dial) (bbdb-modem-device, bbdb-sound-volume): Removed (obsolete). * lisp/bbdb-com.el (bbdb-dial-number): Use browse-url and bbdb-dial-function. (bbdb-play-sound): Removed (obsolete) 2011-09-19 Roland Winkler * lisp/bbdb-com.el (bbdb-dial): First remove extension. Simplify. 2011-09-19 Roland Winkler * lisp/bbdb.el (bbdb-version): Do not use interactive-p. * lisp/bbdb-message.el: Require sendmail for mail-mode-map. * lisp/bbdb-anniv.el (number): Use with-no-warnings. * lisp/bbdb-com.el (bbdb-divide-name): Fix regexp for matching last name prefixes. 2011-05-11 Roland Winkler * lisp/bbdb-mua.el (bbdb-update-records): Fix previous patch. (bbdb-prompt-for-create): Use special-mode. 2011-05-11 Roland Winkler * lisp/bbdb.el (bbdb-notice-mail-hook): Rename from bbdb-notice-hook. (bbdb-notice-record-hook): New variable. (bbdb-notice-hook-pending): Update doc string. * lisp/bbdb-mua.el (bbdb-update-records): Call bbdb-notice-record-hook. (bbdb-annotate-message): Use bbdb-notice-mail-hook. * lisb/bbdb-vm.el (bbdb/vm-auto-add-label): Update doc string. 2011-05-08 Roland Winkler * lisp/bbdb-com.el (bbdb-display-all-records): Use redisplay. Why needed? 2011-05-08 Leo * lisp/bbdb-com.el (bbdb-merge-records-internal): Fix typo 2011-05-08 Leo * lisp/bbdb-mua.el (bbdb-auto-notes): Fix typo 2011-05-07 Roland Winkler * lisp/bbdb-com.el (bbdb-display-current-record): New command. (bbdb-display-all-records): Improve docstring. * lisp/bbdb.el (bbdb-mode-map): Key bindings for bbdb-display-all-records and bbdb-display-current-record. 2011-04-29 Barak A. Pearlmutter * lisp/bbdb.el (bbdb-init-forms): Fix typo. (bbdb-parse-internal): Clarify error message. 2011-04-29 Barak A. Pearlmutter * lisp/bbdb-migrate.el (bbdb-peel-the-onion): New function. (bbdb-migrate): Use it for cleaning up corrupted BBDB files. 2011-04-29 Barak A. Pearlmutter * lisp/Makefile: Use option --batch. New target TAGS. 2011-04-29 Roland Winkler * lisp/bbdb.el, lisp/bbdb-com.el, lisp/bbdb-migrate.el, lisp/bbdb-print.el: Rename degree field to affix. 2011-04-29 Roland Winkler * lisp/bbdb.el (bbdb-display-name-organization): Include name in text property. (bbdb-scan-property): New function. (bbdb-next-record, bbdb-prev-record): Use it. (bbdb-next-field, bbdb-prev-field): New commands bound to "N" and "P". 2011-04-23 Roland Winkler * lisp/bbdb.el (bbdb-pop-up-window): Rename from bbdb-pop-up-buffer. * lisp/bbdb.el (bbdb-display-records-internal) * lisp/bbdb-com.el (bbdb-complete-mail): Use new name. 2011-04-23 Leo * lisp/bbdb.el (bbdb-pop-up-buffer): Distinguish 1 and 1.0 in bbdb-pop-up-window-size. 2011-04-23 Roland Winkler * lisp/bbdb-message.el (bbdb-insinuate-message) (bbdb-insinuate-mail) * lisp/bbdb-rmail.el (bbdb-insinuate-rmail) * lisp/bbdb-gnus.el (bbdb-insinuate-gnus) * lisp/bbdb-mhe.el (bbdb-insinuate-mh) * lisp/bbdb-vm.el (bbdb-insinuate-vm): Fix docstring. 2011-04-23 Roland Winkler * lisp/bbdb.el (bbdb-mode-map): Do no call set-keymap-parent which is done already by define-derived-mode. Reported by Sam Steingold . Add menu binding for revert-buffer. 2011-04-16 Roland Winkler * lisp/bbdb.el (bbdb-create-hook, bbdb-change-hook): Use defvar. 2011-04-16 Roland Winkler * lisp/bbdb.el (bbdb-time-stamp-format): Includes timezone info. 2011-04-16 Roland Winkler * TODO: New file. 2011-04-16 Roland Winkler * lisp/bbdb.el (bbdb-faces): Group of faces used by BBDB. (bbdb-name, bbdb-organization, bbdb-field-name): New faces. (bbdb-display-name-organization, bbdb-display-record-one-line) (bbdb-display-record-multi-line): Use them. 2011-04-16 Roland Winkler * lisp/bbdb.el (bbdb-mode-map): Inherit from special-mode-map. (bbdb-quit-window): Renamed from bbdb-bury-buffer. Use quit-window. (bbdb-mode): Use define-derived-mode. 2011-04-16 Roland Winkler * lisp/bbdb.el (bbdb-indent-string): New function. (bbdb-display-record-multi-line): Use it. (Bug#33101) 2011-04-16 Roland Winkler * lisp/bbdb-com.el: Autoload browse-url-url-at-point. 2011-04-16 Roland Winkler * lisp/bbdb.el (bbdb-create-hook, bbdb-change-hook): Call add-hook for the default hook functions. 2011-04-11 Roland Winkler * lisp/bbdb-com.el (bbdb-complete-mail): Ensure initialization of the database. 2011-04-10 Roland Winkler * lisp/bbdb.el (bbdb-utilities-anniv): New customization group. (bbdb-create-hook, bbdb-change-hook) (bbdb-after-change-hook, bbdb-notice-hook) (bbdb-default-separator): Improve doc string. (bbdb-separator-alist): Improve doc string. Include entries for anniversaries. (bbdb-records): Use make-variable-buffer-local. (bbdb-current-field): Do not remove field-name. (bbdb-record-note): Simplified. (bbdb-record-note-n): Removed. (bbdb-record-note-split): New function. (bbdb-record-set-note): Improved documentation. (bbdb-format-note, bbdb-record-format-note): New function. (bbdb-display-text): Renamed from bbdb-format-text. (bbdb-display-list): Renamed from bbdb-format-list. (bbdb-display-name-organization): Renamed from bbdb-format-name-organization. (bbdb-display-record-one-line): Renamed from bbdb-format-record-one-line. Unify text properties. (bbdb-display-record-multi-line): Renamed from bbdb-format-record-multi-line. Unify text properties. (bbdb-display-record-full-multi-line): Renamed from bbdb-format-record-full-multi-line. (bbdb-display-record-pop-up-multi-line): Renamed from bbdb-format-record-pop-up-multi-line. (bbdb-display-record): Renamed from bbdb-format-record. (bbdb-parse-internal, bbdb-parse-frobnicate): Simplified search for first record. (bbdb-delete-record-internal, bbdb-overwrite-record-internal): Disentangle code. * lisp/bbdb-com.el (bbdb-editable): Throw error if *BBDB* buffer is out of sync with database. (bbdb-search): Use suffix -re for all args that are regular expressions. (bbdb-delete-duplicate-mails, bbdb-sort-addresses) (bbdb-sort-phones, bbdb-sort-notes): New optional arg update. (bbdb-record-edit-note): Renamed from bbdb-record-edit-notes. (bbdb-list-transpose, bbdb-ident-point): New functions. (bbdb-transpose-fields): Use them. Make code more robust such that it can be applied to any subfields of the same type. (bbdb-field-equal, bbdb-next-field): Removed (obsolete). (bbdb-mail-aliases, bbdb-get-mail-aliases, bbdb-add-mail-alias) (bbdb-browse-url): Use bbdb-record-note-split. * lisp/bbdb-mua.el (bbdb-mua-wrapper): Do not use rmail-select-summary. (bbdb-mua-auto-update): Bug fix. * lisp/bbdb-rmail.el (bbdb-insinuate-rmail) * lisp/bbdb-mhe.el (bbdb-insinuate-mh): Bind to bbdb-mua-edit-notes-sender. * lisp/bbdb-vm.el (bbdb/vm-auto-folder, bbdb/vm-virtual-folder) (bbdb/vm-auto-add-label): Use bbdb-record-note-split. * lisp/bbdb-print.el (bbdb-print-omit-fields): Remove `omit'. * lisp/bbdb-anniv.el: New file. * lisp/Makefile: Honor lisp/bbdb-anniv.el. 2011-03-05 Roland Winkler * lisp/bbdb.el (bbdb-modeline-info): New variable. (bbdb-mode): Use it. (bbdb-mode-map): Unify keybindings for search commands. (bbdb-sort-records): Update marker positions correctly. * lisp/bbdb-com.el (bbdb-append-display-p, bbdb-append-display) (bbdb-search-invert-p, bbdb-search-invert): Use bbdb-modeline-info. (bbdb-search): Also search for addresses. Simplify codde. (bbdb-search-address): New command. (bbdb-search-phone): Fix prompt. * lisp/bbdb-mua.el (bbdb-mua-wrapper): Simplify code. (bbdb-mua-auto-update-init): Doc fix. * lisp/bbdb-message.el (bbdb/message-update-records-p) * lisp/bbdb-rmail.el (bbdb/rmail-update-records-p) * lisp/bbdb-gnus.el (bbdb/gnus-update-records-p) * lisp/bbdb-mhe.el (bbdb/mh-update-records-p) * lisp/bbdb-vm.el (bbdb/vm-update-records-p): Doc fix. 2011-02-27 Roland Winkler * lisp/bbdb.el (bbdb-address-format-list): New variable for customization of address formatting and editing. (renamed from bbdb-address-format-alist). (bbdb-format-address): Use it. (bbdb-format-record-one-line, bbdb-format-record-multi-line): Use bbdb-format-address. (bbdb-address-edit-function, bbdb-format-streets) (bbdb-format-address-continental): Removed. Obsolete because of bbdb-address-format-list. (bbdb-format-record): Use funcall instead of eval. (bbdb-continental-postcode-regexp): Renamed from bbdb-continental-zip-regexp. (bbdb-check-postcode): Renamed from bbdb-check-zip. (bbdb-legal-postcodes): Renamed from bbdb-legal-zip-codes. (bbdb-expand-mail-aliases): Removed. (bbdb-notes-label-list): Renamed from bbdb-notes-names. (bbdb-parse-frobnicate): Calculate value of bbdb-notes-label-list instead of reading it. Use memq instead of member. (bbdb-set-notes-labels): Renamed from bbdb-set-notes-names. Do not write value of bbdb-notes-label-list. (bbdb-set-eq): Removed (obsolete). (bbdb-defstruct): Use defsubst. (bbdb-record-unset-name): Clarify code. (bbdb-initialize): Doc fix. * lisp/bbdb-com.el (bbdb-message-search): Use name only if mail address does not match. (bbdb-parse-postcode): Renamed from bbdb-parse-zip. (bbdb-insert-field): In interactive calls ignore fields that are already present. (bbdb-record-edit-phone): Convert format of phone number if old and new format are different. (bbdb-edit-field): Use new bbdb-record-edit-phone. (bbdb-record-edit-address): Use bbdb-address-format-list. (bbdb-edit-address-street): Renamed from bbdb-address-edit-street. Take arg street instead of address. (bbdb-edit-address-default): Renamed from bbdb-address-edit-default. (bbdb-address-edit-continental): Removed (obsolete). (bbdb-complete-mail-cleanup): Removed. Code merged with bbdb-complete-mail. (bbdb-complete-mail): Return non-nil if valid completion exists. Simplify code. * lisp/bbdb-mua.el (bbdb-annotate-message): Use bbdb-string=. (bbdb-mua-wrapper): Also handle mail and message mode. (bbdb-mua-auto-update): Renamed from bbdb-mua-pop-up-bbdb-buffer. Perform auto update even if bbdb-message-pop-up is nil. (bbdb-mua-auto-update-init): Renamed from bbdb-mua-pop-up-init. Doc fix. Use memq instead of member. (bbdb-force-record-create): Removed (obsolete). * lisp/bbdb-migrate.el (bbdb-migrate-postcodes-to-strings): Renamed from bbdb-migrate-zip-codes-to-strings. * lisp/bbdb-print.el (bbdb-print-tex-quote-alist): Fix regexp. (bbdb-print-address-format-list): Renamed from bbdb-print-address-format-alist. Use bbdb-address-format-list as default. (bbdb-print): Use bbdb-format-address. (bbdb-print-address-continental): Removed. 2011-01-17 Roland Winkler * lisp/Makefile: Do not attempt to add empty line to bbdb-autloads.el. 2011-01-16 Roland Winkler * README: Updated. * lisp/Makefile: In bbdb-autloads.el, add BBDB lisp directory to load-path. * lisp/bbdb.el (bbdb-pop-up-buffer): Use condition-case, in case split-window fails. (bbdb-records, bbdb-mode, bbdb-version, bbdb-initialize): Add autoload cookie. 2011-01-15 Roland Winkler * lisp/bbdb-mua.el (bbdb-mua-update-records): For Gnus use gnus-article-buffer. (bbdb-mua-wrapper): New macro. (bbdb-mua-display-records, bbdb-mua-annotate-sender) (bbdb-mua-annotate-recipients, bbdb-mua-edit-notes-sender) (bbdb-mua-edit-notes-recipients): Use it. (bbdb-mua-update-mua): Removed (obsolete because of bbdb-mua-wrapper). * lisp/bbdb-gnus.el (bbdb-insinuate-gnus): Code doc updated. * lisp/bbdb-com.el (bbdb-complete-name): Obsolete alias for bbdb-complete-mail. 2011-01-06 Roland Winkler * lisp/bbdb.el (bbdb-message-headers, bbdb-accept-name-mismatch) (bbdb-use-alternate-names): Fix docstring. (bbdb-auto-notes-rules): Renamed from bbdb-auto-notes-alist. New format. (bbdb-auto-notes-ignore-messages): Renamed from bbdb-auto-notes-ignore-all. (bbdb-auto-notes-ignore-headers): Renamed from bbdb-auto-notes-ignore. (bbdb-pop-up-window-size): Fix docstring. (bbdb-horiz-pop-up-window-size): New variable. (bbdb-pop-up-buffer): Use it. (bbdb-auto-notes-rules-expanded): New variable. * lisp/bbdb-com.el: Use eval-and-compile. (bbdb-subint): Moved here from lisp/bbdb.el. Simplified. (bbdb-parse-phone): Return value always includes extension. (bbdb-read-record): Simplified accordingly. (bbdb-prompt-for-new-field): Use phone number style as returned from bbdb-parse-phone. * lisp/bbdb-mua.el: Use eval-and-compile. (bbdb-update-records): Avoid name clash with function search in cl-seq.el. (bbdb-message-header-re): New function. (bbdb-accept-message): Use it. (bbdb-get-address-components): Also return MUA. (bbdb-annotate-message): Bug fix. Simplify. (bbdb-mua-pop-up-init): New function. (bbdb-auto-notes): Complete re-write. * lisp/bbdb-message.el (bbdb-insinuate-message) (bbdb-insinuate-mail) * lisp/bbdb-rmail.el (bbdb-insinuate-rmail) * lisp/bbdb-gnus.el (bbdb-insinuate-gnus) * lisp/bbdb-mhe.el (bbdb-insinuate-mh) * lisp/bbdb-vm.el (bbdb-insinuate-vm): Do not hook in bbdb-mua-pop-up-bbdb-buffer. (Use instead bbdb-mua-pop-up-init.) 2010-12-15 Roland Winkler * lisp/bbdb.el (bbdb-mua-message): New customization group. (bbdb-update-records-p): Value may also be a function. (bbdb-mua-update-interactive-p): New variable. (bbdb-init-forms): Add message and mail mode support. Sendmail is deprecated (use mail instead). Remove outdated support for reportmail, supercite and w3. (bbdb-initialize): Updated accordingly. Do not test presence of features (which is not needed). (bbdb-insinuate-sendmail): Removed (use bbdb-insinuate-mail). ( bbdb-insinuate-message): Moved to bbdb-message.el. * lisp/bbdb-com.el (bbdb-mail, bbdb-mail-address): Simplified. * lisp/bbdb-mua.el (bbdb-mua, bbdb-message-header): New functions. (bbdb-get-address-components): Use bbdb-message-header. Simplified. (bbdb-update-records): New arg msg-key. Handle message cache. Arg update-p may also be a function. (bbdb-mua-update-records, bbdb-mua-update-mua) (bbdb-mua-update-interactive-p, bbdb-mua-pop-up-bbdb-buffer): New functions. (bbdb-mua-display-records, bbdb-mua-display-sender) (bbdb-mua-display-recipients, bbdb-mua-annotate-sender) (bbdb-mua-annotate-recipients, bbdb-mua-edit-notes-sender) (bbdb-mua-edit-notes-recipients): New commands. * lisp/bbdb-vm.el (bbdb/vm-header): Remove MIME decoding. (bbdb/vm-update-records, bbdb/vm-pop-up-bbdb-buffer) (bbdb/vm-show-records, bbdb/vm-show-sender) (bbdb/vm-show-recipients, bbdb/vm-annotate-sender) (bbdb/vm-edit-notes): Obsolete. Use instead generic functions in bbdb-mua.el. (bbdb-insinuate-vm): Use generic commands. * lisp/bbdb-gnus.el (bbdb/gnus-update-records) (bbdb/gnus-pop-up-bbdb-buffer, bbdb/gnus-show-records) (bbdb/gnus-show-sender, bbdb/gnus-show-recipients) (bbdb/gnus-annotate-sender, bbdb/gnus-edit-notes) (bbdb/gnus-summary-show-all-recipients): Obsolete. Use instead generic functions in bbdb-mua.el. (bbdb-insinuate-gnus): Use generic commands. (bbdb/gnus-lines-and-from-length): Removed as gnus-optional-headers appears to be obsolete, too. (bbdb/gnus-message-marker-field): New variable. (bbdb-message-marker-field): Declared obsolete. (bbdb/gnus-summary-get-sender, bbdb/gnus-summary-sender-in-bbdb) (bbdb/gnus-nnimap-folder-list-from-bbdb): Simplified. * lisp/bbdb-rmail.el (bbdb/rmail-update-records) (bbdb/rmail-pop-up-bbdb-buffer, bbdb/rmail-show-records) (bbdb/rmail-show-sender, bbdb/rmail-show-recipients) (bbdb/rmail-annotate-sender, bbdb/rmail-edit-notes) (bbdb/rmail-summary-show-all-recipients): Obsolete. Use instead generic functions in bbdb-mua.el. (bbdb-insinuate-rmail): Use generic commands. Remove defadvice which has become obsolete because header Messge-ID is used for message caching. * lisp/bbdb-mhe.el, lisp/bbdb-message.el: New files. * lisp/Makefile: Updated to compile also the new files. 2010-11-30 Roland Winkler * lisp/bbdb.el (bbdb-update-records-p): Fix docstring. (bbdb-message-pop-up): Change default to a less aggressive nil. (bbdb-format-record-one-line): Remove linebreaks from multi-line notes. * lisp/bbdb-com.el (bbdb-delete-duplicate-mails) (bbdb-display-records-completely) (bbdb-display-records-with-layout, bbdb-copy-records-as-kill): Doc fix. (bbdb-search-duplicates): Improved interactive spec. New arg records. Doc fix (bbdb-delete-field-or-record): Make records a required arg. New arg fields. Doc fix. (bbdb-delete-records, bbdb-toggle-records-layout) (bbdb-sort-addresses, bbdb-sort-phones, bbdb-sort-notes) (bbdb-add-mail-alias): Make records a required arg. Doc fix. (bbdb-mail-address): New command bound to M. (bbdb-mail): Use it. New arg verbose. Fix interactive spec. (bbdb-mail-yank): Renamed from bbdb-yank-addresses. Bug fix. (bbdb-yank-addresses): Declared obsolete. (bbdb-browse-url): Simplify. Doc fix. (bbdb-grab-url): Simplify. * lisp/bbdb-vm.el (bbdb/vm-update-records-p) * lisp/bbdb-gnus.el (bbdb/gnus-update-records-p) * lisp/bbdb-rmail.el (bbdb/rmail-update-records-p): Improved default. 2010-11-01 Roland Winkler * lisp/bbdb.el (bbdb-wrap-column): New variable. (bbdb-format-list): Use bbdb-wrap-column and bbdb-separator-alist. (bbdb-layout-alist, bbdb-format-address-continental) (bbdb-format-address-default, bbdb-format-record-multi-line): Change value of indentation such that it becomes the total indentation. * lisp/bbdb-com.el (bbdb-dwim-mail): Fix typo. 2010-10-17 Roland Winkler * lisp/bbdb.el (bbdb-mail-allow-redundancy): Doc fix. (bbdb-mode-map): Include bbdb-do-all-records in "Use database" submenu. * lisp/bbdb-com.el (bbdb-record-list): Doc fix. (bbdb-dwim-mail): Arg MAIL may be a number, which will pick the MAILth mail address. (bbdb-mail): New optional arg N to pick Nth mail address. 2010-09-30 Roland Winkler * lisp/bbdb.el (bbdb-insert-record-internal): Handle empty database properly. * lisp/bbdb-com.el (bbdb-dwim-mail): Cleanup code. 2010-09-19 Roland Winkler * lisp/bbdb-mua.el (bbdb-prompt-for-create): Quit with C-g. (bbdb-annotate-message) Call UPDATE-P only if record is not yet defined. 2010-08-28 Roland Winkler * Relicense all BBDB files to GPLv3 or later. Update email address to winkler@gnu.org. * lisp/bbdb.el (bbdb-completion-list): Element name replaced by fl-name and lf-name. * lisp/bbdb-com.el (bbdb-insert-field): Use remq instead of delq. (bbdb-complete-mail): Do not use trimmed version of the pattern for partial completion. Distinguish fl-name and lf-name. 2010-08-01 Roland Winkler * lisp/bbdb.el (bbdb-message-caching): Renamed from bbdb-message-caching-enabled. (bbdb-create-hook): Renamed from bbdb-create-hooks. (bbdb-change-hook): Renamed from bbdb-change-hooks. (bbdb-after-change-hook): Renamed from bbdb-after-change-hooks. (bbdb-notice-hook): Renamed from bbdb-notice-hooks. (bbdb-accept-message-alist): Renamed from bbdb-accept-messages-alist. (bbdb-ignore-message-alist): Renamed from bbdb-ignore-messages-alist. (bbdb-update-records-p): New user var. (bbdb-notice-hook-pending): Renamed from bbdb-inside-notice-hooks. (bbdb-user-mail-address-re): Renamed from bbdb-user-mail-names. (bbdb-mail-allow-redundancy): Renamed from bbdb-dwim-mail-allow-redundancy. (bbdb-check-auto-save-file): Renamed from bbdb-notice-auto-save-file. (bbdb-completion-list): Renamed from bbdb-completion-alist. (bbdb-mail-alias): Renamed from bbdb-mail-alias-mode. (bbdb-mail-user-agent): Replacement for bbdb-user-style. (bbdb-compose-mail): Renamed from bbdb-mail-internal. (bbdb-default-separator): Renamed from bbdb-notes-default-separator. (bbdb-separator-alist): Renamed from bbdb-notes-separator-alist. (bbdb-concat): Renamed from bbdb-join. * lisp/bbdb-com.el (bbdb-grab-url): Renamed from bbdb-url-grab-url. * lisp/bbdb-mua.el: New file. Content merged from bbdb-com.el and bbdb-hooks.el (bbdb-get-address-components): Changed calling sequence. (bbdb-message-header): Renamed from bbdb-message-field. (bbdb-accept-message): Renamed from bbdb-ignore-most-messages. (bbdb-ignore-message): Renamed from bbdb-ignore-some-messages. (bbdb-select-message): Renamed from bbdb-ignore-selected-messages-hook. (bbdb-auto-notes): Renamed from bbdb-auto-notes-hook. (bbdb-canonicalize-mail-1): Renamed from bbdb-sample-canonicalize-mail-function. * lisp/bbdb-print.el (bbdb-print-file): Renamed from bbdb-print-file-name. (bbdb-print-tex-quote-alist): New var. (bbdb-print-address-format-alist): Renamed from bbdb-address-print-format-alist. (bbdb-print-record): Renamed from bbdb-print-format-record. (bbdb-print-address-continental): Renamed from bbdb-print-format-address-continental. (bbdb-print-address-default): Renamed from bbdb-print-format-address-default. (bbdb-print-phone): Renamed from bbdb-print-phone-string. * lisp/bbdb-vm.el (bbdb/vm-auto-folder): Renamed from bbdb/vm-auto-folder-alist. (bbdb/vm-virtual-folder): Renamed from bbdb/vm-virtual-folder-alist. ;; Local Variables: ;; coding: utf-8 ;; End: Copyright (C) 2010-2017 Free Software Foundation, Inc. This file is part of the Insidious Big Brother Database (aka BBDB), BBDB 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. BBDB 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 BBDB. If not, see . bbdb3-3.2/Makefile.am000066400000000000000000000026551322420162700143750ustar00rootroot00000000000000# main Makefile.am for BBDB # # Copyright (C) 2013 Christian Egli # Copyright (C) 2013-2017 Roland Winkler # # This file is part of the Insidious Big Brother Database (aka BBDB), # # BBDB 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. # # BBDB 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 BBDB. If not, see . SUBDIRS = lisp doc tex doc_DATA = COPYING ChangeLog AUTHORS NEWS README TODO EXTRA_DIST = autogen.sh BBDB_ELPA_FILES = README COPYING lisp/*.el doc/*.info doc/dir tex/*.sty BBDB_ELPA_PACKAGE = bbdb-$(PACKAGE_VERSION).tar # doc/dir is needed for the ELPA package doc/dir: doc/bbdb.info install-info $< $@ CLEANFILES = doc/dir # Package everything in a form suitable for ELPA. elpa: $(BBDB_ELPA_FILES) $(AMTAR) --transform='s:\(lisp\|doc\|tex\)/::' \ --transform='s::bbdb-$(PACKAGE_VERSION)/:' \ --exclude=bbdb-loaddefs.el \ -cf $(BBDB_ELPA_PACKAGE) $(BBDB_ELPA_FILES) @echo "Created $(BBDB_ELPA_PACKAGE)" bbdb3-3.2/NEWS000066400000000000000000000035651322420162700130410ustar00rootroot00000000000000BBDB NEWS -- history of user-visible changes. Copyright (C) 2013-2017 Free Software Foundation, Inc. See the end of the file for license conditions. This file is about changes in BBDB version 3. * BBDB 3.2 ** BBDB 3.2 requires GNU Emacs 24 or newer. Support for GNU Emacs 23 has been discontinued. ** Support for Mu4e and Wanderlust has been added. ** Incompatible Changes in BBDB 3.2 *** The variables bbdb/MUA-update-records-p have been removed. This includes the variables bbdb/gnus-update-records-p, bbdb/mail-update-records-p, bbdb/message-update-records-p, bbdb/mh-update-records-p, bbdb/rmail-update-records-p, bbdb/vm-update-records-p. These fall-back variables collided with the user variables bbdb-mua-update-interactive-p and bbdb-mua-auto-update-p. Use function bbdb-mua to define your own function to get MUA-specific values. * BBDB 3.1.2 ** Bug fix release ** New command bbdb-fix-records * BBDB 3.1.1 ** Updated autoconf and automake scripts ** Lisp code in 3.1.1 is identical to lisp code in 3.1. * BBDB 3.1 Initial release ---------------------------------------------------------------------- Copyright (C) 2013-2017 Free Software Foundation, Inc. This file is part of the Insidious Big Brother Database (aka BBDB), BBDB 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. BBDB 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 BBDB. If not, see . Local variables: mode: outline paragraph-separate: "[ ]*$" end: bbdb3-3.2/README000066400000000000000000000232661322420162700132220ustar00rootroot00000000000000Copyright (C) 2010-2017 Free Software Foundation, Inc. See the end of the file for license conditions. BBDB is the Insidious Big Brother Database for GNU Emacs. It provides an address book for email and snail mail addresses, phone numbers and the like. It can be linked with various Emacs mail clients (Message and Mail mode, Rmail, Gnus, MH-E, Mu4e, VM, and Wanderlust). BBDB is fully customizable. BBDB is available at http://elpa.gnu.org/packages/bbdb.html To install this package, run in Emacs: M-x package-install RET bbdb RET BBDB is also available at http://savannah.nongnu.org/projects/bbdb/ To check it out, use git clone git://git.savannah.nongnu.org/bbdb.git Questions, comments, suggestions, and bug reports may be directed to the BBDB mailing list at bbdb-user@nongnu.org. To subscribe to this list, go to https://lists.nongnu.org/mailman/listinfo/bbdb-user. ================================================================== Installation: To install this package from GNU ELPA, run in Emacs: M-x package-install RET bbdb RET To compile and install BBDB from Savannah with `make' (see also the generic file INSTALL): 0) (BBDB development version only) Configure the configure process: Run `autogen.sh' in the top directory of the BBDB code. This creates the `configure' script required for step 1). 1) Configure the build process: Run the `configure' script in the top directory of the BBDB code. This performs a number of checks on your system and generates the Makefiles accordingly. You need at least GNU Emacs 24. The `configure' script comes with various options: `--with-mu4e-dir=DIR' specifies the path where Mu4e can be found. Without this option the resulting BBDB build does not support Mu4e. `--with-vm-dir=DIR' specifies the path where VM can be found. Without this option the resulting BBDB build does not support VM. `--with-wl-dir=DIR' specifies the path where Wanderlust can be found. Without this option the resulting BBDB build does not support WL. `--with-lispdir=DIR' specifies where to install the lisp files. Use `configure --help' to see all available options. 2) Build BBDB: To build BBDB type 'make'. If you use the BBDB development version, but you do not have autoconf, go to the lisp directory and type 'make --makefile=./makefile-temp'. 3) Install BBDB: To install BBDB type `make install'. This installs all files in their usual system directories. You can override these defaults via respective options for the configure script. The TeX files in the ./tex directory are installed in ${datadir} which defaults to /usr/local/share/bbdb/. These files are only used by BBDB. They need not be known to your local TeX installation. See the user variable bbdb-tex-path below. `make install' is not required to run BBDB. 4) Activate BBDB: i) If the BBDB lisp files are in a directory "/path/to/bbdb/lisp" you can use in your Emacs init file (require 'bbdb-loaddefs "/path/to/bbdb/lisp/bbdb-loaddefs.el") This adds "/path/to/bbdb/lisp" to the load-path; so it is all you need to make BBDB known to Emacs. ii) The user variable bbdb-tex-path should point to the directory where the BBDB TeX files reside (default /usr/local/share/bbdb). =============================================================================== Usage notes BBDB 3 is the first release of BBDB after a long time. Up to BBDB 3.1.2 it requires GNU Emacs 23 or newer. More recent versions require GNU Emacs 24 or newer. The code of BBDB 3 is still under development. While it should work reliably, users of previous versions of BBDB are advised that the format of the BBDB database file has changed. Migration to the new format should happen automatically. Yet it is recommended to make a copy of the old file, in case something unexpected happens or you might want to go back. As compared with BBDB 2.xx, many variables, functions, and commands have changed in BBDB 3. Most likely you will have to review your customizations carefully. You may want to call bbdb-undocumented-variables to identify outdated (i.e., now usually undocumented) variables in your init file. Those upgrading from BBDB 2.xx may also find this Emacs wiki page helpful: https://www.emacswiki.org/emacs/UpgradeBBDB All user variables for the core of BBDB 3 are listed at the beginning of bbdb.el. Some extensions of BBDB 3 define their user variables at the beginning of the respective files. Generally the default values for user variables are chosen such that they make BBDB the least aggressive. You can customize this behavior in many ways. See below for an overview. The BBDB info manual is still awaiting a more complete overhaul. BBDB interface with mail user agents (MUAs) =========================================== BBDB can interface with various mail user agents (MUAs). These include Rmail, Gnus, VM, MH-E, Mu4e, Wanderlust, Message and Mail mode. This lets you - display the BBDB records for the sender and/or recipients of a message you are viewing - create or update the BBDB records for the sender and/or recipients of a message - add annotations to the BBDB records for the sender and/or recipients of a message There are two ways for BBDB to interface with MUAs: Interactive commands -------------------- Call bbdb-initialize (usually in your init file) to initialize the MUA interfaces based on interactive commands MUA commands include bbdb-mua-display-records, bbdb-mua-display-sender, bbdb-mua-display-recipients bbdb-annotate-record, bbdb-mua-annotate-sender, bbdb-mua-annotate-recipients bbdb-mua-edit-field, bbdb-mua-edit-field-sender, bbdb-mua-edit-field-recipients These MUA commands operate either on existing records only. Or they can also create new records. All these commands are controlled by bbdb-mua-update-interactive-p. This is a cons pair (WITHOUT-PREFIX . WITH-PREFIX). The car is used if the command is called without a prefix. The cdr is used if the command is called with a prefix (and if the prefix is not used for another purpose). The underlying idea is that the car can provide a less aggressive default such as `search' or `update' (see below), whereas the cdr can provide more aggressive behavior such as `create'. WITHOUT-PREFIX and WITH-PREFIX may take the values (here ADDRESS is an email address found in a message): nil Do nothing. search Search for existing records matching ADDRESS. update Search for existing records matching ADDRESS; update name and mail field if necessary. query Search for existing records matching ADDRESS; query for creation of a new record if the record does not exist. create or t Search for existing records matching ADDRESS; create a new record if it does not yet exist. a function This functions will be called with no arguments. It should return one of the above values (see below). read Read the value interactively. BBDB 2 also used MUA-specific variables bbdb/MUA-update-records-mode to control its interfaces with MUAs. If you liked this feature, use the function bbdb-mua to define your own function to get MUA-specific values for WITHOUT-PREFIX and WITH-PREFIX. Noninteractive functions ------------------------ Call bbdb-mua-auto-update-init (usually in your init file) to hook BBDB's hook function bbdb-mua-auto-update into the MUAs. bbdb-mua-auto-update automatically updates the BBDB records for the sender and/or recipients of a message. If bbdb-mua-pop-up is non-nil, the matching records are also displayed in a continuously updated BBDB window, The behavior of bbdb-mua-auto-update is controlled by bbdb-mua-auto-update-p. This may take the same values as bbdb-mua-update-interactive-p (except read). Binding this to a function is often most helpful for noninteractive use. For example, you may want to bind bbdb-mua-auto-update-p to the function bbdb-select-message, see bbdb-accept-message-alist and bbdb-ignore-message-alist. If a message is accepted by bbdb-select-message, the actual action performed by BBDB (i.e., the return value of bbdb-select-message) is given by bbdb-update-records-p. ================================================================== Notes for BBDB lisp hackers: ---------------------------- If you write your own functions and commands to modify BBDB records, do not call the low-level functions bbdb-record-set-* such as bbdb-record-set-aka, bbdb-record-set-mail etc. The recommended sequence of calls is - one or multiple calls of bbdb-record-set-field for the respective fields to be changed. This not only sets the fields, but it also ensures the integrity of the database. Also, this makes your code more robust with respect to possible future changes of BBDB's innermost internals. - a call of bbdb-change-record which updates the database after a change of record and redisplays the records. - To display newly created records call bbdb-display-records. ================================================================== Copyright (C) 2010-2017 Free Software Foundation, Inc. This file is part of the Insidious Big Brother Database (aka BBDB), BBDB 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. BBDB 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 BBDB. If not, see . bbdb3-3.2/TODO000066400000000000000000000061731322420162700130300ustar00rootroot00000000000000BBDB todo List -*-outline-*- Copyright (C) 2011-2017 Free Software Foundation, Inc. See the end of the file for license conditions. * Bug fixes * Release BBDB v3. ** Facilitate update BBDB v2.x to v3 Compile list of changes BBDB v3 versus v2.x. Which variables / functions / commands / key bindings / concepts in v3 have replaced which ones from v2? Is it possible / meaningful to set up a file bbdb-v2.el with aliases for v2 variable and function names mapping to the names used in v3? ** Update / rewrite texinfo manual ** Copyright Identify contributors. Assign copyright to FSF. ** Get BBDB on the GNU ELPA ** Write BBDB tests using ERT * Features ** Command bbdb-copy-fields-as-kill ** Prioritize BBDB records 2011-04-11 Sam Steingold Records with low priority are not considered for printing etc. ** Prioritize email addresses of a record 2011-04-11 Sam Steingold Records with low priority are still considered for identifying old emails and news messages. But they are ignored for new emails (e.g., completion). ** Import / export BBDB records (e.g. vcard or its XML derivative) 2011-04-05 Leo See https://github.com/trebb/bbdb-vcard (latest commit Apr 2010) or its fork https://github.com/tohojo/bbdb-vcard (latest commit Jul 2015) ** Import from Google Contacts (aka Gmail contacts) 2016-10-24 Barak A. Pearlmutter See https://github.com/tohojo/bbdb-vcard (last commit Sep 2015) which imports only name and email. See also the ASynK program, http://asynk.io/, https://github.com/skarra/ASynK (last commit May 2016), which is a python program that does bi-directional sync between bbdb, Google Contacts, MS Outlook, MS Exchange, and CardDAV. ** Incremental search of BBDB records like bbdb- 2016-10-24 Barak A. Pearlmutter The bbdb- package adds a lovely incremental search facility to bbdb. See https://github.com/aki2o/bbdb- (last commit Feb 2014) which includes a gif showing an incremental search, selection of three records, and their being blasted into the To: and Cc: fields in an email composition buffer. ** Allow splitting of bbdb-file into multiple files ** bbdb-narrow-display: Inverse of bbdb-append-display * Internals ** Remove bbdb-auto-notes-rules-expanded? 2011-05-05 Leo Copyright (C) 2011-2017 Free Software Foundation, Inc. This file is part of the Insidious Big Brother Database (aka BBDB), BBDB 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. BBDB 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 BBDB. If not, see . bbdb3-3.2/autogen.sh000077500000000000000000000023461322420162700143370ustar00rootroot00000000000000#!/bin/sh ### autogen.sh - tool to help build BBDB from a git checkout ## Copyright (C) 2013 Christian Egli ## Copyright (C) 2013-2017 Roland Winkler ## ## This file is part of the Insidious Big Brother Database (aka BBDB), ## ## BBDB 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. ## ## BBDB 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 BBDB. If not, see . ### Commentary: ## The BBDB git repository does not include the configure script ## (and associated helpers). The first time you fetch BBDB from git, ## run this script to generate the necessary files. ### Code: set -e # Refresh GNU autotools toolchain. autoreconf --verbose --force --install --warnings=all echo "You can now run \`./configure'." exit 0 bbdb3-3.2/configure.ac000066400000000000000000000032421322420162700146200ustar00rootroot00000000000000# configure.ac --- configuration setup for BBDB # Copyright (C) 2000-2001 Didier Verna # Copyright (C) 2011-2017 Roland Winkler # # Author: Didier Verna # Maintainer: Roland Winkler # # BBDB 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. # # BBDB 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 BBDB. If not, see . # # Process this file with autoconf to produce a configure script. AC_PREREQ([2.69]) AC_INIT([bbdb],[3.2],[bbdb-user@nongnu.org],[],[http://savannah.nongnu.org/projects/bbdb/]) AC_CONFIG_SRCDIR([lisp/bbdb.el]) AC_CONFIG_MACRO_DIR([m4]) # We need GNU Automake 1.13 for AM_ELCFLAGS. AM_INIT_AUTOMAKE([1.13 -Wall gnu]) AC_PACKAGE_DATE # Checks for programs. AC_PROG_INSTALL # Search for Emacs AM_PATH_LISPDIR AS_IF([test "$EMACS" = no], [AC_MSG_ERROR([cannot find Emacs])]) # Checks for libraries. EMACS_VM EMACS_MU4E EMACS_WL AC_SUBST([AM_ELCFLAGS]) # Generate lisp/bbdb-site.el via lisp/Makefile as pkgdatadir is only known # at "make" time. AC_CONFIG_FILES([Makefile lisp/Makefile lisp/bbdb-pkg.el doc/Makefile tex/Makefile]) AC_OUTPUT bbdb3-3.2/doc/000077500000000000000000000000001322420162700130765ustar00rootroot00000000000000bbdb3-3.2/doc/Makefile.am000066400000000000000000000017031322420162700151330ustar00rootroot00000000000000# doc/Makefile.am for BBDB # # Copyright (C) 2013 Christian Egli # Copyright (C) 2013-2017 Roland Winkler # # This file is part of the Insidious Big Brother Database (aka BBDB), # # BBDB 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. # # BBDB 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 BBDB. If not, see . info_TEXINFOS = bbdb.texi bbdb_TEXINFOS = doclicense.texi gpl.texi doc_DATA = bbdb.pdf bbdb.info bbdb.pdf: $(bbdb_TEXINFOS) bbdb3-3.2/doc/bbdb.texi000066400000000000000000000042251322420162700146650ustar00rootroot00000000000000\input texinfo @c -*-texinfo-*- @c %**start of header @setfilename bbdb.info @settitle Insidious Big Brother Database (BBDB) User Manual @c %**end of header @copying This file documents the Insidious Big Brother Database (BBDB) Copyright (C) 2011-2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or any later version published by the Free Software Foundation; with the Invariant Section being ``GNU GENERAL PUBLIC LICENSE,'' A copy of the license is included in the section entitled ``GNU Free Documentation License.'' @end quotation @end copying @dircategory Emacs misc features @direntry * BBDB: (bbdb). Insidious Big Brother Database (BBDB). @end direntry @titlepage @title Insidious Big Brother Database (BBDB) User Manual @page @vskip 0pt plus 1filll @insertcopying @end titlepage @c Output the table of the contents at the beginning. @contents @ifnottex @node Top, First Chapter, (dir), (dir) @top BBDB User Manual @insertcopying @end ifnottex @menu * First Chapter:: The first chapter is the only chapter in this sample. Appendices * Copying:: The GNU General Public License gives you permission to redistribute GNU Emacs on certain terms; it also explains that there is no warranty. * GNU Free Documentation License:: The license for this documentation. * Index:: Complete index. @end menu @node First Chapter, Copying, Top, Top @chapter First Chapter @cindex chapter, first This is the first chapter. @cindex index entry, another Here is a numbered list. @enumerate @item This is the first item. @item This is the second item. @end enumerate @node Copying, GNU Free Documentation License, First Chapter, Top @appendix GNU GENERAL PUBLIC LICENSE @include gpl.texi @node GNU Free Documentation License, Index, Copying, Top @appendix GNU Free Documentation License @include doclicense.texi @node Index, , GNU Free Documentation License, Top @unnumbered Index @printindex cp @bye bbdb3-3.2/doc/doclicense.texi000066400000000000000000000560451322420162700161130ustar00rootroot00000000000000@c -*-texinfo-*- @c The GNU Free Documentation License. @center Version 1.3, 3 November 2008 @c This file is intended to be included within another document, @c hence no sectioning command or @node. @display Copyright @copyright{} 2000, 2001, 2002, 2007, 2008, 2009 Free Software Foundation, Inc. @uref{http://fsf.org/} Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. @end display @enumerate 0 @item PREAMBLE The purpose of this License is to make a manual, textbook, or other functional and useful document @dfn{free} in the sense of freedom: to assure everyone the effective freedom to copy and redistribute it, with or without modifying it, either commercially or noncommercially. Secondarily, this License preserves for the author and publisher a way to get credit for their work, while not being considered responsible for modifications made by others. This License is a kind of ``copyleft'', which means that derivative works of the document must themselves be free in the same sense. It complements the GNU General Public License, which is a copyleft license designed for free software. We have designed this License in order to use it for manuals for free software, because free software needs free documentation: a free program should come with manuals providing the same freedoms that the software does. But this License is not limited to software manuals; it can be used for any textual work, regardless of subject matter or whether it is published as a printed book. We recommend this License principally for works whose purpose is instruction or reference. @item APPLICABILITY AND DEFINITIONS This License applies to any manual or other work, in any medium, that contains a notice placed by the copyright holder saying it can be distributed under the terms of this License. Such a notice grants a world-wide, royalty-free license, unlimited in duration, to use that work under the conditions stated herein. The ``Document'', below, refers to any such manual or work. Any member of the public is a licensee, and is addressed as ``you''. You accept the license if you copy, modify or distribute the work in a way requiring permission under copyright law. A ``Modified Version'' of the Document means any work containing the Document or a portion of it, either copied verbatim, or with modifications and/or translated into another language. A ``Secondary Section'' is a named appendix or a front-matter section of the Document that deals exclusively with the relationship of the publishers or authors of the Document to the Document's overall subject (or to related matters) and contains nothing that could fall directly within that overall subject. (Thus, if the Document is in part a textbook of mathematics, a Secondary Section may not explain any mathematics.) The relationship could be a matter of historical connection with the subject or with related matters, or of legal, commercial, philosophical, ethical or political position regarding them. The ``Invariant Sections'' are certain Secondary Sections whose titles are designated, as being those of Invariant Sections, in the notice that says that the Document is released under this License. If a section does not fit the above definition of Secondary then it is not allowed to be designated as Invariant. The Document may contain zero Invariant Sections. If the Document does not identify any Invariant Sections then there are none. The ``Cover Texts'' are certain short passages of text that are listed, as Front-Cover Texts or Back-Cover Texts, in the notice that says that the Document is released under this License. A Front-Cover Text may be at most 5 words, and a Back-Cover Text may be at most 25 words. A ``Transparent'' copy of the Document means a machine-readable copy, represented in a format whose specification is available to the general public, that is suitable for revising the document straightforwardly with generic text editors or (for images composed of pixels) generic paint programs or (for drawings) some widely available drawing editor, and that is suitable for input to text formatters or for automatic translation to a variety of formats suitable for input to text formatters. A copy made in an otherwise Transparent file format whose markup, or absence of markup, has been arranged to thwart or discourage subsequent modification by readers is not Transparent. An image format is not Transparent if used for any substantial amount of text. A copy that is not ``Transparent'' is called ``Opaque''. Examples of suitable formats for Transparent copies include plain @sc{ascii} without markup, Texinfo input format, La@TeX{} input format, @acronym{SGML} or @acronym{XML} using a publicly available @acronym{DTD}, and standard-conforming simple @acronym{HTML}, PostScript or @acronym{PDF} designed for human modification. Examples of transparent image formats include @acronym{PNG}, @acronym{XCF} and @acronym{JPG}. Opaque formats include proprietary formats that can be read and edited only by proprietary word processors, @acronym{SGML} or @acronym{XML} for which the @acronym{DTD} and/or processing tools are not generally available, and the machine-generated @acronym{HTML}, PostScript or @acronym{PDF} produced by some word processors for output purposes only. The ``Title Page'' means, for a printed book, the title page itself, plus such following pages as are needed to hold, legibly, the material this License requires to appear in the title page. For works in formats which do not have any title page as such, ``Title Page'' means the text near the most prominent appearance of the work's title, preceding the beginning of the body of the text. The ``publisher'' means any person or entity that distributes copies of the Document to the public. A section ``Entitled XYZ'' means a named subunit of the Document whose title either is precisely XYZ or contains XYZ in parentheses following text that translates XYZ in another language. (Here XYZ stands for a specific section name mentioned below, such as ``Acknowledgements'', ``Dedications'', ``Endorsements'', or ``History''.) To ``Preserve the Title'' of such a section when you modify the Document means that it remains a section ``Entitled XYZ'' according to this definition. The Document may include Warranty Disclaimers next to the notice which states that this License applies to the Document. These Warranty Disclaimers are considered to be included by reference in this License, but only as regards disclaiming warranties: any other implication that these Warranty Disclaimers may have is void and has no effect on the meaning of this License. @item VERBATIM COPYING You may copy and distribute the Document in any medium, either commercially or noncommercially, provided that this License, the copyright notices, and the license notice saying this License applies to the Document are reproduced in all copies, and that you add no other conditions whatsoever to those of this License. You may not use technical measures to obstruct or control the reading or further copying of the copies you make or distribute. However, you may accept compensation in exchange for copies. If you distribute a large enough number of copies you must also follow the conditions in section 3. You may also lend copies, under the same conditions stated above, and you may publicly display copies. @item COPYING IN QUANTITY If you publish printed copies (or copies in media that commonly have printed covers) of the Document, numbering more than 100, and the Document's license notice requires Cover Texts, you must enclose the copies in covers that carry, clearly and legibly, all these Cover Texts: Front-Cover Texts on the front cover, and Back-Cover Texts on the back cover. Both covers must also clearly and legibly identify you as the publisher of these copies. The front cover must present the full title with all words of the title equally prominent and visible. You may add other material on the covers in addition. Copying with changes limited to the covers, as long as they preserve the title of the Document and satisfy these conditions, can be treated as verbatim copying in other respects. If the required texts for either cover are too voluminous to fit legibly, you should put the first ones listed (as many as fit reasonably) on the actual cover, and continue the rest onto adjacent pages. If you publish or distribute Opaque copies of the Document numbering more than 100, you must either include a machine-readable Transparent copy along with each Opaque copy, or state in or with each Opaque copy a computer-network location from which the general network-using public has access to download using public-standard network protocols a complete Transparent copy of the Document, free of added material. If you use the latter option, you must take reasonably prudent steps, when you begin distribution of Opaque copies in quantity, to ensure that this Transparent copy will remain thus accessible at the stated location until at least one year after the last time you distribute an Opaque copy (directly or through your agents or retailers) of that edition to the public. It is requested, but not required, that you contact the authors of the Document well before redistributing any large number of copies, to give them a chance to provide you with an updated version of the Document. @item MODIFICATIONS You may copy and distribute a Modified Version of the Document under the conditions of sections 2 and 3 above, provided that you release the Modified Version under precisely this License, with the Modified Version filling the role of the Document, thus licensing distribution and modification of the Modified Version to whoever possesses a copy of it. In addition, you must do these things in the Modified Version: @enumerate A @item Use in the Title Page (and on the covers, if any) a title distinct from that of the Document, and from those of previous versions (which should, if there were any, be listed in the History section of the Document). You may use the same title as a previous version if the original publisher of that version gives permission. @item List on the Title Page, as authors, one or more persons or entities responsible for authorship of the modifications in the Modified Version, together with at least five of the principal authors of the Document (all of its principal authors, if it has fewer than five), unless they release you from this requirement. @item State on the Title page the name of the publisher of the Modified Version, as the publisher. @item Preserve all the copyright notices of the Document. @item Add an appropriate copyright notice for your modifications adjacent to the other copyright notices. @item Include, immediately after the copyright notices, a license notice giving the public permission to use the Modified Version under the terms of this License, in the form shown in the Addendum below. @item Preserve in that license notice the full lists of Invariant Sections and required Cover Texts given in the Document's license notice. @item Include an unaltered copy of this License. @item Preserve the section Entitled ``History'', Preserve its Title, and add to it an item stating at least the title, year, new authors, and publisher of the Modified Version as given on the Title Page. If there is no section Entitled ``History'' in the Document, create one stating the title, year, authors, and publisher of the Document as given on its Title Page, then add an item describing the Modified Version as stated in the previous sentence. @item Preserve the network location, if any, given in the Document for public access to a Transparent copy of the Document, and likewise the network locations given in the Document for previous versions it was based on. These may be placed in the ``History'' section. You may omit a network location for a work that was published at least four years before the Document itself, or if the original publisher of the version it refers to gives permission. @item For any section Entitled ``Acknowledgements'' or ``Dedications'', Preserve the Title of the section, and preserve in the section all the substance and tone of each of the contributor acknowledgements and/or dedications given therein. @item Preserve all the Invariant Sections of the Document, unaltered in their text and in their titles. Section numbers or the equivalent are not considered part of the section titles. @item Delete any section Entitled ``Endorsements''. Such a section may not be included in the Modified Version. @item Do not retitle any existing section to be Entitled ``Endorsements'' or to conflict in title with any Invariant Section. @item Preserve any Warranty Disclaimers. @end enumerate If the Modified Version includes new front-matter sections or appendices that qualify as Secondary Sections and contain no material copied from the Document, you may at your option designate some or all of these sections as invariant. To do this, add their titles to the list of Invariant Sections in the Modified Version's license notice. These titles must be distinct from any other section titles. You may add a section Entitled ``Endorsements'', provided it contains nothing but endorsements of your Modified Version by various parties---for example, statements of peer review or that the text has been approved by an organization as the authoritative definition of a standard. You may add a passage of up to five words as a Front-Cover Text, and a passage of up to 25 words as a Back-Cover Text, to the end of the list of Cover Texts in the Modified Version. Only one passage of Front-Cover Text and one of Back-Cover Text may be added by (or through arrangements made by) any one entity. If the Document already includes a cover text for the same cover, previously added by you or by arrangement made by the same entity you are acting on behalf of, you may not add another; but you may replace the old one, on explicit permission from the previous publisher that added the old one. The author(s) and publisher(s) of the Document do not by this License give permission to use their names for publicity for or to assert or imply endorsement of any Modified Version. @item COMBINING DOCUMENTS You may combine the Document with other documents released under this License, under the terms defined in section 4 above for modified versions, provided that you include in the combination all of the Invariant Sections of all of the original documents, unmodified, and list them all as Invariant Sections of your combined work in its license notice, and that you preserve all their Warranty Disclaimers. The combined work need only contain one copy of this License, and multiple identical Invariant Sections may be replaced with a single copy. If there are multiple Invariant Sections with the same name but different contents, make the title of each such section unique by adding at the end of it, in parentheses, the name of the original author or publisher of that section if known, or else a unique number. Make the same adjustment to the section titles in the list of Invariant Sections in the license notice of the combined work. In the combination, you must combine any sections Entitled ``History'' in the various original documents, forming one section Entitled ``History''; likewise combine any sections Entitled ``Acknowledgements'', and any sections Entitled ``Dedications''. You must delete all sections Entitled ``Endorsements.'' @item COLLECTIONS OF DOCUMENTS You may make a collection consisting of the Document and other documents released under this License, and replace the individual copies of this License in the various documents with a single copy that is included in the collection, provided that you follow the rules of this License for verbatim copying of each of the documents in all other respects. You may extract a single document from such a collection, and distribute it individually under this License, provided you insert a copy of this License into the extracted document, and follow this License in all other respects regarding verbatim copying of that document. @item AGGREGATION WITH INDEPENDENT WORKS A compilation of the Document or its derivatives with other separate and independent documents or works, in or on a volume of a storage or distribution medium, is called an ``aggregate'' if the copyright resulting from the compilation is not used to limit the legal rights of the compilation's users beyond what the individual works permit. When the Document is included in an aggregate, this License does not apply to the other works in the aggregate which are not themselves derivative works of the Document. If the Cover Text requirement of section 3 is applicable to these copies of the Document, then if the Document is less than one half of the entire aggregate, the Document's Cover Texts may be placed on covers that bracket the Document within the aggregate, or the electronic equivalent of covers if the Document is in electronic form. Otherwise they must appear on printed covers that bracket the whole aggregate. @item TRANSLATION Translation is considered a kind of modification, so you may distribute translations of the Document under the terms of section 4. Replacing Invariant Sections with translations requires special permission from their copyright holders, but you may include translations of some or all Invariant Sections in addition to the original versions of these Invariant Sections. You may include a translation of this License, and all the license notices in the Document, and any Warranty Disclaimers, provided that you also include the original English version of this License and the original versions of those notices and disclaimers. In case of a disagreement between the translation and the original version of this License or a notice or disclaimer, the original version will prevail. If a section in the Document is Entitled ``Acknowledgements'', ``Dedications'', or ``History'', the requirement (section 4) to Preserve its Title (section 1) will typically require changing the actual title. @item TERMINATION You may not copy, modify, sublicense, or distribute the Document except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, or distribute it is void, and will automatically terminate your rights under this License. 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, receipt of a copy of some or all of the same material does not give you any rights to use it. @item FUTURE REVISIONS OF THIS LICENSE The Free Software Foundation may publish new, revised versions of the GNU Free Documentation 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. See @uref{http://www.gnu.org/copyleft/}. Each version of the License is given a distinguishing version number. If the Document specifies that a particular numbered version of this License ``or any later version'' applies to it, you have the option of following the terms and conditions either of that specified version or of any later version that has been published (not as a draft) by the Free Software Foundation. If the Document does not specify a version number of this License, you may choose any version ever published (not as a draft) by the Free Software Foundation. If the Document specifies that a proxy can decide which future versions of this License can be used, that proxy's public statement of acceptance of a version permanently authorizes you to choose that version for the Document. @item RELICENSING ``Massive Multiauthor Collaboration Site'' (or ``MMC Site'') means any World Wide Web server that publishes copyrightable works and also provides prominent facilities for anybody to edit those works. A public wiki that anybody can edit is an example of such a server. A ``Massive Multiauthor Collaboration'' (or ``MMC'') contained in the site means any set of copyrightable works thus published on the MMC site. ``CC-BY-SA'' means the Creative Commons Attribution-Share Alike 3.0 license published by Creative Commons Corporation, a not-for-profit corporation with a principal place of business in San Francisco, California, as well as future copyleft versions of that license published by that same organization. ``Incorporate'' means to publish or republish a Document, in whole or in part, as part of another Document. An MMC is ``eligible for relicensing'' if it is licensed under this License, and if all works that were first published under this License somewhere other than this MMC, and subsequently incorporated in whole or in part into the MMC, (1) had no cover texts or invariant sections, and (2) were thus incorporated prior to November 1, 2008. The operator of an MMC Site may republish an MMC contained in the site under CC-BY-SA on the same site at any time before August 1, 2009, provided the MMC is eligible for relicensing. @end enumerate @page @heading ADDENDUM: How to use this License for your documents To use this License in a document you have written, include a copy of the License in the document and put the following copyright and license notices just after the title page: @smallexample @group Copyright (C) @var{year} @var{your name}. Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or any later version published by the Free Software Foundation; with no Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts. A copy of the license is included in the section entitled ``GNU Free Documentation License''. @end group @end smallexample If you have Invariant Sections, Front-Cover Texts and Back-Cover Texts, replace the ``with@dots{}Texts.'' line with this: @smallexample @group with the Invariant Sections being @var{list their titles}, with the Front-Cover Texts being @var{list}, and with the Back-Cover Texts being @var{list}. @end group @end smallexample If you have Invariant Sections without Cover Texts, or some other combination of the three, merge those two alternatives to suit the situation. If your document contains nontrivial examples of program code, we recommend releasing these examples in parallel under your choice of free software license, such as the GNU General Public License, to permit their use in free software. @c Local Variables: @c ispell-local-pdict: "ispell-dict" @c End: bbdb3-3.2/doc/gpl.texi000066400000000000000000001044211322420162700145550ustar00rootroot00000000000000@c The GNU General Public License. @center Version 3, 29 June 2007 @c This file is intended to be included within another document, @c hence no sectioning command or @node. @display Copyright @copyright{} 2007 Free Software Foundation, Inc. @url{http://fsf.org/} Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. @end display @heading Preamble The GNU General Public License is a free, copyleft license for software and other kinds of works. The licenses for most software and other practical works are designed to take away your freedom to share and change the works. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change all versions of a program---to make sure it remains free software for all its users. We, the Free Software Foundation, use the GNU General Public License for most of our software; it applies also to any other work released this way by its authors. You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for them if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs, and that you know you can do these things. To protect your rights, we need to prevent others from denying you these rights or asking you to surrender the rights. Therefore, you have certain responsibilities if you distribute copies of the software, or if you modify it: responsibilities to respect the freedom of others. For example, if you distribute copies of such a program, whether gratis or for a fee, you must pass on to the recipients the same freedoms that you received. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. Developers that use the GNU GPL protect your rights with two steps: (1) assert copyright on the software, and (2) offer you this License giving you legal permission to copy, distribute and/or modify it. For the developers' and authors' protection, the GPL clearly explains that there is no warranty for this free software. For both users' and authors' sake, the GPL requires that modified versions be marked as changed, so that their problems will not be attributed erroneously to authors of previous versions. Some devices are designed to deny users access to install or run modified versions of the software inside them, although the manufacturer can do so. This is fundamentally incompatible with the aim of protecting users' freedom to change the software. The systematic pattern of such abuse occurs in the area of products for individuals to use, which is precisely where it is most unacceptable. Therefore, we have designed this version of the GPL to prohibit the practice for those products. If such problems arise substantially in other domains, we stand ready to extend this provision to those domains in future versions of the GPL, as needed to protect the freedom of users. Finally, every program is threatened constantly by software patents. States should not allow patents to restrict development and use of software on general-purpose computers, but in those that do, we wish to avoid the special danger that patents applied to a free program could make it effectively proprietary. To prevent this, the GPL assures that patents cannot be used to render the program non-free. The precise terms and conditions for copying, distribution and modification follow. @heading TERMS AND CONDITIONS @enumerate 0 @item Definitions. ``This License'' refers to version 3 of the GNU General Public License. ``Copyright'' also means copyright-like laws that apply to other kinds of works, such as semiconductor masks. ``The Program'' refers to any copyrightable work licensed under this License. Each licensee is addressed as ``you''. ``Licensees'' and ``recipients'' may be individuals or organizations. To ``modify'' a work means to copy from or adapt all or part of the work in a fashion requiring copyright permission, other than the making of an exact copy. The resulting work is called a ``modified version'' of the earlier work or a work ``based on'' the earlier work. A ``covered work'' means either the unmodified Program or a work based on the Program. To ``propagate'' a work means to do anything with it that, without permission, would make you directly or secondarily liable for infringement under applicable copyright law, except executing it on a computer or modifying a private copy. Propagation includes copying, distribution (with or without modification), making available to the public, and in some countries other activities as well. To ``convey'' a work means any kind of propagation that enables other parties to make or receive copies. Mere interaction with a user through a computer network, with no transfer of a copy, is not conveying. An interactive user interface displays ``Appropriate Legal Notices'' to the extent that it includes a convenient and prominently visible feature that (1) displays an appropriate copyright notice, and (2) tells the user that there is no warranty for the work (except to the extent that warranties are provided), that licensees may convey the work under this License, and how to view a copy of this License. If the interface presents a list of user commands or options, such as a menu, a prominent item in the list meets this criterion. @item 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. @item 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. @item 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. @item 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. @item 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: @enumerate a @item The work must carry prominent notices stating that you modified it, and giving a relevant date. @item 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''. @item 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. @item 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. @end enumerate 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. @item 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: @enumerate a @item 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. @item 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. @item 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. @item 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. @item 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. @end enumerate 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. @item 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: @enumerate a @item Disclaiming warranty or limiting liability differently from the terms of sections 15 and 16 of this License; or @item 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 @item 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 @item Limiting the use for publicity purposes of names of licensors or authors of the material; or @item Declining to grant rights under trademark law for use of some trade names, trademarks, or service marks; or @item 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. @end enumerate 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. @item 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. @item 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. @item 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. @item 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. @item 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. @item Use with the GNU Affero General Public License. Notwithstanding any other provision of this License, you have permission to link or combine any covered work with a work licensed under version 3 of the GNU Affero General Public License into a single combined work, and to convey the resulting work. The terms of this License will continue to apply to the part which is the covered work, but the special requirements of the GNU Affero General Public License, section 13, concerning interaction through a network will apply to the combination as such. @item Revised Versions of this License. The Free Software Foundation may publish revised and/or new versions of the GNU General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies that a certain numbered version of the GNU General Public License ``or any later version'' applies to it, you have the option of following the terms and conditions either of that numbered version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the GNU General Public License, you may choose any version ever published by the Free Software Foundation. If the Program specifies that a proxy can decide which future versions of the GNU General Public License can be used, that proxy's public statement of acceptance of a version permanently authorizes you to choose that version for the Program. Later license versions may give you additional or different permissions. However, no additional obligations are imposed on any author or copyright holder as a result of your choosing to follow a later version. @item 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. @item 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. @item 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 enumerate @heading END OF TERMS AND CONDITIONS @heading 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. @smallexample @var{one line to give the program's name and a brief idea of what it does.} Copyright (C) @var{year} @var{name of author} This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see @url{http://www.gnu.org/licenses/}. @end smallexample Also add information on how to contact you by electronic and paper mail. If the program does terminal interaction, make it output a short notice like this when it starts in an interactive mode: @smallexample @var{program} Copyright (C) @var{year} @var{name of author} This program comes with ABSOLUTELY NO WARRANTY; for details type @samp{show w}. This is free software, and you are welcome to redistribute it under certain conditions; type @samp{show c} for details. @end smallexample The hypothetical commands @samp{show w} and @samp{show c} should show the appropriate parts of the General Public License. Of course, your program's commands might be different; for a GUI interface, you would use an ``about box''. You should also get your employer (if you work as a programmer) or school, if any, to sign a ``copyright disclaimer'' for the program, if necessary. For more information on this, and how to apply and follow the GNU GPL, see @url{http://www.gnu.org/licenses/}. The GNU General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. But first, please read @url{http://www.gnu.org/philosophy/why-not-lgpl.html}. bbdb3-3.2/lisp/000077500000000000000000000000001322420162700133005ustar00rootroot00000000000000bbdb3-3.2/lisp/Makefile.am000066400000000000000000000075211322420162700153410ustar00rootroot00000000000000# lisp/Makefile.am for BBDB # # Copyright (C) 2010-2017 Roland Winkler # Author: Roland Winkler # Christian Egli # # This file is part of the Insidious Big Brother Database (aka BBDB), # # BBDB 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. # # BBDB 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 BBDB. If not, see . # --batch implies --no-init-file, yet let's be explicit about what we want AM_ELCFLAGS += --no-init-file --no-site-file dist_lisp_LISP = \ bbdb.el \ bbdb-anniv.el \ bbdb-com.el \ bbdb-gnus.el \ bbdb-gnus-aux.el \ bbdb-ispell.el \ bbdb-message.el \ bbdb-mhe.el \ bbdb-migrate.el \ bbdb-mua.el \ bbdb-pgp.el \ bbdb-tex.el \ bbdb-rmail.el \ bbdb-sc.el \ bbdb-snarf.el \ bbdb-site.el if VM dist_lisp_LISP += bbdb-vm.el dist_lisp_LISP += bbdb-vm-aux.el # We use the Automake variable AM_ELCFLAGS to include the VM lisp directory # in the Emacs load path when compiling BBDB with VM support. endif if MU4E dist_lisp_LISP += bbdb-mu4e.el # We use the Automake variable AM_ELCFLAGS to include the Mu4e lisp directory # in the Emacs load path when compiling BBDB with Mu4e support. endif if WL dist_lisp_LISP += bbdb-wl.el # We use the Automake variable AM_ELCFLAGS to include the WL lisp directory # in the Emacs load path when compiling BBDB with WL support. endif lisp_DATA = bbdb-loaddefs.el MOSTLYCLEANFILES = bbdb-loaddefs.el CLEANFILES = bbdb-site.el bbdb-pkg.el # The Emacs function define-package is not autoloaded. # So we assume we need not compile bbdb-pkg.el (which otherwise # results in a compiler warning that define-package is not defined). EXTRA_DIST = bbdb-site.el.in bbdb-pkg.el makefile-temp bbdb-loaddefs.el: $(dist_lisp_LISP) # 2011-12-11: We switched from bbdb-autoloads.el to bbdb-loaddefs.el. # If the user still has an old bbdb-autoloads.el in the BBDB # lisp directory (and keeps loading it from the emacs init file), # we might get strange error messages that things fail. # So we throw an error if these old files are found. @if test -f bbdb-autoloads.el -o -f bbdb-autoloads.elc; then \ (echo "*** ERROR: Old file(s) \`bbdb-autoloads.el(c)' found ***" ; \ echo "*** Delete these files; do not load them from your init file ***") && \ false ; \ fi @echo "(provide 'bbdb-loaddefs)" > $@; @echo "(if (and load-file-name (file-name-directory load-file-name))" >> $@; @echo " (add-to-list 'load-path (file-name-directory load-file-name)))" >> $@; @echo " " >> $@; # Generated autoload-file must have an absolute path, # $srcdir can be relative. $(EMACS) --batch $(AM_ELCFLAGS) $(ELCFLAGS) \ --load autoload \ --eval '(setq generated-autoload-file "'$(abs_builddir)/$@'")' \ --eval '(setq make-backup-files nil)' \ --funcall batch-update-autoloads $(srcdir) # Generate bbdb-site.el here as pkgdatadir is only known at "make" time. # We protect the autoconf variables in the sed regular expressions # so as not to substitute them when processing Makefile.am. # Warning: the sed expressions will break if PACKAGE_VERSION, PACKAGE_DATE, # or pkgdatadir contain '='. bbdb-site.el: $(top_builddir)/config.status bbdb-site.el.in sed -e "s=[@]pkgdatadir[@]=$(pkgdatadir)=" \ -e "s=[@]PACKAGE_VERSION[@]=$(PACKAGE_VERSION)=" \ < $@.in > $@ # Be sure bbdb-site.el exists early for "(require 'bbdb-site)" BUILT_SOURCES = bbdb-site.el bbdb3-3.2/lisp/bbdb-anniv.el000066400000000000000000000245371322420162700156370ustar00rootroot00000000000000;;; bbdb-anniv.el --- get anniversaries from BBDB -*- lexical-binding: t -*- ;; Copyright (C) 2011-2017 Free Software Foundation, Inc. ;; This file is part of the Insidious Big Brother Database (aka BBDB), ;; BBDB 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. ;; BBDB 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 BBDB. If not, see . ;;; Commentary: ;; Anniversaries are stored in xfields as defined via `bbdb-anniv-alist'. ;; Each such field may contain multiple anniversaries entries with separators ;; defined via `bbdb-separator-alist' (newlines by default). ;; Each anniversary entry is a string DATE followed by optional TEXT. ;; DATE may take the same format as the date of ordinary diary entries. ;; In particular, `calendar-date-style' is obeyed via `diary-date-forms'. ;; If `bbdb-anniv-alist' has a non-nil FORM for this type of anniversary, ;; FORM is used to display the anniversary entry in the diary buffer. ;; If FORM is nil, TEXT is used instead to display the anniversary entry ;; in the diary buffer. ;; ;; To display BBDB anniversaries in the Emacs diary, ;; call `bbdb-initialize' with arg `anniv'. ;; ;; See the BBDB info manual for documentation. ;;; Code: (require 'bbdb) (require 'bbdb-com) (require 'diary-lib) (eval-when-compile (require 'cl-lib)) (defcustom bbdb-anniv-alist '((birthday . "%n's %d%s birthday") (wedding . "%n's %d%s wedding anniversary") (anniversary)) "Alist of rules for formatting anniversaries in the diary buffer. Each element is of the form (LABEL . FORM). LABEL is the xfield where this type of anniversaries is stored. FORM is a format string with the following substitutions: %n name of the record %d number of years %s ordinal suffix (st, nd, rd, th) for the year. %t the optional text following the date string in field LABEL. If FORM is nil, use the text following the date string in field LABEL as format string." :type '(repeat (cons :tag "Rule" (symbol :tag "Label") (choice (string) (const nil)))) :group 'bbdb-utilities-anniv) ;; `bbdb-anniv-diary-entries' becomes a member of `diary-list-entries-hook'. ;; When this hook is run by `diary-list-entries', the variable `original-date' ;; is bound to the value of arg DATE of `diary-list-entries'. ;; Also, `number' is arg NUMBER of `diary-list-entries'. ;; `diary-list-entries' selects the entries for NUMBER days starting with DATE. (defvar original-date) ; defined in diary-lib (with-no-warnings (defvar number)) ; defined in diary-lib ;;;###autoload (defun bbdb-anniv-diary-entries () "Add anniversaries from BBDB records to `diary-list-entries'. This obeys `calendar-date-style' via `diary-date-forms'. To enable this feature, put the following into your .emacs: \(add-hook 'diary-list-entries-hook 'bbdb-anniv-diary-entries)" ;; Loop over NUMBER dates starting from ORGINAL-DATE. (let* ((num-date (1- (calendar-absolute-from-gregorian original-date))) (end-date (+ num-date number))) (while (<= (setq num-date (1+ num-date)) end-date) (let* ((date (calendar-gregorian-from-absolute num-date)) (dd (calendar-extract-day date)) (mm (calendar-extract-month date)) (yy (calendar-extract-year date)) ;; We construct a regexp that only uses shy groups, ;; except for the part of the regexp matching the year. ;; This way we can grab the year from the date string. (year "\\([0-9]+\\)\\|\\*") (dayname (format "%s\\|%s\\.?" (calendar-day-name date) (calendar-day-name date 'abbrev))) (lex-env `((day . ,(format "0*%d" dd)) (month . ,(format "0*%d" mm)) (year . ,year) (dayname . ,dayname) (monthname . ,(format "%s\\|%s" (calendar-month-name mm) (calendar-month-name mm 'abbrev))))) ;; Require that the matched date is at the beginning of the string. (fmt (format "\\`%s?\\(?:%%s\\)" (regexp-quote diary-nonmarking-symbol))) date-forms) (cl-flet ((fun (date-form) (push (cons (format fmt (mapconcat (lambda (form) (eval form lex-env)) (if (eq (car date-form) 'backup) (cdr date-form) date-form) "\\)\\(?:")) (eq (car date-form) 'backup)) date-forms))) (mapc #'fun diary-date-forms) ;; The anniversary of February 29 is considered to be March 1 ;; in non-leap years. So we search for February 29, too. (when (and (= mm 3) (= dd 1) (not (calendar-leap-year-p yy))) (setq lex-env `((day . "0*29") (month . "0*2") (year . ,year) (dayname . ,dayname) (monthname . ,(format "%s\\|%s" (calendar-month-name 2) (calendar-month-name 2 'abbrev))))) (mapc #'fun diary-date-forms))) (dolist (record (bbdb-records)) (dolist (rule bbdb-anniv-alist) (dolist (anniv (bbdb-record-xfield-split record (car rule))) (let ((date-forms date-forms) (anniv-string (concat anniv " X")) ; for backup forms (case-fold-search t) form yr text) (while (setq form (pop date-forms)) (when (string-match (car form) anniv-string) (setq date-forms nil yr (match-string 1 anniv-string) yr (if (and yr (string-match-p "[0-9]+" yr)) (- yy (string-to-number yr)) 100) ; as in `diary-anniversary' ;; For backup forms we should search backward in ;; anniv-string from (match-end 0) for "\\<". ;; That gets too complicated here! ;; Yet for the default value of `diary-date-forms' ;; this would matter only if anniv-string started ;; with a time. That is rather rare for anniversaries. ;; Then we may simply step backward by one character. text (substring anniv-string (if (cdr form) ; backup (1- (match-end 0)) (match-end 0)) -1) text (replace-regexp-in-string "\\`[ \t]+" "" text) text (replace-regexp-in-string "[ \t]+\\'" "" text)) (if (cdr rule) (setq text (replace-regexp-in-string "%t" text (cdr rule)))) ;; Add the anniversaries to `diary-entries-list'. (if (and (numberp yr) (< 0 (length text))) (diary-add-to-list date ;; `diary-add-to-list' expects an arg SPECIFIER for being ;; able to jump to the location of the entry in the diary ;; file. Here we only have BBDB records. So we use ;; an empty string for SPECIFIER, but instead we `propertize' ;; the STRING passed to `diary-add-to-list'. (propertize (format ;; Text substitution similar to `diary-anniversary'. (replace-regexp-in-string "%n" (bbdb-record-name record) text) yr (diary-ordinal-suffix yr)) 'diary-goto-entry (list 'bbdb-display-records (list record))) "")))))))))))) ;; based on `diary-goto-entry' (defun bbdb-anniv-goto-entry (button) "Jump to the diary entry for the BUTTON at point. The character at point may have a text property `diary-goto-entry' which should be a list (FUNCTION ARG1 ARG2 ...). Then call FUNCTION with args ARG1, ARG2, ... to locate the entry. Otherwise follow the rules used by `diary-goto-entry'." (let* ((fun-call (get-text-property (overlay-start button) 'diary-goto-entry)) (locator (button-get button 'locator)) (marker (car locator)) markbuf file) (cond (fun-call (apply (car fun-call) (cdr fun-call))) ;; If marker pointing to diary location is valid, use that. ((and marker (setq markbuf (marker-buffer marker))) (pop-to-buffer markbuf) (goto-char (marker-position marker))) ;; Marker is invalid (eg buffer has been killed). ((and (setq file (cadr locator)) (file-exists-p file) (find-file-other-window file)) (when (eq major-mode (default-value 'major-mode)) (diary-mode)) (goto-char (point-min)) (if (re-search-forward (format "%s.*\\(%s\\)" (regexp-quote (nth 2 locator)) (regexp-quote (nth 3 locator))) nil t) (goto-char (match-beginning 1)))) (t (message "Unable to locate this diary entry"))))) ;; `diary-goto-entry-function' is rather inflexible if multiple packages ;; want to use it for its purposes: this variable can be hijacked ;; only once. Here our function `bbdb-anniv-goto-entry' should work ;; for other packages, too. (setq diary-goto-entry-function 'bbdb-anniv-goto-entry) (provide 'bbdb-anniv) ;;; bbdb-anniv.el ends here bbdb3-3.2/lisp/bbdb-com.el000066400000000000000000003734111322420162700153000ustar00rootroot00000000000000;;; bbdb-com.el --- user-level commands of BBDB -*- lexical-binding: t -*- ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; This file is part of the Insidious Big Brother Database (aka BBDB), ;; BBDB 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. ;; BBDB 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 BBDB. If not, see . ;;; Commentary: ;; This file contains most of the user-level interactive commands for BBDB. ;; See the BBDB info manual for documentation. ;;; Code: (require 'bbdb) (require 'mailabbrev) (eval-and-compile (autoload 'build-mail-aliases "mailalias") (autoload 'browse-url-url-at-point "browse-url")) (require 'crm) (defvar bbdb-crm-local-completion-map (let ((map (make-sparse-keymap))) (set-keymap-parent map crm-local-completion-map) (define-key map " " 'self-insert-command) map) "Keymap used for BBDB crm completions.") (defun bbdb-get-records (prompt) "If inside the *BBDB* buffer get the current records. In other buffers ask the user." (if (string= bbdb-buffer-name (buffer-name)) (bbdb-do-records) (bbdb-completing-read-records prompt))) ;; Note about the arg RECORDS of various BBDB commands: ;; - Usually, RECORDS is a list of records. (Interactively, ;; this list of records is set up by `bbdb-do-records'.) ;; - If these commands are used, e.g., in `bbdb-create-hook' or ;; `bbdb-change-hook', they will be called with one arg, a single record. ;; So depending on context the value of RECORDS will be a single record ;; or a list of records, and we want to handle both cases. ;; So we pass RECORDS to `bbdb-record-list' to handle both cases. (defun bbdb-record-list (records &optional full) "Ensure that RECORDS is a list of records. If RECORDS is a single record turn it into a list. If FULL is non-nil, assume that RECORDS include display information." (if records (if full (if (vectorp (car records)) (list records) records) (if (vectorp records) (list records) records)))) ;; Note about BBDB prefix commands: ;; `bbdb-do-all-records', `bbdb-append-display' and `bbdb-search-invert' ;; are fake prefix commands. They need not precede the main commands. ;; Also, `bbdb-append-display' can act on multiple commands. (defun bbdb-prefix-message () "Display a message about selected BBDB prefix commands." (let ((msg (bbdb-concat " " (elt bbdb-modeline-info 1) (elt bbdb-modeline-info 3) (elt bbdb-modeline-info 5)))) (unless (string= "" msg) (message "%s" msg)))) ;;;###autoload (defun bbdb-do-all-records (&optional arg) "Command prefix for operating on all records currently displayed. With prefix ARG a positive number, operate on all records. With prefix ARG a negative number, operate on current record only. This only works for certain commands." (interactive "P") (setq bbdb-do-all-records (or (and (numberp arg) (< 0 arg)) (and (not (numberp arg)) (not bbdb-do-all-records)))) (aset bbdb-modeline-info 4 (if bbdb-do-all-records "all")) (aset bbdb-modeline-info 5 (if bbdb-do-all-records (substitute-command-keys "\\\\[bbdb-do-all-records]"))) (bbdb-prefix-message)) ;;;###autoload (defun bbdb-do-records (&optional full) "Return list of records to operate on. Normally this list includes only the current record. It includes all currently displayed records if the command prefix \ \\\\[bbdb-do-all-records] is used. If FULL is non-nil, the list of records includes display information." (if bbdb-do-all-records (progn (setq bbdb-do-all-records nil) (aset bbdb-modeline-info 4 nil) (aset bbdb-modeline-info 5 nil) (if full bbdb-records (mapcar 'car bbdb-records))) (list (bbdb-current-record full)))) ;;;###autoload (defun bbdb-append-display-p () "Return variable `bbdb-append-display' and reset." (let ((job (cond ((eq t bbdb-append-display)) ((numberp bbdb-append-display) (setq bbdb-append-display (1- bbdb-append-display)) (if (zerop bbdb-append-display) (setq bbdb-append-display nil)) t) (bbdb-append-display (setq bbdb-append-display nil) t)))) (cond ((numberp bbdb-append-display) (aset bbdb-modeline-info 0 (format "(add %dx)" bbdb-append-display))) ((not bbdb-append-display) (aset bbdb-modeline-info 0 nil) (aset bbdb-modeline-info 1 nil))) job)) ;;;###autoload (defun bbdb-append-display (&optional arg) "Toggle appending next searched records in the *BBDB* buffer. With prefix ARG \\[universal-argument] always append. With ARG a positive number append for that many times. With ARG a negative number do not append." (interactive "P") (setq bbdb-append-display (cond ((and arg (listp arg)) t) ((and (numberp arg) (< 1 arg)) arg) ((or (and (numberp arg) (< arg 0)) bbdb-append-display) nil) (t 'once))) (aset bbdb-modeline-info 0 (cond ((numberp bbdb-append-display) (format "(add %dx)" bbdb-append-display)) ((eq t bbdb-append-display) "Add") (bbdb-append-display "add") (t nil))) (aset bbdb-modeline-info 1 (if bbdb-append-display (substitute-command-keys "\\\\[bbdb-append-display]"))) (bbdb-prefix-message)) (defsubst bbdb-layout-prefix () "Set the LAYOUT arg interactively using the prefix arg." (cond ((eq current-prefix-arg 0) 'one-line) (current-prefix-arg 'multi-line) (t bbdb-layout))) (defun bbdb-search-invert-p () "Return variable `bbdb-search-invert' and set it to nil. To set it again, use command `bbdb-search-invert'." (let ((result bbdb-search-invert)) (setq bbdb-search-invert nil) (aset bbdb-modeline-info 2 nil) (aset bbdb-modeline-info 3 nil) result)) ;;;###autoload (defun bbdb-search-invert (&optional arg) "Toggle inversion of the next search command. With prefix ARG a positive number, invert next search. With prefix ARG a negative number, do not invert next search." (interactive "P") (setq bbdb-search-invert (or (and (numberp arg) (< 0 arg)) (and (not (numberp arg)) (not bbdb-search-invert)))) (aset bbdb-modeline-info 2 (if bbdb-search-invert "inv")) (aset bbdb-modeline-info 3 (if bbdb-search-invert (substitute-command-keys "\\\\[bbdb-search-invert]"))) (bbdb-prefix-message)) (defmacro bbdb-search (records &rest spec) "Search RECORDS for fields matching SPEC. The following keywords are supported in SPEC to search fields in RECORDS matching the regexps RE: :name RE Match RE against first-last name. :name-fl RE Match RE against last-first name. :all-names RE Match RE against first-last, last-first, and aka. :affix RE Match RE against affixes. :aka RE Match RE against akas. :organization RE Match RE against organizations. :mail RE Match RE against mail addresses. :xfield RE Match RE against `bbdb-default-xfield'. RE may also be a cons (LABEL . REGEXP). Then REGEXP is matched against xfield LABEL. If LABEL is '* then RE is matched against all xfields. :creation-date RE Match RE against creation-date. :timestamp RE Match RE against timestamp. Each of these keywords may appear multiple times. Other keywords: :bool BOOL Combine the search for multiple fields using BOOL. BOOL may be either `or' (match either field) or `and' (match all fields) with default `or'. To reverse the search, bind `bbdb-search-invert' to t. See also `bbdb-message-search' for fast searches using `bbdb-hashtable' but not allowing for regexps. For backward compatibility, SPEC may also consist of the optional args NAME ORGANIZATION MAIL XFIELD PHONE ADDRESS which is equivalent to :all-names NAME :organization ORGANIZATION :mail MAIL :xfield XFIELD :phone PHONE :address ADDRESS This usage is discouraged." (when (not (keywordp (car spec))) ;; Old format for backward compatibility (unless (get 'bbdb-search 'bbdb-outdated) (put 'bbdb-search 'bbdb-outdated t) (message "Outdated usage of `bbdb-search'") (sit-for 2)) (let (newspec val) (dolist (key '(:all-names :organization :mail :xfield :phone :address)) (if (setq val (pop spec)) (push (list key val) newspec))) (setq spec (apply 'append newspec)))) (let* ((count 0) (sym-list (mapcar (lambda (_) (make-symbol (format "bbdb-re-%d" (setq count (1+ count))))) spec)) (bool (make-symbol "bool")) (not-invert (make-symbol "not-invert")) (matches (make-symbol "matches")) keyw re-list clauses) (set bool ''or) ; default ;; Check keys. (while (keywordp (setq keyw (car spec))) (setq spec (cdr spec)) (pcase keyw (`:name (let ((sym (pop sym-list))) (push `(,sym ,(pop spec)) re-list) (push `(string-match ,sym (bbdb-record-name record)) clauses))) (`:name-lf (let ((sym (pop sym-list))) (push `(,sym ,(pop spec)) re-list) (push `(string-match ,sym (bbdb-record-name-lf record)) clauses))) (`:all-names (let ((sym (pop sym-list))) (push `(,sym ,(pop spec)) re-list) (push `(or (string-match ,sym (bbdb-record-name record)) (string-match ,sym (bbdb-record-name-lf record)) (let ((akas (bbdb-record-field record 'aka-all)) aka done) (while (and (setq aka (pop akas)) (not done)) (setq done (string-match ,sym aka))) done)) clauses))) (`:affix (let ((sym (pop sym-list))) (push `(,sym ,(pop spec)) re-list) (push `(let ((affixs (bbdb-record-field record 'affix-all)) affix done) (if affix (while (and (setq affix (pop affixs)) (not done)) (setq done (string-match ,sym affix))) ;; so that "^$" matches records without affix (setq done (string-match ,sym ""))) done) clauses))) (`:aka (let ((sym (pop sym-list))) (push `(,sym ,(pop spec)) re-list) (push `(let ((akas (bbdb-record-field record 'aka-all)) aka done) (if aka (while (and (setq aka (pop akas)) (not done)) (setq done (string-match ,sym aka))) ;; so that "^$" matches records without aka (setq done (string-match ,sym ""))) done) clauses))) (`:organization (let ((sym (pop sym-list))) (push `(,sym ,(pop spec)) re-list) (push `(let ((organizations (bbdb-record-organization record)) org done) (if organizations (while (and (setq org (pop organizations)) (not done)) (setq done (string-match ,sym org))) ;; so that "^$" matches records without organizations (setq done (string-match ,sym ""))) done) clauses))) (`:phone (let ((sym (pop sym-list))) (push `(,sym ,(pop spec)) re-list) (push `(let ((phones (bbdb-record-phone record)) ph done) (if phones (while (and (setq ph (pop phones)) (not done)) (setq done (string-match ,sym (bbdb-phone-string ph)))) ;; so that "^$" matches records without phones (setq done (string-match ,sym ""))) done) clauses))) (`:address (let ((sym (pop sym-list))) (push `(,sym ,(pop spec)) re-list) (push `(let ((addresses (bbdb-record-address record)) a done) (if addresses (while (and (setq a (pop addresses)) (not done)) (setq done (string-match ,sym (bbdb-format-address a 2)))) ;; so that "^$" matches records without addresses (setq done (string-match ,sym ""))) done) clauses))) (`:mail (let ((sym (pop sym-list))) (push `(,sym ,(pop spec)) re-list) (push `(let ((mails (bbdb-record-mail record)) (bbdb-case-fold-search t) ; there is no case for mails m done) (if mails (while (and (setq m (pop mails)) (not done)) (setq done (string-match ,sym m))) ;; so that "^$" matches records without mail (setq done (string-match ,sym ""))) done) clauses))) (`:xfield (let ((sym (pop sym-list))) (push `(,sym ,(pop spec)) re-list) (push `(cond ((stringp ,sym) ;; check xfield `bbdb-default-xfield' ;; "^$" matches records without notes field (string-match ,sym (or (bbdb-record-xfield-string record bbdb-default-xfield) ""))) ((eq (car ,sym) '*) ;; check all xfields (let ((labels bbdb-xfield-label-list) done tmp) (while (and (not done) labels) (setq tmp (bbdb-record-xfield-string record (car labels)) done (and tmp (string-match (cdr ,sym) tmp)) labels (cdr labels))) done)) (t ; check one field (string-match (cdr ,sym) (or (bbdb-record-xfield-string record (car ,sym)) "")))) clauses))) (`:creation-date (let ((sym (pop sym-list))) (push `(,sym ,(pop spec)) re-list) (push `(string-match ,sym (bbdb-record-creation-date record)) clauses))) (`:timestamp (let ((sym (pop sym-list))) (push `(,sym ,(pop spec)) re-list) (push `(string-match ,sym (bbdb-record-timestamp record)) clauses))) (`:bool (set bool (pop spec))) ;; Do we need other keywords? (_ (error "Keyword `%s' undefines" keyw)))) `(let ((case-fold-search bbdb-case-fold-search) (,not-invert (not (bbdb-search-invert-p))) ,@re-list ,matches) ;; Are there any use cases for `bbdb-search' where BOOL is only ;; known at run time? A smart byte compiler will hopefully ;; simplify the code below if we know BOOL already at compile time. ;; Alternatively, BOOL could also be a user function that ;; defines more complicated boolian expressions. Yet then we loose ;; the efficiency of `and' and `or' that evaluate its arguments ;; as needed. We would need instead boolian macros that the compiler ;; can analyze at compile time. (if (eq 'and ,(symbol-value bool)) (dolist (record ,records) (unless (eq ,not-invert (not (and ,@clauses))) (push record ,matches))) (dolist (record ,records) (unless (eq ,not-invert (not (or ,@clauses))) (push record ,matches)))) (nreverse ,matches)))) (defun bbdb-search-read (&optional field) "Read regexp to search FIELD values of records." (read-string (format "Search records%s %smatching regexp: " (if field (concat " with " field) "") (if bbdb-search-invert "not " "")))) ;;;###autoload (defun bbdb (regexp &optional layout) "Display all records in the BBDB matching REGEXP in either the name(s), organization, address, phone, mail, or xfields." (interactive (list (bbdb-search-read) (bbdb-layout-prefix))) (let ((records (bbdb-search (bbdb-records) :all-names regexp :organization regexp :mail regexp :xfield (cons '* regexp) :phone regexp :address regexp :bool 'or))) (if records (bbdb-display-records records layout nil t) (message "No records matching '%s'" regexp)))) ;;;###autoload (defun bbdb-search-name (regexp &optional layout) "Display all records in the BBDB matching REGEXP in the name \(or ``alternate'' names\)." (interactive (list (bbdb-search-read "names") (bbdb-layout-prefix))) (bbdb-display-records (bbdb-search (bbdb-records) :all-names regexp) layout)) ;;;###autoload (defun bbdb-search-organization (regexp &optional layout) "Display all records in the BBDB matching REGEXP in the organization field." (interactive (list (bbdb-search-read "organization") (bbdb-layout-prefix))) (bbdb-display-records (bbdb-search (bbdb-records) :organization regexp) layout)) ;;;###autoload (defun bbdb-search-address (regexp &optional layout) "Display all records in the BBDB matching REGEXP in the address fields." (interactive (list (bbdb-search-read "address") (bbdb-layout-prefix))) (bbdb-display-records (bbdb-search (bbdb-records) :address regexp) layout)) ;;;###autoload (defun bbdb-search-mail (regexp &optional layout) "Display all records in the BBDB matching REGEXP in the mail address." (interactive (list (bbdb-search-read "mail address") (bbdb-layout-prefix))) (bbdb-display-records (bbdb-search (bbdb-records) :mail regexp) layout)) ;;;###autoload (defun bbdb-search-phone (regexp &optional layout) "Display all records in the BBDB matching REGEXP in the phones field." (interactive (list (bbdb-search-read "phone") (bbdb-layout-prefix))) (bbdb-display-records (bbdb-search (bbdb-records) :phone regexp) layout)) ;;;###autoload (defun bbdb-search-xfields (field regexp &optional layout) "Display all BBDB records for which xfield FIELD matches REGEXP." (interactive (let ((field (completing-read "Xfield to search (RET for all): " (mapcar 'list bbdb-xfield-label-list) nil t))) (list (if (string= field "") '* (intern field)) (bbdb-search-read (if (string= field "") "any xfield" field)) (bbdb-layout-prefix)))) (bbdb-display-records (bbdb-search (bbdb-records) :xfield (cons field regexp)) layout)) (define-obsolete-function-alias 'bbdb-search-notes 'bbdb-search-xfields "3.0") ;;;###autoload (defun bbdb-search-changed (&optional layout) ;; FIXME: "changes" in BBDB lingo are often called "modifications" ;; in Emacs lingo "Display records which have been changed since BBDB was last saved." (interactive (list (bbdb-layout-prefix))) (if (bbdb-search-invert-p) (let (unchanged-records) (dolist (record (bbdb-records)) (unless (memq record bbdb-changed-records) (push record unchanged-records))) (bbdb-display-records unchanged-records layout)) (bbdb-display-records bbdb-changed-records layout))) (defun bbdb-search-prog (fun &optional layout) "Search records using function FUN. FUN is called with one argument, the record, and should return the record to be displayed or nil otherwise." (bbdb-display-records (delq nil (mapcar fun (bbdb-records))) layout)) ;; clean-up functions ;; Sometimes one gets mail from foo@bar.baz.com, and then later gets mail ;; from foo@baz.com. At this point, one would like to delete the bar.baz.com ;; address, since the baz.com address is obviously superior. (defun bbdb-mail-redundant-re (mail) "Return a regexp matching redundant variants of email address MAIL. For example, \"foo@bar.baz.com\" is redundant w.r.t. \"foo@baz.com\". Return nil if MAIL is not a valid plain email address. In particular, ignore addresses \"Joe Smith \"." (let* ((match (string-match "\\`\\([^ ]+\\)@\\(.+\\)\\'" mail)) (name (and match (match-string 1 mail))) (host (and match (match-string 2 mail)))) (if (and name host) (concat (regexp-quote name) "@.*\\." (regexp-quote host))))) (defun bbdb-delete-redundant-mails (records &optional query update) "Delete redundant or duplicate mails from RECORDS. For example, \"foo@bar.baz.com\" is redundant w.r.t. \"foo@baz.com\". Duplicates may (but should not) occur if we feed BBDB automatically. Interactively, use BBDB prefix \ \\\\[bbdb-do-all-records], see `bbdb-do-all-records'. If QUERY is non-nil (as in interactive calls, unless we use a prefix arg) query before deleting the redundant mail addresses. If UPDATE is non-nil (as in interactive calls) update the database. Otherwise, this is the caller's responsiblity. Noninteractively, this may be used as an element of `bbdb-notice-record-hook' or `bbdb-change-hook'. However, see also `bbdb-ignore-redundant-mails', which is probably more suited for your needs." (interactive (list (bbdb-do-records) (not current-prefix-arg) t)) (bbdb-editable) (dolist (record (bbdb-record-list records)) (let (mails redundant okay) ;; We do not look at the canonicalized mail addresses of RECORD. ;; An address "Joe Smith " can only be entered manually ;; into BBDB, and we assume that this is what the user wants. ;; Anyway, if a mail field contains all the elements ;; foo@baz.com, "Joe Smith ", "Jonathan Smith " ;; we do not know which address to keep and which ones to throw. (dolist (mail (bbdb-record-mail record)) (if (assoc-string mail mails t) ; duplicate mail address (push mail redundant) (push mail mails))) (let ((mail-re (delq nil (mapcar 'bbdb-mail-redundant-re mails))) (case-fold-search t)) (if (not (cdr mail-re)) ; at most one mail-re address to consider (setq okay (nreverse mails)) (setq mail-re (concat "\\`\\(?:" (mapconcat 'identity mail-re "\\|") "\\)\\'")) (dolist (mail mails) (if (string-match mail-re mail) ; redundant mail address (push mail redundant) (push mail okay))))) (let ((form (format "redundant mail%s %s" (if (< 1 (length redundant)) "s" "") (bbdb-concat 'mail (nreverse redundant))))) (when (and redundant (or (not query) (y-or-n-p (format "Delete %s: " form)))) (unless query (message "Deleting %s" form)) (bbdb-record-set-field record 'mail okay) (when update (bbdb-change-record record))))))) (define-obsolete-function-alias 'bbdb-delete-duplicate-mails 'bbdb-delete-redundant-mails "3.0") (defun bbdb-search-duplicates (&optional fields) "Search all records that have duplicate entries for FIELDS. The list FIELDS may contain the symbols `name', `mail', and `aka'. If FIELDS is nil use all these fields. With prefix, query for FIELDS. The search results are displayed in the BBDB buffer." (interactive (list (if current-prefix-arg (list (intern (completing-read "Field: " '("name" "mail" "aka") nil t)))))) (setq fields (or fields '(name mail aka))) (let (hash ret) (dolist (record (bbdb-records)) (when (and (memq 'name fields) (bbdb-record-name record) (setq hash (bbdb-gethash (bbdb-record-name record) '(fl-name lf-name aka))) (> (length hash) 1)) (setq ret (append hash ret)) (message "BBDB record `%s' has duplicate name." (bbdb-record-name record)) (sit-for 0)) (if (memq 'mail fields) (dolist (mail (bbdb-record-mail-canon record)) (setq hash (bbdb-gethash mail '(mail))) (when (> (length hash) 1) (setq ret (append hash ret)) (message "BBDB record `%s' has duplicate mail `%s'." (bbdb-record-name record) mail) (sit-for 0)))) (if (memq 'aka fields) (dolist (aka (bbdb-record-aka record)) (setq hash (bbdb-gethash aka '(fl-name lf-name aka))) (when (> (length hash) 1) (setq ret (append hash ret)) (message "BBDB record `%s' has duplicate aka `%s'" (bbdb-record-name record) aka) (sit-for 0))))) (bbdb-display-records (sort (delete-dups ret) 'bbdb-record-lessp)))) (defun bbdb-fix-records (records) "Fix broken RECORDS. Interactively, use BBDB prefix \ \\\\[bbdb-do-all-records], see `bbdb-do-all-records'." (interactive (list (bbdb-do-records))) (bbdb-editable) (dolist (record (bbdb-record-list records)) ;; For the fields which take a list of strings (affix, organization, ;; aka, and mail) `bbdb=record-set-field' calls `bbdb-list-strings' ;; which removes all elements from such a list which are not non-empty ;; strings. This should fix most problems with these fields. (bbdb-record-set-field record 'affix (bbdb-record-affix record)) (bbdb-record-set-field record 'organization (bbdb-record-organization record)) (bbdb-record-set-field record 'aka (bbdb-record-aka record)) (bbdb-record-set-field record 'mail (bbdb-record-mail record)) (bbdb-change-record record)) (bbdb-sort-records)) (defun bbdb-touch-records (records) "Touch RECORDS by calling `bbdb-change-hook' unconditionally. Interactively, use BBDB prefix \ \\\\[bbdb-do-all-records], see `bbdb-do-all-records'." (interactive (list (bbdb-do-records))) (bbdb-editable) (let ((bbdb-update-unchanged-records t)) (dolist (record (bbdb-record-list records)) (bbdb-change-record record)))) ;;; Time-based functions (defmacro bbdb-compare-records (cmpval label compare) "Builds a lambda comparison function that takes one argument, RECORD. RECORD is returned if (COMPARE VALUE CMPVAL) is t, where VALUE is the value of field LABEL of RECORD." `(lambda (record) (let ((val (bbdb-record-field record ,label))) (if (and val (,compare val ,cmpval)) record)))) (defsubst bbdb-string> (a b) (not (or (string= a b) (string< a b)))) ;;;###autoload (defun bbdb-timestamp-older (date &optional layout) "Display records with timestamp older than DATE. DATE must be in yyyy-mm-dd format." (interactive (list (read-string "Timestamp older than: (yyyy-mm-dd) ") (bbdb-layout-prefix))) (bbdb-search-prog (bbdb-compare-records date 'timestamp string<) layout)) ;;;###autoload (defun bbdb-timestamp-newer (date &optional layout) "Display records with timestamp newer than DATE. DATE must be in yyyy-mm-dd format." (interactive (list (read-string "Timestamp newer than: (yyyy-mm-dd) ") (bbdb-layout-prefix))) (bbdb-search-prog (bbdb-compare-records date 'timestamp bbdb-string>) layout)) ;;;###autoload (defun bbdb-creation-older (date &optional layout) "Display records with creation-date older than DATE. DATE must be in yyyy-mm-dd format." (interactive (list (read-string "Creation older than: (yyyy-mm-dd) ") (bbdb-layout-prefix))) (bbdb-search-prog (bbdb-compare-records date 'creation-date string<) layout)) ;;;###autoload (defun bbdb-creation-newer (date &optional layout) "Display records with creation-date newer than DATE. DATE must be in yyyy-mm-dd format." (interactive (list (read-string "Creation newer than: (yyyy-mm-dd) ") (bbdb-layout-prefix))) (bbdb-search-prog (bbdb-compare-records date 'creation-date bbdb-string>) layout)) ;;;###autoload (defun bbdb-creation-no-change (&optional layout) "Display records that have the same timestamp and creation-date." (interactive (list (bbdb-layout-prefix))) (bbdb-search-prog ;; RECORD is bound in `bbdb-compare-records'. (bbdb-compare-records (bbdb-record-timestamp record) 'creation-date string=) layout)) ;;; Parsing phone numbers ;; XXX this needs expansion to handle international prefixes properly ;; i.e. +353-number without discarding the +353 part. Problem being ;; that this will necessitate yet another change in the database ;; format for people who are using north american numbers. (defsubst bbdb-subint (string num) "Used for parsing phone numbers." (string-to-number (match-string num string))) (defun bbdb-parse-phone (string &optional style) "Parse a phone number from STRING and return a list of integers the form \(area-code exchange number extension). This is both lenient and strict in what it will parse - whitespace may appear (or not) between any of the groups of digits, parentheses around the area code are optional, as is a dash between the exchange and number, and a '1' preceeding the area code; but there must be three digits in the area code and exchange, and four in the number (if they are present). All of these are unambigously parsable: ( 415 ) 555 - 1212 x123 -> (415 555 1212 123) (415)555-1212 123 -> (415 555 1212 123) (1-415) 555-1212 123 -> (415 555 1212 123) 1 (415)-555-1212 123 -> (415 555 1212 123) 555-1212 123 -> (0 555 1212 123) 555 1212 -> (0 555 1212 0) 415 555 1212 -> (415 555 1212 0) 1 415 555 1212 -> (415 555 1212 0) 5551212 -> (0 555 1212 0) 4155551212 -> (415 555 1212 0) 4155551212123 -> (415 555 1212 123) 5551212x123 -> (0 555 1212 123) 1234 -> (0 0 0 1234) Note that \"4151212123\" is ambiguous; it could be interpreted either as \"(415) 121-2123\" or as \"415-1212 x123\". Return a list containing four numbers or one string." ;; RW: Missing parts of NANP numbers are replaced by zeros. ;; Is this always correct? What about an extension zero? ;; Should we use nil instead of zeros? (unless style (setq style bbdb-phone-style)) (let ((area-regexp (concat "(?[ \t]*\\+?1?[ \t]*[-\(]?[ \t]*[-\(]?[ \t]*" "\\([2-9][0-9][0-9]\\)[ \t]*)?[-./ \t]*")) (main-regexp (concat "\\([1-9][0-9][0-9]\\)[ \t]*[-.]?[ \t]*" "\\([0-9][0-9][0-9][0-9]\\)[ \t]*")) (ext-regexp "x?[ \t]*\\([0-9]+\\)[ \t]*")) (cond ((not (eq style 'nanp)) (list (bbdb-string-trim string))) ((string-match ;; (415) 555-1212 x123 (concat "^[ \t]*" area-regexp main-regexp ext-regexp "$") string) (list (bbdb-subint string 1) (bbdb-subint string 2) (bbdb-subint string 3) (bbdb-subint string 4))) ;; (415) 555-1212 ((string-match (concat "^[ \t]*" area-regexp main-regexp "$") string) (list (bbdb-subint string 1) (bbdb-subint string 2) (bbdb-subint string 3) 0)) ;; 555-1212 x123 ((string-match (concat "^[ \t]*" main-regexp ext-regexp "$") string) (list 0 (bbdb-subint string 1) (bbdb-subint string 2) (bbdb-subint string 3))) ;; 555-1212 ((string-match (concat "^[ \t]*" main-regexp "$") string) (list 0 (bbdb-subint string 1) (bbdb-subint string 2) 0)) ;; x123 ((string-match (concat "^[ \t]*" ext-regexp "$") string) (list 0 0 0 (bbdb-subint string 1))) ;; We trust the user she knows what she wants (t (list (bbdb-string-trim string)))))) (defun bbdb-message-search (name mail) "Return list of BBDB records matching NAME and/or MAIL. First try to find a record matching both NAME and MAIL. If this fails try to find a record matching MAIL. If this fails try to find a record matching NAME. NAME may match FIRST_LAST, LAST_FIRST or AKA. This function performs a fast search using `bbdb-hashtable'. NAME and MAIL must be strings or nil. See `bbdb-search' for searching records with regexps." (when (or name mail) (bbdb-buffer) ; make sure database is loaded and up-to-date (let ((mrecords (if mail (bbdb-gethash mail '(mail)))) (nrecords (if name (bbdb-gethash name '(fl-name lf-name aka))))) ;; (1) records matching NAME and MAIL (or (and mrecords nrecords (let (records) (dolist (record nrecords) (mapc (lambda (mr) (if (and (eq record mr) (not (memq record records))) (push record records))) mrecords)) records)) ;; (2) records matching MAIL mrecords ;; (3) records matching NAME nrecords)))) (defun bbdb-read-record (&optional first-and-last) "Read and return a new BBDB record. Does not insert it into the database or update the hashtables, but does ensure that there will not be name collisions." (bbdb-editable) (let ((record (bbdb-empty-record))) (let (name) (bbdb-error-retry (setq name (bbdb-read-name first-and-last)) (bbdb-check-name (car name) (cdr name))) (bbdb-record-set-firstname record (car name)) (bbdb-record-set-lastname record (cdr name))) ;; organization (bbdb-record-set-organization record (bbdb-read-organization)) ;; mail (bbdb-record-set-mail record (bbdb-split 'mail (bbdb-read-string "E-Mail Addresses: "))) ;; address (let (addresses label address) (while (not (string= "" (setq label (bbdb-read-string "Snail Mail Address Label [RET when done]: " nil bbdb-address-label-list)))) (setq address (make-vector bbdb-address-length nil)) (bbdb-record-edit-address address label t) (push address addresses)) (bbdb-record-set-address record (nreverse addresses))) ;; phones (let (phones phone-list label) (while (not (string= "" (setq label (bbdb-read-string "Phone Label [RET when done]: " nil bbdb-phone-label-list)))) (setq phone-list (bbdb-error-retry (bbdb-parse-phone (read-string "Phone: " (and (integerp bbdb-default-area-code) (format "(%03d) " bbdb-default-area-code)))))) (push (apply 'vector label phone-list) phones)) (bbdb-record-set-phone record (nreverse phones))) ;; `bbdb-default-xfield' (let ((xfield (bbdb-read-xfield bbdb-default-xfield))) (unless (string= "" xfield) (bbdb-record-set-xfields record (list (cons bbdb-default-xfield xfield))))) record)) (defun bbdb-read-name (&optional first-and-last dfirst dlast) "Read name for a record from minibuffer. FIRST-AND-LAST controls the reading mode: If it is 'first-last read first and last name separately. If it is 'last-first read last and first name separately. If it is 'fullname read full name at once. If it is t read name parts separately, obeying `bbdb-read-name-format' if possible. Otherwise use `bbdb-read-name-format'. DFIRST and DLAST are default values for the first and last name. Return cons with first and last name." (unless (memq first-and-last '(first-last last-first fullname)) ;; We do not yet know how to read the name (setq first-and-last (if (and first-and-last (not (memq bbdb-read-name-format '(first-last last-first)))) 'first-last bbdb-read-name-format))) (let ((name (cond ((eq first-and-last 'last-first) (let (fn ln) (setq ln (bbdb-read-string "Last Name: " dlast) fn (bbdb-read-string "First Name: " dfirst)) (cons fn ln))) ((eq first-and-last 'first-last) (cons (bbdb-read-string "First Name: " dfirst) (bbdb-read-string "Last Name: " dlast))) (t (bbdb-divide-name (bbdb-read-string "Name: " (bbdb-concat 'name-first-last dfirst dlast))))))) (if (string= (car name) "") (setcar name nil)) (if (string= (cdr name) "") (setcdr name nil)) name)) ;;;###autoload (defun bbdb-create (record) "Add a new RECORD to BBDB. When called interactively read all relevant info. Do not call this from a program; call `bbdb-create-internal' instead." (interactive (list (bbdb-read-record current-prefix-arg))) (bbdb-change-record record) (bbdb-display-records (list record))) (defsubst bbdb-split-maybe (separator string) "Split STRING into list of substrings bounded by matches for SEPARATORS. If STRING is a list, return STRING. Throw error if STRING is neither a string nor a list." (cond ((stringp string) (bbdb-split separator string)) ((listp string) string) (t (error "Cannot convert %s to list" string)))) ;;;###autoload (defun bbdb-create-internal (&rest spec) "Add a new record to the database and return it. The following keywords are supported in SPEC: :name VAL String or a cons cell (FIRST . LAST), the name of the person. An error is thrown if VAL is already in use and `bbdb-allow-duplicates' is nil. :affix VAL List of strings. :aka VAL List of strings. :organization VAL List of strings. :mail VAL String with comma-separated mail address or a list of strings. An error is thrown if a mail address in MAIL is already in use and `bbdb-allow-duplicates' is nil. :phone VAL List of phone-number objects. A phone-number is a vector [\"label\" areacode prefix suffix extension-or-nil] or [\"label\" \"phone-number\"] :address VAL List of addresses. An address is a vector of the form \[\"label\" (\"line1\" \"line2\" ... ) \"City\" \"State\" \"Postcode\" \"Country\"]. :xfields VAL Alist associating symbols with strings. :uuid VAL String, the uuid. :creation-date VAL String, the creation date. :check If present, throw an error if a field value is not syntactically correct." (bbdb-editable) (let ((record (bbdb-empty-record)) (record-type (cdr bbdb-record-type)) (check (prog1 (memq :check spec) (setq spec (delq :check spec)))) keyw) ;; Check keys. (while (keywordp (setq keyw (car spec))) (setq spec (cdr spec)) (pcase keyw (`:name (let ((name (pop spec))) (cond ((stringp name) (setq name (bbdb-divide-name name))) (check (bbdb-check-type name '(or (const nil) (cons string string)) t))) (let ((firstname (car name)) (lastname (cdr name))) (bbdb-check-name firstname lastname) ; check for duplicates (bbdb-record-set-firstname record firstname) (bbdb-record-set-lastname record lastname)))) (`:affix (let ((affix (bbdb-split-maybe 'affix (pop spec)))) (if check (bbdb-check-type affix (bbdb-record-affix record-type) t)) (bbdb-record-set-affix record affix))) (`:organization (let ((organization (bbdb-split-maybe 'organization (pop spec)))) (if check (bbdb-check-type organization (bbdb-record-organization record-type) t)) (bbdb-record-set-organization record organization))) (`:aka (let ((aka (bbdb-split-maybe 'aka (pop spec)))) (if check (bbdb-check-type aka (bbdb-record-aka record-type) t)) (bbdb-record-set-aka record aka))) (`:mail (let ((mail (bbdb-split-maybe 'mail (pop spec)))) (if check (bbdb-check-type mail (bbdb-record-mail record-type) t)) (unless bbdb-allow-duplicates (dolist (elt mail) (if (bbdb-gethash elt '(mail)) (error "%s is already in the database" elt)))) (bbdb-record-set-mail record mail))) (`:phone (let ((phone (pop spec))) (if check (bbdb-check-type phone (bbdb-record-phone record-type) t)) (bbdb-record-set-phone phone record))) (`:address (let ((address (pop spec))) (if check (bbdb-check-type address (bbdb-record-address record-type) t)) (bbdb-record-set-address record address))) (`:xfields (let ((xfields (pop spec))) (if check (bbdb-check-type xfields (bbdb-record-xfields record-type) t)) (bbdb-record-set-xfields record xfields))) (`:uuid (let ((uuid (pop spec))) (if check (bbdb-check-type uuid (bbdb-record-uuid record-type) t)) (bbdb-record-set-uuid record uuid))) (`:creation-date (let ((creation-date (pop spec))) (if check (bbdb-check-type creation-date (bbdb-record-creation-date record-type) t)) (bbdb-record-set-creation-date record creation-date))) (_ (error "Keyword `%s' undefined" keyw)))) (bbdb-change-record record))) ;;;###autoload (defun bbdb-insert-field (record field value) "For RECORD, add a new FIELD with value VALUE. Interactively, read FIELD and VALUE; RECORD is the current record. A non-nil prefix arg is passed on to `bbdb-read-field' as FLAG (see there)." (interactive (let* ((_ (bbdb-editable)) (record (or (bbdb-current-record) (error "Point not on a record"))) (list (append bbdb-xfield-label-list '(affix organization aka phone address mail))) (field "") (completion-ignore-case t) (present (mapcar 'car (bbdb-record-xfields record)))) (if (bbdb-record-affix record) (push 'affix present)) (if (bbdb-record-organization record) (push 'organization present)) (if (bbdb-record-mail record) (push 'mail present)) (if (bbdb-record-aka record) (push 'aka present)) (dolist (field present) (setq list (remq field list))) (setq list (mapcar 'symbol-name list)) (while (string= field "") (setq field (downcase (completing-read "Insert Field: " list)))) (setq field (intern field)) (if (memq field present) (error "Field \"%s\" already exists" field)) (list record field (bbdb-read-field record field current-prefix-arg)))) (cond (;; affix (eq field 'affix) (if (bbdb-record-affix record) (error "Affix field exists already")) (if (stringp value) (setq value (bbdb-split 'affix value))) (bbdb-record-set-field record 'affix value)) ;; organization ((eq field 'organization) (if (bbdb-record-organization record) (error "Organization field exists already")) (if (stringp value) (setq value (bbdb-split 'organization value))) (bbdb-record-set-field record 'organization value)) ;; phone ((eq field 'phone) (bbdb-record-set-field record 'phone (nconc (bbdb-record-phone record) (list value)))) ;; address ((eq field 'address) (bbdb-record-set-field record 'address (nconc (bbdb-record-address record) (list value)))) ;; mail ((eq field 'mail) (if (bbdb-record-mail record) (error "Mail field exists already")) (if (stringp value) (setq value (bbdb-split 'mail value))) (bbdb-record-set-field record 'mail value)) ;; AKA ((eq field 'aka) (if (bbdb-record-aka record) (error "Alternate names field exists already")) (if (stringp value) (setq value (bbdb-split 'aka value))) (bbdb-record-set-field record 'aka value)) ;; xfields ((assq field (bbdb-record-xfields record)) (error "Xfield \"%s\" already exists" field)) (t (bbdb-record-set-xfield record field value))) (unless (bbdb-change-record record) (message "Record unchanged"))) (defun bbdb-read-field (record field &optional flag) "For RECORD read new FIELD interactively. - The phone number style is controlled via `bbdb-phone-style'. A prefix FLAG inverts the style, - If a mail address lacks a domain, append `bbdb-default-domain' if this variable non-nil. With prefix FLAG do not alter the mail address. - The value of an xfield is a string. With prefix FLAG the value may be any lisp object." (let* ((init-f (intern-soft (concat "bbdb-init-" (symbol-name field)))) (init (if (and init-f (functionp init-f)) (funcall init-f record)))) (cond (;; affix (eq field 'affix) (bbdb-read-string "Affix: " init)) ;; organization ((eq field 'organization) (bbdb-read-organization init)) ;; mail ((eq field 'mail) (let ((mail (bbdb-read-string "Mail: " init))) (if (string-match "^mailto:" mail) (setq mail (substring mail (match-end 0)))) (if (or (not bbdb-default-domain) flag (string-match "[@%!]" mail)) mail (concat mail "@" bbdb-default-domain)))) ;; AKA ((eq field 'aka) (bbdb-read-string "Alternate Names: " init)) ;; Phone ((eq field 'phone) (let ((bbdb-phone-style (if flag (if (eq bbdb-phone-style 'nanp) nil 'nanp) bbdb-phone-style))) (apply 'vector (bbdb-read-string "Label: " nil bbdb-phone-label-list) (bbdb-error-retry (bbdb-parse-phone (read-string "Phone: " (and (integerp bbdb-default-area-code) (format "(%03d) " bbdb-default-area-code)))))))) ;; Address ((eq field 'address) (let ((address (make-vector bbdb-address-length nil))) (bbdb-record-edit-address address nil t) address)) ;; xfield ((or (memq field bbdb-xfield-label-list) ;; New xfield (y-or-n-p (format "\"%s\" is an unknown field name. Define it? " field)) (error "Aborted")) (bbdb-read-xfield field init flag))))) ;;;###autoload (defun bbdb-edit-field (record field &optional value flag) "Edit the contents of FIELD of RECORD. If point is in the middle of a multi-line field (e.g., address), then the entire field is edited, not just the current line. For editing phone numbers or addresses, VALUE must be the phone number or address that gets edited. An error is thrown when attempting to edit a phone number or address with VALUE being nil. - The value of an xfield is a string. With prefix FLAG the value may be any lisp object." (interactive (save-excursion (bbdb-editable) ;; when at the end of the line take care of it (if (and (eolp) (not (bobp)) (not (bbdb-current-field))) (backward-char 1)) (let* ((field-l (bbdb-current-field)) (field (car field-l)) (value (nth 1 field-l))) (unless field (error "Point not in a field")) (list (bbdb-current-record) (if (memq field '(name affix organization aka mail phone address uuid creation-date timestamp)) field ; not an xfield (elt value 0)) ; xfield value current-prefix-arg)))) (let (edit-str) (cond ((memq field '(firstname lastname xfields)) ;; FIXME: We could also edit first and last names. (error "Field `%s' not editable this way." field)) ((eq field 'name) (bbdb-error-retry (bbdb-record-set-field record 'name (bbdb-read-name (if flag ;; Here we try to obey the name-format xfield for ;; editing the name field. Is this useful? Or is this ;; irritating overkill and we better obey consistently ;; `bbdb-read-name-format'? (or (bbdb-record-xfield-intern record 'name-format) flag)) (bbdb-record-firstname record) (bbdb-record-lastname record))))) ((eq field 'phone) (unless value (error "No phone specified")) (bbdb-record-edit-phone (bbdb-record-phone record) value)) ((eq field 'address) (unless value (error "No address specified")) (bbdb-record-edit-address value nil flag)) ((eq field 'organization) (bbdb-record-set-field record field (bbdb-read-organization (bbdb-concat field (bbdb-record-organization record))))) ((setq edit-str (assq field '((affix . "Affix") (mail . "Mail") (aka . "AKA")))) (bbdb-record-set-field record field (bbdb-split field (bbdb-read-string (format "%s: " (cdr edit-str)) (bbdb-concat field (bbdb-record-field record field)))))) ((eq field 'uuid) (bbdb-record-set-field record 'uuid (bbdb-read-string "uuid (edit at your own risk): " (bbdb-record-uuid record)))) ((eq field 'creation-date) (bbdb-record-set-creation-date record (bbdb-read-string "creation-date: " (bbdb-record-creation-date record)))) ;; The timestamp is set automatically whenever we save a modified record. ;; So any editing gets overwritten. ((eq field 'timestamp)) ; do nothing (t ; xfield (bbdb-record-set-xfield record field (bbdb-read-xfield field (bbdb-record-xfield record field) flag)))) (cond ((eq field 'timestamp) (message "timestamp not editable")) ((bbdb-change-record record)) (t (message "Record unchanged"))))) (defun bbdb-edit-foo (record field &optional nvalue) "For RECORD edit some FIELD (mostly interactively). FIELD may take the same values as the elements of the variable `bbdb-edit-foo'. If FIELD is 'phone or 'address, NVALUE should be an integer in order to edit the NVALUEth phone or address field; otherwise insert a new phone or address field. Interactively, if called without a prefix, the value of FIELD is the car of the variable `bbdb-edit-foo'. When called with a prefix, the value of FIELD is the cdr of this variable. Then use minibuffer completion to select the field." (interactive (let* ((_ (bbdb-editable)) (record (bbdb-current-record)) (tmp (if current-prefix-arg (cdr bbdb-edit-foo) (car bbdb-edit-foo))) (field (if (memq tmp '(current-fields all-fields)) ;; Do not require match so that we can define new xfields. (intern (completing-read "Edit field: " (mapcar 'list (if (eq tmp 'all-fields) (append '(name affix organization aka mail phone address uuid creation-date) bbdb-xfield-label-list) (append (if (bbdb-record-affix record) '(affix)) (if (bbdb-record-organization record) '(organization)) (if (bbdb-record-aka record) '(aka)) (if (bbdb-record-mail record) '(mail)) (if (bbdb-record-phone record) '(phone)) (if (bbdb-record-address record) '(address)) (mapcar 'car (bbdb-record-xfields record)) '(name uuid creation-date)))))) tmp)) ;; Multiple phone and address fields may use the same label. ;; So we cannot use these labels to uniquely identify ;; a phone or address field. So instead we number these fields ;; consecutively. But we do use the labels to annotate the numbers ;; (available starting from GNU Emacs 24.1). (nvalue (cond ((eq field 'phone) (let* ((phones (bbdb-record-phone record)) (collection (cons (cons "new" "new phone #") (mapcar (lambda (n) (cons (format "%d" n) (bbdb-phone-label (nth n phones)))) (number-sequence 0 (1- (length phones)))))) (completion-extra-properties `(:annotation-function (lambda (s) (format " (%s)" (cdr (assoc s ',collection))))))) (if (< 0 (length phones)) (completing-read "Phone field: " collection nil t) "new"))) ((eq field 'address) (let* ((addresses (bbdb-record-address record)) (collection (cons (cons "new" "new address") (mapcar (lambda (n) (cons (format "%d" n) (bbdb-address-label (nth n addresses)))) (number-sequence 0 (1- (length addresses)))))) (completion-extra-properties `(:annotation-function (lambda (s) (format " (%s)" (cdr (assoc s ',collection))))))) (if (< 0 (length addresses)) (completing-read "Address field: " collection nil t) "new")))))) (list record field (and (stringp nvalue) (if (string= "new" nvalue) 'new (string-to-number nvalue)))))) (if (memq field '(firstname lastname name-lf aka-all mail-aka mail-canon)) (error "Field `%s' illegal" field)) (let ((value (if (numberp nvalue) (nth nvalue (cond ((eq field 'phone) (bbdb-record-phone record)) ((eq field 'address) (bbdb-record-address record)) (t (error "%s: nvalue %s meaningless" field nvalue))))))) (if (and (numberp nvalue) (not value)) (error "%s: nvalue %s out of range" field nvalue)) (if (or (memq field '(name uuid creation-date)) (and (eq field 'affix) (bbdb-record-affix record)) (and (eq field 'organization) (bbdb-record-organization record)) (and (eq field 'mail) (bbdb-record-mail record)) (and (eq field 'aka) (bbdb-record-aka record)) (assq field (bbdb-record-xfields record)) value) (bbdb-edit-field record field value) (bbdb-insert-field record field (bbdb-read-field record field))))) (defun bbdb-read-xfield (field &optional init sexp) "Read xfield FIELD with optional INIT. This calls bbdb-read-xfield-FIELD if it exists." (let ((read-fun (intern-soft (format "bbdb-read-xfield-%s" field)))) (cond ((fboundp read-fun) (funcall read-fun init)) ((and (not sexp) (string-or-null-p init)) (bbdb-read-string (format "%s: " field) init)) (t (read-minibuffer (format "%s (sexp): " field) (prin1-to-string init)))))) (defun bbdb-read-organization (&optional init) "Read organization." (if (string< "24.3" (substring emacs-version 0 4)) (let ((crm-separator (concat "[ \t\n]*" (cadr (assq 'organization bbdb-separator-alist)) "[ \t\n]*")) (crm-local-completion-map bbdb-crm-local-completion-map)) (completing-read-multiple "Organizations: " bbdb-organization-list nil nil init)) (bbdb-split 'organization (bbdb-read-string "Organizations: " init)))) (defun bbdb-record-edit-address (address &optional label ignore-country) "Edit ADDRESS. If LABEL is nil, edit the label sub-field of the address as well. If the country field of ADDRESS is nonempty and IGNORE-COUNTRY is nil, use the rule from `bbdb-address-format-list' matching this country. Otherwise, use the default rule according to `bbdb-address-format-list'." (unless label (setq label (bbdb-read-string "Label: " (bbdb-address-label address) bbdb-address-label-list))) (let ((country (or (bbdb-address-country address) "")) new-addr edit) (unless (or ignore-country (string= "" country)) (let ((list bbdb-address-format-list) identifier elt) (while (and (not edit) (setq elt (pop list))) (setq identifier (car elt)) (if (or (and (listp identifier) (member-ignore-case country identifier)) (and (functionp identifier) (funcall identifier address))) (setq edit (nth 1 elt)))))) (unless edit (setq edit (nth 1 (assq t bbdb-address-format-list)))) (unless edit (error "No address editing function defined")) (if (functionp edit) (setq new-addr (funcall edit address)) (setq new-addr (make-vector 5 "")) (dolist (elt (string-to-list edit)) (cond ((eq elt ?s) (aset new-addr 0 (bbdb-edit-address-street (bbdb-address-streets address)))) ((eq elt ?c) (aset new-addr 1 (bbdb-read-string "City: " (bbdb-address-city address) bbdb-city-list))) ((eq elt ?S) (aset new-addr 2 (bbdb-read-string "State: " (bbdb-address-state address) bbdb-state-list))) ((eq elt ?p) (aset new-addr 3 (bbdb-error-retry (bbdb-parse-postcode (bbdb-read-string "Postcode: " (bbdb-address-postcode address) bbdb-postcode-list))))) ((eq elt ?C) (aset new-addr 4 (bbdb-read-string "Country: " (or (bbdb-address-country address) bbdb-default-country) bbdb-country-list)))))) (bbdb-address-set-label address label) (bbdb-address-set-streets address (elt new-addr 0)) (bbdb-address-set-city address (elt new-addr 1)) (bbdb-address-set-state address (elt new-addr 2)) (bbdb-address-set-postcode address (elt new-addr 3)) (if (string= "" (bbdb-concat "" (elt new-addr 0) (elt new-addr 1) (elt new-addr 2) (elt new-addr 3) (elt new-addr 4))) ;; User did not enter anything. this causes a display bug. ;; The following is a temporary fix. Ideally, we would simply discard ;; the entire address, but that requires bigger hacking. (bbdb-address-set-country address "Emacs") (bbdb-address-set-country address (elt new-addr 4))))) (defun bbdb-edit-address-street (streets) "Edit list STREETS." (let ((n 0) street list) (while (not (string= "" (setq street (bbdb-read-string (format "Street, line %d: " (1+ n)) (nth n streets) bbdb-street-list)))) (push street list) (setq n (1+ n))) (reverse list))) ;; This function can provide some guidance for writing ;; your own address editing function (defun bbdb-edit-address-default (address) "Function to use for address editing. The sub-fields and the prompts used are: Street, line n: (nth n street) City: city State: state Postcode: postcode Country: country" (list (bbdb-edit-address-street (bbdb-address-streets address)) (bbdb-read-string "City: " (bbdb-address-city address) bbdb-city-list) (bbdb-read-string "State: " (bbdb-address-state address) bbdb-state-list) (bbdb-error-retry (bbdb-parse-postcode (bbdb-read-string "Postcode: " (bbdb-address-postcode address) bbdb-postcode-list))) (bbdb-read-string "Country: " (or (bbdb-address-country address) bbdb-default-country) bbdb-country-list))) (defun bbdb-record-edit-phone (phones phone) "For list PHONES edit PHONE number." ;; Phone numbers are special. They are vectors with either ;; two or four elements. We do not know whether after editing PHONE ;; we still have a number requiring the same format as PHONE. ;; So we take all numbers PHONES of the record so that we can ;; replace the element PHONE in PHONES. (setcar (memq phone phones) (apply 'vector (bbdb-read-string "Label: " (bbdb-phone-label phone) bbdb-phone-label-list) (bbdb-error-retry (bbdb-parse-phone (read-string "Phone: " (bbdb-phone-string phone))))))) ;; (bbdb-list-transpose '(a b c d) 1 3) (defun bbdb-list-transpose (list i j) "For LIST transpose elements I and J destructively. I and J start with zero. Return the modified LIST." (if (eq i j) list ; ignore that i, j could be invalid (let (a b c) ;; Travel down LIST only once (if (> i j) (setq a i i j j a)); swap (setq a (nthcdr i list) b (nthcdr (- j i) a) c (car b)) (unless b (error "Args %i, %i beyond length of list." i j)) (setcar b (car a)) (setcar a c) list))) (defun bbdb-ident-point (&optional point) "Return identifier (RECNUM FIELD NUM) for position POINT. If POINT is nil use current value of point. RECNUM is the number of the record (starting from zero). FIELD is the field type. If FIELD's value is a list, NUM is the position of the subfield within FIELD. If any of these terms is not defined at POINT, the respective value is nil." (unless point (setq point (point))) (let ((recnum (get-text-property point 'bbdb-record-number)) (field (get-text-property point 'bbdb-field))) (cond ((not field) (list recnum nil nil)) ((eq (car field) 'name) (list recnum 'name nil)) ((not (nth 1 field)) (list recnum (car field) nil)) (t (let* ((record (car (nth recnum bbdb-records))) (fields (bbdb-record-field record (car field))) (val (nth 1 field)) (num 0) done elt) ;; For xfields we only check the label because the rest of VAL ;; can be anything. (xfields are unique within a record.) (if (eq 'xfields (car field)) (setq val (car val) fields (mapcar 'car fields))) (while (and (not done) (setq elt (pop fields))) (if (eq val elt) (setq done t) (setq num (1+ num)))) (unless done (error "Field %s not found" val)) (list recnum (car field) num)))))) ;;;###autoload (defun bbdb-transpose-fields (arg) "Transpose previous and current field of a BBDB record. With numeric prefix ARG, take previous field and move it past ARG fields. With region active or ARG 0, transpose field point is in and field mark is in. Both fields must be in the same record, and must be of the same basic type \(that is, you can use this command to change the order in which phone numbers or email addresses are listed, but you cannot use it to make an address appear before a phone number; the order of field types is fixed). If the current field is the name field, transpose first and last name, irrespective of the value of ARG." ;; This functionality is inspired by `transpose-lines'. (interactive "p") (bbdb-editable) (let* ((ident (bbdb-ident-point)) (record (and (car ident) (car (nth (car ident) bbdb-records)))) num1 num2) (cond ((not (car ident)) (error "Point not in BBDB record")) ((not (nth 1 ident)) (error "Point not in BBDB field")) ((eq 'name (nth 1 ident)) ;; Transpose firstname and lastname (bbdb-record-set-name record (bbdb-record-lastname record) (bbdb-record-firstname record))) ((not (integerp arg)) (error "Arg `%s' not an integer" arg)) ((not (nth 2 ident)) (error "Point not in a transposable field")) (t (if (or (use-region-p) (zerop arg)) (let ((ident2 (bbdb-ident-point (or (mark) (error "No mark set in this buffer"))))) (unless (and (eq (car ident) (car ident2)) (eq (cadr ident) (cadr ident2)) (integerp (nth 2 ident2))) (error "Mark (or point) not on transposable field")) (setq num1 (nth 2 ident) num2 (nth 2 ident2))) (setq num1 (1- (nth 2 ident)) num2 (+ num1 arg)) (if (or (< (min num1 num2) 0) (>= (max num1 num2) (length (bbdb-record-field record (nth 1 ident))))) (error "Cannot transpose fields of different types"))) (bbdb-record-set-field record (nth 1 ident) (bbdb-list-transpose (bbdb-record-field record (nth 1 ident)) num1 num2)))) (bbdb-change-record record))) ;;;###autoload (defun bbdb-delete-field-or-record (records field &optional noprompt) "For RECORDS delete FIELD. If FIELD is the `name' field, delete RECORDS from datanbase. Interactively, use BBDB prefix \ \\\\[bbdb-do-all-records], see `bbdb-do-all-records', and FIELD is the field point is on. If prefix NOPROMPT is non-nil, do not confirm deletion." ;; The value of FIELD is whatever `bbdb-current-field' returns. ;; This way we can identify more accurately what really needs ;; to be done. (interactive (list (bbdb-do-records) (bbdb-current-field) current-prefix-arg)) (bbdb-editable) (unless field (error "Not a field")) (setq records (bbdb-record-list records)) (let* ((type (car field)) (type-x (if (eq type 'xfields) (car (nth 1 field)) type))) (if (eq type 'name) (bbdb-delete-records records noprompt) (if (memq type '(firstname lastname)) (error "Cannot delete field `%s'" type)) (dolist (record records) (when (or noprompt (y-or-n-p (format "delete this `%s' field (of %s)? " type-x (bbdb-record-name record)))) (cond ((memq type '(phone address)) (bbdb-record-set-field record type ;; We use `delete' which deletes all phone and address ;; fields equal to the current one. This works for ;; multiple records. (delete (nth 1 field) (bbdb-record-field record type)))) ((memq type '(affix organization mail aka)) (bbdb-record-set-field record type nil)) ((eq type 'xfields) (bbdb-record-set-xfield record type-x nil)) (t (error "Unknown field %s" type))) (bbdb-change-record record)))))) ;;;###autoload (defun bbdb-delete-records (records &optional noprompt) "Delete RECORDS. Interactively, use BBDB prefix \ \\\\[bbdb-do-all-records], see `bbdb-do-all-records'. If prefix NOPROMPT is non-nil, do not confirm deletion." (interactive (list (bbdb-do-records) current-prefix-arg)) (bbdb-editable) (let ((all-records (bbdb-with-db-buffer bbdb-records))) (dolist (record (bbdb-record-list records)) (cond ((not (memq record all-records)) ;; Possibly we changed RECORD before deleting it. ;; Otherwise, do nothing if RECORD is unknown to BBDB. (setq bbdb-changed-records (delq record bbdb-changed-records))) ((or noprompt (y-or-n-p (format "Delete the BBDB record of %s? " (or (bbdb-record-name record) (car (bbdb-record-mail record)))))) (bbdb-delete-record-internal record t) (setq bbdb-changed-records (delq record bbdb-changed-records))))))) ;;;###autoload (defun bbdb-display-all-records (&optional layout) "Show all records. If invoked in a *BBDB* buffer point stays on the currently visible record. Inverse of `bbdb-display-current-record'." (interactive (list (bbdb-layout-prefix))) (let ((current (ignore-errors (bbdb-current-record)))) (bbdb-display-records (bbdb-records) layout) (when (setq current (assq current bbdb-records)) (redisplay) ; Strange display bug?? (goto-char (nth 2 current))))) ;; (set-window-point (selected-window) (nth 2 current))))) ;;;###autoload (defun bbdb-display-current-record (&optional layout) "Narrow to current record. Inverse of `bbdb-display-all-records'." (interactive (list (bbdb-layout-prefix))) (bbdb-display-records (list (bbdb-current-record)) layout)) (defun bbdb-change-records-layout (records layout) (dolist (record records) (unless (eq layout (nth 1 record)) (setcar (cdr record) layout) (bbdb-redisplay-record (car record))))) ;;;###autoload (defun bbdb-toggle-records-layout (records &optional arg) "Toggle layout of RECORDS (elided or expanded). Interactively, use BBDB prefix \ \\\\[bbdb-do-all-records], see `bbdb-do-all-records'. With prefix ARG 0, RECORDS are displayed elided. With any other non-nil ARG, RECORDS are displayed expanded." (interactive (list (bbdb-do-records t) current-prefix-arg)) (let* ((record (bbdb-current-record)) (current-layout (nth 1 (assq record bbdb-records))) (layout-alist ;; Try to consider only those layouts that have the `toggle' ;; option set (or (delq nil (mapcar (lambda (l) (if (and (assq 'toggle l) (cdr (assq 'toggle l))) l)) bbdb-layout-alist)) bbdb-layout-alist)) (layout (cond ((eq arg 0) 'one-line) ((null current-layout) 'multi-line) ;; layout is not the last element of layout-alist ;; and we switch to the following element of layout-alist ((caar (cdr (memq (assq current-layout layout-alist) layout-alist)))) (t ; layout is the last element of layout-alist ;; and we switch to the first element of layout-alist (caar layout-alist))))) (message "Using %S layout" layout) (bbdb-change-records-layout (bbdb-record-list records t) layout))) ;;;###autoload (defun bbdb-display-records-completely (records) "Display RECORDS using layout `full-multi-line' (i.e., display all fields). Interactively, use BBDB prefix \ \\\\[bbdb-do-all-records], see `bbdb-do-all-records'." (interactive (list (bbdb-do-records t))) (let* ((record (bbdb-current-record)) (current-layout (nth 1 (assq record bbdb-records))) (layout (if (not (eq current-layout 'full-multi-line)) 'full-multi-line 'multi-line))) (bbdb-change-records-layout (bbdb-record-list records t) layout))) ;;;###autoload (defun bbdb-display-records-with-layout (records layout) "Display RECORDS using LAYOUT. Interactively, use BBDB prefix \ \\\\[bbdb-do-all-records], see `bbdb-do-all-records'." (interactive (list (bbdb-do-records t) (intern (completing-read "Layout: " (mapcar (lambda (i) (list (symbol-name (car i)))) bbdb-layout-alist))))) (bbdb-change-records-layout (bbdb-record-list records t) layout)) ;;;###autoload (defun bbdb-omit-record (n) "Remove current record from the display without deleting it from BBDB. With prefix N, omit the next N records. If negative, omit backwards." (interactive "p") (let ((num (get-text-property (if (and (not (bobp)) (eobp)) (1- (point)) (point)) 'bbdb-record-number))) (if (> n 0) (setq n (min n (- (length bbdb-records) num))) (setq n (min (- n) num)) (bbdb-prev-record n)) (dotimes (_i n) (bbdb-redisplay-record (bbdb-current-record) nil t)))) ;;; Fixing up bogus records ;;;###autoload (defun bbdb-merge-records (record1 record2) "Merge RECORD1 into RECORD2, then delete RECORD1 and return RECORD2. If both records have name fields ask which one to use. Concatenate other fields, ignoring duplicates. RECORD1 need not be known to BBDB, its hash and cache are ignored. Update hash and cache for RECORD2. Interactively, RECORD1 is the current record; prompt for RECORD2. With prefix, RECORD2 defaults to the first record with the same name." (interactive (let* ((_ (bbdb-editable)) (record1 (bbdb-current-record)) (name (bbdb-record-name record1)) (record2 (and current-prefix-arg ;; take the first record with the same name (car (delq record1 (bbdb-search (bbdb-records) :all-names name)))))) (when record2 (message "Merge current record with duplicate record `%s'" name) (sit-for 1)) (list record1 (or record2 (bbdb-completing-read-record (format "merge record \"%s\" into: " (or (bbdb-record-name record1) (car (bbdb-record-mail record1)) "???")) (list record1)))))) (bbdb-editable) (cond ((eq record1 record2) (error "Records are equal")) ((null record2) (error "No record to merge with"))) ;; Merge names (let* ((new-name (bbdb-record-name record2)) (old-name (bbdb-record-name record1)) (old-aka (bbdb-record-aka record1)) extra-name (name (cond ((or (string= "" old-name) (bbdb-string= old-name new-name)) (cons (bbdb-record-firstname record2) (bbdb-record-lastname record2))) ((string= "" new-name) (cons (bbdb-record-firstname record1) (bbdb-record-lastname record1))) (t (prog1 (if (y-or-n-p (format "Use name \"%s\" instead of \"%s\"? " old-name new-name)) (progn (setq extra-name new-name) (cons (bbdb-record-firstname record1) (bbdb-record-lastname record1))) (setq extra-name old-name) (cons (bbdb-record-firstname record2) (bbdb-record-lastname record2))) (unless (bbdb-eval-spec (bbdb-add-job bbdb-add-aka record2 extra-name) (format "Keep \"%s\" as an alternate name? " extra-name)) (setq extra-name nil))))))) (bbdb-record-set-name record2 (car name) (cdr name)) (if extra-name (push extra-name old-aka)) ;; It is better to delete RECORD1 at the end. ;; So we must temporarily allow duplicates in RECORD2. (let ((bbdb-allow-duplicates t)) (bbdb-record-set-field record2 'aka old-aka t))) ;; Merge other stuff (bbdb-record-set-field record2 'affix (bbdb-record-affix record1) t) (bbdb-record-set-field record2 'organization (bbdb-record-organization record1) t) (bbdb-record-set-field record2 'phone (bbdb-record-phone record1) t) (bbdb-record-set-field record2 'address (bbdb-record-address record1) t) (let ((bbdb-allow-duplicates t)) (bbdb-record-set-field record2 'mail (bbdb-record-mail record1) t)) (bbdb-record-set-field record2 'xfields (bbdb-record-xfields record1) t) ;; `bbdb-delete-records' does nothing if RECORD1 is not known to BBDB. (bbdb-delete-records (list record1) 'noprompt) (bbdb-change-record record2) record2) ;; The following sorting functions are also intended for use ;; in `bbdb-change-hook'. Then they will be called with one arg, the record. ;;;###autoload (defun bbdb-sort-addresses (records &optional update) "Sort the addresses in RECORDS according to the label. Interactively, use BBDB prefix \ \\\\[bbdb-do-all-records], see `bbdb-do-all-records'. If UPDATE is non-nil (as in interactive calls) update the database. Otherwise, this is the caller's responsiblity (for example, when used in `bbdb-change-hook')." (interactive (list (bbdb-do-records) t)) (bbdb-editable) (dolist (record (bbdb-record-list records)) (bbdb-record-set-address record (sort (bbdb-record-address record) (lambda (xx yy) (string< (aref xx 0) (aref yy 0))))) (if update (bbdb-change-record record)))) ;;;###autoload (defun bbdb-sort-phones (records &optional update) "Sort the phones in RECORDS according to the label. Interactively, use BBDB prefix \ \\\\[bbdb-do-all-records], see `bbdb-do-all-records'. If UPDATE is non-nil (as in interactive calls) update the database. Otherwise, this is the caller's responsiblity (for example, when used in `bbdb-change-hook')." (interactive (list (bbdb-do-records) t)) (bbdb-editable) (dolist (record (bbdb-record-list records)) (bbdb-record-set-phone record (sort (bbdb-record-phone record) (lambda (xx yy) (string< (aref xx 0) (aref yy 0))))) (if update (bbdb-change-record record)))) ;;;###autoload (defun bbdb-sort-xfields (records &optional update) "Sort the xfields in RECORDS according to `bbdb-xfields-sort-order'. Interactively, use BBDB prefix \ \\\\[bbdb-do-all-records], see `bbdb-do-all-records'. If UPDATE is non-nil (as in interactive calls) update the database. Otherwise, this is the caller's responsiblity (for example, when used in `bbdb-change-hook')." (interactive (list (bbdb-do-records) t)) (bbdb-editable) (dolist (record (bbdb-record-list records)) (bbdb-record-set-xfields record (sort (bbdb-record-xfields record) (lambda (a b) (< (or (cdr (assq (car a) bbdb-xfields-sort-order)) 100) (or (cdr (assq (car b) bbdb-xfields-sort-order)) 100))))) (if update (bbdb-change-record record)))) (define-obsolete-function-alias 'bbdb-sort-notes 'bbdb-sort-xfields "3.0") ;;; Send-Mail interface ;;;###autoload (defun bbdb-dwim-mail (record &optional mail) ;; Do What I Mean! "Return a string to use as the mail address of RECORD. The name in the mail address is formatted obeying `bbdb-mail-name-format' and `bbdb-mail-name'. However, if both the first name and last name are constituents of the address as in John.Doe@Some.Host, and `bbdb-mail-avoid-redundancy' is non-nil, then the address is used as is and `bbdb-mail-name-format' and `bbdb-mail-name' are ignored. If `bbdb-mail-avoid-redundancy' is 'mail-only the name is never included. MAIL may be a mail address to be used for RECORD. If MAIL is an integer, use the MAILth mail address of RECORD. If MAIL is nil use the first mail address of RECORD." (unless mail (let ((mails (bbdb-record-mail record))) (setq mail (or (and (integerp mail) (nth mail mails)) (car mails))))) (unless mail (error "Record has no mail addresses")) (let (name fn ln) (cond ((let ((address (bbdb-decompose-bbdb-address mail))) ;; We need to know whether we should quote the name part of MAIL ;; because of special characters. (if (car address) (setq mail (cadr address) name (car address) ln name)))) ((functionp bbdb-mail-name) (setq name (funcall bbdb-mail-name record)) (if (consp name) (setq fn (car name) ln (cdr name) name (if (eq bbdb-mail-name-format 'first-last) (bbdb-concat 'name-first-last fn ln) (bbdb-concat 'name-last-first ln fn))) (let ((pair (bbdb-divide-name name))) (setq fn (car pair) ln (cdr pair))))) ((setq name (bbdb-record-xfield record bbdb-mail-name)) (let ((pair (bbdb-divide-name name))) (setq fn (car pair) ln (cdr pair)))) (t (setq name (if (eq bbdb-mail-name-format 'first-last) (bbdb-record-name record) (bbdb-record-name-lf record)) fn (bbdb-record-firstname record) ln (bbdb-record-lastname record)))) (if (or (not name) (equal "" name) (eq 'mail-only bbdb-mail-avoid-redundancy) (and bbdb-mail-avoid-redundancy (cond ((and fn ln) (let ((fnq (regexp-quote fn)) (lnq (regexp-quote ln))) (or (string-match (concat "\\`[^!@%]*\\b" fnq "\\b[^!%@]+\\b" lnq "\\b") mail) (string-match (concat "\\`[^!@%]*\\b" lnq "\\b[^!%@]+\\b" fnq "\\b") mail)))) ((or fn ln) (string-match (concat "\\`[^!@%]*\\b" (regexp-quote (or fn ln)) "\\b") mail))))) mail ;; If the name contains backslashes or double-quotes, backslash them. (setq name (replace-regexp-in-string "[\\\"]" "\\\\\\&" name)) ;; If the name contains control chars or RFC822 specials, it needs ;; to be enclosed in quotes. This quotes a few extra characters as ;; well (!,%, and $) just for common sense. ;; `define-mail-alias' uses regexp "[^- !#$%&'*+/0-9=?A-Za-z^_`{|}~]". (format (if (string-match "[][[:cntrl:]\177()<>@,;:.!$%[:nonascii:]]" name) "\"%s\" <%s>" "%s <%s>") name mail)))) (defun bbdb-compose-mail (&rest args) "Start composing a mail message to send. Use `bbdb-mail-user-agent' or (if nil) use `mail-user-agent'. ARGS are passed to `compose-mail'." (let ((mail-user-agent (or bbdb-mail-user-agent mail-user-agent))) (apply 'compose-mail args))) ;;;###autoload (defun bbdb-mail (records &optional subject n verbose) "Compose a mail message to RECORDS (optional: using SUBJECT). Interactively, use BBDB prefix \ \\\\[bbdb-do-all-records], see `bbdb-do-all-records'. By default, the first mail addresses of RECORDS are used. If prefix N is a number, use Nth mail address of RECORDS (starting from 1). If prefix N is C-u (t noninteractively) use all mail addresses of RECORDS. If VERBOSE is non-nil (as in interactive calls) be verbose." (interactive (list (bbdb-do-records) nil (or (consp current-prefix-arg) current-prefix-arg) t)) (setq records (bbdb-record-list records)) (if (not records) (if verbose (message "No records")) (let ((to (bbdb-mail-address records n nil verbose))) (unless (string= "" to) (bbdb-compose-mail to subject))))) (defun bbdb-mail-address (records &optional n kill-ring-save verbose) "Return mail addresses of RECORDS as a string. Interactively, use BBDB prefix \ \\\\[bbdb-do-all-records], see `bbdb-do-all-records'. By default, the first mail addresses of RECORDS are used. If prefix N is a number, use Nth mail address of RECORDS (starting from 1). If prefix N is C-u (t noninteractively) use all mail addresses of RECORDS. If KILL-RING-SAVE is non-nil (as in interactive calls), copy mail addresses to kill ring. If VERBOSE is non-nil (as in interactive calls) be verbose." (interactive (list (bbdb-do-records) (or (consp current-prefix-arg) current-prefix-arg) t t)) (setq records (bbdb-record-list records)) (if (not records) (progn (if verbose (message "No records")) "") (let ((good "") bad) (dolist (record records) (let ((mails (bbdb-record-mail record))) (cond ((not mails) (push record bad)) ((eq n t) (setq good (bbdb-concat ",\n\t" good (mapcar (lambda (mail) (bbdb-dwim-mail record mail)) mails)))) (t (setq good (bbdb-concat ",\n\t" good (bbdb-dwim-mail record (or (and (numberp n) (nth (1- n) mails)) (car mails))))))))) (when (and bad verbose) (message "No mail addresses for %s." (mapconcat 'bbdb-record-name (nreverse bad) ", ")) (unless (string= "" good) (sit-for 2))) (when (and kill-ring-save (not (string= good ""))) (kill-new good) (if verbose (message "%s" good))) good))) ;; Is there better way to yank selected mail addresses from the BBDB ;; buffer into a message buffer? We need some kind of a link between ;; the BBDB buffer and the message buffer, where the mail addresses ;; are supposed to go. Then we could browse the BBDB buffer and copy ;; selected mail addresses from the BBDB buffer into a message buffer. (defun bbdb-mail-yank () "CC the people displayed in the *BBDB* buffer on this mail message. The primary mail of each of the records currently listed in the *BBDB* buffer will be appended to the CC: field of the current buffer." (interactive) (let ((addresses (with-current-buffer bbdb-buffer-name (delq nil (mapcar (lambda (x) (if (bbdb-record-mail (car x)) (bbdb-dwim-mail (car x)))) bbdb-records)))) (case-fold-search t)) (goto-char (point-min)) (if (re-search-forward "^CC:[ \t]*" nil t) ;; We have a CC field. Move to the end of it, inserting a comma ;; if there are already addresses present. (unless (eolp) (end-of-line) (while (looking-at "\n[ \t]") (forward-char) (end-of-line)) (insert ",\n") (indent-relative)) ;; Otherwise, if there is an empty To: field, move to the end of it. (unless (and (re-search-forward "^To:[ \t]*" nil t) (eolp)) ;; Otherwise, insert an empty CC: field. (end-of-line) (while (looking-at "\n[ \t]") (forward-char) (end-of-line)) (insert "\nCC:") (indent-relative))) ;; Now insert each of the addresses on its own line. (while addresses (insert (car addresses)) (when (cdr addresses) (insert ",\n") (indent-relative)) (setq addresses (cdr addresses))))) (define-obsolete-function-alias 'bbdb-yank-addresses 'bbdb-mail-yank "3.0") ;;; completion ;;;###autoload (defun bbdb-completion-predicate (key records) "For use as the third argument to `completing-read'. Obey `bbdb-completion-list'." (cond ((null bbdb-completion-list) nil) ((eq t bbdb-completion-list) t) (t (catch 'bbdb-hash-ok (dolist (record records) (bbdb-hash-p key record bbdb-completion-list)) nil)))) (defun bbdb-completing-read-records (prompt &optional omit-records) "Read and return list of records from the bbdb. Completion is done according to `bbdb-completion-list'. If the user just hits return, nil is returned. Otherwise, a valid response is forced." (let* ((completion-ignore-case t) (string (completing-read prompt bbdb-hashtable 'bbdb-completion-predicate t))) (unless (string= "" string) (let (records) (dolist (record (gethash string bbdb-hashtable)) (if (not (memq record omit-records)) (push record records))) (delete-dups records))))) (defun bbdb-completing-read-record (prompt &optional omit-records) "Prompt for and return a single record from the bbdb; completion is done according to `bbdb-completion-list'. If the user just hits return, nil is returned. Otherwise, a valid response is forced. If OMIT-RECORDS is non-nil it should be a list of records to dis-allow completion with." (let ((records (bbdb-completing-read-records prompt omit-records))) (cond ((eq (length records) 1) (car records)) ((> (length records) 1) (bbdb-display-records records 'one-line) (let* ((count (length records)) (result (completing-read (format "Which record (1-%s): " count) (mapcar 'number-to-string (number-sequence 1 count)) nil t))) (nth (1- (string-to-number result)) records)))))) ;;;###autoload (defun bbdb-completing-read-mails (prompt &optional init) "Like `read-string', but allows `bbdb-complete-mail' style completion." (read-from-minibuffer prompt init bbdb-completing-read-mails-map)) (defconst bbdb-quoted-string-syntax-table (let ((st (make-syntax-table))) (modify-syntax-entry ?\\ "\\" st) (modify-syntax-entry ?\" "\"" st) st) "Syntax-table to parse matched quotes. Used by `bbdb-complete-mail'.") ;;;###autoload (defun bbdb-complete-mail (&optional beg cycle-completion-buffer) "In a mail buffer, complete the user name or mail before point. Completion happens up to the preceeding colon, comma, or BEG. Return non-nil if there is a valid completion, else return nil. Completion behaviour obeys `bbdb-completion-list' (see there). If what has been typed matches a unique BBDB record, insert an address formatted by `bbdb-dwim-mail' (see there). Also, display this record if `bbdb-completion-display-record' is non-nil, If what has been typed is a valid completion but does not match a unique record, display a list of completions. If the completion is done and `bbdb-complete-mail-allow-cycling' is t then cycle through the mails for the matching record. If BBDB would format a given address different from what we have in the mail buffer, the first round of cycling reformats the address accordingly, then we cycle through the mails for the matching record. With prefix CYCLE-COMPLETION-BUFFER non-nil, display a list of all mails available for cycling. Set the variable `bbdb-complete-mail' non-nil for enabling this feature as part of the MUA insinuation." (interactive (list nil current-prefix-arg)) (bbdb-buffer) ; Make sure the database is initialized. ;; Completion should begin after the preceding comma (separating ;; two addresses) or colon (separating the header field name ;; from the header field body). We want to ignore these characters ;; if they appear inside a quoted string (RFC 5322, Sec. 3.2.4). ;; Note also that a quoted string may span multiple lines ;; (RFC 5322, Sec. 2.2.3). ;; So to be save, we go back to the beginning of the header field body ;; (past the colon, when we are certainly not inside a quoted string), ;; then we parse forward, looking for commas not inside a quoted string ;; and positioned before END. - This fails with an unbalanced quote. ;; But an unbalanced quote is bound to fail anyway. (when (and (not beg) (<= (point) (save-restriction ; `mail-header-end' (widen) (save-excursion (rfc822-goto-eoh) (point))))) (let ((end (point)) start pnt state) (save-excursion ;; A header field name must appear at the beginning of a line, ;; and it must be terminated by a colon. (re-search-backward "^[^ \t\n:][^:]*:[ \t\n]+") (setq beg (match-end 0) start beg) (goto-char beg) ;; If we are inside a syntactically correct header field, ;; all continuation lines in between the field name and point ;; must begin with a white space character. (if (re-search-forward "\n[^ \t]" end t) ;; An invalid header is identified via BEG set to nil. (setq beg nil) ;; Parse field body up to END (with-syntax-table bbdb-quoted-string-syntax-table (while (setq pnt (re-search-forward ",[ \t\n]*" end t)) (setq state (parse-partial-sexp start pnt nil nil state) start pnt) (unless (nth 3 state) (setq beg pnt)))))))) ;; Do we have a meaningful way to set BEG if we are not in a message header? (unless beg (message "Not a valid buffer position for mail completion") (sit-for 1)) (let* ((end (point)) (done (unless beg 'nothing)) (orig (and beg (buffer-substring beg end))) (completion-ignore-case t) (completion (and orig (try-completion orig bbdb-hashtable 'bbdb-completion-predicate))) all-completions dwim-completions one-record) (unless done ;; We get fooled if a partial COMPLETION matches "," (for example, ;; a comma in lf-name). Such a partial COMPLETION cannot be protected ;; by quoting. Then the comma gets interpreted as BEG. ;; So we never perform partial completion beyond the first comma. ;; This works even if we have just one record matching ORIG (thus ;; allowing dwim-completion) because ORIG is a substring of COMPLETION ;; even after COMPLETION got truncated; and ORIG by itself must be ;; sufficient to identify this record. ;; Yet if multiple records match ORIG we can only offer a *Completions* ;; buffer. (if (and (stringp completion) (string-match "," completion)) (setq completion (substring completion 0 (match-beginning 0)))) (setq all-completions (all-completions orig bbdb-hashtable 'bbdb-completion-predicate)) ;; Resolve the records matching ORIG: ;; Multiple completions may match the same record (let ((records (delete-dups (apply 'append (mapcar (lambda (compl) (gethash compl bbdb-hashtable)) all-completions))))) ;; Is there only one matching record? (setq one-record (and (not (cdr records)) (car records)))) ;; Clean up *Completions* buffer window, if it exists (let ((window (get-buffer-window "*Completions*"))) (if (window-live-p window) (quit-window nil window))) (cond ;; Match for a single record (one-record (let ((completion-list (if (eq t bbdb-completion-list) '(fl-name lf-name mail aka organization) bbdb-completion-list)) (mails (bbdb-record-mail one-record)) mail elt) (if (not mails) (progn (message "Matching record has no mail field") (sit-for 1) (setq done 'nothing)) ;; Determine the mail address of ONE-RECORD to use for ADDRESS. ;; Do we have a preferential order for the following tests? ;; (1) If ORIG matches name, AKA, or organization of ONE-RECORD, ;; then ADDRESS will be the first mail address of ONE-RECORD. (if (try-completion orig (append (if (memq 'fl-name completion-list) (list (or (bbdb-record-name one-record) ""))) (if (memq 'lf-name completion-list) (list (or (bbdb-record-name-lf one-record) ""))) (if (memq 'aka completion-list) (bbdb-record-field one-record 'aka-all)) (if (memq 'organization completion-list) (bbdb-record-organization one-record)))) (setq mail (car mails))) ;; (2) If ORIG matches one or multiple mail addresses of ONE-RECORD, ;; then we take the first one matching ORIG. ;; We got here with MAIL nil only if `bbdb-completion-list' ;; includes 'mail or 'primary. (unless mail (while (setq elt (pop mails)) (if (try-completion orig (list elt)) (setq mail elt mails nil)))) ;; This error message indicates a bug! (unless mail (error "No match for %s" orig)) (let ((dwim-mail (bbdb-dwim-mail one-record mail))) (if (string= dwim-mail orig) ;; We get here if `bbdb-mail-avoid-redundancy' is 'mail-only ;; and `bbdb-completion-list' includes 'mail. (unless (and bbdb-complete-mail-allow-cycling (< 1 (length (bbdb-record-mail one-record)))) (setq done 'unchanged)) ;; Replace the text with the expansion (delete-region beg end) (insert dwim-mail) (bbdb-complete-mail-cleanup dwim-mail beg) (setq done 'unique)))))) ;; Partial completion ((and (stringp completion) (not (bbdb-string= orig completion))) (delete-region beg end) (insert completion) (setq done 'partial)) ;; Partial match not allowing further partial completion (completion (let ((completion-list (if (eq t bbdb-completion-list) '(fl-name lf-name mail aka organization) bbdb-completion-list))) ;; Now collect all the dwim-addresses for each completion. ;; Add it if the mail is part of the completions (dolist (key all-completions) (dolist (record (gethash key bbdb-hashtable)) (let ((mails (bbdb-record-mail record)) accept) (when mails (dolist (field completion-list) (cond ((eq field 'fl-name) (if (bbdb-string= key (bbdb-record-name record)) (push (car mails) accept))) ((eq field 'lf-name) (if (bbdb-string= key (bbdb-cache-lf-name (bbdb-record-cache record))) (push (car mails) accept))) ((eq field 'aka) (if (member-ignore-case key (bbdb-record-field record 'aka-all)) (push (car mails) accept))) ((eq field 'organization) (if (member-ignore-case key (bbdb-record-organization record)) (push (car mails) accept))) ((eq field 'primary) (if (bbdb-string= key (car mails)) (push (car mails) accept))) ((eq field 'mail) (dolist (mail mails) (if (bbdb-string= key mail) (push mail accept)))))) (dolist (mail (delete-dups accept)) (push (bbdb-dwim-mail record mail) dwim-completions)))))) (setq dwim-completions (sort (delete-dups dwim-completions) 'string-lessp)) (cond ((not dwim-completions) (message "Matching record has no mail field") (sit-for 1) (setq done 'nothing)) ;; DWIM-COMPLETIONS may contain only one element, ;; if multiple completions match the same record. ;; Then we may proceed with DONE set to `unique'. ((eq 1 (length dwim-completions)) (delete-region beg end) (insert (car dwim-completions)) (bbdb-complete-mail-cleanup (car dwim-completions) beg) (setq done 'unique)) (t (setq done 'choose))))))) ;; By now, we have considered all possiblities to perform a completion. ;; If nonetheless we haven't done anything so far, consider cycling. ;; ;; Completion and cycling are really two very separate things. ;; Completion is controlled by the user variable `bbdb-completion-list'. ;; Cycling assumes that ORIG already holds a valid RFC 822 mail address. ;; Therefore cycling may consider different records than completion. (when (and (not done) bbdb-complete-mail-allow-cycling) ;; find the record we are working on. (let* ((address (bbdb-extract-address-components orig)) (record (car (bbdb-message-search (car address) (cadr address))))) (if (and record (setq dwim-completions (mapcar (lambda (m) (bbdb-dwim-mail record m)) (bbdb-record-mail record)))) (cond ((and (= 1 (length dwim-completions)) (string= orig (car dwim-completions))) (setq done 'unchanged)) (cycle-completion-buffer ; use completion buffer (setq done 'cycle-choose)) ;; Reformatting / Clean up: ;; If the canonical mail address (nth 1 address) ;; matches the Nth canonical mail address of RECORD, ;; but ORIG is not `equal' to (bbdb-dwim-mail record n), ;; then we replace ORIG by (bbdb-dwim-mail record n). ;; For example, the address "JOHN SMITH " ;; gets reformatted as "John Smith ". ;; We attempt this reformatting before the yet more ;; aggressive proper cycling. ((let* ((cmails (bbdb-record-mail-canon record)) (len (length cmails)) mail dwim-mail) (while (and (not done) (setq mail (pop cmails))) (when (and (bbdb-string= mail (nth 1 address)) ; ignore case (not (string= orig (setq dwim-mail (nth (- len 1 (length cmails)) dwim-completions))))) (delete-region beg end) (insert dwim-mail) (bbdb-complete-mail-cleanup dwim-mail beg) (setq done 'reformat))) done)) (t ;; ORIG is `equal' to an element of DWIM-COMPLETIONS ;; Use the next element of DWIM-COMPLETIONS. (let ((dwim-mail (or (nth 1 (member orig dwim-completions)) (nth 0 dwim-completions)))) ;; replace with new mail address (delete-region beg end) (insert dwim-mail) (bbdb-complete-mail-cleanup dwim-mail beg) (setq done 'cycle))))))) (when (member done '(choose cycle-choose)) ;; Pop up a completions window using DWIM-COMPLETIONS. ;; `completion-in-region' does not work here as DWIM-COMPLETIONS ;; is not a collection for completion in the usual sense, but it ;; is really a list of replacements. (let ((status (not (eq (selected-window) (minibuffer-window)))) (completion-base-position (list beg end)) ;; We first call the default value of ;; `completion-list-insert-choice-function' ;; before performing our own stuff. (completion-list-insert-choice-function `(lambda (beg end text) ,(if (boundp 'completion-list-insert-choice-function) `(funcall ',completion-list-insert-choice-function beg end text)) (bbdb-complete-mail-cleanup text beg)))) (if status (message "Making completion list...")) (with-output-to-temp-buffer "*Completions*" (display-completion-list dwim-completions)) (if status (message "Making completion list...done")))) ;; If DONE is `nothing' return nil so that possibly some other code ;; can take over. (unless (eq done 'nothing) done))) ;;;###autoload (define-obsolete-function-alias 'bbdb-complete-name 'bbdb-complete-mail "3.0") (defun bbdb-complete-mail-cleanup (mail beg) "Clean up after inserting MAIL at position BEG. If we are past `fill-column', wrap at the previous comma." (if (and (not (auto-fill-function)) (>= (current-column) fill-column)) (save-excursion (goto-char beg) (when (search-backward "," (line-beginning-position) t) (forward-char 1) (insert "\n") (indent-relative) (if (looking-at "[ \t\n]+") (delete-region (point) (match-end 0)))))) (if (or bbdb-completion-display-record bbdb-complete-mail-hook) (let* ((address (bbdb-extract-address-components mail)) (records (bbdb-message-search (car address) (nth 1 address)))) ;; Update the *BBDB* buffer if desired. (if bbdb-completion-display-record (let ((bbdb-silent-internal t)) ;; FIXME: This pops up *BBDB* before removing *Completions* (bbdb-display-records records nil t))) ;; `bbdb-complete-mail-hook' may access MAIL, ADDRESS, and RECORDS. (run-hooks 'bbdb-complete-mail-hook)))) ;;; interface to mail-abbrevs.el. ;;;###autoload (defun bbdb-mail-aliases (&optional force-rebuilt noisy) "Define mail aliases for the records in the database. Define a mail alias for every record that has a `mail-alias' field which is the contents of that field. If there are multiple comma-separated words in the `mail-alias' field, then all of those words will be defined as aliases for that person. If multiple records in the database have the same mail alias, then that alias expands to a comma-separated list of the mail addresses of all of these people. Add this command to `mail-setup-hook'. Mail aliases are (re)built only if `bbdb-mail-aliases-need-rebuilt' is non-nil because the database was newly loaded or it has been edited. Rebuilding the aliases is enforced if prefix FORCE-REBUILT is t." (interactive (list current-prefix-arg t)) ;; Build `mail-aliases' if not yet done. ;; Note: `mail-abbrevs-setup' rebuilds the mail-aliases only if ;; `mail-personal-alias-file' has changed. So it would not do anything ;; if we want to rebuild the mail-aliases because of changes in BBDB. (if (or force-rebuilt (eq t mail-aliases)) (build-mail-aliases)) ;; We should be cleverer here and instead of rebuilding all aliases ;; we should just do what's necessary, i.e. remove deleted records ;; and add new records ;; Calling `bbdb-records' can change `bbdb-mail-aliases-need-rebuilt' (let ((records (bbdb-search (bbdb-records) :xfield (cons bbdb-mail-alias-field "."))) results match) (if (not (or force-rebuilt bbdb-mail-aliases-need-rebuilt)) (if noisy (message "BBDB mail alias: nothing to do")) (setq bbdb-mail-aliases-need-rebuilt nil) ;; collect an alist of (alias rec1 [rec2 ...]) (dolist (record records) (if (bbdb-record-mail record) (dolist (alias (bbdb-record-xfield-split record bbdb-mail-alias-field)) (if (setq match (assoc alias results)) ;; If an alias appears more than once, we collect all records ;; that refer to it. (nconc match (list record)) (push (list alias record) results))) (unless bbdb-silent (bbdb-warn "record %S has no mail address, but the aliases: %s" (bbdb-record-name record) (bbdb-record-xfield record bbdb-mail-alias-field)) (sit-for 1)))) ;; Iterate over the results and create the aliases (dolist (result results) (let* ((aliasstem (car result)) (expansions (if (cddr result) ;; for group aliases we just take all the primary mails ;; and define only one expansion! (list (mapconcat (lambda (record) (bbdb-dwim-mail record)) (cdr result) mail-alias-separator-string)) ;; this is an alias for a single person so deal with it ;; according to `bbdb-mail-alias' (let* ((record (nth 1 result)) (mails (bbdb-record-mail record))) (if (or (eq 'first bbdb-mail-alias) (not (cdr mails))) ;; Either we want to define only one alias for ;; the first mail address or there is anyway ;; only one address. In either case, we take ;; take only the first address. (list (bbdb-dwim-mail record (car mails))) ;; We need to deal with more than one mail address... (let* ((all (mapcar (lambda (m) (bbdb-dwim-mail record m)) mails)) (star (bbdb-concat mail-alias-separator-string all))) (if (eq 'star bbdb-mail-alias) (list star (car all)) ;; if `bbdb-mail-alias' is 'all, we create ;; two aliases for the primary mail address (cons star (cons (car all) all)))))))) (count -1) ; n=-1: *; n=0: ; n>0: n (len (length expansions)) alias f-alias) ;; create the aliases for each expansion (dolist (expansion expansions) (cond ((or (= 1 len) (= count 0)) (setq alias aliasstem)) ((= count -1) ;; all the mails of a record (setq alias (concat aliasstem "*"))) (t ;; n for each mail of a record (setq alias (format "%s%s" aliasstem count)))) (setq count (1+ count)) (bbdb-pushnew (cons alias expansion) mail-aliases) (define-mail-abbrev alias expansion) (unless (setq f-alias (intern-soft (downcase alias) mail-abbrevs)) (error "Cannot find the alias")) ;; `define-mail-abbrev' initializes f-alias to be ;; `mail-abbrev-expand-hook'. We replace this by ;; `bbdb-mail-abbrev-expand-hook' (unless (eq (symbol-function f-alias) 'mail-abbrev-expand-hook) (error "mail-aliases contains unexpected hook %s" (symbol-function f-alias))) ;; `bbdb-mail-abbrev-hook' is called with mail addresses instead of ;; bbdb records to avoid keeping pointers to records, which would ;; lose if the database was reverted. ;; `bbdb-mail-abbrev-hook' uses `bbdb-message-search' to convert ;; these mail addresses to records, which is plenty fast. ;; FIXME: The value of arg MAILS for `bbdb-mail-abbrev-hook' ;; is wrong. Currently it is based on the list of records that have ;; referenced ALIASTEM and we simply take the first mail address ;; from each of these records. ;; Then `bbdb-message-search' will find the correct records ;; (assuming that each mail address appears only once in the ;; database). Nonethless, arg MAILS for `bbdb-mail-abbrev-hook' ;; does not, in general, contain the actual mail addresses ;; of EXPANSION. So what we would need is to go back from ;; EXPANSION to the mail addresses it contains (which is tricky ;; because mail addresses in the database can be shortcuts for ;; the addresses in EXPANSION). (fset f-alias `(lambda () (bbdb-mail-abbrev-expand-hook ,alias ',(mapcar (lambda (r) (car (bbdb-record-mail r))) (cdr result)))))))) (if noisy (message "BBDB mail alias: rebuilding done"))))) (defun bbdb-mail-abbrev-expand-hook (alias mails) (run-hook-with-args 'bbdb-mail-abbrev-expand-hook alias mails) (mail-abbrev-expand-hook) (when bbdb-completion-display-record (let ((bbdb-silent-internal t)) (bbdb-display-records (apply 'append (mapcar (lambda (mail) (bbdb-message-search nil mail)) mails)) nil t)))) (defun bbdb-get-mail-aliases () "Return a list of mail aliases used in the BBDB." (let ((records (bbdb-search (bbdb-records) :xfield (cons bbdb-mail-alias-field "."))) result) (dolist (record records) (dolist (alias (bbdb-record-xfield-split record bbdb-mail-alias-field)) (bbdb-pushnew alias result))) result)) ;;;###autoload (defsubst bbdb-mail-alias-list (alias) (if (stringp alias) (bbdb-split bbdb-mail-alias-field alias) alias)) (defun bbdb-add-mail-alias (records &optional alias delete) "Add ALIAS to RECORDS. If prefix DELETE is non-nil, remove ALIAS from RECORDS. Interactively, use BBDB prefix \ \\\\[bbdb-do-all-records], see `bbdb-do-all-records'. Arg ALIAS is ignored if list RECORDS contains more than one record. Instead read ALIAS interactively for each record in RECORDS. If the function `bbdb-init-mail-alias' is defined, it is called with one arg RECORD to define the default value for ALIAS of RECORD." (interactive (list (bbdb-do-records) nil current-prefix-arg)) (bbdb-editable) (setq records (bbdb-record-list records)) (if (< 1 (length records)) (setq alias nil)) (let* ((tmp (intern-soft (concat "bbdb-init-" (symbol-name bbdb-mail-alias-field)))) (init-f (if (functionp tmp) tmp))) (dolist (record records) (let ((r-a-list (bbdb-record-xfield-split record bbdb-mail-alias-field)) (alias alias) a-list) (if alias (setq a-list (bbdb-mail-alias-list alias)) (when init-f (setq a-list (bbdb-mail-alias-list (funcall init-f record)) alias (if a-list (bbdb-concat bbdb-mail-alias-field a-list)))) (let ((crm-separator (concat "[ \t\n]*" (cadr (assq bbdb-mail-alias-field bbdb-separator-alist)) "[ \t\n]*")) (crm-local-completion-map bbdb-crm-local-completion-map) (prompt (format "%s mail alias:%s " (if delete "Remove" "Add") (if alias (format " (default %s)" alias) ""))) (collection (if delete (or r-a-list (error "Record has no alias")) (bbdb-get-mail-aliases)))) (setq a-list (if (string< "24.3" (substring emacs-version 0 4)) (completing-read-multiple prompt collection nil delete nil nil alias) (bbdb-split bbdb-mail-alias-field (completing-read prompt collection nil delete nil nil alias)))))) (dolist (a a-list) (if delete (setq r-a-list (delete a r-a-list)) ;; Add alias only if it is not there yet (bbdb-pushnew a r-a-list))) ;; This also handles `bbdb-mail-aliases-need-rebuilt' (bbdb-record-set-xfield record bbdb-mail-alias-field (bbdb-concat bbdb-mail-alias-field r-a-list)) (bbdb-change-record record))))) ;;; Dialing numbers from BBDB (defun bbdb-dial-number (phone-string) "Dial the number specified by PHONE-STRING. This uses the tel URI syntax passed to `browse-url' to make the call. If `bbdb-dial-function' is non-nil then that is called to make the phone call." (interactive "sDial number: ") (if bbdb-dial-function (funcall bbdb-dial-function phone-string) (browse-url (concat "tel:" phone-string)))) ;;;###autoload (defun bbdb-dial (phone force-area-code) "Dial the number at point. If the point is at the beginning of a record, dial the first phone number. Use rules from `bbdb-dial-local-prefix-alist' unless prefix FORCE-AREA-CODE is non-nil. Do not dial the extension." (interactive (list (bbdb-current-field) current-prefix-arg)) (if (eq (car-safe phone) 'name) (setq phone (car (bbdb-record-phone (bbdb-current-record))))) (if (eq (car-safe phone) 'phone) (setq phone (car (cdr phone)))) (or (vectorp phone) (error "Not on a phone field")) (let ((number (bbdb-phone-string phone)) shortnumber) ;; cut off the extension (if (string-match "x[0-9]+$" number) (setq number (substring number 0 (match-beginning 0)))) (unless force-area-code (let ((alist bbdb-dial-local-prefix-alist) prefix) (while (setq prefix (pop alist)) (if (string-match (concat "^" (eval (car prefix))) number) (setq shortnumber (concat (cdr prefix) (substring number (match-end 0))) alist nil))))) (if shortnumber (setq number shortnumber) ;; This is terrifically Americanized... ;; Leading 0 => local number (?) (if (and bbdb-dial-local-prefix (string-match "^0" number)) (setq number (concat bbdb-dial-local-prefix number))) ;; Leading + => long distance/international number (if (and bbdb-dial-long-distance-prefix (string-match "^\+" number)) (setq number (concat bbdb-dial-long-distance-prefix " " (substring number 1))))) (unless bbdb-silent (message "Dialing %s" number)) (bbdb-dial-number number))) ;;; url interface ;;;###autoload (defun bbdb-browse-url (records &optional which) "Brwose URLs stored in the `url' field of RECORDS. Interactively, use BBDB prefix \ \\\\[bbdb-do-all-records], see `bbdb-do-all-records'. Prefix WHICH specifies which URL in field `url' is used (starting from 0). Default is the first URL." (interactive (list (bbdb-get-records "Visit (URL): ") (and current-prefix-arg (prefix-numeric-value current-prefix-arg)))) (unless which (setq which 0)) (dolist (record (bbdb-record-list records)) (let ((url (bbdb-record-xfield-split record 'url))) (when url (setq url (read-string "fetch: " (nth which url))) (unless (string= "" url) (browse-url url)))))) ;;;###autoload (defun bbdb-grab-url (record url) "Grab URL and store it in RECORD." (interactive (let ((url (browse-url-url-at-point))) (unless url (error "No URL at point")) (list (bbdb-completing-read-record (format "Add `%s' for: " url)) url))) (bbdb-record-set-field record 'url url t) (bbdb-change-record record) (bbdb-display-records (list record))) ;;; Copy to kill ring ;;;###autoload (defun bbdb-copy-records-as-kill (records) "Copy RECORDS to kill ring. Interactively, use BBDB prefix \ \\\\[bbdb-do-all-records], see `bbdb-do-all-records'." (interactive (list (bbdb-do-records t))) (let (drec) (dolist (record (bbdb-record-list records t)) (push (buffer-substring (nth 2 record) (or (nth 2 (car (cdr (memq record bbdb-records)))) (point-max))) drec)) (kill-new (replace-regexp-in-string "[ \t\n]*\\'" "\n" (mapconcat 'identity (nreverse drec) ""))))) ;;;###autoload (defun bbdb-copy-fields-as-kill (records field &optional num) "For RECORDS copy values of FIELD at point to kill ring. If FIELD is an address or phone with a label, copy only field values with the same label. With numeric prefix NUM, if the value of FIELD is a list, copy only the NUMth list element. Interactively, use BBDB prefix \ \\\\[bbdb-do-all-records], see `bbdb-do-all-records'." (interactive (list (bbdb-do-records t) (bbdb-current-field) (and current-prefix-arg (prefix-numeric-value current-prefix-arg)))) (unless field (error "Not a field")) (let* ((type (if (eq (car field) 'xfields) (car (nth 1 field)) (car field))) (label (if (memq type '(phone address)) (aref (cadr field) 0))) (ident (and (< 1 (length records)) (not (eq type 'name)))) val-list) (dolist (record (bbdb-record-list records)) (let ((raw-val (bbdb-record-field (car record) type)) value) (if raw-val (cond ((eq type 'phone) (dolist (elt raw-val) (if (equal label (aref elt 0)) (push (bbdb-phone-string elt) value))) (setq value (bbdb-concat 'phone (nreverse value)))) ((eq type 'address) (dolist (elt raw-val) (if (equal label (aref elt 0)) (push (bbdb-format-address elt (if (eq (nth 1 record) 'one-line) 3 2)) value))) (setq value (bbdb-concat 'address (nreverse value)))) ((consp raw-val) (setq value (if num (nth num raw-val) (bbdb-concat type raw-val)))) (t (setq value raw-val)))) (if value (push (if ident (bbdb-concat 'name-field (bbdb-record-name (car record)) value) value) val-list)))) (let ((str (bbdb-concat 'record (nreverse val-list)))) (kill-new str) (message "%s" str)))) ;;; Help and documentation ;;;###autoload (defun bbdb-info () (interactive) (info (format "(%s)Top" (or bbdb-info-file "bbdb")))) ;;;###autoload (defun bbdb-help () (interactive) (message (substitute-command-keys "\\\ new field: \\[bbdb-insert-field]; \ edit field: \\[bbdb-edit-field]; \ delete field: \\[bbdb-delete-field-or-record]; \ mode help: \\[describe-mode]; \ info: \\[bbdb-info]"))) (provide 'bbdb-com) ;;; bbdb-com.el ends here bbdb3-3.2/lisp/bbdb-gnus-aux.el000066400000000000000000000377651322420162700163020ustar00rootroot00000000000000;;; bbdb-gnus-aux.el --- aux parts of BBDB interface to Gnus -*- lexical-binding: t -*- ;; Copyright (C) 1991, 1992, 1993 Jamie Zawinski . ;; Copyright (C) 2010-2017 Roland Winkler ;; This file is part of the Insidious Big Brother Database (aka BBDB), ;; BBDB 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. ;; BBDB 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 BBDB. If not, see . ;;; Commentary: ;; This file contains auxiliary parts of the BBDB interface to Gnus. ;; See the BBDB info manual for documentation. ;;; Code: (require 'bbdb) (require 'bbdb-com) (require 'bbdb-mua) (require 'gnus) (eval-and-compile (autoload 'message-make-domain "message")) ;; Scoring ;; RW 2017-11-16: Does this scoring currently work at all? ;; How is this code supposed to hook into Gnus? (defcustom bbdb/gnus-score-field 'gnus-score "This variable contains the name of the BBDB field which should be checked for a score to add to the mail addresses in the same record." :group 'bbdb-mua-gnus-scoring :type 'symbol) (defcustom bbdb/gnus-score-default nil "If this is set, then every mail address in the BBDB that does not have an associated score field will be assigned this score. A value of nil implies a default score of zero." :group 'bbdb-mua-gnus-scoring :type '(choice (const :tag "Do not assign default score" nil) (integer :tag "Assign this default score" 0))) (defvar bbdb/gnus-score-default-internal nil "Internal variable for detecting changes to `bbdb/gnus-score-default'. You should not set this variable directly - set `bbdb/gnus-score-default' instead.") (defvar bbdb/gnus-score-alist nil "The text version of the scoring structure returned by bbdb/gnus-score. This is built automatically from the BBDB.") (defvar bbdb/gnus-score-rebuild-alist t "Set to t to rebuild bbdb/gnus-score-alist on the next call to bbdb/gnus-score. This will be set automatically if you change a BBDB record which contains a gnus-score field.") ;;;###autoload (defun bbdb/gnus-score-invalidate-alist (record) "This function is called through `bbdb-after-change-hook', and sets `bbdb/gnus-score-rebuild-alist' to t if the changed record contains a gnus-score field." (if (bbdb-record-xfield record bbdb/gnus-score-field) (setq bbdb/gnus-score-rebuild-alist t))) (add-hook 'bbdb-after-change-hook 'bbdb/gnus-score-invalidate-alist) ;; (setq gnus-score-find-score-files-function ;; (if (boundp 'gnus-score-find-score-files-function) ;; (cond ((functionp gnus-score-find-score-files-function) ;; (list gnus-score-find-score-files-function 'bbdb/gnus-score)) ;; ((listp gnus-score-find-score-files-function) ;; (append gnus-score-find-score-files-function 'bbdb/gnus-score)) ;; (t 'bbdb/gnus-score)) ;; 'bbdb/gnus-score)) ;;;###autoload (defun bbdb/gnus-score (group) "This returns a score alist for Gnus. A score pair will be made for every member of the mail field in records which also have a gnus-score field. This allows the BBDB to serve as a supplemental global score file, with the advantage that it can keep up with multiple and changing addresses better than the traditionally static global scorefile." (list (list (condition-case nil (read (bbdb/gnus-score-as-text group)) (error (setq bbdb/gnus-score-rebuild-alist t) (message "Problem building BBDB score table.") (ding) (sit-for 2) nil))))) (defun bbdb/gnus-score-as-text (_group) "Returns a SCORE file format string built from the BBDB." (cond ((or (cond ((/= (or bbdb/gnus-score-default 0) (or bbdb/gnus-score-default-internal 0)) (setq bbdb/gnus-score-default-internal bbdb/gnus-score-default) t)) (not bbdb/gnus-score-alist) bbdb/gnus-score-rebuild-alist) (setq bbdb/gnus-score-rebuild-alist nil) (setq bbdb/gnus-score-alist (concat "((touched nil) (\"from\"\n" (mapconcat (lambda (record) (let ((score (or (bbdb-record-xfield record bbdb/gnus-score-field) bbdb/gnus-score-default)) (mail (bbdb-record-mail record))) (when (and score mail) (mapconcat (lambda (address) (format "(\"%s\" %s)\n" address score)) mail "")))) (bbdb-records) "") "))")))) bbdb/gnus-score-alist) ;; from Brian Edmonds' gnus-bbdb.el ;; ;; Splitting / filing with gnus-folder ;; ;; To use this feature, you need to put this file somewhere in your ;; load-path and add the following lines of code to your .gnus file: ;; ;; (setq nnmail-split-methods 'bbdb/gnus-split-method) ;; ;; You should also examine the variables defvar'd below and customize ;; them to your taste. They're listed roughly in descending likelihood ;; of your wanting to change them. Once that is done, you need to add ;; filing information to your BBDB. There are two fields of interest: ;; ;; 1. gnus-private. This field contains the name of the group in which ;; mail to you from any of the addresses associated with this record ;; will be filed. Also, any self-copies of mail you send any of the ;; same addresses will be filed here. ;; 2. gnus-public. This field is used to keep mail from mailing lists ;; out of the private mailboxes. It should be added to a record for ;; the list submission address, and is formatted as follows: ;; "group regexp" ;; where group is where mail from the list should be filed, and ;; regexp is a regular expression which is checked against the ;; envelope sender (from the From_ header) to verify that this is ;; the copy which came from the list. For example, the entry for ;; the ding mailing list might be: ;; "mail.emacs.ding ding-request@ifi.uio.no" ;; Yes, the second part *is* a regexp, so those dots may match ;; something other than dots. Sue me. ;; ;; Note that you can also specify a gnus-private field for mailing list ;; addresses, in which case self-copies of mail you send to the list ;; will be filed there. Also, the field names can be changed below if ;; the defaults are not hip enough for you. Lastly, if you specify a ;; gnus-private field for your *own* BBDB record, then all self-copies ;; of mail you send will be filed to that group. ;; ;; This documentation should probably be expanded and moved to a ;; separate file, but it's late, and *I* know what I'm trying to ;; say. :) (defcustom bbdb/gnus-split-default-group "mail.misc" "If the BBDB does not indicate any group to spool a message to, it will be spooled to this group. If `bbdb/gnus-split-crosspost-default' is not nil, and if the BBDB did not indicate a specific group for one or more addresses, messages will be crossposted to this group in addition to any group(s) which the BBDB indicated." :group 'bbdb-mua-gnus-splitting :type 'string) (defcustom bbdb/gnus-split-nomatch-function nil "This function will be called after searching the BBDB if no place to file the message could be found. It should return a group name (or list of group names) -- `nnmail-split-fancy' as provided with Gnus is an excellent choice." :group 'bbdb-mua-gnus-splitting :type 'function) (defcustom bbdb/gnus-split-myaddr-regexp (concat "^" (user-login-name) "$\\|^" (user-login-name) "@\\([-a-z0-9]+\\.\\)*" (or (message-make-domain) (system-name) "") "$") "This regular expression should match your address as found in the From header of your mail." :group 'bbdb-mua-gnus-splitting :type 'regexp) (defcustom bbdb/gnus-split-crosspost-default nil "If this variable is not nil, then if the BBDB could not identify a group for every mail address, messages will be filed in `bbdb/gnus-split-default-group' in addition to any group(s) which the BBDB identified." :group 'bbdb-mua-gnus-splitting :type 'boolean) (defcustom bbdb/gnus-split-private-field 'gnus-private "This variable is used to determine the xfield to reference to find the associated group when saving private mail for a mail address known to the BBDB. The value of the xfield should be the name of a mail group." :group 'bbdb-mua-gnus-splitting :type 'symbol) (defcustom bbdb/gnus-split-public-field 'gnus-public "This variable is used to determine the xfield to reference to find the associated group when saving non-private mail (received from a mailing list) for a mail address known to the BBDB. The value of the xfield should be the name of a mail group, followed by a space, and a regular expression to match on the envelope sender to verify that this mail came from the list in question." :group 'bbdb-mua-gnus-splitting :type 'symbol) ;; The split function works by assigning one of four spooling priorities ;; to each group that is associated with an address in the message. The ;; priorities are assigned as follows: ;; ;; 0. This priority is assigned when crosspost-default is nil to To/Cc ;; addresses which have no private group defined in the BBDB. If the ;; user's own address has no private group defined, then it will ;; always be given this priority. ;; 1. This priority is assigned to To/Cc addresses which have a private ;; group defined in the BBDB. If crosspost-default is not nil, then ;; To/Cc addresses which have no private group will also be assigned ;; this priority. This is also assigned to the user's own address in ;; the From position if a private group is defined for it. ;; 2. This priority is assigned to From addresses which have a private ;; group defined in the BBDB, except for the user's own address as ;; described under priorities 0 and 1. ;; 3. This priority is assigned to To/Cc addresses which have a public ;; group defined in the BBDB, and whose associated regular expression ;; matches the envelope sender (found in the header From_). ;; ;; The split function evaluates the spool priority for each address in ;; the headers of the message, and returns as a list all the groups ;; associated with the addresses which share the highest calculated ;; priority. ;;;###autoload (defun bbdb/gnus-split-method () "This function expects to be called in a buffer which contains a mail message to be spooled, and the buffer should be narrowed to the message headers. It returns a list of groups to which the message should be spooled, using the addresses in the headers and information from BBDB." (let ((prq (list (list 0) (list 1) (list 2) (list 3)))) ;; the From: header is special (let* ((hdr (or (mail-fetch-field "resent-from") (mail-fetch-field "from") (user-login-name))) (rv (bbdb/gnus-split-to-group hdr t))) (setcdr (nth (cdr rv) prq) (list (car rv)))) ;; do the rest of the headers (let ((hdr (or (concat (or (mail-fetch-field "resent-to" nil t) (mail-fetch-field "to" nil t)) ", " (mail-fetch-field "cc" nil t) ", " (mail-fetch-field "apparently-to" nil t)) ""))) (dolist (address (bbdb-extract-address-components hdr t)) (let* ((rv (bbdb/gnus-split-to-group address)) (pr (nth (cdr rv) prq))) (unless (member-ignore-case (car rv) pr) (setcdr pr (cons (car rv) (cdr pr))))))) ;; find the highest non-empty queue (setq prq (reverse prq)) (while (and prq (not (cdr (car prq)))) (setq prq (cdr prq))) ;; and return... (if (not (or (not (cdr (car prq))) (and (equal (cdr (car prq)) (list bbdb/gnus-split-default-group)) (symbolp bbdb/gnus-split-nomatch-function) (fboundp bbdb/gnus-split-nomatch-function)))) (cdr (car prq)) (goto-char (point-min)) (funcall bbdb/gnus-split-nomatch-function)))) (defun bbdb/gnus-split-to-group (address &optional source) "This function is called from `bbdb/gnus-split-method' in order to determine the group and spooling priority for a single address." (condition-case nil (let* ((tmp (bbdb-extract-address-components address)) (mail (cadr tmp)) (record (car (bbdb-message-search (car tmp) mail))) public private rgx) (when record (setq private (bbdb-record-xfield record bbdb/gnus-split-private-field) public (bbdb-record-xfield record bbdb/gnus-split-public-field)) (if (and public (not source) (string-match "^\\([^ ]+\\) \\(.*\\)$" public)) (setq rgx (substring public (match-beginning 2) (match-end 2)) public (substring public (match-beginning 1) (match-end 1))) (setq public nil))) (cond ((and rgx public (goto-char (point-min)) (re-search-forward "^From: \\([^ \n]+\\)[ \n]" nil t) (string-match rgx (buffer-substring (match-beginning 1) (match-end 1)))) (cons public 3)) (private (cons private (- 1 (if source -1 0) (if (string-match bbdb/gnus-split-myaddr-regexp mail) 1 0)))) (t (cons bbdb/gnus-split-default-group (cond ((string-match bbdb/gnus-split-myaddr-regexp mail) 0) (source 2) (bbdb/gnus-split-crosspost-default 1) (t 0)))))) (error (cons bbdb/gnus-split-default-group 0)))) ;; ;; Imap support (Uwe Brauer) ;; ;;;###autoload (defun bbdb/gnus-nnimap-folder-list-from-bbdb () "Return a list of \( \"From\" mail-regexp imap-folder-name\) tuples based on the contents of the bbdb. The folder-name is the value of the 'imap attribute of the BBDB record; the mail-regexp consists of all the mail addresses for the BBDB record concatenated with OR. Records without an 'imap attribute are ignored. Here is an example of a relevant BBDB record: Uwe Brauer mail: oub@mat.ucm.es imap: testimap This function uses `regexp-opt' to generate the mail-regexp which automatically `regexp-quote's its arguments. Please note: in order that this will work with the `nnimap-split-fancy' method you have to use macros, that is your setting will look like: \(setq nnimap-split-rule 'nnimap-split-fancy nnimap-split-inbox \"INBOX\" nnimap-split-fancy `\(| ,@\(bbdb/gnus-nnimap-folder-list-from-bbdb\) ... \)\) Note that `\( is the backquote, NOT the quote '\(." (let (;; the value of the 'imap attribute of a bbdb record folder-attr ;; a regexp matching all the mail addresses from a bbdb record mail-regexp ;; the list of (folder mail) tuples to return new-elmnt-list) ;; Loop over BBDB records. If an imap attribute exists for ;; the record, generate a regexp matching all the mail addresses ;; and add a tuple (folder mail-regexp) to the new-elmnt-list (dolist (record (bbdb-records)) (when (setq folder-attr (bbdb-record-xfield record 'imap)) (setq mail-regexp (regexp-opt (mapcar 'downcase (bbdb-record-mail record)))) (unless (string= "" mail-regexp) (push (list "From" mail-regexp folder-attr) new-elmnt-list)))) new-elmnt-list)) (provide 'bbdb-gnus-aux) ;;; bbdb-gnus-aux.el ends here bbdb3-3.2/lisp/bbdb-gnus.el000066400000000000000000000053411322420162700154700ustar00rootroot00000000000000;;; bbdb-gnus.el --- BBDB interface to Gnus -*- lexical-binding: t -*- ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; This file is part of the Insidious Big Brother Database (aka BBDB), ;; BBDB 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. ;; BBDB 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 BBDB. If not, see . ;;; Commentary: ;;; This file contains the BBDB interface to Gnus. ;;; See the BBDB info manual for documentation. ;;; Code: (require 'bbdb) (require 'bbdb-com) (require 'bbdb-mua) (require 'gnus) ;;; Insinuation ;;;###autoload (defun bbdb-insinuate-gnus () "Hook BBDB into Gnus. Do not call this in your init file. Use `bbdb-initialize'." ;; `bbdb-mua-display-sender' fails in *Article* buffers, where ;; `gnus-article-read-summary-keys' provides an additional wrapper ;; that restores the window configuration. (define-key gnus-summary-mode-map ":" 'bbdb-mua-display-sender) (define-key gnus-article-mode-map ":" 'bbdb-mua-display-sender) ;; For `bbdb-mua-edit-field-sender' it is probably OK if ;;`gnus-article-read-summary-keys' restores the window configuration. (define-key gnus-summary-mode-map ";" 'bbdb-mua-edit-field-sender) (define-key gnus-article-mode-map ";" 'bbdb-mua-edit-field-sender) ;; Do we need keybindings for more commands? Suggestions welcome. ;; (define-key gnus-summary-mode-map ":" 'bbdb-mua-display-records) ;; (define-key gnus-summary-mode-map "'" 'bbdb-mua-display-recipients) ;; (define-key gnus-summary-mode-map ";" 'bbdb-mua-edit-field-recipients) ;; Set up user field for use in `gnus-summary-line-format' ;; (1) Big solution: use whole name (if bbdb-mua-summary-unify-format-letter (defalias (intern (concat "gnus-user-format-function-" bbdb-mua-summary-unify-format-letter)) (lambda (header) (bbdb-mua-summary-unify (mail-header-from header))))) ;; (2) Small solution: a mark for messages whose sender is in BBDB. (if bbdb-mua-summary-mark-format-letter (defalias (intern (concat "gnus-user-format-function-" bbdb-mua-summary-mark-format-letter)) (lambda (header) (bbdb-mua-summary-mark (mail-header-from header)))))) (provide 'bbdb-gnus) ;;; bbdb-gnus.el ends here bbdb3-3.2/lisp/bbdb-ispell.el000066400000000000000000000115741322420162700160110ustar00rootroot00000000000000;;; bbdb-ispell.el --- export names from BBDB to personal ispell dictionaries -*- lexical-binding: t -*- ;; Copyright (C) 2011-2017 Free Software Foundation, Inc. ;; Author: Ivan Kanis ;; This file is part of the Insidious Big Brother Database (aka BBDB), ;; BBDB 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. ;; BBDB 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 BBDB. If not, see . ;;; Commentary: ;; ;; Names are often not recognized by the standard ispell dictionaries. ;; `bbdb-ispell-export' exports the names from your BBDB records to your ;; personal ispell dictionaries. ;; The personal dictionaries are in `bbdb-ispell-dictionary-list' ;; The BBDB fields for this are in `bbdb-ispell-field-list'. ;; Exclude words via `bbdb-ispell-min-word-length' and `bbdb-ispell-ignore-re'. ;; ;; Bugs: ;; Save your personal directories before running this code. I had my ;; dictionary truncated while debugging. It shouldn't happen ;; but better be safe than sorry... ;; ;; See the BBDB info manual for documentation. ;;; Code: (require 'ispell) (require 'bbdb) (defcustom bbdb-ispell-dictionary-list '("default") "List of ispell personal dictionaries. Allowed elements are as in the return value of `ispell-valid-dictionary-list'." :group 'bbdb-utilities-ispell :type (cons 'set (mapcar (lambda (dict) `(string ,dict)) (ispell-valid-dictionary-list)))) (defcustom bbdb-ispell-field-list '(name organization aka) "List of fields of each BBDB record considered for the personal dictionary." :group 'bbdb-utilities-ispell :type (list 'repeat (append '(choice) (mapcar (lambda (field) `(const ,field)) '(name organization affix aka address)) '((symbol :tag "xfield"))))) (defcustom bbdb-ispell-min-word-length 3 "Words with fewer characters are ignored." :group 'bbdb-utilities-ispell :type 'number) (defcustom bbdb-ispell-ignore-re "[^[:alpha:]]" "Words matching this regexp are ignored." :group 'bbdb-utilities-ispell :type 'regexp) ;; Internal variable (defvar bbdb-ispell-word-list nil "List of words extracted from the BBDB records.") ;;;###autoload (defun bbdb-ispell-export () "Export BBDB records to ispell personal dictionaries." (interactive) (message "Exporting to personal dictionary...") (let (bbdb-ispell-word-list) ;; Collect words from BBDB records. (dolist (record (bbdb-records)) (dolist (field bbdb-ispell-field-list) (bbdb-ispell-collect-words (bbdb-record-field record field)))) ;; Update personal dictionaries (dolist (dict (or bbdb-ispell-dictionary-list '("default"))) (ispell-change-dictionary dict) ;; Initialize variables and dicts alists (ispell-set-spellchecker-params) (ispell-init-process) ;; put in verbose mode (ispell-send-string "%\n") (let (new) (dolist (word (delete-dups bbdb-ispell-word-list)) (ispell-send-string (concat "^" word "\n")) (while (progn (ispell-accept-output) (not (string= "" (car ispell-filter))))) ;; remove extra \n (setq ispell-filter (cdr ispell-filter)) (when (and ispell-filter (listp ispell-filter) (not (eq (ispell-parse-output (car ispell-filter)) t))) ;; ok the word doesn't exist, add it (ispell-send-string (concat "*" word "\n")) (setq new t))) (when new ;; Save dictionary: ;; aspell doesn't tell us when it completed the saving. ;; So we send it another word for spellchecking. (ispell-send-string "#\n^hello\n") (while (progn (ispell-accept-output) (not (string= "" (car ispell-filter))))))))) (message "Exporting to personal dictionary...done")) (defun bbdb-ispell-collect-words (field) "Parse BBDB FIELD and collect words in `bbdb-ispell-word-list'." ;; Ignore everything in FIELD that is not a string or a sequence. (cond ((stringp field) (dolist (word (split-string field)) (if (and (>= (length word) bbdb-ispell-min-word-length) (not (string-match bbdb-ispell-ignore-re word))) (push word bbdb-ispell-word-list)))) ((sequencep field) (mapc 'bbdb-ispell-collect-words field)))) (provide 'bbdb-ispell) ;;; bbdb-ispell.el ends here bbdb3-3.2/lisp/bbdb-message.el000066400000000000000000000042031322420162700161340ustar00rootroot00000000000000;;; bbdb-message.el --- BBDB interface to Mail Composition Packages. -*- lexical-binding: t -*- ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; This file is part of the Insidious Big Brother Database (aka BBDB), ;; BBDB 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. ;; BBDB 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 BBDB. If not, see . ;;; Commentary: ;;; This file contains the BBDB interface to Mail Composition Packages. ;;; See the BBDB info manual for documentation. ;;; Code: (require 'bbdb) (require 'message) (require 'sendmail) ;;;###autoload (defun bbdb-insinuate-message () "Hook BBDB into Message Mode. Do not call this in your init file. Use `bbdb-initialize'." ;; Suggestions welcome: What are good keybindings for the following ;; commands that do not collide with existing bindings? ;; (define-key message-mode-map "'" 'bbdb-mua-display-recipients) ;; (define-key message-mode-map ";" 'bbdb-mua-edit-field-recipients) ;; (define-key message-mode-map "/" 'bbdb) (if bbdb-complete-mail (define-key message-mode-map "\M-\t" 'bbdb-complete-mail))) ;;;###autoload (defun bbdb-insinuate-mail () "Hook BBDB into Mail Mode. Do not call this in your init file. Use `bbdb-initialize'." ;; Suggestions welcome: What are good keybindings for the following ;; commands that do not collide with existing bindings? ;; (define-key mail-mode-map "'" 'bbdb-mua-display-recipients) ;; (define-key mail-mode-map ";" 'bbdb-mua-edit-field-recipients) ;; (define-key mail-mode-map "/" 'bbdb) (if bbdb-complete-mail (define-key mail-mode-map "\M-\t" 'bbdb-complete-mail))) (provide 'bbdb-message) ;;; bbdb-message.el ends here bbdb3-3.2/lisp/bbdb-mhe.el000066400000000000000000000074201322420162700152650ustar00rootroot00000000000000;;; bbdb-mhe.el --- BBDB interface to mh-e -*- lexical-binding: t -*- ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; This file is part of the Insidious Big Brother Database (aka BBDB), ;; BBDB 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. ;; BBDB 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 BBDB. If not, see . ;;; Commentary: ;;; This file contains the BBDB interface to mh-e. ;;; See the BBDB info manual for documentation. ;;; Code: (require 'bbdb) (require 'bbdb-com) (require 'bbdb-mua) (require 'mh-e) (if (fboundp 'mh-version) (require 'mh-comp)) ; For mh-e 4.x (require 'advice) ;; A simplified `mail-fetch-field'. We could use instead (like rmail): ;; (mail-header (intern-soft (downcase header)) (mail-header-extract)) ;;;###autoload (defun bbdb/mh-header (header) "Find and return the value of HEADER in the current buffer. Returns the empty string if HEADER is not in the message." (let ((case-fold-search t)) (goto-char (point-min)) ;; This will be fooled if HEADER appears in the body of the message. ;; Also, it fails if HEADER appears more than once. (cond ((not (re-search-forward header nil t)) "") ((looking-at "[\t ]*$") "") (t (re-search-forward "[ \t]*\\([^ \t\n].*\\)$" nil t) (let ((start (match-beginning 1))) (while (progn (forward-line 1) (looking-at "[ \t]"))) (backward-char 1) (buffer-substring-no-properties start (point))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Use BBDB for interactive spec of MH-E commands (defadvice mh-send (before mh-bbdb-send act) (interactive (list (bbdb-completing-read-mails "To: ") (bbdb-completing-read-mails "Cc: ") (read-string "Subject: ")))) (defadvice mh-send-other-window (before mh-bbdb-send-other act) (interactive (list (bbdb-completing-read-mails "To: ") (bbdb-completing-read-mails "Cc: ") (read-string "Subject: ")))) (defadvice mh-forward (before mh-bbdb-forward act) (interactive (list (bbdb-completing-read-mails "To: ") (bbdb-completing-read-mails "Cc: ") (if current-prefix-arg (mh-read-seq-default "Forward" t) (mh-get-msg-num t))))) (defadvice mh-redistribute (before mh-bbdb-redist act) (interactive (list (bbdb-completing-read-mails "Redist-To: ") (bbdb-completing-read-mails "Redist-Cc: ") (mh-get-msg-num t)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;###autoload (defun bbdb-insinuate-mh () "Call this function to hook BBDB into MH-E. Do not call this in your init file. Use `bbdb-initialize'." (define-key mh-folder-mode-map ":" 'bbdb-mua-display-sender) (define-key mh-folder-mode-map ";" 'bbdb-mua-edit-field-sender) ;; Do we need keybindings for more commands? Suggestions welcome. ;; (define-key mh-folder-mode-map ":" 'bbdb-mua-display-records) ;; (define-key mh-folder-mode-map "'" 'bbdb-mua-display-recipients) ;; (define-key mh-folder-mode-map ";" 'bbdb-mua-edit-field-recipients) (when bbdb-complete-mail (define-key mh-letter-mode-map "\M-;" 'bbdb-complete-mail) (define-key mh-letter-mode-map "\e\t" 'bbdb-complete-mail))) (provide 'bbdb-mhe) ;;; bbdb-mhe.el ends here bbdb3-3.2/lisp/bbdb-migrate.el000066400000000000000000000273441322420162700161530ustar00rootroot00000000000000;;; bbdb-migrate.el --- migration functions for BBDB -*- lexical-binding: t -*- ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; This file is part of the Insidious Big Brother Database (aka BBDB), ;; BBDB 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. ;; BBDB 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 BBDB. If not, see . ;;; Commentary: ;;; This file contains the migration functions for BBDB. ;;; See the BBDB info manual for documentation. ;; Changes in `bbdb-file-format': ;; 3 Date format for `creation-date' and `timestamp' changed ;; from "dd mmm yy" (ex: 25 Sep 97) to "yyyy-mm-dd" (ex: 1997-09-25). ;; 4 Country field added. ;; 5 Streets are lists. ;; 6 Postcodes are plain strings. ;; 7 New field `affix'. Organizations are a list. ;; Xfields is always a list. ;; (8 Skipped format in "official BBDB": Some BBDB users introduced ;; an xfield uuid in their format 8. To bring them back, we jump ;; straight from 7 to 9.) ;; 9 New field uuid. Make `creation-date' and `timestamp' immutable fields. ;;; Code: (require 'bbdb) ;;; Migrating the BBDB (defvar bbdb-migrate-uuid-xfield 'uuid "Xfield holding a uuid in file format 8.") ;;;###autoload (defun bbdb-migrate (records old) "Migrate RECORDS from format OLD to `bbdb-file-format'." ;; Some BBDB files were corrupted by random outer layers of ;; parentheses surrounding the actual correct data. We attempt to ;; compensate for this. (while (and (consp records) (listp (car records)) (null (cdr records))) (setq records (car records))) ;; `bbdb-migrate-lambda' uses the usual functions to access and set ;; the fields of a record. So if a new record format changes ;; the set of fields, we need to make these changes first. ;; Format 7: Add new field `affix'. (if (< old 7) (let (new-records) (dolist (record records) (push (vector (elt record 0) (elt record 1) nil (elt record 2) (elt record 3) (elt record 4) (elt record 5) (elt record 6) (elt record 7) (elt record 8)) new-records)) (setq records (nreverse new-records)))) ;; Format 9: New field `uuid'. ;; Make `creation-date' and `timestamp' immutable fields. (if (< old 9) (let (new-records) (dolist (record records) (let ((uuid (or (cdr (assq bbdb-migrate-uuid-xfield (elt record 8))) (bbdb-uuid))) (creation-date (or (cdr (assq 'creation-date (elt record 8))) (format-time-string bbdb-time-stamp-format nil t))) (timestamp (or (cdr (assq 'timestamp (elt record 8))) (format-time-string bbdb-time-stamp-format nil t)))) (push (vector (elt record 0) (elt record 1) (elt record 2) (elt record 3) (elt record 4) (elt record 5) (elt record 6) (elt record 7) (let ((xfields (elt record 8))) (dolist (elt '(uuid creation-date timestamp)) (setq xfields (assq-delete-all elt xfields))) xfields) uuid creation-date timestamp (elt record 9)) new-records))) (setq records (nreverse new-records)))) (mapc (bbdb-migrate-lambda old) records) records) (defconst bbdb-migrate-alist '((3 (bbdb-record-xfields bbdb-record-set-xfields bbdb-migrate-dates)) (4 (bbdb-record-address bbdb-record-set-address bbdb-migrate-add-country)) (5 (bbdb-record-address bbdb-record-set-address bbdb-migrate-streets-to-list)) (6 (bbdb-record-address bbdb-record-set-address bbdb-migrate-postcode-to-string)) (7 (bbdb-record-xfields bbdb-record-set-xfields bbdb-migrate-xfields-to-list) (bbdb-record-organization bbdb-record-set-organization bbdb-migrate-organization-to-list))) ;; Formats 8 and 9: do nothing "Alist (VERSION . CHANGES). CHANGES is a list with elements (GET SET FUNCTION) that expands to action (SET record (FUNCTION (GET record))).") (defun bbdb-migrate-lambda (old) "Return the function to migrate from OLD to `bbdb-file-format'. The manipulations are defined by `bbdb-migrate-alist'." (let (spec) (while (<= old bbdb-file-format) (setq spec (append spec (cdr (assoc old bbdb-migrate-alist))) old (1+ old))) `(lambda (record) ,@(mapcar (lambda (change) ;; (SET record (FUNCTION (GET record))) `(,(nth 1 change) record ; SET (,(nth 2 change) ; FUNCTION (,(nth 0 change) record)))) ; GET spec) record))) (defun bbdb-migrate-postcode-to-string (addresses) "Make all postcodes plain strings. This uses the code that used to be in `bbdb-address-postcode'." ;; apply the function to all addresses in the list and return a ;; modified list of addresses (mapcar (lambda (address) (let ((postcode (bbdb-address-postcode address))) (bbdb-address-set-postcode address (cond ((stringp postcode) postcode) ;; nil or zero ((or (zerop postcode) (null postcode)) "") ;; a number ((numberp postcode) (format "%d" postcode)) ;; list with two strings ((and (stringp (nth 0 postcode)) (stringp (nth 1 postcode))) ;; the second string starts with 4 digits (if (string-match "^[0-9][0-9][0-9][0-9]" (nth 1 postcode)) (format "%s-%s" (nth 0 postcode) (nth 1 postcode)) ;; ("abc" "efg") (format "%s %s" (nth 0 postcode) (nth 1 postcode)))) ;; list with two numbers ((and (integerp (nth 0 postcode)) (integerp (nth 1 postcode))) (format "%05d-%04d" (nth 0 postcode) (nth 1 postcode))) ;; list with a string and a number ((and (stringp (nth 0 postcode)) (integerp (nth 1 postcode))) (format "%s-%d" (nth 0 postcode) (nth 1 postcode))) ;; ("SE" (123 45)) ((and (stringp (nth 0 postcode)) (integerp (nth 0 (nth 1 postcode))) (integerp (nth 1 (nth 1 postcode)))) (format "%s-%d %d" (nth 0 postcode) (nth 0 (nth 1 postcode)) (nth 1 (nth 1 postcode)))) ;; last possibility (t (format "%s" postcode))))) address) addresses)) (defun bbdb-migrate-dates (xfields) "Change date formats. Formats are changed in timestamp and creation-date fields from \"dd mmm yy\" to \"yyyy-mm-dd\"." (unless (stringp xfields) (mapc (lambda (xfield) (when (memq (car xfield) '(creation-date timestamp)) (bbdb-migrate-date xfield))) xfields) xfields)) (defun bbdb-migrate-date (field) "Convert date field FIELD from \"dd mmm yy\" to \"yyyy-mm-dd\"." (let* ((date (cdr field)) (parsed (timezone-parse-date (concat date " 00:00:00")))) ;; If `timezone-parse-date' cannot make sense of its arg DATE ;; it returns ["0" "0" "0" "0" nil]. (if (equal parsed ["0" "0" "0" "0" nil]) (setq parsed (timezone-parse-date date))) (when (equal parsed ["0" "0" "0" "0" nil]) (cond ((string-match "^\\([0-9]\\{4\\}\\)[-/]\\([ 0-9]?[0-9]\\)[-/]\\([ 0-9]?[0-9]\\)" date) (setq parsed (vector (match-string 1 date) (match-string 2 date) (match-string 3 date)))) ((string-match "^\\([ 0-9]?[0-9]\\)[-/]\\([ 0-9]?[0-9]\\)[-/]\\([0-9]\\{4\\}\\)" date) (setq parsed (vector (match-string 3 date) (match-string 1 date) (match-string 2 date)))))) ;; We need numbers for the following sanity check (dotimes (i 3) (if (stringp (aref parsed i)) (aset parsed i (string-to-number (aref parsed i))))) ;; Sanity check (if (and (< 0 (aref parsed 0)) (< 0 (aref parsed 1)) (< (aref parsed 1) 13) (< 0 (aref parsed 2)) (<= (aref parsed 2) (timezone-last-day-of-month (aref parsed 1) (aref parsed 0)))) (setcdr field (format "%04d-%02d-%02d" (aref parsed 0) (aref parsed 1) (aref parsed 2))) (error "BBDB cannot parse %s header value %S for upgrade" field date)))) (defun bbdb-migrate-add-country (addrl) "Add a country field to each address in the address list." (mapcar (lambda (address) (vconcat address [bbdb-default-country])) addrl)) (defun bbdb-migrate-streets-to-list (addrl) "Convert the streets to a list." (mapcar (lambda (address) (vector (aref address 0) ; key (delq nil (delete "" ; nuke empties (list (aref address 1) ; street1 (aref address 2) ; street2 (aref address 3))));street3 (aref address 4) ; city (aref address 5) ; state (aref address 6) ; postcode (aref address 7))) ; country addrl)) (defun bbdb-migrate-xfields-to-list (xfields) "Migrate XFIELDS to list." (if (stringp xfields) `((notes . ,xfields)) xfields)) (defun bbdb-migrate-organization-to-list (organization) "Migrate ORGANIZATION to list." (if (stringp organization) (bbdb-split 'organization organization) organization)) ;;;###autoload (defun bbdb-undocumented-variables (&optional name-space message) "Return list of undocumented variables in NAME-SPACE. NAME-SPACE defaults to \"bbdb-\". Use a prefix arg to specify NAME-SPACE interactively. If MESSAGE is non-nil (as in interactive calls) display the list in the message area. This command may come handy to identify BBDB variables in your init file that are not used anymore by the current version of BBDB. Yet this fails for outdated BBDB variables that are set via your personal `custom-file'." (interactive (list (if current-prefix-arg (read-string "Name space: ")) t)) (let ((re (concat "\\`" (or name-space "bbdb-"))) list) (mapatoms (lambda (vv) (if (and (boundp vv) (string-match re (symbol-name vv)) (not (get vv 'variable-documentation)) (not (get vv 'byte-obsolete-variable))) (push vv list)))) (if message (if list (apply 'message (concat "Undocumented variables: " (mapconcat (lambda (_m) "%s") list " ")) list) (message "No undocumented variables `%s...'" name-space))) list)) (provide 'bbdb-migrate) ;;; bbdb-migrate.el ends here bbdb3-3.2/lisp/bbdb-mu4e.el000066400000000000000000000030401322420162700153600ustar00rootroot00000000000000;;; bbdb-mu4e.el --- BBDB interface to mu4e -*- lexical-binding: t -*- ;; Copyright (C) 2015-2017 Free Software Foundation, Inc. ;; This file is part of the Insidious Big Brother Database (aka BBDB), ;; BBDB 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. ;; BBDB 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 BBDB. If not, see . ;;; Commentary: ;; This file contains the BBDB interface to mu4e. ;; See the BBDB info manual for documentation. ;;; Code: (require 'bbdb) (if t (require 'mu4e-view)) (defvar mu4e-view-mode-map) ;;;###autoload (defun bbdb-insinuate-mu4e () "Hook BBDB into mu4e. Do not call this in your init file. Use `bbdb-initialize'." ;; Tackle headers later ;; (define-key mu4e-headers-mode-map ":" 'bbdb-mua-display-sender) ;; (define-key mu4e-headers-mode-map ";" 'bbdb-mua-edit-field-sender) ;; Do we need keybindings for more commands? Suggestions welcome. (define-key mu4e-view-mode-map ":" 'bbdb-mua-display-sender) (define-key mu4e-view-mode-map ";" 'bbdb-mua-edit-field-sender)) (provide 'bbdb-mu4e) ;;; bbdb-mu4e.el ends here bbdb3-3.2/lisp/bbdb-mua.el000066400000000000000000001416451322420162700153060ustar00rootroot00000000000000;;; bbdb-mua.el --- various MUA functionality for BBDB -*- lexical-binding: t -*- ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; This file is part of the Insidious Big Brother Database (aka BBDB), ;; BBDB 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. ;; BBDB 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 BBDB. If not, see . ;;; Commentary: ;; This file provides various additional functionality for BBDB ;; See the BBDB info manual for documentation. ;; This file lets you do stuff like ;; ;; o automatically add some string to some field(s) based on the ;; contents of header fields of the current message ;; o only automatically create records when certain header fields ;; are matched ;; o do not automatically create records when certain header fields ;; are matched ;; ;; Read the docstrings; read the texinfo file. ;;; Code: (require 'bbdb) (require 'bbdb-com) (eval-and-compile (autoload 'gnus-fetch-original-field "gnus-utils") (autoload 'gnus-summary-select-article "gnus-sum") (defvar gnus-article-buffer) (autoload 'bbdb/vm-header "bbdb-vm") (autoload 'vm-follow-summary-cursor "vm-motion") (autoload 'vm-select-folder-buffer "vm-macro") (autoload 'vm-check-for-killed-summary "vm-misc") (autoload 'vm-error-if-folder-empty "vm-misc") (autoload 'bbdb/rmail-header "bbdb-rmail") (defvar rmail-buffer) (autoload 'bbdb/mh-header "bbdb-mhe") (autoload 'mh-show "mh-show") (defvar mh-show-buffer) (defvar mu4e~view-buffer-name) (autoload 'bbdb/wl-header "bbdb-wl") (autoload 'message-field-value "message") (autoload 'mail-decode-encoded-word-string "mail-parse")) (defconst bbdb-mua-mode-alist '((vm vm-mode vm-virtual-mode vm-summary-mode vm-presentation-mode) (gnus gnus-summary-mode gnus-article-mode gnus-tree-mode) (rmail rmail-mode rmail-summary-mode) (mh mhe-mode mhe-summary-mode mh-folder-mode) (mu4e mu4e-view-mode) ; Tackle `mu4e-headers-mode' later (wl wl-summary-mode wl-draft-mode) (message message-mode mu4e-compose-mode notmuch-message-mode) (mail mail-mode)) "Alist of MUA modes supported by BBDB. Each element is of the form (MUA MODE MODE ...), where MODEs are used by MUA.") (defun bbdb-mua () "For the current message return the MUA. Return values include gnus Newsreader Gnus rmail Reading Mail in Emacs vm Viewmail mh Emacs interface to the MH mail system (aka MH-E) mu4e Mu4e wl Wanderlust message Mail and News composition mode that goes with Gnus mail Emacs Mail Mode." (let ((mm-alist bbdb-mua-mode-alist) elt mua) (while (setq elt (pop mm-alist)) (if (memq major-mode (cdr elt)) (setq mua (car elt) mm-alist nil))) (or mua (error "BBDB: MUA `%s' not supported" major-mode)))) ;;;###autoload (defun bbdb-message-header (header) "For the current message return the value of HEADER. MIME encoded headers are decoded. Return nil if HEADER does not exist." ;; RW: If HEADER was allowed to be a regexp and the content of multiple ;; matching headers was concatenated as in `message-field-value', ;; this would simplify the usage of `bbdb-accept-message-alist' and ;; `bbdb-ignore-message-alist'. ;; RW: If this function had a remember table, it could look up the value ;; of a header if we request the value of the same header multiple times. ;; (We would reset the remember table each time we move on to a new message.) (let* ((mua (bbdb-mua)) (val (cond (;; It seems that `gnus-fetch-field' fetches decoded content of ;; `gnus-visible-headers', ignoring `gnus-ignored-headers'. ;; Here we use instead `gnus-fetch-original-field' that fetches ;; the encoded content of `gnus-original-article-buffer'. ;; Decoding makes this possibly a bit slower, but something like ;; `bbdb-select-message' does not get fooled by an apparent ;; absence of some headers. ;; See http://permalink.gmane.org/gmane.emacs.gnus.general/78741 (eq mua 'gnus) (gnus-fetch-original-field header)) ((eq mua 'vm) (bbdb/vm-header header)) ((eq mua 'rmail) (bbdb/rmail-header header)) ((eq mua 'mh) (bbdb/mh-header header)) ((eq mua 'mu4e) (message-field-value header)) ((eq mua 'wl) (bbdb/wl-header header)) ((memq mua '(message mail)) (message-field-value header)) (t (error "BBDB/%s: header function undefined" mua))))) (if val (mail-decode-encoded-word-string val)))) (defsubst bbdb-message-header-re (header regexp) "Return non-nil if REGEXP matches value of HEADER." (let ((val (bbdb-message-header header)) (case-fold-search t)) ; RW: Is this what we want? (and val (string-match regexp val)))) ;;; Update database ;;;###autoload (defun bbdb-accept-message (&optional invert) "For use with variable `bbdb-mua-update-interactive-p' and friends. Return the value of variable `bbdb-update-records-p' for messages matching `bbdb-accept-message-alist'. If INVERT is non-nil, accept messages not matching `bbdb-ignore-message-alist'." (let ((rest (if invert bbdb-ignore-message-alist bbdb-accept-message-alist)) done elt) (if (eq rest t) (setq done t) (while (and (setq elt (pop rest)) (not done)) (dolist (header (if (stringp (car elt)) (list (car elt)) (car elt))) (if (bbdb-message-header-re header (cdr elt)) (setq done t))))) (if invert (setq done (not done))) (if done bbdb-update-records-p))) ;;;###autoload (defun bbdb-ignore-message (&optional invert) "For use with variable `bbdb-mua-update-interactive-p' and friends. Return the value of variable `bbdb-update-records-p' for messages not matching `bbdb-ignore-message-alist'. If INVERT is non-nil, accept messages matching `bbdb-accept-message-alist'." (bbdb-accept-message (not invert))) ;;;###autoload (defun bbdb-select-message () "For use with variable `bbdb-mua-update-interactive-p' and friends. Return the value of variable `bbdb-update-records-p' for messages both matching `bbdb-accept-message-alist' and not matching `bbdb-ignore-message-alist'." (and (bbdb-accept-message) (bbdb-ignore-message))) (defun bbdb-get-address-components (&optional header-class ignore-address) "Extract mail addresses from a message. Return list with elements (NAME EMAIL HEADER HEADER-CLASS MUA). HEADER-CLASS is defined in `bbdb-message-headers'. If HEADER-CLASS is nil, use all classes in `bbdb-message-headers'. If regexp IGNORE-ADDRESS matches NAME or EMAIL of an address, this address is ignored. If IGNORE-ADDRESS is nil, use value of `bbdb-user-mail-address-re'." ;; We do not use `bbdb-message-all-addresses' here because only when we ;; have compared the addresses with the records in BBDB do we know which ;; address(es) are relevant for us. (let ((message-headers (if header-class (list (assoc header-class bbdb-message-headers)) bbdb-message-headers)) (mua (bbdb-mua)) (ignore-address (or ignore-address bbdb-user-mail-address-re)) address-list name mail mail-list content) (dolist (headers message-headers) (dolist (header (cdr headers)) (when (setq content (bbdb-message-header header)) ;; Always extract all addresses because we do not know yet which ;; address might match IGNORE-ADDRESS. (dolist (address (bbdb-extract-address-components content t)) ;; We canonicalize name and mail as early as possible. (setq name (car address) mail (cadr address)) ;; ignore uninteresting addresses (unless (or (and (stringp ignore-address) (or (and name (string-match ignore-address name)) (and mail (string-match ignore-address mail)))) (and mail (member-ignore-case mail mail-list))) ;; Add each address only once. (Use MAIL-LIST for book keeping.) ;; Thus if we care about whether an address gets associated with ;; one or another header, the order of elements in ;; `bbdb-message-headers' is relevant. The "most important" ;; headers should be first in `bbdb-message-headers'. (if mail (push mail mail-list)) (push (list name mail header (car headers) mua) address-list)))))) (or (nreverse address-list) (and header-class bbdb-message-try-all-headers ;; Try again the remaining header classes (let ((bbdb-message-headers (remove (assoc header-class bbdb-message-headers) bbdb-message-headers))) (bbdb-get-address-components nil ignore-address)))))) ;;;###autoload (defun bbdb-update-records (address-list &optional update-p sort) "Return the list of BBDB records matching ADDRESS-LIST. ADDRESS-LIST is a list of mail addresses. (It can be extracted from a mail message using `bbdb-get-address-components'.) UPDATE-P may take the following values: search Search for existing records matching ADDRESS. update Search for existing records matching ADDRESS; update name and mail field if necessary. query Search for existing records matching ADDRESS; query for creation of a new record if the record does not exist. create or t Search for existing records matching ADDRESS; create a new record if it does not yet exist. nil Do nothing. a function This functions will be called with no arguments. It should return one of the above values. If SORT is non-nil, sort records according to `bbdb-record-lessp'. Ottherwise, the records are ordered according to ADDRESS-LIST. Usually this function is called by the wrapper `bbdb-mua-update-records'." ;; UPDATE-P allows filtering of complete messages. ;; Filtering of individual addresses within an accepted message ;; is done by `bbdb-get-address-components' using `bbdb-user-mail-address-re'. ;; We resolve UPDATE-P repeatedly. This is needed, for example, ;; with the chain `bbdb-mua-auto-update-p' -> `bbdb-select-message' ;; -> `bbdb-update-records-p'. (while (and (functionp update-p) ;; Bad! `search' is a function in `cl-seq.el'. (not (eq update-p 'search))) (setq update-p (funcall update-p))) (cond ((eq t update-p) (setq update-p 'create)) ((not (memq update-p '(search update query create nil))) (error "Illegal value of arg update-p: %s" update-p))) (let (;; `bbdb-update-records-p' and `bbdb-offer-to-create' are used here ;; as internal variables for communication with `bbdb-query-create'. ;; This does not affect the value of the global user variable ;; `bbdb-update-records-p'. (bbdb-offer-to-create 'start) (bbdb-update-records-p update-p) address records) (when update-p (while (setq address (pop address-list)) (let* ((bbdb-update-records-address address) hits (task (catch 'done (setq hits ;; We put the call of `bbdb-notice-mail-hook' ;; into `bbdb-annotate-message' so that this hook ;; runs only if the user agreed to change a record. (cond ((or bbdb-read-only (eq bbdb-update-records-p 'search)) ;; Search for records having this mail address ;; but do not modify an existing record. ;; This does not run `bbdb-notice-mail-hook'. (bbdb-message-search (car address) (cadr address))) ((eq bbdb-update-records-p 'update) (bbdb-annotate-message address 'update)) ((eq bbdb-update-records-p 'query) (bbdb-annotate-message address 'bbdb-query-create)) ((eq bbdb-update-records-p 'create) (bbdb-annotate-message address 'create)))) nil))) (cond ((eq task 'quit) (setq address-list nil)) ((not (eq task 'next)) (dolist (hit (delq nil (nreverse hits))) (bbdb-pushnew hit records)))) (if (and records (not bbdb-message-all-addresses)) (setq address-list nil)))) (setq records (if sort (sort records 'bbdb-record-lessp) ;; Make RECORDS a list ordered like ADDRESS-LIST. (nreverse records)))) ;; `bbdb-message-search' might yield multiple records (if (and records (not bbdb-message-all-addresses)) (setq records (list (car records)))) (unless bbdb-read-only (bbdb-editable) (dolist (record records) (run-hook-with-args 'bbdb-notice-record-hook record))) records)) (defun bbdb-query-create () "Interactive query used by `bbdb-update-records'. Return t if the record should be created or `nil' otherwise. Honor previous answers such as `!'." (let ((task bbdb-offer-to-create)) ;; If we have remembered what the user typed previously, ;; `bbdb-offer-to-create' holds a character, i.e., a number. ;; -- Right now, we only remember "!". (when (not (integerp task)) (let ((prompt (format "%s is not in BBDB; add? (y,!,n,s,q,?) " (or (nth 0 bbdb-update-records-address) (nth 1 bbdb-update-records-address)))) event) (while (not event) (setq event (read-key-sequence prompt)) (setq event (if (stringp event) (aref event 0)))) (setq task event) (message ""))) ; clear the message buffer (cond ((eq task ?y) t) ((eq task ?!) (setq bbdb-offer-to-create task) t) ((or (eq task ?n) (eq task ?\s)) (throw 'done 'next)) ((or (eq task ?q) (eq task ?\a)) ; ?\a = C-g (throw 'done 'quit)) ((eq task ?s) (setq bbdb-update-records-p 'search) (throw 'done 'next)) (t ; any other key sequence (save-window-excursion (let* ((buffer (get-buffer-create " *BBDB Help*")) (window (or (get-buffer-window buffer) (split-window (get-lru-window))))) (with-current-buffer buffer (special-mode) (let (buffer-read-only) (erase-buffer) (insert "Your answer controls how BBDB updates/searches for records. Type ? for this help. Type y to add the current record. Type ! to add all remaining records. Type n to skip the current record. (You might also type space) Type s to switch from annotate to search mode. Type q to quit updating records. No more search or annotation is done.") (set-buffer-modified-p nil) (goto-char (point-min))) (set-window-buffer window buffer) (fit-window-to-buffer window))) ;; Try again! (bbdb-query-create)))))) (defun bbdb-annotate-message (address &optional update-p) "Fill the records for message ADDRESS with as much info as possible. If a record for ADDRESS does not yet exist, UPDATE-P controls whether a new record is created for ADDRESS. UPDATE-P may take the values: update or nil Update existing records, never create a new record. query Query interactively whether to create a new record. create or t Create a new record. a function This functions will be called with no arguments. It should return one of the above values. Return the records matching ADDRESS or nil." (let* ((mail (nth 1 address)) ; possibly nil (name (unless (equal mail (car address)) (car address))) (records (bbdb-message-search name mail)) created-p new-records) (if (and (not records) (functionp update-p)) (setq update-p (funcall update-p))) (cond ((eq t update-p) (setq update-p 'create)) ((not update-p) (setq update-p 'update))) ;; Create a new record if nothing else fits. ;; In this way, we can fill the slots of the new record with ;; the same code that updates the slots of existing records. (unless (or records (eq update-p 'update) (not (or name mail))) ;; If there is no name, try to use the mail address as name (if (and bbdb-message-mail-as-name mail (or (null name) (string= "" name))) (setq name (funcall bbdb-message-clean-name-function mail))) (if (or (eq update-p 'create) (and (eq update-p 'query) (y-or-n-p (format "%s is not in the BBDB. Add? " (or name mail))))) (setq records (list (bbdb-empty-record)) created-p t))) (dolist (record records) (let* ((old-name (bbdb-record-name record)) (fullname (bbdb-divide-name (or name ""))) (fname (car fullname)) (lname (cdr fullname)) (mail mail) ;; possibly changed below (created-p created-p) (update-p update-p) change-p add-mails add-name ignore-redundant) ;; Analyze the name part of the record. (cond ((or (not name) ;; The following tests can differ for more complicated names (bbdb-string= name old-name) (and (equal fname (bbdb-record-firstname record)) ; possibly (equal lname (bbdb-record-lastname record))) ; nil (member-ignore-case name (bbdb-record-aka record)))) ; do nothing (created-p ; new record (bbdb-record-set-field record 'name (cons fname lname))) ((not (setq add-name (bbdb-add-job bbdb-add-name record name)))) ; do nothing ((numberp add-name) (unless bbdb-silent (message "name mismatch: \"%s\" changed to \"%s\"" old-name name) (sit-for add-name))) ((bbdb-eval-spec add-name (if old-name (format "Change name \"%s\" to \"%s\"? " old-name name) (format "Assign name \"%s\" to address \"%s\"? " name (car (bbdb-record-mail record))))) ;; Keep old-name as AKA? (when (and old-name (not (member-ignore-case old-name (bbdb-record-aka record)))) (if (bbdb-eval-spec (bbdb-add-job bbdb-add-aka record old-name) (format "Keep name \"%s\" as an AKA? " old-name)) (bbdb-record-set-field record 'aka (cons old-name (bbdb-record-aka record))) (bbdb-remhash old-name record))) (bbdb-record-set-field record 'name (cons fname lname)) (setq change-p 'name)) ;; make new name an AKA? ((and old-name (not (member-ignore-case name (bbdb-record-aka record))) (bbdb-eval-spec (bbdb-add-job bbdb-add-aka record name) (format "Make \"%s\" an alternate for \"%s\"? " name old-name))) (bbdb-record-set-field record 'aka (cons name (bbdb-record-aka record))) (setq change-p 'name))) ;; Is MAIL redundant compared with the mail addresses ;; that are already known for RECORD? (if (and mail (setq ignore-redundant (bbdb-add-job bbdb-ignore-redundant-mails record mail))) (let ((mails (bbdb-record-mail-canon record)) (case-fold-search t) redundant ml re) (while (setq ml (pop mails)) (if (and (setq re (bbdb-mail-redundant-re ml)) (string-match re mail)) (setq redundant ml mails nil))) (if redundant (cond ((numberp ignore-redundant) (unless bbdb-silent (message "%s: redundant mail `%s'" (bbdb-record-name record) mail) (sit-for ignore-redundant))) ((or (eq t ignore-redundant) bbdb-silent (y-or-n-p (format "Ignore redundant mail %s?" mail))) (setq mail redundant)))))) ;; Analyze the mail part of the new records (cond ((or (not mail) (equal mail "???") (member-ignore-case mail (bbdb-record-mail-canon record)))) ; do nothing (created-p ; new record (bbdb-record-set-field record 'mail (list mail))) ((not (setq add-mails (bbdb-add-job bbdb-add-mails record mail)))) ; do nothing ((numberp add-mails) (unless bbdb-silent (message "%s: new address `%s'" (bbdb-record-name record) mail) (sit-for add-mails))) ((or (eq add-mails t) ; add it automatically bbdb-silent (y-or-n-p (format "Add address \"%s\" to %s? " mail (bbdb-record-name record))) (and (or (and (functionp update-p) (progn (setq update-p (funcall update-p)) nil)) (memq update-p '(t create)) (and (eq update-p 'query) (y-or-n-p (format "Create a new record for %s? " (bbdb-record-name record))))) (progn (setq record (bbdb-empty-record)) (bbdb-record-set-name record fname lname) (setq created-p t)))) (let ((mails (bbdb-record-mail record))) (if ignore-redundant ;; Does the new address MAIL make an old address redundant? (let ((mail-re (bbdb-mail-redundant-re mail)) (case-fold-search t) okay redundant) (dolist (ml mails) (if (string-match mail-re ml) ; redundant mail address (push ml redundant) (push ml okay))) (let ((form (format "redundant mail%s %s" (if (< 1 (length redundant)) "s" "") (bbdb-concat 'mail (nreverse redundant)))) (name (bbdb-record-name record))) (if redundant (cond ((numberp ignore-redundant) (unless bbdb-silent (message "%s: %s" name form) (sit-for ignore-redundant))) ((or (eq t ignore-redundant) bbdb-silent (y-or-n-p (format "Delete %s: " form))) (if (eq t ignore-redundant) (message "%s: deleting %s" name form)) (setq mails okay))))))) ;; then modify RECORD (bbdb-record-set-field record 'mail (if (and mails (bbdb-eval-spec (bbdb-add-job bbdb-new-mails-primary record mail) (format "Make \"%s\" the primary address? " mail))) (cons mail mails) (nconc mails (list mail)))) (unless change-p (setq change-p t))))) (cond (created-p (unless bbdb-silent (if (bbdb-record-name record) (message "created %s's record with address \"%s\"" (bbdb-record-name record) mail) (message "created record with naked address \"%s\"" mail))) (bbdb-change-record record)) (change-p (unless bbdb-silent (cond ((eq change-p 'name) (message "noticed \"%s\"" (bbdb-record-name record))) ((bbdb-record-name record) (message "noticed %s's address \"%s\"" (bbdb-record-name record) mail)) (t (message "noticed naked address \"%s\"" mail)))) (bbdb-change-record record))) (run-hook-with-args 'bbdb-notice-mail-hook record) (push record new-records))) (nreverse new-records))) (defun bbdb-mua-update-records (&optional header-class update-p sort) "Wrapper for `bbdb-update-records'. HEADER-CLASS is defined in `bbdb-message-headers'. If it is nil, use all classes in `bbdb-message-headers'. UPDATE-P is defined in `bbdb-update-records'. If SORT is non-nil, sort records according to `bbdb-record-lessp'." (let ((mua (bbdb-mua))) (save-current-buffer (cond ;; VM ((eq mua 'vm) (vm-select-folder-buffer) (vm-check-for-killed-summary) (vm-error-if-folder-empty) (let ((enable-local-variables t)) ; ...or vm bind this to nil. (bbdb-update-records (bbdb-get-address-components header-class) update-p sort))) ;; Gnus ((eq mua 'gnus) (set-buffer gnus-article-buffer) (bbdb-update-records (bbdb-get-address-components header-class) update-p sort)) ;; MH-E ((eq mua 'mh) (if mh-show-buffer (set-buffer mh-show-buffer)) (bbdb-update-records (bbdb-get-address-components header-class) update-p sort)) ;; Rmail ((eq mua 'rmail) (set-buffer rmail-buffer) (bbdb-update-records (bbdb-get-address-components header-class) update-p sort)) ;; mu4e ((eq mua 'mu4e) (set-buffer mu4e~view-buffer-name) (bbdb-update-records (bbdb-get-address-components header-class) update-p sort)) ;; Wanderlust ((eq mua 'wl) (bbdb-update-records (bbdb-get-address-components header-class) update-p sort)) ;; Message and Mail ((memq mua '(message mail)) (bbdb-update-records (bbdb-get-address-components header-class) update-p sort)))))) (defmacro bbdb-mua-wrapper (&rest body) "Perform BODY in a MUA buffer." (declare (debug t)) `(let ((mua (bbdb-mua))) ;; Here we replicate BODY multiple times which gets clumsy ;; for a larger BODY! (cond ((eq mua 'gnus) ;; This fails in *Article* buffers, where ;; `gnus-article-read-summary-keys' provides an additional wrapper (save-current-buffer (gnus-summary-select-article) ; sets buffer `gnus-summary-buffer' ,@body)) ((memq mua '(mail message rmail mh vm mu4e wl)) (cond ((eq mua 'vm) (vm-follow-summary-cursor)) ((eq mua 'mh) (mh-show))) ;; rmail, mail, message, mu4e and wl do not require any wrapper ,@body)))) (defun bbdb-mua-update-interactive-p () "Interactive spec for arg UPDATE-P of `bbdb-mua-display-records' and friends. If these commands are called without a prefix, the value of their arg UPDATE-P is the car of the variable `bbdb-mua-update-interactive-p'. Called with a prefix, the value of UPDATE-P is the cdr of this variable." (let ((update-p (if current-prefix-arg (cdr bbdb-mua-update-interactive-p) (car bbdb-mua-update-interactive-p)))) (if (eq update-p 'read) (let ((str (completing-read "Action: " '((query) (search) (create)) nil t))) (unless (string= "" str) (intern str))) ; nil otherwise update-p))) (defun bbdb-mua-window-p () "Return lambda function matching the MUA window. This return value can be used as arg HORIZ-P of `bbdb-display-records'." (let ((mm-alist bbdb-mua-mode-alist) elt fun) (while (setq elt (cdr (pop mm-alist))) (if (memq major-mode elt) (setq fun `(lambda (window) (with-current-buffer (window-buffer window) (memq major-mode ',elt))) mm-alist nil))) fun)) ;;;###autoload (defun bbdb-mua-display-records (&optional header-class update-p all) "Display the BBDB record(s) for the addresses in this message. This looks into the headers of a message according to HEADER-CLASS. Then for the mail addresses found the corresponding BBDB records are displayed. UPDATE-P determines whether only existing BBDB records are displayed or whether also new records are created for these mail addresses. HEADER-CLASS is defined in `bbdb-message-headers'. If it is nil, use all classes in `bbdb-message-headers'. UPDATE-P may take the same values as `bbdb-update-records-p'. For interactive calls, see function `bbdb-mua-update-interactive-p'. If ALL is non-nil, bind `bbdb-message-all-addresses' to ALL." (interactive (list nil (bbdb-mua-update-interactive-p))) (let ((bbdb-pop-up-window-size bbdb-mua-pop-up-window-size) (bbdb-message-all-addresses (or all bbdb-message-all-addresses)) records) (bbdb-mua-wrapper (setq records (bbdb-mua-update-records header-class update-p t))) (if records (bbdb-display-records records nil nil nil (bbdb-mua-window-p))) records)) ;; The following commands are some frontends for `bbdb-mua-display-records', ;; which is always doing the real work. In your init file, you can further ;; modify or adapt these simple commands to your liking. ;;;###autoload (defun bbdb-mua-display-sender (&optional update-p) "Display the BBDB record(s) for the sender of this message. UPDATE-P may take the same values as `bbdb-update-records-p'. For interactive calls, see function `bbdb-mua-update-interactive-p'." (interactive (list (bbdb-mua-update-interactive-p))) (bbdb-mua-display-records 'sender update-p)) ;;;###autoload (defun bbdb-mua-display-recipients (&optional update-p) "Display the BBDB record(s) for the recipients of this message. UPDATE-P may take the same values as `bbdb-update-records-p'. For interactive calls, see function `bbdb-mua-update-interactive-p'." (interactive (list (bbdb-mua-update-interactive-p))) (bbdb-mua-display-records 'recipients update-p)) ;;;###autoload (defun bbdb-mua-display-all-records (&optional update-p) "Display the BBDB record(s) for all addresses in this message. UPDATE-P may take the same values as `bbdb-update-records-p'. For interactive calls, see function `bbdb-mua-update-interactive-p'." (interactive (list (bbdb-mua-update-interactive-p))) (bbdb-mua-display-records nil update-p t)) ;;;###autoload (defun bbdb-mua-display-all-recipients (&optional update-p) "Display BBDB records for all recipients of this message. UPDATE-P may take the same values as `bbdb-update-records-p'. For interactive calls, see function `bbdb-mua-update-interactive-p'." (interactive (list (bbdb-mua-update-interactive-p))) (bbdb-mua-display-records 'recipients update-p t)) ;; The commands `bbdb-annotate-record' and `bbdb-mua-edit-field' ;; have kind of similar goals, yet they use rather different strategies. ;; `bbdb-annotate-record' is less obtrusive. It does not display ;; the records it operates on, nor does it display the content ;; of the field before or after adding or replacing the annotation. ;; Hence the user needs to know what she is doing. ;; `bbdb-mua-edit-field' is more explicit: It displays the records ;; as well as the current content of the field that gets edited. ;; In principle, this function can be used not only with MUAs. (defun bbdb-annotate-record (record annotation &optional field replace) "In RECORD add an ANNOTATION to field FIELD. FIELD defaults to `bbdb-annotate-field'. If REPLACE is non-nil, ANNOTATION replaces the content of FIELD. If ANNOTATION is an empty string and REPLACE is non-nil, delete FIELD." (if (memq field '(name firstname lastname phone address xfields)) (error "Field `%s' illegal" field)) (setq annotation (bbdb-string-trim annotation)) (cond ((memq field '(affix organization mail aka)) (setq annotation (list annotation))) ((not field) (setq field bbdb-annotate-field))) (bbdb-record-set-field record field annotation (not replace)) (bbdb-change-record record)) ;; FIXME: For interactive calls of the following commands, the arg UPDATE-P ;; should have the same meaning as for `bbdb-mua-display-records', ;; that is, it should use `bbdb-mua-update-interactive-p'. ;; But here the prefix arg is already used in a different way. ;; We could possibly solve this problem if all `bbdb-mua-*' commands ;; used another prefix arg that is consistently used only for ;; `bbdb-mua-update-interactive-p'. ;; Yet this prefix arg must be defined within the key space of the MUA(s). ;; This results in lots of conflicts... ;; ;; Current workaround: ;; These commands use merely the car of `bbdb-mua-update-interactive-p'. ;; If one day someone proposes a smart solution to this problem (suggestions ;; welcome!), this solution will hopefully include the current workaround ;; as a subset of all its features. (defun bbdb-mua-annotate-field-interactive () "Interactive specification for `bbdb-mua-annotate-sender' and friends." (bbdb-editable) (let ((field (if (eq 'all-fields bbdb-annotate-field) (intern (completing-read "Field: " (mapcar 'symbol-name (append '(affix organization mail aka) bbdb-xfield-label-list)))) bbdb-annotate-field))) (list (read-string (format "Annotate `%s': " field)) field current-prefix-arg (car bbdb-mua-update-interactive-p)))) ;;;###autoload (defun bbdb-mua-annotate-sender (annotation &optional field replace update-p) "Add ANNOTATION to field FIELD of the BBDB record(s) of message sender(s). FIELD defaults to `bbdb-annotate-field'. If REPLACE is non-nil, ANNOTATION replaces the content of FIELD. UPDATE-P may take the same values as `bbdb-update-records-p'. For interactive calls, use car of `bbdb-mua-update-interactive-p'." (interactive (bbdb-mua-annotate-field-interactive)) (bbdb-mua-wrapper (dolist (record (bbdb-mua-update-records 'sender update-p)) (bbdb-annotate-record record annotation field replace)))) ;;;###autoload (defun bbdb-mua-annotate-recipients (annotation &optional field replace update-p) "Add ANNOTATION to field FIELD of the BBDB records of message recipients. FIELD defaults to `bbdb-annotate-field'. If REPLACE is non-nil, ANNOTATION replaces the content of FIELD. UPDATE-P may take the same values as `bbdb-update-records-p'. For interactive calls, use car of `bbdb-mua-update-interactive-p'." (interactive (bbdb-mua-annotate-field-interactive)) (bbdb-mua-wrapper (dolist (record (bbdb-mua-update-records 'recipients update-p)) (bbdb-annotate-record record annotation field replace)))) (defun bbdb-mua-edit-field-interactive () "Interactive specification for command `bbdb-mua-edit-field' and friends." (bbdb-editable) (list (if (eq 'all-fields bbdb-mua-edit-field) (intern (completing-read "Field: " (mapcar 'symbol-name (append '(name affix organization aka mail) bbdb-xfield-label-list)))) bbdb-mua-edit-field) (bbdb-mua-update-interactive-p))) ;;;###autoload (defun bbdb-mua-edit-field (&optional field update-p header-class) "Edit FIELD of the BBDB record(s) of message sender(s) or recipients. FIELD defaults to value of variable `bbdb-mua-edit-field'. UPDATE-P may take the same values as `bbdb-update-records-p'. For interactive calls, see function `bbdb-mua-update-interactive-p'. HEADER-CLASS is defined in `bbdb-message-headers'. If it is nil, use all classes in `bbdb-message-headers'." (interactive (bbdb-mua-edit-field-interactive)) (cond ((memq field '(firstname lastname address phone xfields)) (error "Field `%s' not editable this way" field)) ((not field) (setq field bbdb-mua-edit-field))) (bbdb-mua-wrapper (let ((records (bbdb-mua-update-records header-class update-p)) (bbdb-pop-up-window-size bbdb-mua-pop-up-window-size)) (when records (bbdb-display-records records nil nil nil (bbdb-mua-window-p)) (dolist (record records) (bbdb-edit-field record field)))))) ;;;###autoload (defun bbdb-mua-edit-field-sender (&optional field update-p) "Edit FIELD of record corresponding to sender of this message. FIELD defaults to value of variable `bbdb-mua-edit-field'. UPDATE-P may take the same values as `bbdb-update-records-p'. For interactive calls, see function `bbdb-mua-update-interactive-p'." (interactive (bbdb-mua-edit-field-interactive)) (bbdb-mua-edit-field field update-p 'sender)) ;;;###autoload (defun bbdb-mua-edit-field-recipients (&optional field update-p) "Edit FIELD of record corresponding to recipient of this message. FIELD defaults to value of variable `bbdb-mua-edit-field'. UPDATE-P may take the same values as `bbdb-update-records-p'. For interactive calls, see function `bbdb-mua-update-interactive-p'." (interactive (bbdb-mua-edit-field-interactive)) (bbdb-mua-edit-field field update-p 'recipients)) ;; Functions for noninteractive use in MUA hooks ;;;###autoload (defun bbdb-mua-auto-update (&optional header-class update-p) "Update BBDB automatically based on incoming and outgoing messages. This looks into the headers of a message according to HEADER-CLASS. Then for the mail addresses found the corresponding BBDB records are updated. UPDATE-P determines whether only existing BBDB records are taken or whether also new records are created for these mail addresses. Return matching records. HEADER-CLASS is defined in `bbdb-message-headers'. If it is nil, use all classes in `bbdb-message-headers'. UPDATE-P may take the same values as `bbdb-mua-auto-update-p'. If UPDATE-P is nil, use `bbdb-mua-auto-update-p' (which see). If `bbdb-mua-pop-up' is non-nil, BBDB pops up the *BBDB* buffer along with the MUA window(s), displaying the matching records using `bbdb-pop-up-layout'. If this is nil, BBDB is updated silently. This function is intended for noninteractive use via appropriate MUA hooks. Call `bbdb-mua-auto-update-init' in your init file to put this function into the respective MUA hooks. See `bbdb-mua-display-records' and friends for interactive commands." (let* ((bbdb-silent-internal t) (records (bbdb-mua-update-records header-class (or update-p bbdb-mua-auto-update-p))) (bbdb-pop-up-window-size bbdb-mua-pop-up-window-size)) (if bbdb-mua-pop-up (if records (bbdb-display-records records bbdb-pop-up-layout nil nil (bbdb-mua-window-p)) ;; If there are no records, empty the BBDB window. (bbdb-undisplay-records))) records)) ;; Should the following be replaced by a minor mode?? ;; Or should we make this function interactive in some other way? ;;;###autoload (defun bbdb-mua-auto-update-init (&rest muas) "For MUAS add `bbdb-mua-auto-update' to their presentation hook. If a MUA is not an element of MUAS, `bbdb-mua-auto-update' is removed from the respective presentation hook. Call this function in your init file to use the auto update feature with MUAS. This function is separate from the general function `bbdb-initialize' as this allows one to initialize the auto update feature for some MUAs only, for example only for outgoing messages. See `bbdb-mua-auto-update' for details about the auto update feature." (dolist (mua '((message . message-send-hook) (mail . mail-send-hook) (rmail . rmail-show-message-hook) (gnus . gnus-article-prepare-hook) (mh . mh-show-hook) (vm . vm-select-message-hook) (wl . wl-message-redisplay-hook))) (if (memq (car mua) muas) (add-hook (cdr mua) 'bbdb-mua-auto-update) (remove-hook (cdr mua) 'bbdb-mua-auto-update)))) ;;;###autoload (defun bbdb-auto-notes (record) "Automatically annotate RECORD based on the headers of the current message. See the variables `bbdb-auto-notes-rules', `bbdb-auto-notes-ignore-messages' and `bbdb-auto-notes-ignore-headers'. For use as an element of `bbdb-notice-record-hook'." ;; This code re-evaluates the annotations each time a message is viewed. ;; It would be faster if we could somehow store (permanently?) that we ;; have already annotated a message. (let ((case-fold-search t)) (unless (or bbdb-read-only ;; check the ignore-messages pattern (let ((ignore-messages bbdb-auto-notes-ignore-messages) ignore rule) (while (and (not ignore) (setq rule (pop ignore-messages))) (if (cond ((functionp rule) ;; RULE may use `bbdb-update-records-address' (funcall rule record)) ((symbolp rule) (eq rule (nth 4 bbdb-update-records-address))) ((eq 1 (safe-length rule)) (bbdb-message-header-re (car rule) (cdr rule))) ((eq 2 (safe-length rule)) (and (eq (car rule) (nth 4 bbdb-update-records-address)) (bbdb-message-header-re (nth 1 rule) (nth 2 rule))))) (setq ignore t))) ignore)) (bbdb-editable) ;; For speed-up expanded rules are stored in `bbdb-auto-notes-rules-expanded'. (when (and bbdb-auto-notes-rules (not bbdb-auto-notes-rules-expanded)) (let (expanded mua from-to header) (dolist (rule bbdb-auto-notes-rules) ;; Which MUA do we want? (if (or (stringp (car rule)) (stringp (nth 1 rule))) (setq mua t) (setq mua (if (symbolp (car rule)) (listp (car rule)) (car rule)) rule (cdr rule))) ;; Which FROM-TO headers do we want? (if (stringp (car rule)) (setq from-to t) (setq from-to (car rule) rule (cdr rule))) (setq header (car rule)) (let (string field replace elt-e) (dolist (elt (cdr rule)) (if (consp (setq string (cdr elt))) (setq field (car string) ; (REGEXP FIELD-NAME STRING REPLACE) replace (nth 2 string) ; perhaps nil string (nth 1 string)) ;; else it's simple (REGEXP . STRING) (setq field bbdb-default-xfield replace nil)) (push (list (car elt) field string replace) elt-e)) (push (append (list mua from-to header) (nreverse elt-e)) expanded))) (setq bbdb-auto-notes-rules-expanded (nreverse expanded)))) (dolist (rule bbdb-auto-notes-rules-expanded) (let ((mua (car rule)) (from-to (nth 1 rule)) (header (nth 2 rule)) hd-val string annotation) (when (and (or (eq mua t) (memq (nth 4 bbdb-update-records-address) mua)) (or (eq from-to t) (member-ignore-case (nth 2 bbdb-update-records-address) from-to) (memq (nth 3 bbdb-update-records-address) from-to)) (setq hd-val (bbdb-message-header header))) (dolist (elt (nthcdr 3 rule)) (when (and (string-match (car elt) hd-val) (let ((ignore (cdr (assoc-string header bbdb-auto-notes-ignore-headers t)))) (not (and ignore (string-match ignore hd-val))))) (setq string (nth 2 elt) annotation (cond ((integerp string) (match-string string hd-val)) ((stringp string) (replace-match string nil nil hd-val)) ((functionp string) (funcall string hd-val)) (t (error "Illegal value: %s" string)))) (bbdb-annotate-record record annotation (nth 1 elt) (nth 3 elt)))))))))) ;;; Mark BBDB records in the MUA summary buffer (defun bbdb-mua-summary-unify (address) "Unify mail ADDRESS displayed for a message in the MUA Summary buffer. Typically ADDRESS refers to the value of the From header of a message. If ADDRESS matches a record in BBDB display a unified name instead of ADDRESS in the MUA Summary buffer. Unification uses `bbdb-mua-summary-unification-list' (see there). The first match in this list becomes the text string displayed for a message in the MUA Summary buffer instead of ADDRESS. If variable `bbdb-mua-summary-mark' is non-nil use it to precede known addresses. Return the unified mail address. Currently this works with Gnus and VM. It requires the BBDB insinuation of these MUAs. Also, the MUA Summary format string must use `bbdb-mua-summary-unify-format-letter' (see there)." ;; ADDRESS is analyzed as in `bbdb-get-address-components'. (let* ((data (bbdb-extract-address-components address)) (name (car data)) (mail (cadr data)) (record (car (bbdb-message-search name mail))) (u-list bbdb-mua-summary-unification-list) elt val) (while (setq elt (pop u-list)) (setq val (cond ((eq elt 'message-name) name) ((eq elt 'message-mail) mail) ((eq elt 'message-address) address) (record (let ((result (bbdb-record-field record elt))) (if (stringp result) result (car result)))))) ; RESULT is list. (if val (setq u-list nil))) (format "%s%s" (cond ((not bbdb-mua-summary-mark) "") ((not record) " ") ((functionp bbdb-mua-summary-mark-field) (funcall bbdb-mua-summary-mark-field record)) ((bbdb-record-xfield record bbdb-mua-summary-mark-field)) (t bbdb-mua-summary-mark)) (or val name mail address "**UNKNOWN**")))) (defun bbdb-mua-summary-mark (address) "In the MUA Summary buffer mark messages matching a BBDB record. ADDRESS typically refers to the value of the From header of a message. If ADDRESS matches a record in BBDB return a mark, \" \" otherwise. The mark itself is the value of the xfield `bbdb-mua-summary-mark-field' if this xfield is in the poster's record, and `bbdb-mua-summary-mark' otherwise." (if (not bbdb-mua-summary-mark) "" ; for consistency ;; ADDRESS is analyzed as in `bbdb-get-address-components'. (let* ((data (bbdb-extract-address-components address)) (record (car (bbdb-message-search (car data) (cadr data))))) (if record (or (when (functionp bbdb-mua-summary-mark-field) (funcall bbdb-mua-summary-mark-field record) t) (bbdb-record-xfield record bbdb-mua-summary-mark-field) bbdb-mua-summary-mark) " ")))) (provide 'bbdb-mua) ;;; bbdb-mua.el ends here bbdb3-3.2/lisp/bbdb-pgp.el000066400000000000000000000243021322420162700153000ustar00rootroot00000000000000;;; bbdb-pgp.el --- use BBDB to handle PGP preferences -*- lexical-binding: t -*- ;; Copyright (C) 2013-2017 Free Software Foundation, Inc. ;; This file is part of the Insidious Big Brother Database (aka BBDB), ;; BBDB 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. ;; BBDB 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 BBDB. If not, see . ;;; Commentary: ;; It is believed that encrypted mail works best if all mail between ;; individuals is encrypted - even concerning matters that are not ;; confidential. The reasoning is that confidential messages cannot ;; then be easily spotted and decryption efforts concentrated on them. ;; Some people therefore prefer to have all their email encrypted. ;; This package allows you to mark the BBDB entries for those ;; individuals so that messages will be (signed or) encrypted ;; when they are sent. ;;; Usage: ;; Add the xfield pgp-mail (see `bbdb-pgp-field') with the value ;; `sign' or `encrypt' to the BBDB records of the message recipients. ;; If the value is `sign-query' or `encrypt-query', this will query ;; whether to send signed or encrypted messages. ;; ;; Then call `bbdb-pgp' on outgoing message to add MML tags, ;; see info node `(message)security'. For all message recipients ;; in `bbdb-pgp-headers', this command grabs the action in `bbdb-pgp-field' ;; of their BBDB records. If this proposes multiple actions, ;; perform the action which appears first in `bbdb-pgp-ranked-actions'. ;; If this proposes no action at all, use `bbdb-pgp-default'. ;; The variable `bbdb-pgp-method' defines the method which is actually used ;; for signing and encrypting, see also `bbdb-pgp-method-alist'. ;; ;; `bbdb-pgp' works with both `mail-mode' and `message-mode' to send ;; signed or encrypted mail. ;; ;; To run `bbdb-pgp' automatically when sending a message, ;; use `bbdb-initialize' with arg `pgp' to add this function ;; to `message-send-hook' and `mail-send-hook'. ;; Yet see info node `(message)Signing and encryption' why you ;; might not want to rely for encryption on a hook function ;; which runs just before the message is sent, that is, you might want ;; to call the command `bbdb-pgp' manually, then call `mml-preview'. ;; ;; A thought: For these hooks we could define a wrapper that calls ;; first `bbdb-pgp', then `mml-preview' for preview. The wrapper should ;; abort the sending of the message if the preview is not getting ;; the user's approval. Yet this might require some recursive editing mode ;; so that the user can browse the preview before approving it. ;; ;;; Todo: ;; Spot incoming PGP-signed or encrypted messages and prompt for adding ;; `bbdb-pgp-field' to the senders' BBDB records; similar to how ;; bbdb-sc.el maintains attribution preferences. ;;; Code: (require 'message) (require 'bbdb-com) (defcustom bbdb-pgp-field 'pgp-mail "BBDB xfield holding the PGP action. If the recipient of a message has this xfield in his/her BBDB record, its value determines whether `bbdb-pgp' signs or encrypts the message. The value of this xfield should be one of the following symbols: sign Sign the message sign-query Query whether to sign the message encrypt Encrypt the message encrypt-query Query whether to encrypt the message If the xfield is absent use `bbdb-pgp-default'. See also info node `(message)security'." :type '(symbol :tag "BBDB xfield") :group 'bbdb-utilities-pgp) (defcustom bbdb-pgp-default nil "Default action when sending a message and the recipients are not in BBDB. This should be one of the following symbols: nil Do nothing sign Sign the message sign-query Query whether to sign the message encrypt Encrypt the message encrypt-query Query whether to encrypt the message See info node `(message)security'." :type '(choice (const :tag "Do Nothing" nil) (const :tag "Encrypt" encrypt) (const :tag "Query encryption" encrypt-query) (const :tag "Sign" sign) (const :tag "Query signing" sign-query)) :group 'bbdb-utilities-pgp) (defcustom bbdb-pgp-ranked-actions '(encrypt-query sign-query encrypt sign) "Ranked list of actions when sending a message. If a message has multiple recipients such that their BBDB records specify different actions for this message, `bbdb-pgp' will perform the action which appears first in `bbdb-pgp-ranked-actions'. This list should include the following four symbols: sign Sign the message sign-query Query whether to sign the message encrypt Encrypt the message encrypt-query Query whether to encrypt the message." :type '(repeat (symbol :tag "Action")) :group 'bbdb-utilities-pgp) (defcustom bbdb-pgp-headers '("To" "Cc") "Message headers to look at." :type '(repeat (string :tag "Message header")) :group 'bbdb-utilities-pgp) (defcustom bbdb-pgp-method 'pgpmime "Method for signing and encrypting messages. It should be one of the keys of `bbdb-pgp-method-alist'. The default methods include pgp Add MML tags for PGP format pgpauto Add MML tags for PGP-auto format pgpmime Add MML tags for PGP/MIME smime Add MML tags for S/MIME See info node `(message)security'." :type '(choice (const :tag "MML PGP" pgp) (const :tag "MML PGP-auto" pgpauto) (const :tag "MML PGP/MIME" pgpmime) (const :tag "MML S/MIME" smime) (symbol :tag "Custom")) :group 'bbdb-utilities-pgp) (defcustom bbdb-pgp-method-alist '((pgp mml-secure-message-sign-pgp mml-secure-message-encrypt-pgp) (pgpmime mml-secure-message-sign-pgpmime mml-secure-message-encrypt-pgpmime) (smime mml-secure-message-sign-smime mml-secure-message-encrypt-smime) (pgpauto mml-secure-message-sign-pgpauto mml-secure-message-encrypt-pgpauto)) "Alist of methods for signing and encrypting a message with `bbdb-pgp'. Each method is a list (KEY SIGN ENCRYPT). The symbol KEY identifies the method. The function SIGN signs the message; the function ENCRYPT encrypts it. These functions take no arguments. The default methods include pgp Add MML tags for PGP format pgpauto Add MML tags for PGP-auto format pgpmime Add MML tags for PGP/MIME smime Add MML tags for S/MIME See info node `(message)security'." :type '(repeat (list (symbol :tag "Key") (symbol :tag "Sign method") (symbol :tag "Encrypt method"))) :group 'bbdb-utilities-pgp) ;;;###autoload (defun bbdb-read-xfield-pgp-mail (&optional init) "Set `bbdb-pgp-field', requiring match with `bbdb-pgp-ranked-actions'." (bbdb-read-string "PGP action: " init (mapcar 'list bbdb-pgp-ranked-actions) t)) ;;;###autoload (defun bbdb-pgp () "Add PGP MML tags to a message according to the recipients' BBDB records. For all message recipients in `bbdb-pgp-headers', this grabs the action in `bbdb-pgp-field' of their BBDB records. If this proposes multiple actions, perform the action which appears first in `bbdb-pgp-ranked-actions'. If this proposes no action at all, use `bbdb-pgp-default'. The variable `bbdb-pgp-method' defines the method which is actually used for signing and encrypting. This command works with both `mail-mode' and `message-mode' to send signed or encrypted mail. To run this command automatically when sending a message, use `bbdb-initialize' with arg `pgp' to add this function to `message-send-hook' and `mail-send-hook'. Yet see info node `(message)Signing and encryption' why you might not want to rely for encryption on a hook function which runs just before the message is sent, that is, you might want to call the command `bbdb-pgp' manually, then call `mml-preview'." (interactive) (save-excursion (save-restriction (widen) (message-narrow-to-headers) (when mail-aliases ;; (sendmail-sync-aliases) ; needed? (expand-mail-aliases (point-min) (point-max))) (let ((actions (or (delq nil (delete-dups (mapcar (lambda (record) (bbdb-record-xfield-intern record bbdb-pgp-field)) (delete-dups (apply 'nconc (mapcar (lambda (address) (bbdb-message-search (car address) (cadr address))) (bbdb-extract-address-components (mapconcat (lambda (header) (mail-fetch-field header nil t)) bbdb-pgp-headers ", ") t))))))) (and bbdb-pgp-default (list bbdb-pgp-default))))) (when actions (widen) ; after analyzing the headers (let ((ranked-actions bbdb-pgp-ranked-actions) action) (while ranked-actions (if (memq (setq action (pop ranked-actions)) actions) (cond ((or (eq action 'sign) (and (eq action 'sign-query) (y-or-n-p "Sign message? "))) (funcall (nth 1 (assq bbdb-pgp-method bbdb-pgp-method-alist))) (setq ranked-actions nil)) ((or (eq action 'encrypt) (and (eq action 'encrypt-query) (y-or-n-p "Encrypt message? "))) (funcall (nth 2 (assq bbdb-pgp-method bbdb-pgp-method-alist))) (setq ranked-actions nil))))))))))) (provide 'bbdb-pgp) ;;; bbdb-pgp.el ends here bbdb3-3.2/lisp/bbdb-pkg.el.in000066400000000000000000000001511322420162700156740ustar00rootroot00000000000000(define-package "@PACKAGE_NAME@" "@PACKAGE_VERSION@" "The Insidious Big Brother Database for GNU Emacs") bbdb3-3.2/lisp/bbdb-rmail.el000066400000000000000000000040411322420162700156140ustar00rootroot00000000000000;;; bbdb-rmail.el --- BBDB interface to Rmail -*- lexical-binding: t -*- ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; This file is part of the Insidious Big Brother Database (aka BBDB), ;; BBDB 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. ;; BBDB 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 BBDB. If not, see . ;;; Commentary: ;;; This file contains the BBDB interface to Rmail. ;;; See the BBDB info manual for documentation. ;;; Code: (require 'bbdb) (require 'bbdb-com) (require 'bbdb-mua) (require 'rmail) (require 'rmailsum) (require 'mailheader) ;;;###autoload (defun bbdb/rmail-header (header) "Pull HEADER out of Rmail header." (with-current-buffer rmail-buffer (save-restriction (with-no-warnings (rmail-narrow-to-non-pruned-header)) (mail-header (intern-soft (downcase header)) (mail-header-extract))))) ;;;###autoload (defun bbdb-insinuate-rmail () "Hook BBDB into RMAIL. Do not call this in your init file. Use `bbdb-initialize'." ;; Do we need keybindings for more commands? Suggestions welcome. ;; (define-key rmail-mode-map ":" 'bbdb-mua-display-records) ;; (define-key rmail-mode-map "'" 'bbdb-mua-display-recipients) (define-key rmail-mode-map ":" 'bbdb-mua-display-sender) (define-key rmail-mode-map ";" 'bbdb-mua-edit-field-sender) ;; (define-key rmail-mode-map ";" 'bbdb-mua-edit-field-recipients) (define-key rmail-summary-mode-map ":" 'bbdb-mua-display-sender) (define-key rmail-summary-mode-map ";" 'bbdb-mua-edit-field-sender)) (provide 'bbdb-rmail) ;;; bbdb-rmail.el ends here bbdb3-3.2/lisp/bbdb-sc.el000066400000000000000000000213371322420162700151240ustar00rootroot00000000000000;;; bbdb-sc.el --- BBDB interface to Supercite -*- lexical-binding: t -*- ;; Copyright (C) 1991, 1992 Jamie Zawinski . ;; Copyright (C) 2010-2017 Roland Winkler ;; This file is part of the Insidious Big Brother Database (aka BBDB), ;; BBDB 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. ;; BBDB 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 BBDB. If not, see . ;;; Commentary: ;; This file contains the BBDB interface to Supercite (sc) ;; This file was written by Martin Sjolin ;; based on the original code by Tom Tromey . ;; Thanks to Richard Stanton for ideas ;; for improvements and to Michael D. Carney ;; for testing and feedback. ;; This file adds the ability to define attributions for Supercite in BBDB ;; and it enables you to retrieve your standard attribution from BBDB. ;; If the From header in the mail message to which you are replying only ;; contains the mail address, the sender's name is looked up in BBDB. ;; The attribution is stored in the xfield `attribution' (unless you ;; have changed `bbdb-sc-attribution-field'). ;; To enable supercite support for BBDB, call `bbdb-initialize' with arg `sc'. ;; Also customize supercite as follows: ;; (1) Add element "sc-consult" to `sc-preferred-attribution-list' ;; (note that order matters!), e.g., ;; ;; (setq sc-preferred-attribution-list ;; '("sc-lastchoice" "x-attribution" "sc-consult" ;; "initials" "firstname" "lastname")) ;; ;; (2) The variable `sc-attrib-selection-list' should include an element ;; ;; (add-to-list 'sc-attrib-selection-list ;; '("from" ((".*" . (bbdb-sc-get-attrib ;; (sc-mail-field "from")))))) ;; ;; (3) Set `sc-mail-glom-frame' as follows to fetch the sender's name from BBDB ;; if there is only a plain mail address in the From field of the mail message, ;; e.g., ;; ;; (setq sc-mail-glom-frame ;; '((begin (setq sc-mail-headers-start (point))) ;; ("^From " (sc-mail-check-from) nil nil) ;; ("^x-attribution:[ \t]+.*$" (sc-mail-fetch-field t) nil t) ;; ("^\\S +:.*$" (sc-mail-fetch-field) nil t) ;; ("^$" (list 'abort '(step . 0))) ;; ("^[ \t]+" (sc-mail-append-field)) ;; (sc-mail-warn-if-non-rfc822-p (sc-mail-error-in-mail-field)) ;; (end (progn ;; (bbdb-sc-update-from) ;; (setq sc-mail-headers-end (point)))))) ;;; Code: (require 'bbdb-com) (require 'bbdb-mua) (require 'supercite) (defcustom bbdb-sc-attribution-field 'attribution "The BBDB xfield used for Supercite attribution." :group 'bbdb-utilities-sc :type '(symbol :tag "Field name")) (define-obsolete-variable-alias 'bbdb/sc-attribution-field 'bbdb-sc-attribution-field) (defcustom bbdb-sc-update-records-p 'search "How `bbdb-sc-set-attrib' updates BBDB records automatically. This may take the same values as arg UPDATE-P of `bbdb-update-records'." :group 'bbdb-utilities-sc :type '(choice (const :tag "do nothing" nil) (const :tag "search for existing records" search) (const :tag "update existing records" update) (const :tag "query annotation of all messages" query) (const :tag "annotate all messages" create) (function :tag "User-defined function"))) (defcustom bbdb-sc-update-attrib-p 'query "How `bbdb-sc-set-attrib' updates the attribution field. Allowed values include nil Do not create or modify the attribution field query Query before creating or modifying the attribution field. t Create or modify the attribution field." :group 'bbdb-utilities-sc :type '(choice (const :tag "Do nothing" nil) (const :tag "Query before updating the attribution field" query) (const :tag "Update the attribution field" t))) ;;; Internal variables (defvar bbdb-sc-last-attrib "" "Last attribution used by Supercite. Used to compare against citation selected by the user.") (defun bbdb-sc-get-attrib (mail) "Get the Supercite attribution from BBDB. MAIL is the mail address to look for in BBDB." ;; We could store in `sc-mail-info' from which record we grabbed ;; this attribution. Yet we do not know whether `bbdb-sc-set-attrib' ;; will want to use the same record. (let* ((address (bbdb-extract-address-components mail)) (record (bbdb-message-search (car address) (cadr address)))) ;; FIXME: What to do if we have multiple matching records? (when (cdr record) (message "Multiple records match %s" mail) (sit-for 1)) (if record (bbdb-record-field (car record) bbdb-sc-attribution-field)))) (define-obsolete-function-alias 'bbdb/sc-consult-attr 'bbdb-sc-get-attrib) (defun bbdb-sc-set-attrib () "Store attribution in BBDB." (let ((from (bbdb-extract-address-components (sc-mail-field "from"))) (attrib (sc-mail-field "sc-attribution")) bbdb-notice-mail-hook record) (when (and from attrib bbdb-sc-update-attrib-p (not (string-equal attrib bbdb-sc-last-attrib)) (setq record (bbdb-update-records (list from) bbdb-sc-update-records-p))) ;; FIXME: What to do if we have multiple matching records? (when (cdr record) (message "Multiple records match %s" from) (sit-for 1)) (setq record (car record)) (let ((old (bbdb-record-field record bbdb-sc-attribution-field))) ;; Do nothing if the new value equals the old value (when (and (not (and old (string-equal old attrib))) (or (not (eq bbdb-sc-update-attrib-p 'query)) (y-or-n-p (format (if (bbdb-record-field record bbdb-sc-attribution-field) "Change attribution for %s to %s?" "For %s add attribution %s?") (bbdb-record-name record) attrib)))) (bbdb-record-set-field record bbdb-sc-attribution-field attrib) (bbdb-change-record record)))))) (define-obsolete-function-alias 'bbdb/sc-set-attr 'bbdb-sc-set-attrib) ;;;###autoload (defun bbdb-sc-update-from () "Update the \"from\" field in `sc-mail-info'. If the \"from\" field in `sc-mail-info' contains only a plain mail address, complement the \"from\" field in `sc-mail-info' with the sender's name in BBDB." (let* ((from (sc-mail-field "from")) ;; Do not use `bbdb-extract-address-components' that can "invent" names. (address (and from (bbdb-decompose-bbdb-address from))) ;; FIXME: Should we always update the sender's name in `sc-mail-info' ;; if it does not agree with what BBDB says? (record (if (and (cadr address) (not (car address))) (bbdb-message-search nil (cadr address)))) ;; FIXME: What to do if we have multiple matching records? (_ (when (cdr record) (message "Multiple records match %s" from) (sit-for 1))) (name (and record (bbdb-record-name (car record))))) (if name (setcdr (assoc-string "from" sc-mail-info t) (format "%s <%s>" name (cadr address)))))) (define-obsolete-function-alias 'bbdb/sc-default 'bbdb-sc-update-from) ;; Insert our hooks ;; Dammit, supercite! It runs `sc-attribs-postselect-hook' in an ;; environment with the local variable `attribution' that we rely on. (with-no-warnings (defvar attribution)) ;;;###autoload (defun bbdb-insinuate-sc () "Hook BBDB into Supercite. Do not call this in your init file. Use `bbdb-initialize'. However, this is not the full story. See bbdb-sc.el for how to fully hook BBDB into Supercite." (add-hook 'sc-post-hook 'bbdb-sc-set-attrib) (add-hook 'sc-attribs-postselect-hook (lambda () (setq bbdb-sc-last-attrib (if sc-downcase-p (downcase attribution) attribution))))) (provide 'bbdb-sc) ;;; bbdb-sc.el ends here bbdb3-3.2/lisp/bbdb-site.el.in000066400000000000000000000034101322420162700160600ustar00rootroot00000000000000;;; bbdb-site.el.in --- site-specific variables for BBDB -*- lexical-binding: t -*- ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; This file is part of the Insidious Big Brother Database (aka BBDB), ;; BBDB 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. ;; BBDB 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 BBDB. If not, see . ;;; Code: (defconst bbdb-version "@PACKAGE_VERSION@" "Version of BBDB.") (if (< emacs-major-version 24) (error "BBDB %s requires GNU Emacs 24 or later" bbdb-version)) (defcustom bbdb-tex-path (let* ((default "@pkgdatadir@") (dir (cond ((file-accessible-directory-p default) default) (load-file-name (expand-file-name "tex/" (file-name-directory load-file-name))) (t (let ((f (locate-file "tex/bbdb.sty" load-path))) (if f (file-name-directory f))))))) (if dir (list dir))) "List of directories with the BBDB TeX files. If this is t assume that these files reside in directories that are part of the regular TeX search path." :group 'bbdb-utilities-tex :type '(choice (const :tag "Files in TeX path" t) (repeat (directory :tag "Directory")))) (provide 'bbdb-site) ;;; bbdb-site.el.in ends here bbdb3-3.2/lisp/bbdb-snarf.el000066400000000000000000000446771322420162700156440ustar00rootroot00000000000000;;; bbdb-snarf.el --- convert free-form text to BBDB records -*- lexical-binding: t -*- ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; This file is part of the Insidious Big Brother Database (aka BBDB), ;; BBDB 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. ;; BBDB 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 BBDB. If not, see . ;;; Commentary: ;; The commands `bbdb-snarf', `bbdb-snarf-yank' and `bbdb-snarf-paragraph' ;; create BBDB records by picking the name, addresses, phones, etc. ;; out of a (buffer) string. Things are recognized by context (e.g., URLs ;; start with http:// or www.). See `bbdb-snarf-rule-alist' for details. ;; ;; The rule `eu' should work out of the box for many continental ;; European countries. It can be further customized by defining ;; a suitable postcode regexp passed to `bbdb-snarf-address-eu'. ;; `mail' is a simple rule that can pick a single mail address from, ;; say, a long list of mail addresses in a message. ;; ;; RW: `bbdb-snarf' is an interesting proof of concept. Yet I find ;; its snarfing algorithms often too simplistic to be useful in real life. ;; How can this possibly be improved? Suggestions welcome. ;;; Code: (require 'bbdb-com) (defcustom bbdb-snarf-rule-alist '((us bbdb-snarf-surrounding-space bbdb-snarf-phone-nanp bbdb-snarf-url bbdb-snarf-mail bbdb-snarf-empty-lines bbdb-snarf-name bbdb-snarf-address-us bbdb-snarf-empty-lines bbdb-snarf-notes bbdb-snarf-name-mail) ; currently useless (eu bbdb-snarf-surrounding-space bbdb-snarf-phone-eu bbdb-snarf-url bbdb-snarf-mail bbdb-snarf-empty-lines bbdb-snarf-name bbdb-snarf-address-eu bbdb-snarf-empty-lines bbdb-snarf-notes bbdb-snarf-name-mail) ; currently useless (mail bbdb-snarf-mail-address)) "Alist of rules for snarfing. Each rule is of the form (KEY FUNCTION FUNCTION ...). The symbol KEY identifies the rule, see also `bbdb-snarf-rule-default'. Snarfing is a cumulative process. The text is copied to a temporary snarf buffer that becomes current during snarfing. Each FUNCTION is called with one arg, the RECORD we are snarfing, and with point at the beginning of the snarf buffer. FUNCTION should populate the fields of RECORD. It may delete the part of the snarf buffer that it has processed so that the remaining FUNCTIONs operate only on those parts that were not yet snarfed. The order of the FUNCTION calls in a rule is then crucial. Unlike other parts of BBDB, FUNCTIONs need not update the cache and hash table for RECORD which is done at the end by `bbdb-snarf'." :group 'bbdb-utilities-snarf :type '(repeat (cons (symbol :tag "Key") (repeat (function :tag "Snarf function"))))) (defcustom bbdb-snarf-rule-default 'us "Default rule for snarfing." :group 'bbdb-utilities-snarf :type 'symbol) (defcustom bbdb-snarf-name-regexp "^[ \t'\"]*\\([- .,[:word:]]*[[:word:]]\\)" "Regexp matching a name. Case is ignored. The first subexpression becomes the name." :group 'bbdb-utilities-snarf :type 'regexp) (defcustom bbdb-snarf-mail-regexp (concat "\\(?:\\(?:mailto:\\|e?mail:?\\)[ \t]*\\)?" "]+\\)>?") "Regexp matching a mail address. Case is ignored. The first subexpression becomes the mail address." :group 'bbdb-utilities-snarf :type 'regexp) (defcustom bbdb-snarf-phone-nanp-regexp (concat "\\(?:phone:?[ \t]*\\)?" "\\(\\(?:([2-9][0-9][0-9])[-. ]?\\|[2-9][0-9][0-9][-. ]\\)?" "[0-9][0-9][0-9][-. ][0-9][0-9][0-9][0-9]" "\\(?: *\\(?:x\\|ext\\.?\\) *[0-9]+\\)?\\)") "Regexp matching a NANP phone number. Case is ignored. NANP is the North American Numbering Plan used in North and Central America. The first subexpression becomes the phone number." :group 'bbdb-utilities-snarf :type 'regexp) (defcustom bbdb-snarf-phone-eu-regexp (concat "\\(?:phone?:?[ \t]*\\)?" "\\(\\(?:\\+[1-9]\\|(\\)[-0-9()\s]+\\)") "Regexp matching a European phone number. The first subexpression becomes the phone number." :group 'bbdb-utilities-snarf :type 'regexp) (defcustom bbdb-snarf-postcode-us-regexp ;; US postcode appears at end of line (concat "\\(\\<[0-9][0-9][0-9][0-9][0-9]" "\\(-[0-9][0-9][0-9][0-9]\\)?" "\\>\\)$") "Regexp matching US postcodes. The first subexpression becomes the postcode." :group 'bbdb-utilities-snarf :type 'regexp) (defcustom bbdb-snarf-address-us-country nil "Country to use for US addresses. If nil leave country blank." :group 'bbdb-utilities-snarf :type '(choice (const :tag "Leave blank" nil) (string :tag "Country"))) (defcustom bbdb-snarf-postcode-eu-regexp "^\\([0-9][0-9][0-9][0-9][0-9]?\\)" ; four or five digits "Regexp matching many European postcodes. `bbdb-snarf-address-eu' assumes that the address appears at the beginning of a line followed by the name of the city." :group 'bbdb-utilities-snarf :type 'regexp) (defcustom bbdb-snarf-address-eu-country nil "Country to use for EU addresses. If nil leave country blank." :group 'bbdb-utilities-snarf :type '(choice (const :tag "Leave blank" nil) (string :tag "Country"))) (defcustom bbdb-snarf-default-label-alist '((phone . "work") (address . "work")) "Default labels for snarfing. This is an alist where each element is a cons pair (FIELD . LABEL). The symbol FIELD denotes a record field like `phone' or `address'. The string LABEL denotes the default label for FIELD." :group 'bbdb-utilities-snarf :type '(repeat (cons (symbol :tag "Field") (string :tag "Label")))) (defcustom bbdb-snarf-url 'url "What xfield BBDB should use for URLs, or nil to not snarf URLs." :group 'bbdb-utilities-snarf :type 'symbol) (defcustom bbdb-snarf-url-regexp "\\(\\(?:http://\\|www\\.\\)[^ \t\n]+\\)" "Regexp matching a URL. Case is ignored. The first subexpression becomes the URL." :group 'bbdb-utilities-snarf :type 'regexp) (defun bbdb-snarf-surrounding-space (_record) "Discard beginning and trailing space when snarfing RECORD." (while (re-search-forward "^[ \t]+" nil t) (replace-match "")) (goto-char (point-min)) (while (re-search-forward "\\s-+$" nil t) (replace-match ""))) (defun bbdb-snarf-empty-lines (_record) "Discard empty lines when snarfing RECORD." (while (re-search-forward "^[ \t]*\n" nil t) (replace-match ""))) (defun bbdb-snarf-name (record) "Snarf name for RECORD." (if (and (not (bbdb-record-lastname record)) (let ((case-fold-search t)) (re-search-forward bbdb-snarf-name-regexp nil t))) (let ((name (match-string 1))) (replace-match "") (setq name (bbdb-divide-name name)) (bbdb-record-set-firstname record (car name)) (bbdb-record-set-lastname record (cdr name))))) (defun bbdb-snarf-name-mail (record) "Snarf name from mail address for RECORD." ;; Fixme: This is currently useless because `bbdb-snarf-mail-regexp' ;; cannot handle names in RFC 5322-like addresses "John Smith ". (let ((name (bbdb-record-lastname record))) (when (and (not name) (bbdb-record-mail record) (setq name (car (bbdb-extract-address-components (car (bbdb-record-mail record))))) (setq name (bbdb-divide-name name))) (bbdb-record-set-firstname record (car name)) (bbdb-record-set-lastname record (cadr name))))) (defun bbdb-snarf-mail-address (record) "Snarf name and mail address for RECORD." ;; The voodoo of `mail-extract-address-components' makes ;; the following quite powerful. If this function is used as part of ;; a more complex rule, the buffer should be narrowed appropriately. (let* ((data (bbdb-extract-address-components (buffer-string))) (name (and (car data) (bbdb-divide-name (car data))))) (bbdb-record-set-firstname record (car name)) (bbdb-record-set-lastname record (cdr name)) (bbdb-record-set-mail record (list (cadr data))) (delete-region (point-min) (point-max)))) (defun bbdb-snarf-mail (record) "Snarf mail addresses for RECORD. This uses the first subexpresion of `bbdb-snarf-mail-regexp'." (let ((case-fold-search t) mails) (while (re-search-forward bbdb-snarf-mail-regexp nil t) (push (match-string 1) mails) (replace-match "")) (bbdb-record-set-mail record (nconc (bbdb-record-mail record) mails)))) (defun bbdb-snarf-label (field) "Extract the label before point, or return default label for FIELD." (save-match-data (if (looking-back "\\(?:^\\|[,:]\\)\\([^\n,:]+\\):[ \t]*" (line-beginning-position)) (prog1 (match-string 1) (delete-region (match-beginning 1) (match-end 0))) (cdr (assq field bbdb-snarf-default-label-alist))))) (defun bbdb-snarf-phone-nanp (record) "Snarf NANP phone numbers for RECORD. NANP is the North American Numbering Plan used in North and Central America. This uses the first subexpresion of `bbdb-snarf-phone-nanp-regexp'." (let ((case-fold-search t) phones) (while (re-search-forward bbdb-snarf-phone-nanp-regexp nil t) (goto-char (match-beginning 0)) (if (save-match-data (looking-back "[0-9A-Z]" nil)) ;; not really an NANP phone number (goto-char (match-end 0)) (push (vconcat (list (bbdb-snarf-label 'phone)) (save-match-data (bbdb-parse-phone (match-string 1)))) phones) (replace-match ""))) (bbdb-record-set-phone record (nconc (bbdb-record-phone record) (nreverse phones))))) (defun bbdb-snarf-phone-eu (record &optional phone-regexp) "Snarf European phone numbers for RECORD. PHONE-REGEXP is the regexp to match a phone number. It defaults to `bbdb-snarf-phone-eu-regexp'." (let ((case-fold-search t) phones) (while (re-search-forward (or phone-regexp bbdb-snarf-phone-eu-regexp) nil t) (goto-char (match-beginning 0)) (push (vector (bbdb-snarf-label 'phone) (match-string 1)) phones) (replace-match "")) (bbdb-record-set-phone record (nconc (bbdb-record-phone record) (nreverse phones))))) (defun bbdb-snarf-streets (address) "Snarf streets for ADDRESS. This assumes a narrowed region." (bbdb-address-set-streets address (bbdb-split "\n" (buffer-string))) (delete-region (point-min) (point-max))) (defun bbdb-snarf-address-us (record) "Snarf a US address for RECORD." (let ((address (make-vector bbdb-address-length nil))) (cond ((re-search-forward bbdb-snarf-postcode-us-regexp nil t) ;; Streets, City, State Postcode (save-restriction (narrow-to-region (point-min) (match-end 0)) ;; Postcode (goto-char (match-beginning 0)) (bbdb-address-set-postcode address (bbdb-parse-postcode (match-string 1))) ;; State (skip-chars-backward " \t") (let ((pos (point))) (skip-chars-backward "^ \t,") (bbdb-address-set-state address (buffer-substring (point) pos))) ;; City (skip-chars-backward " \t,") (let ((pos (point))) (beginning-of-line) (bbdb-address-set-city address (buffer-substring (point) pos))) ;; Toss it (forward-char -1) (delete-region (point) (point-max)) ;; Streets (goto-char (point-min)) (bbdb-snarf-streets address))) ;; Try for just Streets, City, State ((let (case-fold-search) (re-search-forward "^\\(.*\\), \\([A-Z][A-Za-z]\\)$" nil t)) (bbdb-address-set-city address (match-string 1)) (bbdb-address-set-state address (match-string 2)) (replace-match "") (save-restriction (narrow-to-region (point-min) (match-beginning 0)) (goto-char (point-min)) (bbdb-snarf-streets address)))) (when (bbdb-address-city address) (if bbdb-snarf-address-us-country (bbdb-address-set-country address bbdb-snarf-address-us-country)) ;; Fixme: There are no labels anymore. `bbdb-snarf-streets' snarfed ;; everything that was left! (bbdb-address-set-label address (bbdb-snarf-label 'address)) (bbdb-record-set-address record (nconc (bbdb-record-address record) (list address)))))) (defun bbdb-snarf-address-eu (record &optional postcode-regexp country) "Snarf a European address for RECORD. POSTCODE-REGEXP is a regexp matching the postcode assumed to appear at the beginning of a line followed by the name of the city. This format is used in many continental European countries. POSTCODE-REGEXP defaults to `bbdb-snarf-postcode-eu-regexp'. COUNTRY is the country to use. It defaults to `bbdb-snarf-address-eu-country'." (when (re-search-forward (or postcode-regexp bbdb-snarf-postcode-eu-regexp) nil t) (let ((address (make-vector bbdb-address-length nil))) (save-restriction (goto-char (match-end 0)) (narrow-to-region (point-min) (line-end-position)) ;; Postcode (bbdb-address-set-postcode address (match-string 1)) ;; City (skip-chars-forward " \t") (bbdb-address-set-city address (buffer-substring (point) (point-max))) ;; Toss it (delete-region (match-beginning 0) (point-max)) ;; Streets (goto-char (point-min)) (bbdb-snarf-streets address)) (unless country (setq country bbdb-snarf-address-eu-country)) (if country (bbdb-address-set-country address country)) (bbdb-address-set-label address (bbdb-snarf-label 'address)) (bbdb-record-set-address record (nconc (bbdb-record-address record) (list address)))))) (defun bbdb-snarf-url (record) "Snarf URL for RECORD. This uses the first subexpresion of `bbdb-snarf-url-regexp'." (when (and bbdb-snarf-url (let ((case-fold-search t)) (re-search-forward bbdb-snarf-url-regexp nil t))) (bbdb-record-set-xfields record (nconc (bbdb-record-xfields record) (list (cons bbdb-snarf-url (match-string 1))))) (replace-match ""))) (defun bbdb-snarf-notes (record) "Snarf notes for RECORD." (when (/= (point-min) (point-max)) (bbdb-record-set-xfields record (nconc (bbdb-record-xfields record) (list (cons bbdb-default-xfield (buffer-string))))) (erase-buffer))) (defsubst bbdb-snarf-rule-interactive () "Read snarf rule interactively." (intern (completing-read (format "Rule: (default `%s') " bbdb-snarf-rule-default) bbdb-snarf-rule-alist nil t nil nil (symbol-name bbdb-snarf-rule-default)))) ;;;###autoload (defun bbdb-snarf-paragraph (pos &optional rule) "Snarf BBDB record from paragraph around position POS using RULE. The paragraph is the one that contains POS or follows POS. Interactively POS is the position of point. RULE defaults to `bbdb-snarf-rule-default'. See `bbdb-snarf-rule-alist' for details." (interactive (list (point) (bbdb-snarf-rule-interactive))) (bbdb-snarf (save-excursion (goto-char pos) ;; similar to `mark-paragraph' (let ((end (progn (forward-paragraph 1) (point)))) (buffer-substring-no-properties (progn (backward-paragraph 1) (point)) end))) rule)) ;;;###autoload (defun bbdb-snarf-yank (&optional rule) "Snarf a BBDB record from latest kill using RULE. The latest kill may also be a window system selection, see `current-kill'. RULE defaults to `bbdb-snarf-rule-default'. See `bbdb-snarf-rule-alist' for details." (interactive (list (bbdb-snarf-rule-interactive))) (bbdb-snarf (current-kill 0) rule)) ;;;###autoload (defun bbdb-snarf (string &optional rule) "Snarf a BBDB record in STRING using RULE. Display and return this record. Interactively, STRING is the current region. RULE defaults to `bbdb-snarf-rule-default'. See `bbdb-snarf-rule-alist' for details." (interactive (list (buffer-substring-no-properties (region-beginning) (region-end)) (bbdb-snarf-rule-interactive))) (bbdb-editable) (let ((record (bbdb-empty-record))) (with-current-buffer (get-buffer-create " *BBDB Snarf*") (erase-buffer) (insert (substring-no-properties string)) (mapc (lambda (fun) (goto-char (point-min)) (funcall fun record)) (cdr (assq (or rule bbdb-snarf-rule-default) bbdb-snarf-rule-alist)))) (let ((old-record (car (bbdb-message-search (bbdb-concat 'name-first-last (bbdb-record-firstname record) (bbdb-record-lastname record)) (car (bbdb-record-mail record)))))) ;; Install RECORD after searching for OLD-RECORD (bbdb-change-record record) (if old-record (bbdb-merge-records old-record record))) (bbdb-display-records (list record)) record)) ;; Some test cases ;; ;; US: ;; ;; another test person ;; 1234 Gridley St. ;; Los Angeles, CA 91342 ;; 555-1212 ;; test@person.net ;; http://www.foo.bar/ ;; other stuff about this person ;; ;; test person ;; 1234 Gridley St. ;; St. Los Angeles, CA 91342-1234 ;; 555-1212 ;; ;; ;; x test person ;; 1234 Gridley St. ;; Los Angeles, California 91342-1234 ;; work: 555-1212 ;; home: 555-1213 ;; test@person.net ;; ;; y test person ;; 1234 Gridley St. ;; Los Angeles, CA ;; 555-1212 ;; test@person.net ;; ;; z test person ;; 555-1212 ;; test@person.net ;; ;; EU: ;; ;; Maja Musterfrau ;; Strasse 15 ;; 12345 Ort ;; +49 12345 ;; phon: (110) 123 456 ;; mobile: (123) 456 789 ;; xxx.xxx@xxxx.xxx ;; http://www.xxx.xx ;; notes bla bla bla (provide 'bbdb-snarf) ;;; bbdb-snarf.el ends here bbdb3-3.2/lisp/bbdb-tex.el000066400000000000000000000570241322420162700153210ustar00rootroot00000000000000;;; bbdb-tex.el --- feed BBDB into LaTeX -*- lexical-binding: t -*- ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; Authors: Boris Goldowsky ;; Dirk Grunwald ;; Luigi Semenzato ;; This file is part of the Insidious Big Brother Database (aka BBDB), ;; BBDB 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. ;; BBDB 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 BBDB. If not, see . ;;; Commentary: ;; This file lets you feed BBDB into LaTeX. ;; See the BBDB info manual for documentation. ;; ;; In the *BBDB* buffer, type M-x `bbdb-tex' to convert the listing ;; to LaTeX format. ;; ;; TeX macros appearing in the output: ;; \name{first}{last} ;; \organization{foo bar} ;; \affix{foo bar} ;; \aka{foo bar} ;; \phone{key}{123 456 7890} ;; \address{key}{foo bar} ;; \mail{foo@bar.com}{Smith } ;; \xfield{key}{value} ;; Each macro may appear multiple times. ;; ;; The detailed grammar of the output is defined in `bbdb-tex-alist'. ;; The output starts with a prolog where you can specify LaTeX packages ;; and other customizations in the usual way. The above macros should get ;; defined, too. By default, this happens in the style file bbdb.sty that ;; is shipped with BBDB. ;; ;; The body of the output contains the BBDB records. Usually, the records ;; are placed inside some "bbdb" environment. You can customize which fields ;; of each record should appear in the listing and in which order. ;; Also, you can put separators between individual fields. A separator macro ;; can also separate records when the first character of the last name differs ;; from the first character of the last name of the previous record. ;; The listing ends with an epilog. ;; A few notes on "advanced usage" of `bbdb-tex': ;; ;; It should be possible to use `bbdb-tex' with all the bells and whistles ;; of LaTeX by loading the appropriate LaTeX style files and packages or ;; embedding the output of `bbdb-tex' into more complex LaTeX documents. ;; For this you can customize the rules in `bbdb-tex-alist' and use ;; customized style files for interpreting the TeX macros used by `bbdb-tex'. ;; ;; Generally, lisp customizations for `bbdb-tex' are intended to provide control ;; of *what* appears in the TeX listing. But there are no lisp customization ;; options to control the actual layout that should be handled by LaTeX. ;; BBDB is shipped with one basic LaTeX style file bbdb.sty to handle ;; the TeX macros listed above. You should customize this LaTeX style file ;; to match your taste and / or your needs. Note also that `bbdb-tex-alist' ;; allows you to specify an arbitrary number of rules that may use different ;; style files for the above TeX macros. ;; Generally, it will be advantageous to make all relevant style files ;; and packages known to LaTeX by putting them in the appropriate directories ;; of your TeX installation. Likely, the user variable `bbdb-tex-path' ;; should not be used in such advanced cases. The main purpose of the ;; inlining mechanism provided via `bbdb-tex-path' is that we can ship ;; and install BBDB without worrying about the tricky question where to ;; (auto-) install the basic style file bbdb.sty shipped with BBDB so that ;; TeX finds it. Most often, it will be best to manually install even bbdb.sty ;; in a directory where TeX finds it and bind `bbdb-tex-path' to t to fully ;; suppress the inlining. ;; ;; Before generating the TeX output, the field values of a record are massaged ;; by `bbdb-tex-field' that passes these values by default to `bbdb-tex-replace', ;; see also `bbdb-tex-replace-list'. Instead the user may also define functions ;; `bbdb-tex-output-...' that take precedence, see `bbdb-tex-field'. ;; ;; `bbdb-tex' understands one new BBDB xfield: tex-name, see also ;; `bbdb-tex-name'. If this xfield is defined for a record, ;; this will be used for the TeXed listing instead of the name field ;; of that record. The value of the xfield tex-name is used verbatim, ;; it does not see `bbdb-tex-field' and `bbdb-tex-replace-list'. ;; ;; ;; This program was adapted for BBDB by Boris Goldowsky ;; and Dirk Grunwald ;; using a TeX format designed by Luigi ;; Semenzato . ;; We are also grateful to numerous people on the bbdb-info ;; mailing list for suggestions and bug reports. ;;; Code: (require 'bbdb) (require 'bbdb-com) ;;; Variables: (defcustom bbdb-tex-name 'tex-name "Xfield holding the name in TeX format. The string in this field gets split into first and last name using `bbdb-separator-alist'. The separator defaults to \"#\"." :group 'bbdb-utilities-tex :type '(symbol :tag "Xfield")) (defcustom bbdb-tex-alist `((multi-line (demand (or address phone)) (prolog ,(concat "\\documentclass{article}\n\\usepackage{bbdb}\n" "\\usepackage{multicol}\n" "\\begin{document}\n\\begin{multicols}{2}")) (record "\\begin{bbdbrecord}" name organization ; affix aka (address t) (phone t) (mail t) (xfields t nil (omit ,bbdb-tex-name mail-alias creation-date timestamp)) "\\end{bbdbrecord}\n") (separator "\\bbdbseparator{%s}\n") (epilog ,(concat "\\noindent\\hrulefill\\\\\nPrinted \\today\n" "\\end{multicols}\n\\end{document}")) (options (bbdb-tex-linebreak "\\\\\\\\\n") (bbdb-tex-address-layout 2))) (one-line (demand phone) (prolog ,(concat "\\documentclass{article}\n\\usepackage{bbdb}\n" "\\begin{document}\n\\begin{bbdb}{llllll}")) (record name "&" (organization 1) "&" (phone 2 "&") "&" (mail 1) "&" (address 1) "\\\\") (separator "\\bbdbseparator{%s}") (epilog "\\end{bbdb}\n\\end{document}") (options (bbdb-tex-linebreak ", ") (bbdb-tex-address-layout 3))) (phone (demand phone) (prolog ,(concat "\\documentclass{article}\n\\usepackage{bbdb}\n" "\\begin{document}\n\\begin{bbdb}{ll}")) (record name "&" (phone 2 "&") "\\\\") (separator "\\bbdbseparator{%s}") (epilog "\\end{bbdb}\n\\end{document}") (options (bbdb-tex-linebreak ", ") (bbdb-tex-address-layout 3))) (example ; another rule with more examples (demand (or address phone)) (prolog ,(concat "\\documentclass{article}\n\\usepackage{bbdb}\n" "\\usepackage{multicol}\n" "\\begin{document}\n\\begin{multicols}{2}")) (record "\\begin{bbdbrecord}" name organization (address 1 nil (omit "work")) (phone 2 nil (admit "home" "cell")) (mail t) (birthday t) (xfields t nil (omit ,bbdb-tex-name mail-alias creation-date timestamp)) "\\end{bbdbrecord}\n") (separator "\\bbdbseparator{%s}\n") (epilog ,(concat "\\noindent\\hrulefill\\\\\nPrinted \\today\n" "\\end{multicols}\n\\end{document}")) (options (bbdb-tex-linebreak "\\\\\\\\\n") (bbdb-tex-address-layout 2)))) "Alist of rules for passing BBDB to LaTeX. Each rule has the form (RULE LIST1 LIST2 ...). The symbol RULE identifies the rule. The remainder are lists LIST that should have one of these forms: (demand FORM) Here FORM is a lisp expression. A record will be TeXed only if evaluating FORM yields a non-nil value for this record. When FORM is evaluated, the symbols name, affix, organization, mail, phone, address, and xfields are set to the corresponding values of this record; these symbols are nil if the respective field does not exist for this record. (prolog STRING) The string STRING is inserted at the beginning of the buffer. If STRING contains the substring \"\\usepackage{foo}\" and a file \"foo.sty\" exists within `bbdb-tex-path', replace \"\\usepackage{foo}\" with the content of the file \"foo.sty\", surrounded by \"\\makeatletter\" and \"\\makeatother\". Note: This fails with more sophisticated LaTeX style files using, e.g., optional arguments for the \"\\usepackage\" macro. (record ELT1 ELT2 ...) Here ELT may be one of the following: IF ELT is name, this expands to \"\\name{first}{last}\" If ELT is affix, organization, or aka, ELT expands to \"\\ELT{value}\". Here the elements of ELT are concatenated to get one value. If ELT is the key of an xfield, ELT expands to \"\\xfield{ELT}{value}\". If ELT is a string, this is inserted \"as is\" in the TeX buffer. ELT may also be a loop (FLD COUNT [SEPARATOR] [OPT...]) looping over the values of FLD. If FLD is mail, this expands to \"\\mail{short}{long}\", such as \"\\mail{foo@bar.com}{Smith }\", If FLD is phone, this expands to \"\\phone{key}{number}\" If FLD is address, this expands to \"\\address{key}{value}\". If FLD is xfields, this expands to \"\\xfield{key}{value}\". If FLD is the key of an xfield, split the value of FLD using `bbdb-separator-alist' to generate a list of values, which then expand to \"\\xfield{FLD}{value}\". If COUNT is a number, process at most COUNT values of FLD. IF COUNT is t, process all values of FLD. If SEPARATOR is non-nil, it is a string that is inserted between the values of FLD. Insert COUNT - 1 instances of SEPARATOR, even if there are fewer values of FLD. If FLD is mail, phone, address, or xfields, OPT may be a list (admit KEY ...) or (omit KEY ...). Then a value is admitted or omitted if its key KEY is listed here. (separator STRING) When the first letter of the records' sortkey increases compared with the previous record in the TeX listing, the new letter is formatted using the format string STRING to generate a separator macro. (epilog STRING) The string STRING is inserted at the end of the buffer." :group 'bbdb-utilities-TeX :type '(repeat (cons (symbol :tag "rule") (repeat (choice (cons :tag "demand" (const demand) sexp) (list :tag "prolog" (const prolog) string) (cons :tag "record" (const record) sexp) (list :tag "separator" (const separator) string) (list :tag "epilog" (const epilog) string) (cons :tag "options" (const options) sexp)))))) (defcustom bbdb-tex-rule-default 'multi-line "Default rule for BBDB tex. This symbol should be a key in `bbdb-tex-alist'." :group 'bbdb-utilities-tex :type '(symbol :tag "rule")) ;; FIXME ;; (defcustom bbdb-tex-empty-fields nil ;; "If non-nil generate TeX output even for empty fields." ;; :group 'bbdb-utilities-tex) (defcustom bbdb-tex-replace-list '(("[#$%&_]" . "\\\\\\&") ("<" . "\\\\textless ") (">" . "\\\\textgreater ") ("~" . "\\\\textasciitilde ") ("{" . "\\\\textbraceleft ") ("}" . "\\\\textbraceright ")) "Replacement list for TeX's special characters. Each element is of the form (REGEXP . REPLACE)." :group 'bbdb-utilities-tex :type '(repeat (cons regexp string))) (defcustom bbdb-tex-linebreak "\\\\\\\\\n" "Replacement for linebreaks." :group 'bbdb-utilities-tex :type 'string) (defcustom bbdb-tex-address-format-list bbdb-address-format-list "List of address formatting rules for `bbdb-tex'. Each element may take the same values as in `bbdb-address-format-list'. The elements EDIT of `bbdb-address-format-list' are ignored." :group 'bbdb-utilities-tex :type '(repeat (list (choice (const :tag "Default" t) (function :tag "Function") (repeat (string))) (choice (string) (function :tag "Function")) (choice (string) (function :tag "Function")) (choice (string) (function :tag "Function"))))) (defcustom bbdb-tex-address-layout 2 "Address layout according to `bbdb-tex-address-format-list'. 2 is multi-line layout, 3 is one-line layout." :group 'bbdb-utilities-TeX :type '(choice (const :tag "multi-line" 2) (const :tag "one-line" 3))) (defcustom bbdb-tex-file "~/bbdb.tex" "Default file name for TeXing BBDB." :group 'bbdb-utilities-tex :type 'file) ;;; Internal variables (defvar bbdb-tex-rule-last bbdb-tex-rule-default "Last rule used for TeXing BBDB.") (defvar bbdb-tex-file-last bbdb-tex-file "Last used TeX file") ;;; Functions: ;; While we use `bbdb-tex-replace' only once in `bbdb-tex-field', ;; we keep it as a separate function so that it can also be used ;; inside user-defined functions `bbdb-tex-output-...'. (defun bbdb-tex-replace (string) "Apply replacement rules `bbdb-tex-replace-list' to STRING. Also, replace linebreaks by `bbdb-tex-linebreak'." (if (not string) "" (dolist (elt bbdb-tex-replace-list) (setq string (replace-regexp-in-string (car elt) (cdr elt) string))) (replace-regexp-in-string "\n" bbdb-tex-linebreak string))) (defun bbdb-tex-field (field str) "Massage string STR for LaTeX. By default, STR is passed to `bbdb-tex-replace'. The user may also define a function `bbdb-tex-output-FIELD' that takes precedence." (let ((fun (intern-soft (format "bbdb-tex-output-%s" field)))) (if fun (funcall fun str) (bbdb-tex-replace str)))) (defun bbdb-tex-list (list rule fun) "Use function FUN to generate output for LIST according to RULE. LIST is a list of field values such as a list of addresses. RULE is an element of a record list as in `bbdb-tex-alist' used to select the elements of LIST that get processed by calling FUN." (let ((admit (cdr (assq 'admit rule))) (omit (cdr (assq 'omit rule))) (num (if (numberp (nth 1 rule)) (nth 1 rule))) (sep (if (nth 2 rule) (concat (nth 2 rule) "\n"))) (i -1) new-list elt) ;; Select the relevant elements of LIST. (cond (admit (dolist (l list) (if (member (elt l 0) admit) (push l new-list))) (setq new-list (nreverse new-list))) (omit (dolist (l list) (unless (member (elt l 0) omit) (push l new-list))) (setq new-list (nreverse new-list))) (t (setq new-list list))) (cond ((not num) (insert (mapconcat fun new-list (or sep "")))) ((not sep) (while (and (< (setq i (1+ i)) num) (setq elt (pop new-list))) (insert (funcall fun elt)))) (t (while (< (setq i (1+ i)) num) (if (setq elt (pop new-list)) (insert (funcall fun elt))) (if (< (1+ i) num) (insert sep))))))) ;;;###autoload (defun bbdb-tex (records file rule) "Generate FILE for TeXing RECORDS. Interactively, use BBDB prefix \ \\\\[bbdb-do-all-records], see `bbdb-do-all-records'. RULE should be an element of `bbdb-tex-alist'." (interactive (list (bbdb-do-records) (read-file-name (format "TeX file: (default %s) " (abbreviate-file-name bbdb-tex-file-last)) (file-name-directory bbdb-tex-file-last) bbdb-tex-file-last) (intern (completing-read (format "Rule: (default %s) " bbdb-tex-rule-last) bbdb-tex-alist nil t nil nil (symbol-name bbdb-tex-rule-last))))) ;; Remember our choice for `bbdb-tex-file-last'. (setq bbdb-tex-file-last (expand-file-name file)) (find-file bbdb-tex-file-last) (let* ((buffer-undo-list t) (rule (assq rule bbdb-tex-alist)) (demand (nth 1 (assq 'demand rule))) (separator (nth 1 (assq 'separator rule))) current-letter p-symbols p-values) (erase-buffer) ;; Options (dolist (option (cdr (assq 'options rule))) (push (car option) p-symbols) (push (cadr option) p-values)) (cl-progv p-symbols p-values ;; Prolog (let ((prolog (nth 1 (assq 'prolog rule)))) (when prolog (insert prolog) (when (consp bbdb-tex-path) (goto-char (point-min)) (while (re-search-forward "\\\\usepackage[ \t\n]*{\\([^}]+\\)}" nil t) (let ((sty (locate-file (match-string 1) bbdb-tex-path '(".sty")))) (when sty (replace-match (format "\n\\\\makeatletter\n%% begin %s\n%% end %s\n\\\\makeatother\n" sty sty)) (save-excursion (forward-line -2) (insert-file-contents sty)))))) (goto-char (point-max)) (unless (bolp) (insert "\n")) (insert "% end BBDB prolog\n"))) ;; Process Records (dolist (record (bbdb-record-list records)) (let* ((first-letter (substring (bbdb-record-sortkey record) 0 1)) (firstname (bbdb-record-firstname record)) (lastname (bbdb-record-lastname record)) (name (bbdb-record-name record)) (name-lf (bbdb-record-name-lf record)) (organization (bbdb-record-organization record)) (affix (bbdb-record-affix record)) (aka (bbdb-record-aka record)) (mail (bbdb-record-mail record)) (phone (bbdb-record-phone record)) (address (bbdb-record-address record)) (xfields (bbdb-record-xfields record)) (lex-env `((firstname . ,firstname) (lastname . ,lastname) (name . ,name) (name-lf . ,name-lf) (aka . ,aka) (organization . ,organization) (affix . ,affix) (mail . ,mail) (phone . ,phone) (address . ,address) (xfields . ,xfields))) (bbdb-address-format-list bbdb-tex-address-format-list)) ;; A record is processed only if the form DEMAND ;; evaluates to a non-nil value. (when (or (not demand) (eval demand lex-env)) ;; Separator (if (and separator (not (and current-letter (equal first-letter current-letter)))) (insert (format separator (upcase first-letter)) "\n")) (setq current-letter first-letter) (dolist (elt (cdr (assq 'record rule))) (cond ((stringp elt) (insert elt "\n")) ((eq elt 'name) ; name of record (let ((tex-name (and bbdb-tex-name (bbdb-record-field record bbdb-tex-name))) (fmt "\\name{%s}{%s}\n")) (if tex-name (let ((first-last (bbdb-split bbdb-tex-name tex-name))) (cond ((eq 2 (length first-last)) (insert (format fmt (car first-last) (cadr first-last)))) ((eq 1 (length first-last)) (insert (format fmt "" (car first-last)))) (t (error "TeX name %s cannot be split" tex-name)))) (insert (format fmt (bbdb-tex-field 'firstname firstname) (bbdb-tex-field 'lastname lastname)))))) ;; organization, affix or aka as single string ((memq elt '(organization affix aka)) (let ((val (bbdb-record-field record elt))) (if val (insert (format "\\%s{%s}\n" elt (bbdb-tex-field elt (bbdb-concat elt val))))))) ;; organization, affix or aka as list of strings ((memq (car elt) '(organization affix aka)) (bbdb-tex-list (bbdb-record-field record (car elt)) elt `(lambda (o) (format "\\%s{%s}\n" ',(car elt) (bbdb-tex-field ',(car elt) o))))) ((eq (car elt) 'mail) ; mail (bbdb-tex-list mail elt (lambda (m) (format "\\mail{%s}{%s}\n" ;; No processing of plain mail address (nth 1 (bbdb-decompose-bbdb-address m)) (bbdb-tex-field 'mail m))))) ((eq (car elt) 'address) ; address (bbdb-tex-list address elt (lambda (a) (format "\\address{%s}{%s}\n" (bbdb-tex-field 'address-label (bbdb-address-label a)) (bbdb-tex-field 'address (bbdb-format-address a bbdb-tex-address-layout)))))) ((eq (car elt) 'phone) ; phone (bbdb-tex-list phone elt (lambda (p) (format "\\phone{%s}{%s}\n" (bbdb-tex-field 'phone-label (bbdb-phone-label p)) (bbdb-tex-field 'phone (bbdb-phone-string p)))))) ((eq (car elt) 'xfields) ; list of xfields (bbdb-tex-list (bbdb-record-field record 'xfields) elt (lambda (x) (format "\\xfield{%s}{%s}\n" (bbdb-tex-field 'xfield-label (symbol-name (car x))) (bbdb-tex-field 'xfield (cdr x)))))) ((symbolp elt) ; xfield as single string ;; The value of an xfield may be a sexp instead of a string. ;; Ideally, a sexp should be formatted by `pp-to-string', ;; then printed verbatim. (let ((val (format "%s" (bbdb-record-field record elt)))) (if val (insert (format "\\xfield{%s}{%s}\n" elt (bbdb-tex-field elt (bbdb-concat elt val))))))) ((consp elt) ; xfield as list of strings (bbdb-tex-list (bbdb-split (car elt) (format "%s" (bbdb-record-field record (car elt)))) elt `(lambda (x) (format "\\xfield{%s}{%s}\n" ',(car elt) (bbdb-tex-field ',(car elt) x))))) (t (error "Rule `%s' undefined" elt))))))) ;; Epilog (let ((epilog (nth 1 (assq 'epilog rule)))) (when epilog (insert "% begin BBDB epilog\n" epilog) (unless (bolp) (insert "\n")))))) (setq buffer-undo-list nil) (save-buffer)) (provide 'bbdb-tex) ;;; bbdb-tex.el ends here bbdb3-3.2/lisp/bbdb-vm-aux.el000066400000000000000000000321631322420162700157330ustar00rootroot00000000000000;;; bbdb-vm-aux.el --- aux parts of BBDB interface to VM -*- lexical-binding: t -*- ;; Copyright (C) 1991, 1992, 1993 Jamie Zawinski . ;; Copyright (C) 2010-2017 Roland Winkler ;; This file is part of the Insidious Big Brother Database (aka BBDB), ;; BBDB 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. ;; BBDB 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 BBDB. If not, see . ;;; Commentary: ;; This file contains auxiliary parts of the BBDB interface to VM. ;; See the BBDB info manual for documentation. ;;; Code: (require 'bbdb) (require 'bbdb-com) (require 'bbdb-mua) (when t ;Don't require during compilation, since VM might not be installed! (require 'vm-autoloads) (require 'vm) (require 'vm-motion) (require 'vm-summary) (require 'vm-mime) (require 'vm-vars) (require 'vm-macro) (require 'vm-message) (require 'vm-misc)) (declare-function vm-su-from "vm-summary" (m)) (declare-function vm-su-to "vm-summary" (m)) (declare-function vm-su-to-names "vm-summary" (m)) (declare-function vm-su-full-name "vm-summary" (m)) (declare-function vm-add-message-labels "vm-undo" (string count)) (declare-function vm-decode-mime-encoded-words-in-string "vm-mime" (string)) (defvar vm-summary-uninteresting-senders) ;In vm-vars (defvar vm-summary-uninteresting-senders-arrow) ;In vm-vars (defvar vm-auto-folder-alist) ;In vm-vars (defvar vm-virtual-folder-alist) ;In vm-vars (defvar vm-folder-directory) ;In vm-vars (defvar vm-primary-inbox) ;In vm-vars ;; By Alastair Burt ;; vm 5.40 and newer support a new summary format, %U, to call ;; a user-provided function. Use "%-17.17UB" instead of "%-17.17F" to ;; have your VM summary buffers display BBDB's idea of the sender's full ;; name instead of the name (or lack thereof) in the message itself. ;; RW: this is a VM-specific version of `bbdb-mua-summary-unify' ;; which respects `vm-summary-uninteresting-senders'. ;;;###autoload (defun vm-summary-function-B (m) "For VM message M return the BBDB name of the sender. Respect `vm-summary-uninteresting-senders'." (if vm-summary-uninteresting-senders (if (let ((case-fold-search t)) (string-match vm-summary-uninteresting-senders (vm-su-from m))) (concat vm-summary-uninteresting-senders-arrow (or (bbdb/vm-alternate-full-name (vm-su-to m)) (vm-decode-mime-encoded-words-in-string (vm-su-to-names m)))) (or (bbdb/vm-alternate-full-name (vm-su-from m)) (vm-su-full-name m))) (or (bbdb/vm-alternate-full-name (vm-su-from m)) (vm-decode-mime-encoded-words-in-string (vm-su-full-name m))))) (defun bbdb/vm-alternate-full-name (address) (if address (let* ((data (bbdb-extract-address-components address)) (record (car (bbdb-message-search (car data) (cadr data))))) (if record (or (bbdb-record-xfield record 'mail-name) (bbdb-record-name record)))))) ;;;###autoload (defcustom bbdb/vm-auto-folder-headers '("From:" "To:" "CC:") "The headers used by `bbdb/vm-auto-folder'. The order in this list is the order how matching will be performed." :group 'bbdb-mua-vm :type '(repeat (string :tag "header name"))) ;;;###autoload (defcustom bbdb/vm-auto-folder-field 'vm-folder "The xfield which `bbdb/vm-auto-folder' searches for." :group 'bbdb-mua-vm :type 'symbol) ;;;###autoload (defcustom bbdb/vm-virtual-folder-field 'vm-virtual "The xfield which `bbdb/vm-virtual-folder' searches for." :group 'bbdb-mua-vm :type 'symbol) ;;;###autoload (defcustom bbdb/vm-virtual-real-folders nil "Real folders used for defining virtual folders. If nil use `vm-primary-inbox'." :group 'bbdb-mua-vm :type '(choice (const :tag "Use vm-primary-inbox" nil) (repeat (string :tag "Real folder")))) ;;;###autoload (defun bbdb/vm-auto-folder () "Add entries to `vm-auto-folder-alist' for the records in BBDB. For each record that has a `vm-folder' xfield, add an element \(MAIL-REGEXP . FOLDER-NAME) to `vm-auto-folder-alist'. The element gets added to the sublists of `vm-auto-folder-alist' specified in `bbdb/vm-auto-folder-headers'. MAIL-REGEXP matches the mail addresses of the BBDB record. The value of the `vm-folder' xfield becomes FOLDER-NAME. The `vm-folder' xfield is defined via `bbdb/vm-auto-folder-field'. Add this function to `bbdb-before-save-hook' and your .vm." (interactive) (let ((records ; Collect BBDB records with a vm-folder xfield. (delq nil (mapcar (lambda (r) (if (bbdb-record-xfield r bbdb/vm-auto-folder-field) r)) (bbdb-records)))) folder-list folder-name mail-regexp) ;; Add (MAIL-REGEXP . FOLDER-NAME) pair to this sublist of `vm-auto-folder-alist' (dolist (header bbdb/vm-auto-folder-headers) ;; create the folder-list in `vm-auto-folder-alist' if it does not exist (unless (setq folder-list (assoc header vm-auto-folder-alist)) (push (list header) vm-auto-folder-alist) (setq folder-list (assoc header vm-auto-folder-alist))) (dolist (record records) ;; Ignore everything past a comma (setq folder-name (car (bbdb-record-xfield-split record bbdb/vm-auto-folder-field)) ;; quote all the mail addresses for the record and join them mail-regexp (regexp-opt (bbdb-record-mail record))) ;; In general, the values of xfields are strings (required for editing). ;; If we could set the value of `bbdb/vm-auto-folder-field' to a symbol, ;; it could be a function that is called with arg record to calculate ;; the value of folder-name. ;; (if (functionp folder-name) ;; (setq folder-name (funcall folder-name record))) (unless (or (string= "" mail-regexp) (assoc mail-regexp folder-list)) ;; Convert relative into absolute file names using ;; `vm-folder-directory'. (unless (file-name-absolute-p folder-name) (setq folder-name (abbreviate-file-name (expand-file-name folder-name vm-folder-directory)))) ;; nconc modifies the list in place (nconc folder-list (list (cons mail-regexp folder-name)))))))) ;;;###autoload (defun bbdb/vm-virtual-folder () "Create `vm-virtual-folder-alist' according to the records in BBDB. For each record that has a `vm-virtual' xfield, add or modify the corresponding VIRTUAL-FOLDER-NAME element of `vm-virtual-folder-alist'. (VIRTUAL-FOLDER-NAME ((FOLDER-NAME ...) (author-or-recipient MAIL-REGEXP))) VIRTUAL-FOLDER-NAME is the first element of the `vm-virtual' xfield. FOLDER-NAME ... are either the remaining elements of the `vm-virtual' xfield, or `bbdb/vm-virtual-real-folders' or `vm-primary-inbox'. MAIL-REGEXP matches the mail addresses of the BBDB record. The `vm-virtual' xfield is defined via `bbdb/vm-virtual-folder-field'. Add this function to `bbdb-before-save-hook' and your .vm." (interactive) (let (real-folders mail-regexp folder val tmp) (dolist (record (bbdb-records)) (when (setq val (bbdb-record-xfield-split record bbdb/vm-virtual-folder-field)) (setq mail-regexp (regexp-opt (bbdb-record-mail record))) (unless (string= "" mail-regexp) (setq folder (car val) real-folders (mapcar (lambda (f) (if (file-name-absolute-p f) f (abbreviate-file-name (expand-file-name f vm-folder-directory)))) (or (cdr val) bbdb/vm-virtual-real-folders (list vm-primary-inbox))) ;; Either extend the definition of an already defined ;; virtual folder or define a new virtual folder tmp (or (assoc folder vm-virtual-folder-alist) (car (push (list folder) vm-virtual-folder-alist))) tmp (or (assoc real-folders (cdr tmp)) (car (setcdr tmp (cons (list real-folders) (cdr tmp))))) tmp (or (assoc 'author-or-recipient (cdr tmp)) (car (setcdr tmp (cons (list 'author-or-recipient) (cdr tmp)))))) (cond ((not (cdr tmp)) (setcdr tmp (list mail-regexp))) ((not (string-match (regexp-quote mail-regexp) (cadr tmp))) (setcdr tmp (list (concat (cadr tmp) "\\|" mail-regexp)))))))))) ;; RW: Adding custom labels to VM messages allows one to create, ;; for example, virtual folders. The following code creates ;; the required labels in a rather simplistic way, checking merely ;; whether the sender's BBDB record uses a certain mail alias. ;; (Note that `bbdb/vm-virtual-folder' can achieve the same goal, ;; yet this requires a second xfield that must be kept up-to-date, too.) ;; To make auto labels yet more useful, the code could allow more ;; sophisticated schemes, too. Are there real-world applications ;; for this? ;;; Howard Melman, contributed Jun 16 2000 (defcustom bbdb/vm-auto-add-label-list nil "List used by `bbdb/vm-auto-add-label' to automatically label VM messages. Its elements may be strings used both as the xfield value to check for and as the label to apply to the message. If an element is a cons pair (VALUE . LABEL), VALUE is the xfield value to search for and LABEL is the label to apply." :group 'bbdb-mua-vm :type 'list) (defcustom bbdb/vm-auto-add-label-field bbdb-mail-alias-field "Xfields used by `bbdb/vm-auto-add-label' to automatically label messages. This is either a single BBDB xfield or a list of xfields that `bbdb/vm-auto-add-label' uses to check for labels to apply to a message. Defaults to `bbdb-mail-alias-field' which defaults to `mail-alias'." :group 'bbdb-mua-vm :type '(choice symbol list)) ;;;###autoload (defun bbdb/vm-auto-add-label (record) "Automatically add labels to VM messages. Add this to `bbdb-notice-record-hook' to check the messages noticed by BBDB. If the value of `bbdb/vm-auto-add-label-field' in the sender's BBDB record matches a value in `bbdb/vm-auto-add-label-list' then a VM label will be added to the message. Such VM labels can be used, e.g., to mark messages via `vm-mark-matching-messages' or to define virtual folders via `vm-create-virtual-folder' Typically `bbdb/vm-auto-add-label-field' and `bbdb/vm-auto-add-label-list' refer to mail aliases FOO used with multiple records. This adds a label FOO to all incoming messages matching FOO. Then VM can create a virtual folder for these messages. The concept of combining multiple recipients of an outgoing message in one mail alias thus gets extended to incoming messages from different senders." ;; This could go into `vm-arrived-message-hook' to check messages only once. (if (eq major-mode 'vm-mode) (let* ((xvalues ;; Inspect the relevant fields of RECORD (append (mapcar (lambda (field) (bbdb-record-xfield-split record field)) (cond ((listp bbdb/vm-auto-add-label-field) bbdb/vm-auto-add-label-field) ((symbolp bbdb/vm-auto-add-label-field) (list bbdb/vm-auto-add-label-field)) (t (error "Bad value for bbdb/vm-auto-add-label-field")))))) ;; Collect the relevant labels from `bbdb/vm-auto-add-label-list' (labels (delq nil (mapcar (lambda (l) (cond ((stringp l) (if (member l xvalues) l)) ((and (consp l) (stringp (car l)) (stringp (cdr l))) (if (member (car l) xvalues) (cdr l))) (t (error "Malformed bbdb/vm-auto-add-label-list")))) bbdb/vm-auto-add-label-list)))) (if labels (vm-add-message-labels (mapconcat 'identity labels " ") 1))))) (provide 'bbdb-vm-aux) ;;; bbdb-vm-aux.el ends here bbdb3-3.2/lisp/bbdb-vm.el000066400000000000000000000073311322420162700151370ustar00rootroot00000000000000;;; bbdb-vm.el --- BBDB interface to VM -*- lexical-binding: t -*- ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; This file is part of the Insidious Big Brother Database (aka BBDB), ;; BBDB 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. ;; BBDB 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 BBDB. If not, see . ;;; Commentary: ;; This file contains the BBDB interface to VM. ;; See the BBDB info manual for documentation. ;;; Code: (require 'bbdb) (require 'bbdb-com) (require 'bbdb-mua) (when t ;Don't require during compilation, since VM might not be installed! (require 'vm-autoloads) (require 'vm-summary) (require 'vm-mime) (require 'vm-vars)) (declare-function vm-get-header-contents "vm-summary" (message header-name-regexp &optional clump-sep)) (declare-function vm-decode-mime-encoded-words-in-string "vm-mime" (string)) (declare-function vm-su-interesting-full-name "vm-summary" (m)) (declare-function vm-su-from "vm-summary" (m)) (defvar vm-message-pointer) ;In vm-vars (defvar vm-mode-map) ;In vm-vars ;;;###autoload (defun bbdb/vm-header (header) (save-current-buffer (vm-select-folder-buffer) (vm-get-header-contents (car vm-message-pointer) (concat header ":")))) ;;;###autoload (defun bbdb-insinuate-vm () "Hook BBDB into VM. Do not call this in your init file. Use `bbdb-initialize'." (define-key vm-mode-map ":" 'bbdb-mua-display-records) (define-key vm-mode-map "`" 'bbdb-mua-display-sender) (define-key vm-mode-map "'" 'bbdb-mua-display-recipients) (define-key vm-mode-map ";" 'bbdb-mua-edit-field-sender) ;; Do we need keybindings for more commands? Suggestions welcome. ;; (define-key vm-mode-map "'" 'bbdb-mua-edit-field-recipients) (define-key vm-mode-map "/" 'bbdb) ;; `mail-mode-map' is the parent of `vm-mail-mode-map'. ;; So the following is also done by `bbdb-insinuate-mail'. (if (and bbdb-complete-mail (boundp 'vm-mail-mode-map)) (define-key vm-mail-mode-map "\M-\t" 'bbdb-complete-mail)) ;; Set up user field for use in `vm-summary-format' ;; (1) Big solution: use whole name (if bbdb-mua-summary-unify-format-letter (defalias (intern (concat "vm-summary-function-" bbdb-mua-summary-unify-format-letter)) (lambda (m) (bbdb-mua-summary-unify ;; VM does not give us the original From header. ;; So we have to work backwards. (let ((name (vm-decode-mime-encoded-words-in-string (vm-su-interesting-full-name m))) (mail (vm-su-from m))) (if (string= name mail) mail (format "\"%s\" <%s>" name mail))))))) ;; (2) Small solution: a mark for messages whos sender is in BBDB. (if bbdb-mua-summary-mark-format-letter (defalias (intern (concat "vm-summary-function-" bbdb-mua-summary-mark-format-letter)) ;; VM does not give us the original From header. ;; So we assume that the mail address is sufficient to identify ;; the BBDB record of the sender. (lambda (m) (bbdb-mua-summary-mark (vm-su-from m)))))) (provide 'bbdb-vm) ;;; bbdb-vm.el ends here bbdb3-3.2/lisp/bbdb-wl.el000066400000000000000000000035701322420162700151400ustar00rootroot00000000000000;;; bbdb-wl.el --- BBDB interface to Wanderlust -*- lexical-binding: t -*- ;; Copyright (C) 2015-2017 Free Software Foundation, Inc. ;; This file is part of the Insidious Big Brother Database (aka BBDB), ;; BBDB 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. ;; BBDB 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 BBDB. If not, see . ;;; Commentary: ;; This file contains the BBDB interface to Wl. ;; See the BBDB info manual for documentation. ;;; Code: (require 'bbdb) (require 'bbdb-mua) (defvar wl-summary-mode-map) (defvar wl-draft-mode-map) (defvar wl-summary-buffer-elmo-folder) (eval-and-compile (autoload 'wl-summary-message-number "wl-summary") (autoload 'elmo-message-entity "elmo-msgdb") (autoload 'elmo-message-entity-field "elmo-msgdb")) ;;;###autoload (defun bbdb/wl-header (header) (elmo-message-entity-field (elmo-message-entity wl-summary-buffer-elmo-folder (wl-summary-message-number)) (intern (downcase header)) 'string)) ;;;###autoload (defun bbdb-insinuate-wl () "Hook BBDB into Wanderlust." (define-key wl-summary-mode-map (kbd ":") #'bbdb-mua-display-sender) (define-key wl-summary-mode-map (kbd ";") #'bbdb-mua-edit-field-sender) (when bbdb-complete-mail (define-key wl-draft-mode-map (kbd "M-;") #'bbdb-complete-mail) (define-key wl-draft-mode-map (kbd "M-") #'bbdb-complete-mail))) (provide 'bbdb-wl) ;;; bbdb-wl.el ends here bbdb3-3.2/lisp/bbdb.el000066400000000000000000006332431322420162700145260ustar00rootroot00000000000000;;; bbdb.el --- core of BBDB -*- lexical-binding: t -*- ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; Version: 3.2 ;; Package-Requires: ((emacs "24")) ;; This file is part of the Insidious Big Brother Database (aka BBDB), ;; BBDB 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. ;; BBDB 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 BBDB. If not, see . ;;; Commentary: ;; This file is the core of the Insidious Big Brother Database (aka BBDB), ;; See the BBDB info manual for documentation. ;; ;; ----------------------------------------------------------------------- ;; | There is a mailing list for discussion of BBDB: | ;; | bbdb-user@nongnu.org | ;; | To join, go to https://lists.nongnu.org/mailman/listinfo/bbdb-user | ;; | | ;; | When joining this list or reporting bugs, please mention which | ;; | version of BBDB you have. | ;; ----------------------------------------------------------------------- ;;; Code: (require 'timezone) (require 'bbdb-site) ;; When running BBDB, we have (require 'bbdb-autoloads) (declare-function widget-group-match "wid-edit") (declare-function bbdb-migrate "bbdb-migrate") (declare-function bbdb-do-records "bbdb-com") (declare-function bbdb-append-display-p "bbdb-com") (declare-function bbdb-toggle-records-layout "bbdb-com") (declare-function bbdb-dwim-mail "bbdb-com") (declare-function bbdb-layout-prefix "bbdb-com") (declare-function bbdb-completing-read-records "bbdb-com") (declare-function bbdb-merge-records "bbdb-com") (declare-function mail-position-on-field "sendmail") (declare-function vm-select-folder-buffer "vm-folder") ;; cannot use autoload for variables... (defvar message-mode-map) ;; message.el (defvar mail-mode-map) ;; sendmail.el (defvar gnus-article-buffer) ;; gnus-art.el ;; Custom groups (defgroup bbdb nil "The Insidious Big Brother Database." :group 'news :group 'mail) (defgroup bbdb-record-display nil "Variables that affect the display of BBDB records" :group 'bbdb) (defgroup bbdb-record-edit nil "Variables that affect the editing of BBDB records" :group 'bbdb) (defgroup bbdb-sendmail nil "Variables that affect sending mail." :group 'bbdb) (defgroup bbdb-mua nil "Variables that specify the BBDB-MUA interface" :group 'bbdb) (defgroup bbdb-mua-gnus nil "Gnus-specific BBDB customizations" :group 'bbdb-mua) (put 'bbdb-mua-gnus 'custom-loads '(bbdb-gnus)) (defgroup bbdb-mua-gnus-scoring nil "Gnus-specific scoring BBDB customizations" :group 'bbdb-mua-gnus) (put 'bbdb-mua-gnus-scoring 'custom-loads '(bbdb-gnus)) (defgroup bbdb-mua-gnus-splitting nil "Gnus-specific splitting BBDB customizations" :group 'bbdb-mua-gnus) (put 'bbdb-mua-gnus-splitting 'custom-loads '(bbdb-gnus)) (defgroup bbdb-mua-vm nil "VM-specific BBDB customizations" :group 'bbdb-mua) (put 'bbdb-mua-vm 'custom-loads '(bbdb-vm)) (defgroup bbdb-mua-message nil "Message-specific BBDB customizations" :group 'bbdb-mua) (put 'bbdb-mua-message 'custom-loads '(bbdb-message)) (defgroup bbdb-utilities nil "Customizations for BBDB Utilities" :group 'bbdb) (defgroup bbdb-utilities-dialing nil "BBDB Customizations for phone number dialing" :group 'bbdb) (defgroup bbdb-utilities-tex nil "Customizations for TeXing BBDB." :group 'bbdb) (put 'bbdb-utilities-tex 'custom-loads '(bbdb-tex)) (defgroup bbdb-utilities-anniv nil "Customizations for BBDB Anniversaries" :group 'bbdb-utilities) (put 'bbdb-utilities-anniv 'custom-loads '(bbdb-anniv)) (defgroup bbdb-utilities-ispell nil "Customizations for BBDB ispell interface" :group 'bbdb-utilities) (put 'bbdb-utilities-ispell 'custom-loads '(bbdb-ispell)) (defgroup bbdb-utilities-snarf nil "Customizations for BBDB snarf" :group 'bbdb-utilities) (put 'bbdb-utilities-snarf 'custom-loads '(bbdb-snarf)) (defgroup bbdb-utilities-pgp nil "Customizations for BBDB pgp" :group 'bbdb-utilities) (put 'bbdb-utilities-pgp 'custom-loads '(bbdb-pgp)) (defgroup bbdb-utilities-sc nil "Customizations for using Supercite with the BBDB." :group 'bbdb-utilities :prefix "bbdb-sc") (put 'bbdb-utilities-sc 'custom-loads '(bbdb-sc)) ;;; Customizable variables (defcustom bbdb-file (locate-user-emacs-file "bbdb" ".bbdb") "The name of the Insidious Big Brother Database file." :group 'bbdb :type 'file) ;; This should be removed, and the following put in place: ;; a hierarchical structure of bbdb files, some perhaps read-only, ;; perhaps caching in the local bbdb. This way one could have, e.g. an ;; organization address book, with each person having access to it, and ;; then a local address book with personal stuff in it. (defcustom bbdb-file-remote nil "The remote file to save the BBDB database to. When this is non-nil, it should be a file name. When BBDB reads `bbdb-file', it also checks this file, and if it is newer than `bbdb-file', it loads this file. When BBDB writes `bbdb-file', it also writes this file. This feature allows one to keep the database in one place while using different computers, thus reducing the need for merging different files." :group 'bbdb :type '(choice (const :tag "none" nil) (file :tag "remote file name"))) (defcustom bbdb-file-remote-save-always t "If t `bbdb-file-remote' is saved automatically when `bbdb-file' is saved. When nil, ask." :group 'bbdb :type 'boolean) (defcustom bbdb-read-only nil "If t then BBDB will not modify `bbdb-file'. If you have more than one Emacs running at the same time, you might want to set this to t in all but one of them." :group 'bbdb :type '(choice (const :tag "Database is read-only" t) (const :tag "Database is writable" nil))) (defcustom bbdb-auto-revert nil "If t revert unchanged database without querying. If t and `bbdb-file' has changed on disk, while the database has not been modified inside Emacs, revert the database automatically. If nil or the database has been changed inside Emacs, always query before reverting." :group 'bbdb :type '(choice (const :tag "Revert unchanged database without querying" t) (const :tag "Ask before reverting database" nil))) (defcustom bbdb-check-auto-save-file nil "If t BBDB will check its auto-save file. If this file is newer than `bbdb-file', BBDB will offer to revert." :group 'bbdb :type '(choice (const :tag "Check auto-save file" t) (const :tag "Do not check auto-save file" nil))) (defcustom bbdb-before-save-hook nil "Hook run before saving `bbdb-file'." :group 'bbdb :type 'hook) (defcustom bbdb-after-save-hook nil "Hook run after saving `bbdb-file'." :group 'bbdb :type 'hook) (defcustom bbdb-create-hook nil "*Hook run each time a new BBDB record is created. Run with one argument, the new record. This is called before the record is added to the database, followed by a call of `bbdb-change-hook'. If a record has been created by analyzing a mail message, hook functions can use the variable `bbdb-update-records-address' to determine the header and class of the mail address according to `bbdb-message-headers'." :group 'bbdb :type 'hook) (defcustom bbdb-change-hook nil "*Hook run each time a BBDB record is changed. Run with one argument, the record. This is called before the database is modified. If a new bbdb record is created, `bbdb-create-hook' is called first, followed by a call of this hook." :group 'bbdb :type 'hook) (defcustom bbdb-merge-records-function nil "If non-nil, a function for merging two records. This function is called when loading a record into BBDB that has the same uuid as an exisiting record. If nil use `bbdb-merge-records'. This function should take two arguments RECORD1 and RECORD2, with RECORD2 being the already existing record. It should merge RECORD1 into RECORD2, and return RECORD2." :group 'bbdb :type 'function) (defcustom bbdb-time-stamp-format "%Y-%m-%d %T %z" "The BBDB time stamp format. See `format-time-string'. This function is called with arg UNIVERSAL being non-nil." :group 'bbdb :type 'string) (defcustom bbdb-after-change-hook nil "Hook run each time a BBDB record is changed. Run with one argument, the record. This is called after the database is modified. So if you want to modify a record when it is created or changed, use instead `bbdb-create-hook' and / or `bbdb-change-hook'." :group 'bbdb :type 'hook) (defcustom bbdb-after-read-db-hook nil "Hook run (with no arguments) after `bbdb-file' is read. Note that this can be called more than once if the BBDB is reverted." :group 'bbdb :type 'hook) (defcustom bbdb-initialize-hook nil "Normal hook run after the BBDB initialization function `bbdb-initialize'." :group 'bbdb :type 'hook) (defcustom bbdb-mode-hook nil "Normal hook run when the *BBDB* buffer is created." :group 'bbdb :type 'hook) (defcustom bbdb-silent nil "If t, BBDB suppresses all its informational messages and queries. Be very very certain you want to set this to t, because it will suppress queries to alter record names, assign names to addresses, etc. Lisp Hackers: See also `bbdb-silent-internal'." :group 'bbdb :type '(choice (const :tag "Run silently" t) (const :tag "Disable silent running" nil))) (defcustom bbdb-info-file nil "Location of the bbdb info file, if it's not in the standard place." :group 'bbdb :type '(choice (const :tag "Standard location" nil) (file :tag "Nonstandard location"))) ;;; Record display (defcustom bbdb-pop-up-window-size 0.5 "Vertical size of BBDB window (vertical split). If it is an integer number, it is the number of lines used by BBDB. If it is a fraction between 0.0 and 1.0 (inclusive), it is the fraction of the tallest existing window that BBDB will take over. If it is t use `display-buffer'/`pop-to-buffer' to create the BBDB window. See also `bbdb-mua-pop-up-window-size'." :group 'bbdb-record-display :type '(choice (number :tag "BBDB window size") (const :tag "Use `pop-to-buffer'" t))) (defcustom bbdb-dedicated-window nil "Make *BBDB* window a dedicated window. Allowed values include nil (not dedicated) 'bbdb (weakly dedicated) and t (strongly dedicated)." :group 'bbdb-record-display :type '(choice (const :tag "BBDB window not dedicated" nil) (const :tag "BBDB window weakly dedicated" bbdb) (const :tag "BBDB window strongly dedicated" t))) (defcustom bbdb-layout-alist '((one-line (order . (phone mail-alias mail notes)) (name-end . 24) (toggle . t)) (multi-line (omit . (uuid creation-date timestamp name-format name-face)) (toggle . t) (indentation . 21)) (pop-up-multi-line (omit . (uuid creation-date timestamp name-format name-face)) (indentation . 21)) (full-multi-line (indentation . 21))) "Alist describing each display layout. The format of an element is (LAYOUT-NAME OPTION-ALIST). By default there are four different layout types used by BBDB, which are `one-line', `multi-line', `pop-up-multi-line' (used for pop-ups) and `full-multi-line' (showing all fields of a record). OPTION-ALIST specifies the options for the layout. Valid options are: ------- Availability -------- Format one-line multi-line default if unset ------------------------------------------------------------------------------ (toggle . BOOL) + + nil (order . FIELD-LIST) + + '(phone ...) (omit . FIELD-LIST) + + nil (name-end . INTEGER) + - 40 (indentation . INTEGER) - + 21 (primary . BOOL) - + nil (display-p . FUNCTION) + + nil - toggle: controls if this layout is included when toggeling the layout - order: defines a user specific order for the fields, where t is a place holder for all remaining fields - omit: is a list of xfields which should not be displayed or t to exclude all xfields except those listed in the order option - name-end: sets the column where the name should end in one-line layout. - indentation: sets the level of indentation for multi-line display. - primary: controls whether only the primary mail is shown or all are shown. - display-p: a function controlling whether the record is to be displayed. When you add a new layout FOO, you can write a corresponding layout function `bbdb-display-record-layout-FOO'. If you do not write your own layout function, the multi-line layout will be used." :group 'bbdb-record-display :type `(repeat (cons :tag "Layout Definition" (choice :tag "Layout type" (const one-line) (const multi-line) (const pop-up-multi-line) (const full-multi-line) (symbol)) (set :tag "Properties" (cons :tag "Order" (const :tag "List of fields to order by" order) (repeat (choice (const phone) (const address) (const mail) (const AKA) (const notes) (symbol :tag "other") (const :tag "Remaining fields" t)))) (choice :tag "Omit" :value (omit . nil) (cons :tag "List of fields to omit" (const :tag "Fields not to display" omit) (repeat (choice (const phone) (const address) (const mail) (const AKA) (const notes) (symbol :tag "other")))) (const :tag "Exclude all fields except those listed in the order note" t)) (cons :tag "Indentation" :value (indentation . 14) (const :tag "Level of indentation for multi-line layout" indentation) (number :tag "Column")) (cons :tag "End of name field" :value (name-end . 24) (const :tag "The column where the name should end in one-line layout" name-end) (number :tag "Column")) (cons :tag "Toggle" (const :tag "The layout is included when toggling layout" toggle) boolean) (cons :tag "Primary Mail Only" (const :tag "Only the primary mail address is included" primary) boolean) (cons :tag "Display-p" (const :tag "Show only records passing this test" display-p) (choice (const :tag "No test" nil) (function :tag "Predicate"))))))) (defcustom bbdb-layout 'multi-line "Default display layout." :group 'bbdb-record-display :type '(choice (const one-line) (const multi-line) (const full-multi-line) (symbol))) (defcustom bbdb-pop-up-layout 'pop-up-multi-line "Default layout for pop-up BBDB buffers (mail, news, etc.)." :group 'bbdb-record-display :type '(choice (const one-line) (const multi-line) (const full-multi-line) (symbol))) (defcustom bbdb-wrap-column nil "Wrap column for multi-line display. If nil do not wrap lines." :group 'bbdb-record-display :type '(choice (const :tag "No line wrapping" nil) (number :tag "Wrap column"))) (defcustom bbdb-case-fold-search (default-value 'case-fold-search) "Value of `case-fold-search' used by BBDB and friends. This variable lets the case-sensitivity of the BBDB commands be different from standard commands like command `isearch-forward'." :group 'bbdb-record-display :type 'boolean) (defcustom bbdb-name-format 'first-last "Format for displaying names. If first-last names are displayed as \"Firstname Lastname\". If last-first names are displayed as \"Lastname, Firstname\". This can be overriden per record via the xfield name-format, which should take the same values. See also `bbdb-read-name-format'." :group 'bbdb-record-display :type '(choice (const :tag "Firstname Lastname" first-last) (const :tag "Lastname, Firstname" last-first))) ;; See http://en.wikipedia.org/wiki/Postal_address ;; http://www.upu.int/en/activities/addressing/postal-addressing-systems-in-member-countries.html (defcustom bbdb-address-format-list '((("Argentina") "spcSC" "@%s\n@%p, @%c@, %S@\n%C@" "@%c@") (("Australia") "scSpC" "@%s\n@%c@ %S@ %p@\n%C@" "@%c@") (("Austria" "Germany" "Spain" "Switzerland") "spcSC" "@%s\n@%p @%c@ (%S)@\n%C@" "@%c@") (("Canada") "scSCp" "@%s\n@%c@, %S@\n%C@ %p@" "@%c@") (("China") "scpSC" "@%s\n@%c@\n%p@ %S@\n%C@" "@%c@") ; English format ; (("China") "CpScs" "@%C @%p\n@%S @%c@ %s@" "@%c@") ; Chinese format (("India") "scpSC" "@%s\n@%c@ %p@ (%S)@\n%C@" "@%c@") (("USA") "scSpC" "@%s\n@%c@, %S@ %p@\n%C@" "@%c@") (t bbdb-edit-address-default bbdb-format-address-default "@%c@")) "List of address editing and formatting rules for BBDB. Each rule is a list (IDENTIFIER EDIT FORMAT FORMAT). The first rule for which IDENTIFIER matches an address is used for editing and formatting the address. IDENTIFIER may be a list of countries. IDENTIFIER may also be a function that is called with one arg, the address to be used. The rule applies if the function returns non-nil. See `bbdb-address-continental-p' for an example. If IDENTIFIER is t, this rule always applies. Usually, this should be the last rule that becomes a fall-back (default). EDIT may be a function that is called with one argument, the address. See `bbdb-edit-address-default' for an example. EDIT may also be an editting format string. It is a string containing the five letters s, c, p, S, and C that specify the order for editing the five elements of an address: s streets c city p postcode S state C country The first FORMAT of each rule is used for multi-line layout, the second FORMAT is used for one-line layout. FORMAT may be a function that is called with one argument, the address. See `bbdb-format-address-default' for an example. FORMAT may also be a format string. It consists of formatting elements separated by a delimiter defined via the first (and last) character of FORMAT. Each formatting element may contain one of the following format specifiers: %s streets (used repeatedly for each street part) %c city %p postcode %S state %C country A formatting element will be applied only if the corresponding part of the address is a non-empty string. See also `bbdb-tex-address-format-list'." :group 'bbdb-record-display :type '(repeat (list (choice (const :tag "Default" t) (function :tag "Function") (repeat (string))) (choice (string) (function :tag "Function")) (choice (string) (function :tag "Function")) (choice (string) (function :tag "Function"))))) (defcustom bbdb-continental-postcode-regexp "^\\s *[A-Z][A-Z]?\\s *-\\s *[0-9][0-9][0-9]" "Regexp matching continental postcodes. Used by address format identifier `bbdb-address-continental-p'. The regexp should match postcodes of the form CH-8052, NL-2300RA, and SE-132 54." :group 'bbdb-record-display :type 'regexp) (defcustom bbdb-default-separator '("[,;]" ", ") "The default field separator. It is a list (SPLIT-RE JOIN). This is used for fields which do not have an entry in `bbdb-separator-alist'. Whitespace surrounding SPLIT-RE is ignored." :group 'bbdb-record-display :type '(list regexp string)) (defcustom bbdb-separator-alist '((record "\n\n" "\n\n") ; used by `bbdb-copy-fields-as-kill' (name-first-last "[ ,;]" " ") (name-last-first "[ ,;]" ", ") (name-field ":\n" ":\n") ; used by `bbdb-copy-fields-as-kill' (phone "[,;]" ", ") (address ";\n" ";\n") ; ditto (organization "[,;]" ", ") (affix "[,;]" ", ") (aka "[,;]" ", ") (mail "[,;]" ", ") (mail-alias "[,;]" ", ") (vm-folder "[,;]" ", ") (birthday "\n" "\n") (wedding "\n" "\n") (anniversary "\n" "\n") (notes "\n" "\n") (tex-name "#" " # ")) "Alist of field separators. Each element is of the form (FIELD SPLIT-RE JOIN). Whitespace surrounding SPLIT-RE is ignored. For fields lacking an entry here `bbdb-default-separator' is used instead." :group 'bbdb-record-display :type '(repeat (list symbol regexp string))) (defcustom bbdb-user-menu-commands nil "User defined menu entries which should be appended to the BBDB menu. This should be a list of menu entries. When set to a function, it is called with two arguments RECORD and FIELD and it should either return nil or a list of menu entries. Used by `bbdb-mouse-menu'." :group 'bbdb-record-display :type 'sexp) (defcustom bbdb-display-hook nil "Hook run after the *BBDB* is filled in." :group 'bbdb-record-display :type 'hook) (defcustom bbdb-multiple-buffers nil "When non-nil we create a new buffer of every buffer causing pop-ups. You can also set this to a function returning a buffer name. Here a value may be the predefined function `bbdb-multiple-buffers-default'." :group 'bbdb-record-display :type '(choice (const :tag "Disabled" nil) (function :tag "Enabled" bbdb-multiple-buffers-default) (function :tag "User defined function"))) (defcustom bbdb-image nil "If non-nil display records with an image. If a symbol this should be an xfield holding the name of the image file associated with the record. If it is `name' or `fl-name', the first and last name of the record are used as file name. If it is `lf-name', the last and first name of the record are used as file name. If a function it is called with one arg, the record, and it should return the name of the image file. The file is searched in the directories in `bbdb-image-path'. File name suffixes are appended according to `bbdb-image-suffixes'. See `locate-file'." :group 'bbdb-record-display :type '(choice (const :tag "Disabled" nil) (function :tag "User defined function") (symbol :tag "Record field"))) (defcustom bbdb-image-path nil "List of directories to search for `bbdb-image'." :group 'bbdb-record-display :type '(repeat (directory))) (defcustom bbdb-image-suffixes '(".png" ".jpg" ".gif" ".xpm") "List of file name suffixes searched for `bbdb-image'." :group 'bbdb-record-display :type '(repeat (string :tag "File suffix"))) (defcustom bbdb-read-name-format 'fullname "Default format for reading names via `bbdb-read-name'. If it is 'first-last read first and last name separately. If it is 'last-first read last and first name separately. With any other value read full name at once. See also `bbdb-name-format'." :group 'bbdb-record-display :type '(choice (const :tag "Firstname Lastname" first-last) (const :tag "Lastname, Firstname" last-first) (const :tag "Full name" fullname))) ;;; Record editing (defcustom bbdb-lastname-prefixes '("von" "de" "di") "List of lastname prefixes recognized in name fields. Used to enhance dividing name strings into firstname and lastname parts. Case is ignored." :group 'bbdb-record-edit :type '(repeat string)) (defcustom bbdb-lastname-re (concat "[- \t]*\\(\\(?:\\<" (regexp-opt bbdb-lastname-prefixes) ;; multiple last names concatenated by `-' "\\>[- \t]+\\)?\\(?:\\w+[ \t]*-[ \t]*\\)*\\w+\\)\\'") "Regexp matching the last name of a full name. Its first parenthetical subexpression becomes the last name." :group 'bbdb-record-edit :type 'regexp) (defcustom bbdb-lastname-suffixes '("Jr" "Sr" "II" "III") "List of lastname suffixes recognized in name fields. Used to dividing name strings into firstname and lastname parts. All suffixes are complemented by optional `.'. Case is ignored." :group 'bbdb-record-edit :type '(repeat string)) (defcustom bbdb-lastname-suffix-re (concat "[-,. \t/\\]+\\(" (regexp-opt bbdb-lastname-suffixes) ;; suffices are complemented by optional `.'. "\\.?\\)\\W*\\'") "Regexp matching the suffix of a last name. Its first parenthetical subexpression becomes the suffix." :group 'bbdb-record-edit :type 'regexp) (defcustom bbdb-default-domain nil "Default domain to append when reading a new mail address. If a mail address does not contain `[@%!]', append @`bbdb-default-domain' to it. The address is not altered if `bbdb-default-domain' is nil or if a prefix argument is given to the command `bbdb-insert-field'." :group 'bbdb-record-edit :type '(choice (const :tag "none" nil) (string :tag "Default Domain"))) (defcustom bbdb-phone-style 'nanp "Phone numbering plan assumed by BBDB. The value 'nanp refers to the North American Numbering Plan. The value nil refers to a free-style numbering plan. You can have both styles of phone number in your database by providing a prefix argument to the command `bbdb-insert-field'." :group 'bbdb-record-edit :type '(choice (const :tag "NANP" nanp) (const :tag "none" nil))) (defcustom bbdb-default-area-code nil "Default area code to use when reading a new phone number. This variable also affects dialing." :group 'bbdb-record-edit :type '(choice (const :tag "none" nil) (integer :tag "Default Area Code")) :set (lambda( symb val ) (if (or (and (stringp val) (string-match "^[0-9]+$" val)) (integerp val) (null val)) (set symb val) (error "%s must contain digits only." symb)))) (defcustom bbdb-allow-duplicates nil "When non-nil BBDB allows records with duplicate names and email addresses. In rare cases, this may lead to confusion with BBDB's MUA interface." :group 'bbdb-record-edit :type 'boolean) (defcustom bbdb-default-label-list '("home" "work" "other") "Default list of labels for Address and Phone fields." :group 'bbdb-record-edit :type '(repeat string)) (defcustom bbdb-address-label-list bbdb-default-label-list "List of labels for Address field." :group 'bbdb-record-edit :type '(repeat string)) (defcustom bbdb-phone-label-list '("home" "work" "cell" "other") "List of labels for Phone field." :group 'bbdb-record-edit :type '(repeat string)) (defcustom bbdb-default-country "Emacs";; what do you mean, it's not a country? "Default country to use if none is specified." :group 'bbdb-record-edit :type '(choice (const :tag "None" nil) (string :tag "Default Country"))) (defcustom bbdb-check-postcode t "If non-nil, require legal postcodes when entering an address. The format of legal postcodes is determined by the variable `bbdb-legal-postcodes'." :group 'bbdb-record-edit :type 'boolean) (defcustom bbdb-legal-postcodes '(;; empty string "^$" ;; Matches 1 to 6 digits. "^[ \t\n]*[0-9][0-9]?[0-9]?[0-9]?[0-9]?[0-9]?[ \t\n]*$" ;; Matches 5 digits and 3 or 4 digits. "^[ \t\n]*\\([0-9][0-9][0-9][0-9][0-9]\\)[ \t\n]*-?[ \t\n]*\\([0-9][0-9][0-9][0-9]?\\)[ \t\n]*$" ;; Match postcodes for Canada, UK, etc. (result is ("LL47" "U4B")). "^[ \t\n]*\\([A-Za-z0-9]+\\)[ \t\n]+\\([A-Za-z0-9]+\\)[ \t\n]*$" ;; Match postcodes for continental Europe. Examples "CH-8057" ;; or "F - 83320" (result is ("CH" "8057") or ("F" "83320")). ;; Support for "NL-2300RA" added at request from Carsten Dominik ;; "^[ \t\n]*\\([A-Z]+\\)[ \t\n]*-?[ \t\n]*\\([0-9]+ ?[A-Z]*\\)[ \t\n]*$" ;; Match postcodes from Sweden where the five digits are grouped 3+2 ;; at the request from Mats Lofdahl . ;; (result is ("SE" (133 36))) "^[ \t\n]*\\([A-Z]+\\)[ \t\n]*-?[ \t\n]*\\([0-9]+\\)[ \t\n]+\\([0-9]+\\)[ \t\n]*$") "List of regexps that match legal postcodes. Whether this is used at all depends on the variable `bbdb-check-postcode'." :group 'bbdb-record-edit :type '(repeat regexp)) (defcustom bbdb-default-xfield 'notes "Default xfield when editing BBDB records." :group 'bbdb-record-edit :type '(symbol :tag "Xfield")) (defcustom bbdb-edit-foo (cons bbdb-default-xfield 'current-fields) "Fields to edit with command `bbdb-edit-foo'. This is a cons pair (WITHOUT-PREFIX . WITH-PREFIX). The car is used if the command is called without a prefix. The cdr is used if the command is called with a prefix. WITHOUT-PREFIX and WITH-PREFIX may take the values: name The full name affix The list of affixes organization The list of organizations aka the list of AKAs mail the list of email addresses phone the list of phone numbers address the list of addresses current-fields Read the field to edit using a completion table that includes all fields of the current record. all-fields Read the field to edit using a completion table that includes all fields currently known to BBDB. Any other symbol is interpreted as the label of an xfield." :group 'bbdb-record-edit :type '(cons (symbol :tag "Field without prefix") (symbol :tag "Field with prefix"))) ;;; MUA interface (defcustom bbdb-annotate-field bbdb-default-xfield "Field to annotate via `bbdb-annotate-record' and friends. This may take the values: affix The list of affixes organization The list of organizations aka the list of AKAs mail the list of email addresses all-fields Read the field to edit using a completion table that includes all fields currently known to BBDB. Any other symbol is interpreted as the label of an xfield." :group 'bbdb-mua :type '(symbol :tag "Field to annotate")) (defcustom bbdb-mua-edit-field bbdb-default-xfield "Field to edit with command `bbdb-mua-edit-field' and friends. This may take the values: name The full name affix The list of affixes organization The list of organizations aka the list of AKAs mail the list of email addresses all-fields Read the field to edit using a completion table that includes all fields currently known to BBDB. Any other symbol is interpreted as the label of an xfield." :group 'bbdb-mua :type '(symbol :tag "Field to edit")) (defcustom bbdb-mua-update-interactive-p '(search . query) "How BBDB's interactive MUA commands update BBDB records. This is a cons pair (WITHOUT-PREFIX . WITH-PREFIX). The car is used if the command is called without a prefix. The cdr is used if the command is called with a prefix (and if the prefix is not used for another purpose). WITHOUT-PREFIX and WITH-PREFIX may take the values \(here ADDRESS is an email address found in a message): nil Do nothing. search Search for existing records matching ADDRESS. update Search for existing records matching ADDRESS; update name and mail field if necessary. query Search for existing records matching ADDRESS; query for creation of a new record if the record does not exist. create or t Search for existing records matching ADDRESS; create a new record if it does not yet exist. a function This functions will be called with no arguments. It should return one of the above values. read Read the value interactively." :group 'bbdb-mua :type '(cons (choice (const :tag "do nothing" nil) (const :tag "search for existing records" search) (const :tag "update existing records" update) (const :tag "query annotation of all messages" query) (const :tag "annotate all messages" create) (function :tag "User-defined function") (const :tag "read arg interactively" read)) (choice (const :tag "do nothing" nil) (const :tag "search for existing records" search) (const :tag "update existing records" update) (const :tag "query annotation of all messages" query) (const :tag "annotate all messages" create) (function :tag "User-defined function") (const :tag "read arg interactively" read)))) (defcustom bbdb-mua-auto-update-p 'bbdb-select-message "How `bbdb-mua-auto-update' updates BBDB records automatically. Allowed values are (here ADDRESS is an email address found in a message): nil Do nothing. search Search for existing records matching ADDRESS. update Search for existing records matching ADDRESS; update name and mail field if necessary. query Search for existing records matching ADDRESS; query for creation of a new record if the record does not exist. create or t Search for existing records matching ADDRESS; create a new record if it does not yet exist. a function This functions will be called with no arguments. It should return one of the above values. For an example, see `bbdb-select-message' with `bbdb-mua-update-records-p', `bbdb-accept-message-alist' and `bbdb-ignore-message-alist'. To initiate auto-updating of BBDB records, call `bbdb-mua-auto-update-init' for the respective MUAs in your init file." :group 'bbdb-mua :type '(choice (const :tag "do nothing" nil) (const :tag "search for existing records" search) (const :tag "update existing records" update) (const :tag "query annotation of all messages" query) (const :tag "annotate all messages" create) (function :tag "User-defined function"))) (defcustom bbdb-update-records-p 'search "Return value for `bbdb-select-message' and friends. These functions can select messages for further processing by BBDB, The amount of subsequent processing is determined by `bbdb-update-records-p'. Allowed values are (here ADDRESS is an email address selected by `bbdb-select-message'): nil Do nothing. search Search for existing records matching ADDRESS. update Search for existing records matching ADDRESS; update name and mail field if necessary. query Search for existing records matching ADDRESS; query for creation of a new record if the record does not exist. create or t Search for existing records matching ADDRESS; create a new record if it does not yet exist. a function This functions will be called with no arguments. It should return one of the above values." ;; Also: Used for communication between `bbdb-update-records' ;; and `bbdb-query-create'. :group 'bbdb-mua :type '(choice (const :tag "do nothing" nil) (const :tag "search for existing records" search) (const :tag "update existing records" update) (const :tag "query annotation of all messages" query) (const :tag "annotate all messages" create) (function :tag "User-defined function"))) (defcustom bbdb-message-headers '((sender "From" "Resent-From" "Reply-To" "Sender") (recipients "Resent-To" "Resent-CC" "To" "CC" "BCC")) "Alist of headers to search for sender and recipients mail addresses. Each element is of the form (CLASS HEADER ...) The symbol CLASS defines a class of headers. The strings HEADER belong to CLASS." :group 'bbdb-mua :type 'list) (defcustom bbdb-message-all-addresses nil "If t `bbdb-update-records' returns all mail addresses of a message. Otherwise this function returns only the first mail address of each message." :group 'bbdb-mua :type 'boolean) (defcustom bbdb-message-try-all-headers nil "If t try all message headers to extract an email address from a message. Several BBDB commands extract either the sender or the recipients' email addresses from a message according to `bbdb-message-headers'. If BBDB does not find any email address in this subset of message headers (for example, because an email address is excluded because of `bbdb-user-mail-address-re') but `bbdb-message-try-all-headers' is t, then these commands will also consider the email addresses in the remaining headers." :group 'bbdb-mua :type 'boolean) (defcustom bbdb-accept-message-alist t "Alist describing which messages to automatically create BBDB records for. The format of this alist is ((HEADER-NAME . REGEXP) ...) For example, if ((\"From\" . \"@.*\\.maximegalon\\.edu\") (\"Subject\" . \"time travel\")) BBDB records are only created for messages sent by people at Maximegalon U., or people posting about time travel. If t accept all messages. If nil do not accept any messages. See also `bbdb-ignore-message-alist', which has the opposite effect." :group 'bbdb-mua :type '(repeat (cons (string :tag "Header name") (regexp :tag "Regexp to match on header value")))) (defcustom bbdb-ignore-message-alist nil "Alist describing which messages not to automatically create BBDB records for. The format of this alist is ((HEADER-NAME . REGEXP) ... ) For example, if ((\"From\" . \"mailer-daemon\") ((\"To\" \"CC\") . \"mailing-list-1\\\\|mailing-list-2\")) no BBDB records are created for messages from any mailer daemon, or messages sent to or CCed to either of two mailing lists. If t ignore all messages. If nil do not ignore any messages. See also `bbdb-accept-message-alist', which has the opposite effect." :group 'bbdb-mua :type '(repeat (cons (string :tag "Header name") (regexp :tag "Regexp to match on header value")))) (defcustom bbdb-user-mail-address-re (and (stringp user-mail-address) (string-match "\\`\\([^@]*\\)\\(@\\|\\'\\)" user-mail-address) (concat "\\<" (regexp-quote (match-string 1 user-mail-address)) "\\>")) "A regular expression matching your mail addresses. Several BBDB commands extract either the sender or the recipients' email addresses from a message according to `bbdb-message-headers'. Yet an email address will be ignored if it matches `bbdb-user-mail-address-re'. This way the commands will not operate on your own record. See also `bbdb-message-try-all-headers'." :group 'bbdb-mua :type '(regexp :tag "Regexp matching your mail addresses")) (defcustom bbdb-add-name 'query "How to handle new names for existing BBDB records. This handles messages where the real name differs from the name in a BBDB record with the same mail address, as in \"John Smith \" versus \"John Q. Smith \". Allowed values are: t Automatically change the name to the new value. query Query whether to use the new name. nil Ignore the new name. a number Number of seconds BBDB displays the name mismatch. (without further action). a function This is called with two args, the record and the new name. It should return one of the above values. a regexp If the new name matches this regexp ignore it. Otherwise query to add it. See also `bbdb-add-aka'." :group 'bbdb-mua :type '(choice (const :tag "Automatically use the new name" t) (const :tag "Query for name changes" query) (const :tag "Ignore the new name" nil) (integer :tag "Number of seconds to display name mismatch") (function :tag "Function for analyzing name handling") (regexp :tag "If the new name matches this regexp ignore it."))) (defcustom bbdb-add-aka 'query "How to handle alternate names for existing BBDB records. Allowed values are: t Automatically store alternate names as AKA. query Query whether to store alternate names as an AKA. nil Ignore alternate names. a function This is called with two args, the record and the new name. It should return one of the above values. a regexp If the alternate name matches this regexp ignore it. Otherwise query to add it. See also `bbdb-add-name'." :group 'bbdb-mua :type '(choice (const :tag "Automatically store alternate names as AKA" t) (const :tag "Query for alternate names" query) (const :tag "Ignore alternate names" nil) (function :tag "Function for alternate name handling") (regexp :tag "If the alternate name matches this regexp ignore it."))) (defcustom bbdb-add-mails 'query "How to handle new mail addresses for existing BBDB records. This handles messages where the mail address differs from the mail addresses in a BBDB record with the same name as in \"John Q. Smith \" versus \"John Q. Smith \". Allowed values are: t Automatically add new mail addresses to the list of mail addresses. query Query whether to add it. nil Ignore new mail addresses. a number Number of seconds BBDB displays the new address (without further action). a function This is called with two args, the record and the new mail address. It should return one of the above values. a regexp If the new mail address matches this regexp ignore the new address. Otherwise query to add it. See also `bbdb-new-mails-primary' and `bbdb-ignore-redundant-mails'." :group 'bbdb-mua :type '(choice (const :tag "Automatically add new mail addresses" t) (const :tag "Query before adding new mail addresses" query) (const :tag "Never add new mail addresses" nil) (number :tag "Number of seconds to display new addresses") (function :tag "Function for analyzing name handling") (regexp :tag "If the new address matches this regexp ignore it."))) (defcustom bbdb-new-mails-primary 'query "Where to put new mail addresses for existing BBDB records. A new mail address may either become the new primary mail address, when it is put at the beginning of the list of mail addresses. Or the new mail address is added at the end of the list of mail addresses. Allowed values are: t Make a new address automatically the primary address. query Query whether to make it the primary address. nil Add the new address to the end of the list. a function This is called with two args, the record and the new mail address. It should return one of the above values. a regexp If the new mail address matches this regexp put it at the end. Otherwise query to make it the primary address. See also `bbdb-add-mails'." :group 'bbdb-mua :type '(choice (const :tag "New address automatically made primary" t) (const :tag "Query before making a new address primary" query) (const :tag "Do not make new address primary" nil) (function :tag "Function for analyzing primary handling") (regexp :tag "If the new mail address matches this regexp put it at the end."))) (defcustom bbdb-canonicalize-mail-function nil "If non-nil, it should be a function of one arg: a mail address string. When BBDB \"notices\" a message, the corresponding mail addresses are passed to this function first. It acts as a kind of \"filter\" to transform the mail addresses before they are compared against or added to the database. See `bbdb-canonicalize-mail-1' for a more complete example. If this function returns nil, BBDB assumes that there is no mail address. See also `bbdb-ignore-redundant-mails'." :group 'bbdb-mua :type 'function) (defcustom bbdb-ignore-redundant-mails 'query "How to handle redundant mail addresses for existing BBDB records. For example, \"foo@bar.baz.com\" is redundant w.r.t. \"foo@baz.com\". This affects two things, whether a new redundant mail address is added to BBDB and whether an old mail address, which has become redundant because of a newly added mail address, is removed from BBDB. Allowed values are: t Automatically ignore redundant mail addresses. query Query whether to ignore them. nil Do not ignore redundant mail addresses. a number Number of seconds BBDB displays redundant mail addresses (without further action). a function This is called with two args, the record and the new mail address. It should return one of the above values. a regexp If the new mail address matches this regexp never ignore this mail address. Otherwise query to ignore it. See also `bbdb-add-mails' and `bbdb-canonicalize-mail-function'." :group 'bbdb-mua :type '(choice (const :tag "Automatically ignore redundant mail addresses" t) (const :tag "Query whether to ignore them" query) (const :tag "Do not ignore redundant mail addresses" nil) (number :tag "Number of seconds to display redundant addresses") (function :tag "Function for handling redundant mail addresses") (regexp :tag "If the new address matches this regexp never ignore it."))) (define-obsolete-variable-alias 'bbdb-canonicalize-redundant-mails 'bbdb-ignore-redundant-mails "3.0") (defcustom bbdb-message-clean-name-function 'bbdb-message-clean-name-default "Function to clean up the name in the header of a message. It takes one argument, the name as extracted by `mail-extract-address-components'." :group 'bbdb-mua :type 'function) (defcustom bbdb-message-mail-as-name t "If non-nil use mail address of message as fallback for name of new records." :group 'bbdb-mua :type 'boolean) (defcustom bbdb-notice-mail-hook nil "Hook run each time a mail address of a record is \"noticed\" in a message. This means that the mail address in a message belongs to an existing BBDB record or to a record BBDB has created for the mail address. Run with one argument, the record. It is up to the hook function to determine which MUA is used and to act appropriately. Hook functions can use the variable `bbdb-update-records-address' to determine the header and class of the mail address according to `bbdb-message-headers'. See `bbdb-auto-notes' for how to annotate records using `bbdb-update-records-address' and the headers of a mail message. If a message contains multiple mail addresses belonging to one BBDB record, this hook is run for each mail address. Use `bbdb-notice-record-hook' if you want to notice each record only once per message." :group 'bbdb-mua :type 'hook) (defcustom bbdb-notice-record-hook nil "Hook run each time a BBDB record is \"noticed\" in a message. This means that one of the mail addresses in a message belongs to an existing record or it is a record BBDB has created for the mail address. If a message contains multiple mail addresses belonging to one BBDB record, this hook is nonetheless run only once. Use `bbdb-notice-mail-hook' if you want to run a hook function for each mail address in a message. Hook is run with one argument, the record." :group 'bbdb-mua :type 'hook) (define-widget 'bbdb-alist-with-header 'group "My group" :match 'bbdb-alist-with-header-match :value-to-internal (lambda (_widget value) (if value (list (car value) (cdr value)))) :value-to-external (lambda (_widget value) (if value (append (list (car value)) (cadr value))))) (defun bbdb-alist-with-header-match (widget value) (widget-group-match widget (widget-apply widget :value-to-internal value))) (defvar bbdb-auto-notes-rules-expanded nil "Expanded `bbdb-auto-notes-rules'.") ; Internal variable (defcustom bbdb-auto-notes-rules nil "List of rules for adding notes to records of mail addresses of messages. This automatically annotates the BBDB record of the sender or recipient of a message based on the value of a header such as the Subject header. This requires that `bbdb-notice-mail-hook' contains `bbdb-auto-notes' and that the record already exists or `bbdb-update-records-p' returns such that the record will be created. Messages matching `bbdb-auto-notes-ignore-messages' are ignored. The elements of this list are (MUA FROM-TO HEADER ANNOTATE ...) (FROM-TO HEADER ANNOTATE ...) (HEADER ANNOTATE ...) MUA is the active MUA or a list of MUAs (see `bbdb-mua'). If MUA is missing or t, use this rule for all MUAs. FROM-TO is a list of headers and/or header classes as in `bbdb-message-headers'. The record corresponding to a mail address of a message is considered for annotation if this mail address was found in a header matching FROM-TO. If FROM-TO is missing or t, records for each mail address are considered irrespective of where the mail address was found in a message. HEADER is a message header that is considered for generating the annotation. ANNOTATE may take the following values: (REGEXP . STRING) [this is equivalent to (REGEXP notes STRING)] (REGEXP FIELD STRING) (REGEXP FIELD STRING REPLACE) REGEXP must match the value of HEADER for generating an annotation. However, if the value of HEADER also matches an element of `bbdb-auto-notes-ignore-headers' no annotation is generated. The annotation will be added to FIELD of the respective record. FIELD defaults to `bbdb-default-xfield'. STRING defines a replacement for the match of REGEXP in the value of HEADER. It may contain \\& or \\N specials used by `replace-match'. The resulting string becomes the annotation. If STRING is an integer N, the Nth matching subexpression is used. If STRING is a function, it will be called with one arg, the value of HEADER. The return value (which must be a string) is then used. If REPLACE is t, the resulting string replaces the old contents of FIELD. If it is nil, the string is appended to the contents of FIELD (unless the annotation is already part of the content of field). For example, ((\"To\" (\"-vm@\" . \"VM mailing list\")) (\"Subject\" (\"sprocket\" . \"mail about sprockets\") (\"you bonehead\" . \"called me a bonehead\"))) will cause the text \"VM mailing list\" to be added to the notes field of the records corresponding to anyone you get mail from via one of the VM mailing lists. If multiple clauses match the message, all of the corresponding strings will be added. See also variables `bbdb-auto-notes-ignore-messages' and `bbdb-auto-notes-ignore-headers'. For speed-up, the function `bbdb-auto-notes' actually use expanded rules stored in the internal variable `bbdb-auto-notes-rules-expanded'. If you change the value of `bbdb-auto-notes-rules' outside of customize, set `bbdb-auto-notes-rules-expanded' to nil, so that the expanded rules will be re-evaluated." :group 'bbdb-mua :set (lambda (symbol value) (set-default symbol value) (setq bbdb-auto-notes-rules-expanded nil)) :type '(repeat (bbdb-alist-with-header (repeat (choice (const sender) (const recipients))) (string :tag "Header name") (repeat (choice (cons :tag "Value Pair" (regexp :tag "Regexp to match on header value") (string :tag "String for notes if regexp matches")) (list :tag "Replacement list" (regexp :tag "Regexp to match on header value") (choice :tag "Record field" (const notes :tag "xfields") (const organization :tag "Organization") (symbol :tag "Other")) (choice :tag "Regexp match" (string :tag "Replacement string") (integer :tag "Subexpression match") (function :tag "Callback Function")) (choice :tag "Replace previous contents" (const :tag "No" nil) (const :tag "Yes" t)))))))) (defcustom bbdb-auto-notes-ignore-messages nil "List of rules for ignoring entire messages in `bbdb-auto-notes'. The elements may have the following values: a function This function is called with one arg, the record that would be annotated. Ignore this message if the function returns non-nil. This function may use `bbdb-update-records-address'. MUA Ignore messages from MUA (see `bbdb-mua'). (HEADER . REGEXP) Ignore messages where HEADER matches REGEXP. For example, (\"From\" . bbdb-user-mail-address-re) disables any recording of notes for mail addresses found in messages coming from yourself, see `bbdb-user-mail-address-re'. (MUA HEADER REGEXP) Ignore messages from MUA where HEADER matches REGEXP. See also `bbdb-auto-notes-ignore-headers'." :group 'bbdb-mua :type '(repeat (cons (string :tag "Header name") (regexp :tag "Regexp to match on header value")))) (defcustom bbdb-auto-notes-ignore-headers nil "Alist of headers and regexps to ignore in `bbdb-auto-notes'. Each element is of the form (HEADER . REGEXP) For example, (\"Organization\" . \"^Gatewayed from\\\\\|^Source only\") will exclude the phony `Organization:' headers in GNU mailing-lists gatewayed to gnu.* newsgroups. See also `bbdb-auto-notes-ignore-messages'." :group 'bbdb-mua :type '(repeat (cons (string :tag "Header name") (regexp :tag "Regexp to match on header value")))) (defcustom bbdb-mua-pop-up t "If non-nil, display an auto-updated BBDB window while using a MUA. If 'horiz, stack the window horizontally if there is room. If this is nil, BBDB is updated silently. See also `bbdb-mua-pop-up-window-size' and `bbdb-horiz-pop-up-window-size'." :group 'bbdb-mua :type '(choice (const :tag "MUA BBDB window stacked vertically" t) (const :tag "MUA BBDB window stacked horizontally" horiz) (const :tag "No MUA BBDB window" nil))) (define-obsolete-variable-alias 'bbdb-message-pop-up 'bbdb-mua-pop-up "3.0") (defcustom bbdb-mua-pop-up-window-size bbdb-pop-up-window-size "Vertical size of MUA pop-up BBDB window (vertical split). If it is an integer number, it is the number of lines used by BBDB. If it is a fraction between 0.0 and 1.0 (inclusive), it is the fraction of the tallest existing window that BBDB will take over. If it is t use `pop-to-buffer' to create the BBDB window. See also `bbdb-pop-up-window-size'." :group 'bbdb-mua :type '(choice (number :tag "BBDB window size") (const :tag "Use `pop-to-buffer'" t))) (defcustom bbdb-horiz-pop-up-window-size '(112 . 0.3) "Horizontal size of a MUA pop-up BBDB window (horizontal split). It is a cons pair (TOTAL . BBDB-SIZE). The window that will be considered for horizontal splitting must have at least TOTAL columns. BBDB-SIZE is the horizontal size of the BBDB window. If it is an integer number, it is the number of columns used by BBDB. If it is a fraction between 0 and 1, it is the fraction of the window width that BBDB will take over." :group 'bbdb-mua :type '(cons (number :tag "Total number of columns") (number :tag "Horizontal size of BBDB window"))) ;;; xfields processing (defcustom bbdb-xfields-sort-order '((notes . 0) (url . 1) (ftp . 2) (gopher . 3) (telnet . 4) (mail-alias . 5) (mail-folder . 6) (lpr . 7)) "The order for sorting the xfields. If an xfield is not in the alist, it is assigned weight 100, so all xfields with weights less then 100 will be in the beginning, and all xfields with weights more than 100 will be in the end." :group 'bbdb-mua :type '(repeat (cons (symbol :tag "xfield") (number :tag "Weight")))) (define-obsolete-variable-alias 'bbdb-notes-sort-order 'bbdb-xfields-sort-order "3.0") (defcustom bbdb-merge-xfield-function-alist nil "Alist defining merging functions for particular xfields. Each element is of the form (LABEL . MERGE-FUN). For merging xfield LABEL, this will use MERGE-FUN." :group 'bbdb-mua :type '(repeat (cons (symbol :tag "xfield") (function :tag "merge function")))) (define-obsolete-variable-alias 'bbdb-merge-notes-function-alist 'bbdb-merge-xfield-function-alist "3.0") (defcustom bbdb-mua-summary-unification-list '(name mail message-name message-mail message-address) "List of FIELDs considered by `bbdb-mua-summary-unify'. For the RECORD matching the address of a message, `bbdb-mua-summary-unify' returns the first non-empty field value matching an element FIELD from this list. Each element FIELD may be a valid argument of `bbdb-record-field' for RECORD. In addition, this list may also include the following elements: message-name The name in the address of the message message-mail The mail in the address of the message message-address The complete address of the message These provide a fallback if a message does not have a matching RECORD or if some FIELD of RECORD is empty." :group 'bbdb-mua :type '(repeat (symbol :tag "Field"))) (defcustom bbdb-mua-summary-mark-field 'mark-char "BBDB xfield whose value is used to mark message addresses known to BBDB. This may also be a function, called with one arg, the record, which should return the mark. See `bbdb-mua-summary-mark' and `bbdb-mua-summary-unify'. See also `bbdb-mua-summary-mark'." :group 'bbdb-mua-gnus :type 'symbol) (defcustom bbdb-mua-summary-mark "+" "Default mark for message addresses known to BBDB. If nil do not mark message addresses known to BBDB. See `bbdb-mua-summary-mark' and `bbdb-mua-summary-unify'. See also `bbdb-mua-summary-mark-field'." :group 'bbdb-mua :type '(choice (string :tag "Mark used") (const :tag "Do not mark known posters" nil))) (defcustom bbdb-mua-summary-unify-format-letter "B" "Letter required for `bbdb-mua-summary-unify' in the MUA Summary format string. For Gnus, combine it with the %u specifier in `gnus-summary-line-format' \(see there), for example use \"%U%R%z%I%(%[%4L: %-23,23uB%]%) %s\\n\". For VM, combine it with the %U specifier in `vm-summary-format' (see there), for example, use \"%n %*%a %-17.17UB %-3.3m %2d %4l/%-5c %I\\\"%s\\\"\\n\". This customization of `gnus-summary-line-format' / `vm-summary-format' is required to use `bbdb-mua-summary-unify'. Currently no other MUAs support this BBDB feature." :group 'bbdb-mua :type 'string) (defcustom bbdb-mua-summary-mark-format-letter "b" "Letter required for `bbdb-mua-summary-mark' in the MUA Summary format string. For Gnus, combine it with the %u specifier in `gnus-summary-line-format' \(see there), for example, use \"%U%R%z%I%(%[%4L: %ub%-23,23f%]%) %s\\n\". For VM, combine it with the %U specifier in `vm-summary-format' (see there), for example, use \"%n %*%a %Ub%-17.17F %-3.3m %2d %4l/%-5c %I\\\"%s\\\"\\n\". This customization of `gnus-summary-line-format' / `vm-summary-format' is required to use `bbdb-mua-summary-mark'. Currently no other MUAs support this BBDB feature." :group 'bbdb-mua :type 'string) ;;; Sending mail (defcustom bbdb-mail-user-agent mail-user-agent "Mail user agent used by BBDB. Allowed values are those allowed for `mail-user-agent'." :group 'bbdb-sendmail :type '(radio (function-item :tag "Message package" :format "%t\n" message-user-agent) (function-item :tag "Mail package" :format "%t\n" sendmail-user-agent) (function-item :tag "Emacs interface to MH" :format "%t\n" mh-e-user-agent) (function-item :tag "Message with full Gnus features" :format "%t\n" gnus-user-agent) (function-item :tag "VM" :format "%t\n" vm-user-agent) (function :tag "Other") (const :tag "Default" nil))) (defcustom bbdb-mail-name-format 'first-last "Format for names when sending mail. If first-last format names as \"Firstname Lastname\". If last-first format names as \"Lastname, Firstname\". If `bbdb-mail-name' returns the full name as a single string, this takes precedence over `bbdb-mail-name-format'. Likewise, if the mail address itself includes a name, this is not reformatted." :group 'bbdb-sendmail :type '(choice (const :tag "Firstname Lastname" first-last) (const :tag "Lastname, Firstname" last-first))) (defcustom bbdb-mail-name 'mail-name "Xfield holding the full name for a record when sending mail. This may also be a function taking one argument, a record. If it returns the full mail name as a single string, this is used \"as is\". If it returns a cons pair (FIRST . LAST) with the first and last name for this record, these are formatted obeying `bbdb-mail-name-format'." :group 'bbdb-sendmail :type '(choice (symbol :tag "xfield") (function :tag "mail name function"))) (defcustom bbdb-mail-alias-field 'mail-alias "Xfield holding the mail alias for a record. Used by `bbdb-mail-aliases'. See also `bbdb-mail-alias'." :group 'bbdb-sendmail :type 'symbol) (defcustom bbdb-mail-alias 'first "Defines which mail aliases are generated for a BBDB record. first: Generate one alias \"\" that expands to the first mail address of a record. star: Generate a second alias \"*\" that expands to all mail addresses of a record. all: Generate the aliases \"\" and \"*\" (as for 'star) and aliases \"n\" for each mail address, where n is the position of the mail address of a record." :group 'bbdb-sendmail :type '(choice (symbol :tag "Only first" first) (symbol :tag "* for all mails" star) (symbol :tag "All aliases" all))) (defcustom bbdb-mail-avoid-redundancy nil "Mail address to use for BBDB records when sending mail. If non-nil do not use full name in mail address when same as mail. If value is mail-only never use full name." :group 'bbdb-sendmail :type '(choice (const :tag "Allow redundancy" nil) (const :tag "Never use full name" mail-only) (const :tag "Avoid redundancy" t))) (defcustom bbdb-complete-mail t "If t MUA insinuation provides key binding for command `bbdb-complete-mail'." :group 'bbdb-sendmail :type 'boolean) (defcustom bbdb-completion-list t "Controls the behaviour of `bbdb-complete-mail'. If a list of symbols, it specifies which fields to complete. Symbols include fl-name (= first and last name) lf-name (= last and first name) organization aka mail (= all email addresses of each record) primary (= first email address of each record) If t, completion is done for all of the above. If nil, no completion is offered." ;; These symbols match the fields for which BBDB provides entries in ;; `bbdb-hashtable'. :group 'bbdb-sendmail :type '(choice (const :tag "No Completion" nil) (const :tag "Complete across all fields" t) (repeat :tag "Field" (choice (const fl-name) (const lf-name) (const aka) (const organization) (const primary) (const mail))))) (defcustom bbdb-complete-mail-allow-cycling nil "If non-nil cycle mail addresses when calling `bbdb-complete-mail'." :group 'bbdb-sendmail :type 'boolean) (defcustom bbdb-complete-mail-hook nil "List of functions called after a sucessful completion." :group 'bbdb-sendmail :type 'hook) (defcustom bbdb-mail-abbrev-expand-hook nil ;; Replacement for function `mail-abbrev-expand-hook'. "Function (not hook) run each time an alias is expanded. The function is called with two args the alias and the list of corresponding mail addresses." :group 'bbdb-sendmail :type 'function) (defcustom bbdb-completion-display-record t "If non-nil `bbdb-complete-mail' displays the BBDB record after completion." :group 'bbdb-sendmail :type '(choice (const :tag "Update the BBDB buffer" t) (const :tag "Do not update the BBDB buffer" nil))) ;;;Dialing (defcustom bbdb-dial-local-prefix-alist '(((if (integerp bbdb-default-area-code) (format "(%03d)" bbdb-default-area-code) (or bbdb-default-area-code "")) . "")) "Mapping to remove local prefixes from numbers. If this is non-nil, it should be an alist of \(PREFIX . REPLACEMENT) elements. The first part of a phone number matching the regexp returned by evaluating PREFIX will be replaced by the corresponding REPLACEMENT when dialing." :group 'bbdb-utilities-dialing :type 'sexp) (defcustom bbdb-dial-local-prefix nil "Local prefix digits. If this is non-nil, it should be a string of digits which your phone system requires before making local calls (for example, if your phone system requires you to dial 9 before making outside calls.) In BBDB's opinion, you're dialing a local number if it starts with a 0 after processing `bbdb-dial-local-prefix-alist'." :group 'bbdb-utilities-dialing :type '(choice (const :tag "No digits required" nil) (string :tag "Dial this first" "9"))) (defcustom bbdb-dial-long-distance-prefix nil "Long distance prefix digits. If this is non-nil, it should be a string of digits which your phone system requires before making a long distance call (one not in your local area code). For example, in some areas you must dial 1 before an area code. Note that this is used to replace the + sign in phone numbers when dialling (international dialing prefix.)" :group 'bbdb-utilities-dialing :type '(choice (const :tag "No digits required" nil) (string :tag "Dial this first" "1"))) (defcustom bbdb-dial-function nil "If non-nil this should be a function used for dialing phone numbers. This function is used by `bbdb-dial-number'. It requires one argument which is a string for the number that is dialed. If nil then `bbdb-dial-number' uses the tel URI syntax passed to `browse-url' to make the call." :group 'bbdb-utilities-dialing :type 'function) ;; Faces for font-lock (defgroup bbdb-faces nil "Faces used by BBDB." :group 'bbdb :group 'faces) (defface bbdb-name '((t (:inherit font-lock-function-name-face))) "Face used for BBDB names." :group 'bbdb-faces) ;; KEY needs to match the value of the xfield name-face, which is a string. ;; To avoid confusion, we make KEY a string, too, though symbols might be ;; faster. (defcustom bbdb-name-face-alist nil "Alist used for font-locking the name of a record. Each element should be a cons cell (KEY . FACE) with string KEY and face FACE. To use FACE for font-locking the name of a record, the xfield name-face of this record should have the value KEY. The value of name-face may also be a face which is then used directly. If none of these schemes succeeds, the face `bbdb-name' is used." :group 'bbdb-faces :type '(repeat (cons (symbol :tag "Key") (face :tag "Face")))) (defface bbdb-organization '((t (:inherit font-lock-comment-face))) "Face used for BBDB names." :group 'bbdb-faces) (defface bbdb-field-name '((t (:inherit font-lock-variable-name-face))) "Face used for BBDB names." :group 'bbdb-faces) ;;; Internal variables (eval-and-compile (defvar bbdb-debug t "Enable debugging if non-nil during compile time. You really should not disable debugging. But it will speed things up.")) (defconst bbdb-file-format 9 "BBDB file format.") (defconst bbdb-record-type '(vector (or string (const nil)) ; first name (or string (const nil)) ; last name (repeat string) ; affix (repeat string) ; aka (repeat string) ; organization (repeat (or (vector string string) (vector string integer integer integer integer))) ; phone (repeat (vector string (repeat string) string string string string)) ; address (repeat string) ; mail (repeat (cons symbol sexp)) ; xfields (cons symbol string) ; uuid (cons symbol string) ; creation-date (cons symbol string) ; timestamp sexp) ; cache "Pseudo-code for the structure of a record. Used by `bbdb-check-type'.") (defconst bbdb-file-coding-system 'utf-8 "Coding system used for reading and writing `bbdb-file'.") (defvar bbdb-mail-aliases-need-rebuilt nil "Non-nil if mail aliases need to be rebuilt.") (defvar bbdb-buffer nil "Buffer visiting `bbdb-file'.") (defvar bbdb-buffer-name "*BBDB*" "Name of the BBDB buffer.") (defvar bbdb-silent-internal nil "Bind this to t to quiet things down - do not set it. See also `bbdb-silent'.") (defvar bbdb-init-forms '((gnus ; gnus 3.15 or newer (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus)) (mh-e ; MH-E (add-hook 'mh-folder-mode-hook 'bbdb-insinuate-mh)) (rmail ; RMAIL (add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail)) (vm ; newer versions of vm do not have `vm-load-hook' (eval-after-load "vm" '(bbdb-insinuate-vm))) (mail ; the standard mail user agent (add-hook 'mail-setup-hook 'bbdb-insinuate-mail)) (sendmail (progn (message "BBDB: sendmail insinuation deprecated. Use mail.") (add-hook 'mail-setup-hook 'bbdb-insinuate-mail))) (message ; the gnus mail user agent (add-hook 'message-setup-hook 'bbdb-insinuate-message)) (mu4e ; the mu4e user agent (add-hook 'mu4e-main-mode-hook 'bbdb-insinuate-mu4e)) (sc ; supercite (add-hook 'sc-load-hook 'bbdb-insinuate-sc)) (anniv ; anniversaries (add-hook 'diary-list-entries-hook 'bbdb-anniv-diary-entries)) (pgp ; pgp-mail (progn (add-hook 'message-send-hook 'bbdb-pgp) (add-hook 'mail-send-hook 'bbdb-pgp))) (wl (add-hook 'wl-init-hook 'bbdb-insinuate-wl))) "Alist mapping features to insinuation forms.") (defvar bbdb-search-invert nil "Bind this variable to t in order to invert the result of `bbdb-search'.") (defvar bbdb-do-all-records nil "Controls the behavior of the command `bbdb-do-all-records'.") (defvar bbdb-append-display nil "Controls the behavior of the command `bbdb-append-display'.") (defvar bbdb-offer-to-create nil "For communication between `bbdb-update-records' and `bbdb-query-create'.") (defvar bbdb-update-records-address nil "For communication between `bbdb-update-records' and `bbdb-query-create'. It is a list with elements (NAME MAIL HEADER HEADER-CLASS MUA).") ;;; Buffer-local variables for the database. (defvar bbdb-records nil "BBDB records list. In buffer `bbdb-file' this list includes all records. In the *BBDB* buffers it includes the records that are actually displayed and its elements are (RECORD DISPLAY-FORMAT MARKER-POS).") (make-variable-buffer-local 'bbdb-records) (defvar bbdb-changed-records nil "List of records that has been changed since BBDB was last saved. Use `bbdb-search-changed' to display these records.") (defvar bbdb-end-marker nil "Marker holding the buffer position of the end of the last record.") (defvar bbdb-hashtable (make-hash-table :test 'equal) "Hash table for BBDB records. Hashes the fields first-last-name, last-first-name, organization, aka, and mail.") (defvar bbdb-uuid-table (make-hash-table :test 'equal) "Hash table for uuid's of BBDB records.") (defvar bbdb-xfield-label-list nil "List of labels for xfields.") (defvar bbdb-organization-list nil "List of organizations known to BBDB.") (defvar bbdb-street-list nil "List of streets known to BBDB.") (defvar bbdb-city-list nil "List of cities known to BBDB.") (defvar bbdb-state-list nil "List of states known to BBDB.") (defvar bbdb-postcode-list nil "List of post codes known to BBDB.") (defvar bbdb-country-list nil "List of countries known to BBDB.") (defvar bbdb-modeline-info (make-vector 6 nil) "Precalculated mode line info for BBDB commands. This is a vector [APPEND-M APPEND INVERT-M INVERT ALL-M ALL]. APPEND-M is the mode line info if `bbdb-append-display' is non-nil. INVERT-M is the mode line info if `bbdb-search-invert' is non-nil. ALL-M is the mode line info if `bbdb-do-all-records' is non-nil. APPEND, INVERT, and ALL appear in the message area.") (defvar bbdb-update-unchanged-records nil "If non-nil update unchanged records in the database. Normally calls of `bbdb-change-hook' and updating of a record are suppressed, if an editing command did not really change the record. Bind this to t if you want to call `bbdb-change-hook' and update the record unconditionally.") ;;; Keymap (defvar bbdb-mode-map (let ((km (make-sparse-keymap))) (define-key km "*" 'bbdb-do-all-records) (define-key km "+" 'bbdb-append-display) (define-key km "!" 'bbdb-search-invert) (define-key km "a" 'bbdb-add-mail-alias) (define-key km "A" 'bbdb-mail-aliases) (define-key km "c" 'bbdb-create) (define-key km "e" 'bbdb-edit-field) (define-key km ";" 'bbdb-edit-foo) (define-key km "n" 'bbdb-next-record) (define-key km "p" 'bbdb-prev-record) (define-key km "N" 'bbdb-next-field) (define-key km "\t" 'bbdb-next-field) ; TAB (define-key km "P" 'bbdb-prev-field) (define-key km "\d" 'bbdb-prev-field) ; DEL (define-key km "d" 'bbdb-delete-field-or-record) (define-key km "\C-k" 'bbdb-delete-field-or-record) (define-key km "i" 'bbdb-insert-field) (define-key km "s" 'bbdb-save) (define-key km "\C-x\C-s" 'bbdb-save) (define-key km "t" 'bbdb-toggle-records-layout) (define-key km "T" 'bbdb-display-records-completely) (define-key km "o" 'bbdb-omit-record) (define-key km "m" 'bbdb-mail) (define-key km "M" 'bbdb-mail-address) (define-key km "\M-d" 'bbdb-dial) (define-key km "h" 'bbdb-info) (define-key km "?" 'bbdb-help) ;; (define-key km "q" 'quit-window) ; part of `special-mode' bindings (define-key km "\C-x\C-t" 'bbdb-transpose-fields) (define-key km "Cr" 'bbdb-copy-records-as-kill) (define-key km "Cf" 'bbdb-copy-fields-as-kill) (define-key km "u" 'bbdb-browse-url) (define-key km "\C-c\C-t" 'bbdb-tex) (define-key km "=" 'delete-other-windows) ;; Search keys (define-key km "b" 'bbdb) (define-key km "/1" 'bbdb-display-records) (define-key km "/n" 'bbdb-search-name) (define-key km "/o" 'bbdb-search-organization) (define-key km "/p" 'bbdb-search-phone) (define-key km "/a" 'bbdb-search-address) (define-key km "/m" 'bbdb-search-mail) (define-key km "/N" 'bbdb-search-xfields) (define-key km "/x" 'bbdb-search-xfields) (define-key km "/c" 'bbdb-search-changed) (define-key km "/d" 'bbdb-search-duplicates) (define-key km "\C-xnw" 'bbdb-display-all-records) (define-key km "\C-xnd" 'bbdb-display-current-record) (define-key km [delete] 'scroll-down) ; 24.1: part of `special-mode' (define-key km " " 'scroll-up) ; 24.1: part of `special-mode' (define-key km [mouse-3] 'bbdb-mouse-menu) (define-key km [mouse-2] (lambda (event) ;; Toggle record layout (interactive "e") (save-excursion (posn-set-point (event-end event)) (bbdb-toggle-records-layout (bbdb-do-records t) current-prefix-arg)))) km) "Keymap for Insidious Big Brother Database. This is a child of `special-mode-map'.") (easy-menu-define bbdb-menu bbdb-mode-map "BBDB Menu" '("BBDB" ("Display" ["Previous field" bbdb-prev-field t] ["Next field" bbdb-next-field t] ["Previous record" bbdb-prev-record t] ["Next record" bbdb-next-record t] "--" ["Show all records" bbdb-display-all-records t] ["Show current record" bbdb-display-current-record t] ["Omit record" bbdb-omit-record t] "--" ["Toggle layout" bbdb-toggle-records-layout t] ["Show all fields" bbdb-display-records-completely t]) ("Searching" ["General search" bbdb t] ["Search one record" bbdb-display-records t] ["Search name" bbdb-search-name t] ["Search organization" bbdb-search-organization t] ["Search phone" bbdb-search-phone t] ["Search address" bbdb-search-address t] ["Search mail" bbdb-search-mail t] ["Search xfields" bbdb-search-xfields t] ["Search changed records" bbdb-search-changed t] ["Search duplicates" bbdb-search-duplicates t] "--" ["Old time stamps" bbdb-timestamp-older t] ["New time stamps" bbdb-timestamp-newer t] ["Old creation date" bbdb-creation-older t] ["New creation date" bbdb-creation-newer t] ["Creation date = time stamp" bbdb-creation-no-change t] "--" ["Append search" bbdb-append-display t] ["Invert search" bbdb-search-invert t]) ("Mail" ["Send mail" bbdb-mail t] ["Save mail address" bbdb-mail-address t] "--" ["Add mail alias" bbdb-add-mail-alias t] ["(Re-)Build mail aliases" bbdb-mail-aliases t]) ("Use database" ["Prefix: do all records" bbdb-do-all-records t] "--" ["Send mail" bbdb-mail t] ["Dial phone number" bbdb-dial t] ["Browse URL" bbdb-browse-url t] ["Copy records as kill" bbdb-copy-records-as-kill t] ["Copy fields as kill" bbdb-copy-fields-as-kill t] "--" ["TeX records" bbdb-tex t]) ("Manipulate database" ["Prefix: do all records" bbdb-do-all-records t] "--" ["Create new record" bbdb-create t] ["Edit current field" bbdb-edit-field t] ["Insert new field" bbdb-insert-field t] ["Edit some field" bbdb-edit-foo t] ["Transpose fields" bbdb-transpose-fields t] ["Delete record or field" bbdb-delete-field-or-record t] "--" ["Sort addresses" bbdb-sort-addresses t] ["Sort phones" bbdb-sort-phones t] ["Sort xfields" bbdb-sort-xfields t] ["Merge records" bbdb-merge-records t] ["Sort database" bbdb-sort-records t] ["Delete duplicate mails" bbdb-delete-redundant-mails t] "--" ["Save BBDB" bbdb-save t] ["Revert BBDB" revert-buffer t]) ("Help" ["Brief help" bbdb-help t] ["BBDB Manual" bbdb-info t]) "--" ["Quit" quit-window t])) (defvar bbdb-completing-read-mails-map (let ((map (copy-keymap minibuffer-local-completion-map))) (define-key map " " 'self-insert-command) (define-key map "\t" 'bbdb-complete-mail) (define-key map "\M-\t" 'bbdb-complete-mail) map) "Keymap used by `bbdb-completing-read-mails'.") ;;; Helper functions (defun bbdb-warn (&rest args) "Display a message at the bottom of the screen. ARGS are passed to `message'." (ding t) (apply 'message args)) (defun bbdb-string-trim (string &optional null) "Remove leading and trailing whitespace and all properties from STRING. If STRING is nil return an empty string unless NULL is non-nil." (if (null string) (unless null "") (setq string (substring-no-properties string)) (if (string-match "\\`[ \t\n]+" string) (setq string (substring-no-properties string (match-end 0)))) (if (string-match "[ \t\n]+\\'" string) (setq string (substring-no-properties string 0 (match-beginning 0)))) (unless (and null (string= "" string)) string))) (defsubst bbdb-string= (str1 str2) "Return t if strings STR1 and STR2 are equal, ignoring case." (and (stringp str1) (stringp str2) (eq t (compare-strings str1 0 nil str2 0 nil t)))) (defun bbdb-split (separator string) "Split STRING into list of substrings bounded by matches for SEPARATORS. SEPARATOR may be a regexp. SEPARATOR may also be a symbol \(a field name). Then look up the value in `bbdb-separator-alist' or use `bbdb-default-separator'. Whitespace around SEPARATOR is ignored unless SEPARATOR matches the string \" \\t\\n\". Almost the inverse function of `bbdb-concat'." (if (symbolp separator) (setq separator (car (or (cdr (assq separator bbdb-separator-alist)) bbdb-default-separator)))) (if (<= 24.4 (string-to-number emacs-version)) ;; `split-string' applied to an empty STRING gives nil. (split-string string separator t (unless (string-match separator " \t\n") "[ \t\n]*")) (unless (string-match separator " \t\n") (setq separator (concat "[ \t\n]*" separator "[ \t\n]*"))) (split-string (bbdb-string-trim string) separator t))) (defun bbdb-concat (separator &rest strings) "Concatenate STRINGS to a string sticking in SEPARATOR. STRINGS may be strings or lists of strings. Empty strings are ignored. SEPARATOR may be a string. SEPARATOR may also be a symbol (a field name). Then look up the value of SEPARATOR in `bbdb-separator-alist' or use `bbdb-default-separator'. The inverse function of `bbdb-split'." (if (symbolp separator) (setq separator (nth 1 (or (cdr (assq separator bbdb-separator-alist)) bbdb-default-separator)))) (mapconcat 'identity (delete "" (apply 'append (mapcar (lambda (x) (if (stringp x) (list x) x)) strings))) separator)) (defun bbdb-list-strings (list) "Remove all elements from LIST which are not non-empty strings." (let (new-list) (dolist (elt list) (if (and (stringp elt) (not (string= "" elt))) (push elt new-list))) (nreverse new-list))) ;; A call of `indent-region' swallows any indentation ;; that might be part of the field itself. So we indent manually. (defsubst bbdb-indent-string (string column) "Indent nonempty lines in STRING to COLUMN (except first line). This happens in addition to any pre-defined indentation of STRING." (replace-regexp-in-string "\n\\([^\n]\\)" (concat "\n" (make-string column ?\s) "\\1") string)) (defun bbdb-read-string (prompt &optional init collection require-match) "Read a string, trimming whitespace and text properties. PROMPT is a string to prompt with. INIT appears as initial input which is useful for editing existing records. COLLECTION and REQUIRE-MATCH have the same meaning as in `completing-read'." (bbdb-string-trim (if collection ;; Hack: In `minibuffer-local-completion-map' remove ;; the binding of SPC to `minibuffer-complete-word' ;; and of ? to `minibuffer-completion-help'. (minibuffer-with-setup-hook (lambda () (use-local-map (let ((map (make-sparse-keymap))) (set-keymap-parent map (current-local-map)) (define-key map " " nil) (define-key map "?" nil) map))) (completing-read prompt collection nil require-match init)) (read-string prompt init)))) ;; The following macros implement variants of `pushnew' (till emacs 24.2) ;; or `cl-pushnew' (since emacs 24.3). To be compatible with older and newer ;; versions of emacs we use our own macros. We call these macros often. ;; So we keep them simple. Nothing fancy is needed here. (defmacro bbdb-pushnew (element listname) "Add ELEMENT to the value of LISTNAME if it isn't there yet. The test for presence of ELEMENT is done with `equal'. The return value is the new value of LISTNAME." `(let ((elt ,element)) (if (member elt ,listname) ,listname (setq ,listname (cons elt ,listname))))) (defmacro bbdb-pushnewq (element listname) "Add ELEMENT to the value of LISTNAME if it isn't there yet. The test for presence of ELEMENT is done with `eq'. The return value is the new value of LISTNAME." `(let ((elt ,element)) (if (memq elt ,listname) ,listname (setq ,listname (cons elt ,listname))))) (defmacro bbdb-pushnewt (element listname) "Add ELEMENT to the value of LISTNAME if it isn't there yet and non-nil. The test for presence of ELEMENT is done with `equal'. The return value is the new value of LISTNAME." `(let ((elt ,element)) (if (or (not elt) (member elt ,listname)) ,listname (setq ,listname (cons elt ,listname))))) (defun bbdb-current-record (&optional full) "Return the record point is at. If FULL is non-nil record includes the display information." (unless (eq major-mode 'bbdb-mode) (error "This only works while in BBDB buffers.")) (let ((num (get-text-property (if (and (not (bobp)) (eobp)) (1- (point)) (point)) 'bbdb-record-number)) record) (unless num (error "Not a BBDB record")) (setq record (nth num bbdb-records)) (if full record (car record)))) (defun bbdb-current-field () "Return current field point is on." (unless (bbdb-current-record) (error "Not a BBDB record")) (get-text-property (point) 'bbdb-field)) (defmacro bbdb-debug (&rest body) "Excecute BODY just like `progn' with debugging capability. Debugging is enabled if variable `bbdb-debug' is non-nil during compile. You really should not disable debugging. But it will speed things up." (declare (indent 0)) (if bbdb-debug ; compile-time switch `(let ((debug-on-error t)) ,@body))) ;; inspired by `gnus-bind-print-variables' (defmacro bbdb-with-print-loadably (&rest body) "Bind print-* variables for BBDB and evaluate BODY. This macro is used with `prin1', `prin1-to-string', etc. in order to ensure printed Lisp objects are loadable by BBDB." (declare (indent 0)) `(let ((print-escape-newlines t) ;; BBDB needs this! print-escape-nonascii print-escape-multibyte print-quoted print-length print-level) ;; print-circle print-gensym ;; print-continuous-numbering ;; print-number-table ;; float-output-format ,@body)) (defun bbdb-timestamp (_record) "" (unless (get 'bbdb-timestamp 'bbdb-obsolete) (put 'bbdb-timestamp 'bbdb-obsolete t) (message "Function `bbdb-timestamp' is obsolete. Remove it from any hooks.") (sit-for 2))) (make-obsolete 'bbdb-timestamp nil "2017-08-09") (defun bbdb-creation-date (_record) "" (unless (get 'bbdb-creation-date 'bbdb-obsolete) (put 'bbdb-creation-date 'bbdb-obsolete t) (message "Function `bbdb-creation-date' is obsolete. Remove it from any hooks.") (sit-for 2))) (make-obsolete 'bbdb-creation-date nil "2017-08-09") ;; Copied from org-id.el (defun bbdb-uuid () "Return string with random (version 4) UUID." (let ((rnd (md5 (format "%s%s%s%s%s%s%s" (random) (current-time) (user-uid) (emacs-pid) (user-full-name) user-mail-address (recent-keys))))) (format "%s-%s-4%s-%s%s-%s" (substring rnd 0 8) (substring rnd 8 12) (substring rnd 13 16) (format "%x" (logior #b10000000 (logand #b10111111 (string-to-number (substring rnd 16 18) 16)))) (substring rnd 18 20) (substring rnd 20 32)))) (defun bbdb-multiple-buffers-default () "Default function for guessing a name for new *BBDB* buffers. May be used as value of variable `bbdb-multiple-buffers'." (save-current-buffer (cond ((memq major-mode '(vm-mode vm-summary-mode vm-presentation-mode vm-virtual-mode)) (vm-select-folder-buffer) (buffer-name)) ((memq major-mode '(gnus-summary-mode gnus-group-mode)) (set-buffer gnus-article-buffer) (buffer-name)) ((memq major-mode '(mail-mode vm-mail-mode message-mode)) "message composition")))) (defsubst bbdb-add-job (spec record string) "Internal function: Evaluate SPEC for RECORD and STRING. If SPEC is a function call it with args RECORD and STRING. Return value. If SPEC is a regexp, return 'query unless SPEC matches STRING. Otherwise return SPEC. Used with variable `bbdb-add-name' and friends." (cond ((functionp spec) (funcall spec record string)) ((stringp spec) (unless (string-match spec string) 'query)) ; be least aggressive (spec))) (defsubst bbdb-eval-spec (spec prompt) "Internal function: Evaluate SPEC using PROMPT. Return t if either SPEC equals t, or SPEC equals 'query and `bbdb-silent' is non-nil or `y-or-no-p' returns t using PROMPT. Used with return values of `bbdb-add-job'." (or (eq spec t) (and (eq spec 'query) (or bbdb-silent (y-or-n-p prompt))))) (defun bbdb-clean-address-components (components) "Clean mail address COMPONENTS. COMPONENTS is a list (FULL-NAME CANONICAL-ADDRESS) as returned by `mail-extract-address-components'. Pass FULL-NAME through `bbdb-message-clean-name-function' and CANONICAL-ADDRESS through `bbdb-canonicalize-mail-function'." (list (if (car components) (if bbdb-message-clean-name-function (funcall bbdb-message-clean-name-function (car components)) (car components))) (if (cadr components) (if bbdb-canonicalize-mail-function (funcall bbdb-canonicalize-mail-function (cadr components)) ;; Minimalistic clean-up (bbdb-string-trim (cadr components)))))) (defun bbdb-extract-address-components (address &optional all) "Given an RFC-822 address ADDRESS, extract full name and canonical address. This function behaves like `mail-extract-address-components', but it passes its return value through `bbdb-clean-address-components'. See also `bbdb-decompose-bbdb-address'." (if all (mapcar 'bbdb-clean-address-components (mail-extract-address-components address t)) (bbdb-clean-address-components (mail-extract-address-components address)))) ;; Inspired by `gnus-extract-address-components' from gnus-utils. (defun bbdb-decompose-bbdb-address (mail) "Given an RFC-822 address MAIL, extract full name and canonical address. In general, this function behaves like the more sophisticated function `mail-extract-address-components'. Yet for an address `' lacking a real name the latter function returns the name \"Joe Smith\". This is useful when analyzing the headers of email messages we receive from the outside world. Yet when analyzing the mail addresses stored in BBDB, this pollutes the mail-aka space. So we define here an intentionally much simpler function for decomposing the names and canonical addresses in the mail field of BBDB records." (let (name address) ;; First find the address - the thing with the @ in it. (cond (;; Check `' first in order to handle the quite common ;; form `"abc@xyz" ' (i.e. `@' as part of a comment) ;; correctly. (string-match "<\\([^@ \t<>]+[!@][^@ \t<>]+\\)>" mail) (setq address (match-string 1 mail))) ((string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" mail) (setq address (match-string 0 mail)))) ;; Then check whether the `name
' format is used. (and address ;; Linear white space is not required. (string-match (concat "[ \t]*<" (regexp-quote address) ">") mail) (setq name (substring mail 0 (match-beginning 0))) ;; Strip any quotes mail the name. (string-match "^\".*\"$" name) (setq name (substring name 1 (1- (match-end 0))))) ;; If not, then check whether the `address (name)' format is used. (or name (and (string-match "(\\([^)]+\\))" mail) (setq name (match-string 1 mail)))) (list (if (equal name "") nil name) (or address mail)))) ;;; Massage of mail addresses (defcustom bbdb-canonical-hosts ;; Example (regexp-opt '("cs.cmu.edu" "ri.cmu.edu")) "Regexp matching the canonical part of the domain part of a mail address. If the domain part of a mail address matches this regexp, the domain is replaced by the substring that actually matched this address. Used by `bbdb-canonicalize-mail-1'. See also `bbdb-ignore-redundant-mails'." :group 'bbdb-mua :type '(regexp :tag "Regexp matching sites")) (defun bbdb-canonicalize-mail-1 (address) "Example of `bbdb-canonicalize-mail-function'. However, this function is too specific to be useful for the general user. Take it as a source of inspiration for what can be done." (setq address (bbdb-string-trim address)) (cond ;; Rewrite mail-drop hosts. ;; RW: The following is now also handled by `bbdb-ignore-redundant-mails' ((string-match (concat "\\`\\([^@%!]+@\\).*\\.\\(" bbdb-canonical-hosts "\\)\\'") address) (concat (match-string 1 address) (match-string 2 address))) ;; ;; Here at Lucid, our workstation names sometimes get into our mail ;; addresses in the form "jwz%thalidomide@lucid.com" (instead of simply ;; "jwz@lucid.com"). This removes the workstation name. ((string-match "\\`\\([^@%!]+\\)%[^@%!.]+@\\(lucid\\.com\\)\\'" address) (concat (match-string 1 address) "@" (match-string 2 address))) ;; ;; Another way that our local mailer is misconfigured: sometimes addresses ;; which should look like "user@some.outside.host" end up looking like ;; "user%some.outside.host" or even "user%some.outside.host@lucid.com" ;; instead. This rule rewrites it into the original form. ((string-match "\\`\\([^@%]+\\)%\\([^@%!]+\\)\\(@lucid\\.com\\)?\\'" address) (concat (match-string 1 address) "@" (match-string 2 address))) ;; ;; Sometimes I see addresses like "foobar.com!user@foobar.com". ;; That's totally redundant, so this rewrites it as "user@foobar.com". ((string-match "\\`\\([^@%!]+\\)!\\([^@%!]+[@%]\\1\\)\\'" address) (match-string 2 address)) ;; ;; Sometimes I see addresses like "foobar.com!user". Turn it around. ((string-match "\\`\\([^@%!.]+\\.[^@%!]+\\)!\\([^@%]+\\)\\'" address) (concat (match-string 2 address) "@" (match-string 1 address))) ;; ;; The mailer at hplb.hpl.hp.com tends to puke all over addresses which ;; pass through mailing lists which are maintained there: it turns normal ;; addresses like "user@foo.com" into "user%foo.com@hplb.hpl.hp.com". ;; This reverses it. (I actually could have combined this rule with ;; the similar lucid.com rule above, but then the regexp would have been ;; more than 80 characters long...) ((string-match "\\`\\([^@!]+\\)%\\([^@%!]+\\)@hplb\\.hpl\\.hp\\.com\\'" address) (concat (match-string 1 address) "@" (match-string 2 address))) ;; ;; Another local mail-configuration botch: sometimes mail shows up ;; with addresses like "user@workstation", where "workstation" is a ;; local machine name. That should really be "user" or "user@netscape.com". ;; (I'm told this one is due to a bug in SunOS 4.1.1 sendmail.) ((string-match "\\`\\([^@%!]+\\)[@%][^@%!.]+\\'" address) (match-string 1 address)) ;; ;; Sometimes I see addresses like "foo%somewhere%uunet.uu.net@somewhere.else". ;; This is silly, because I know that I can send mail to uunet directly. ((string-match ".%uunet\\.uu\\.net@[^@%!]+\\'" address) (concat (substring address 0 (+ (match-beginning 0) 1)) "@UUNET.UU.NET")) ;; ;; Otherwise, leave it as it is. (t address))) (defun bbdb-message-clean-name-default (name) "Default function for `bbdb-message-clean-name-function'. This strips garbage from the user full NAME string." ;; Remove leading non-alpha chars (if (string-match "\\`[^[:alpha:]]+" name) (setq name (substring name (match-end 0)))) (if (string-match "^\\([^@]+\\)@" name) ;; The name is really a mail address and we use the part preceeding "@". ;; Everything following "@" is ignored. (setq name (match-string 1 name))) ;; Replace "firstname.surname" by "firstname surname". ;; Do not replace ". " with " " because that could be an initial. (setq name (replace-regexp-in-string "\\.\\([^ ]\\)" " \\1" name)) ;; Replace tabs, spaces, and underscores with a single space. (setq name (replace-regexp-in-string "[ \t\n_]+" " " name)) ;; Remove trailing comments separated by "(" or " [-#]" ;; This does not work all the time because some of our friends in ;; northern europe have brackets in their names... (if (string-match "[^ \t]\\([ \t]*\\((\\| [-#]\\)\\)" name) (setq name (substring name 0 (match-beginning 1)))) ;; Remove phone extensions (like "x1234" and "ext. 1234") (let ((case-fold-search t)) (setq name (replace-regexp-in-string "\\W+\\(x\\|ext\\.?\\)\\W*[-0-9]+" "" name))) ;; Remove trailing non-alpha chars (if (string-match "[^[:alpha:]]+\\'" name) (setq name (substring name 0 (match-beginning 0)))) ;; Remove text properties (substring-no-properties name)) ;; BBDB data structure (defmacro bbdb-defstruct (name &rest elts) "Define two functions to operate on vector NAME for each symbol ELT in ELTS. The function bbdb-NAME-ELT returns the element ELT in vector NAME. The function bbdb-NAME-set-ELT sets ELT. Also define a constant bbdb-NAME-length that holds the number of ELTS in vector NAME." (declare (indent 1)) (let* ((count 0) (sname (symbol-name name)) (uname (upcase sname)) (cname (concat "bbdb-" sname "-")) body) (dolist (elt elts) (let* ((selt (symbol-name elt)) (setname (intern (concat cname "set-" selt)))) (push (list 'defsubst (intern (concat cname selt)) `(,name) (format "For BBDB %s read element %i `%s'." uname count selt) ;; Use `elt' instead of `aref' so that these functions ;; also work for the `bbdb-record-type' pseudo-code. `(elt ,name ,count)) body) (push (list 'defsubst setname `(,name value) (format "For BBDB %s set element %i `%s' to VALUE. \ Return VALUE. Do not call this function directly. Call instead `bbdb-record-set-field' which ensures the integrity of the database. Also, this makes your code more robust with respect to possible future changes of BBDB's innermost internals." uname count selt) `(aset ,name ,count value)) body)) (setq count (1+ count))) (push (list 'defconst (intern (concat cname "length")) count (concat "Length of BBDB `" sname "'.")) body) (cons 'progn body))) ;; Define RECORD: (bbdb-defstruct record firstname lastname affix aka organization phone address mail xfields uuid creation-date timestamp cache) ;; Define PHONE: (bbdb-defstruct phone label area exchange suffix extension) ;; Define ADDRESS: (bbdb-defstruct address label streets city state postcode country) ;; Define record CACHE: ;; - fl-name (first and last name of the person referred to by the record), ;; - lf-name (last and first name of the person referred to by the record), ;; - mail-aka (list of names associated with mail addresses) ;; - mail-canon (list of canonical mail addresses) ;; - sortkey (the concatenation of the elements used for sorting the record), ;; - marker (position of beginning of record in `bbdb-file') (bbdb-defstruct cache fl-name lf-name mail-aka mail-canon sortkey marker) (defsubst bbdb-record-mail-aka (record) "Record cache function: Return mail-aka for RECORD." (bbdb-cache-mail-aka (bbdb-record-cache record))) (defsubst bbdb-record-mail-canon (record) "Record cache function: Return mail-canon for RECORD." (bbdb-cache-mail-canon (bbdb-record-cache record))) (defun bbdb-empty-record () "Return a new empty record structure with a cache. It is the caller's responsibility to make the new record known to BBDB." (let ((record (make-vector bbdb-record-length nil))) (bbdb-record-set-cache record (make-vector bbdb-cache-length nil)) record)) ;; `bbdb-hashtable' associates with each KEY a list of matching records. ;; KEY includes fl-name, lf-name, organizations, AKAs and email addresses. ;; When loading the database the hash table is initialized by calling ;; `bbdb-hash-record' for each record. This function is also called ;; when new records are added to the database. ;; `bbdb-delete-record-internal' with arg REMHASH non-nil removes a record ;; from the hash table (besides deleting the record from the database). ;; When an existing record is modified, the code that modifies the record ;; needs to update the hash table, too. This includes removing the outdated ;; associations between KEYs and record as well as adding the new associations. ;; This is one reason to modify records by calling `bbdb-record-set-field' ;; which properly updates the hash table. ;; The hash table can be accessed via `bbdb-gethash' ;; and via functions like `completing-read'. (defun bbdb-puthash (key record) "Associate RECORD with KEY in `bbdb-hashtable'. KEY must be a string or nil. Empty strings and nil are ignored." (if (and key (not (string= "" key))) ; do not hash empty strings (let* ((key (downcase key)) (records (gethash key bbdb-hashtable))) (puthash key (if records (bbdb-pushnewq record records) (list record)) bbdb-hashtable)))) (defun bbdb-gethash (key &optional predicate) "Return list of records associated with KEY in `bbdb-hashtable'. KEY must be a string or nil. Empty strings and nil are ignored. PREDICATE may take the same values as `bbdb-completion-list'." (when (and key (not (string= "" key))) (let* ((key (downcase key)) (all-records (gethash key bbdb-hashtable)) records) (if (or (not predicate) (eq t predicate)) all-records (dolist (record all-records) (if (catch 'bbdb-hash-ok (bbdb-hash-p key record predicate)) (push record records))) records)))) (defun bbdb-hash-p (key record predicate) "Throw `bbdb-hash-ok' non-nil if KEY matches RECORD acording to PREDICATE. PREDICATE may take the same values as the elements of `bbdb-completion-list'." (if (and (memq 'fl-name predicate) (bbdb-string= key (or (bbdb-record-name record) ""))) (throw 'bbdb-hash-ok 'fl-name)) (if (and (memq 'lf-name predicate) (bbdb-string= key (or (bbdb-record-name-lf record) ""))) (throw 'bbdb-hash-ok 'lf-name)) (if (memq 'organization predicate) (mapc (lambda (organization) (if (bbdb-string= key organization) (throw 'bbdb-hash-ok 'organization))) (bbdb-record-organization record))) (if (memq 'aka predicate) (mapc (lambda (aka) (if (bbdb-string= key aka) (throw 'bbdb-hash-ok 'aka))) (bbdb-record-field record 'aka-all))) (if (and (memq 'primary predicate) (bbdb-string= key (car (bbdb-record-mail-canon record)))) (throw 'bbdb-hash-ok 'primary)) (if (memq 'mail predicate) (mapc (lambda (mail) (if (bbdb-string= key mail) (throw 'bbdb-hash-ok 'mail))) (bbdb-record-mail-canon record))) nil) (defun bbdb-remhash (key record) "Remove RECORD from list of records associated with KEY. KEY must be a string or nil. Empty strings and nil are ignored." (if (and key (not (string= "" key))) (let* ((key (downcase key)) (records (gethash key bbdb-hashtable))) (when records (setq records (delq record records)) (if records (puthash key records bbdb-hashtable) (remhash key bbdb-hashtable)))))) (defun bbdb-hash-record (record) "Insert RECORD in `bbdb-hashtable'. This performs all initializations required for a new record. Do not call this for existing records that require updating." (bbdb-puthash (bbdb-record-name record) record) (bbdb-puthash (bbdb-record-name-lf record) record) (dolist (organization (bbdb-record-organization record)) (bbdb-puthash organization record)) (dolist (aka (bbdb-record-aka record)) (bbdb-puthash aka record)) (bbdb-puthash-mail record) (puthash (bbdb-record-uuid record) record bbdb-uuid-table)) (defun bbdb-puthash-mail (record) "For RECORD put mail into `bbdb-hashtable'." (let (mail-aka mail-canon address) (dolist (mail (bbdb-record-mail record)) (setq address (bbdb-decompose-bbdb-address mail)) (when (car address) (push (car address) mail-aka) (bbdb-puthash (car address) record)) (push (nth 1 address) mail-canon) (bbdb-puthash (nth 1 address) record)) (bbdb-cache-set-mail-aka (bbdb-record-cache record) (nreverse mail-aka)) (bbdb-cache-set-mail-canon (bbdb-record-cache record) (nreverse mail-canon)))) (defun bbdb-hash-update (record old new) "Update hash for RECORD. Remove OLD, insert NEW. Both OLD and NEW are lists of values." (dolist (elt old) (bbdb-remhash elt record)) (dolist (elt new) (bbdb-puthash elt record))) (defun bbdb-check-name (first last &optional record) "Check whether the name FIRST LAST is a valid name. This throws an error if the name is already used by another record and `bbdb-allow-duplicates' is nil. If RECORD is non-nil, FIRST and LAST may correspond to RECORD without raising an error." ;; Are there more useful checks for names beyond checking for duplicates? (unless bbdb-allow-duplicates (let* ((name (bbdb-concat 'name-first-last first last)) (records (bbdb-gethash name '(fl-name lf-name aka)))) (if (or (and (not record) records) (remq record records)) (error "%s is already in BBDB" name))))) (defun bbdb-record-name (record) "Record cache function: Return the full name FIRST_LAST of RECORD. Return empty string if both the first and last name are nil. If the name is not available in the name cache, the name cache value is generated and stored." (or (bbdb-cache-fl-name (bbdb-record-cache record)) ;; Build the name cache for a record. (bbdb-record-set-name record t t))) (defun bbdb-record-name-lf (record) "Record cache function: Return the full name LAST_FIRST of RECORD. If the name is not available in the name cache, the name cache value is generated and stored." (or (bbdb-cache-lf-name (bbdb-record-cache record)) ;; Build the name cache for a record. (progn (bbdb-record-set-name record t t) (bbdb-cache-lf-name (bbdb-record-cache record))))) (defun bbdb-record-set-name (record first last) "Record cache function: For RECORD set full name based on FIRST and LAST. If FIRST or LAST are t use respective existing entries of RECORD. Set full name in cache and hash. Return first-last name." (let* ((cache (bbdb-record-cache record)) (fl-name (bbdb-cache-fl-name cache)) (lf-name (bbdb-cache-lf-name cache))) (if fl-name (bbdb-remhash fl-name record)) (if lf-name (bbdb-remhash lf-name record))) (if (eq t first) (setq first (bbdb-record-firstname record)) (bbdb-record-set-firstname record first)) (if (eq t last) (setq last (bbdb-record-lastname record)) (bbdb-record-set-lastname record last)) (let ((fl-name (bbdb-concat 'name-first-last first last)) (lf-name (bbdb-concat 'name-last-first last first)) (cache (bbdb-record-cache record))) ;; Set cache of RECORD (bbdb-cache-set-fl-name cache fl-name) (bbdb-cache-set-lf-name cache lf-name) ;; Set hash. For convenience, the hash contains the full name ;; as first-last and last-fist. (bbdb-puthash fl-name record) (bbdb-puthash lf-name record) fl-name)) (defun bbdb-record-sortkey (record) "Record cache function: Return the sortkey for RECORD. Set and store it if necessary." (or (bbdb-cache-sortkey (bbdb-record-cache record)) (bbdb-record-set-sortkey record))) (defun bbdb-record-set-sortkey (record) "Record cache function: Set and return RECORD's sortkey." (bbdb-cache-set-sortkey (bbdb-record-cache record) (downcase (bbdb-concat "" (bbdb-record-lastname record) (bbdb-record-firstname record) (bbdb-record-organization record))))) (defsubst bbdb-record-marker (record) "Record cache function: Return the marker for RECORD." (bbdb-cache-marker (bbdb-record-cache record))) (defsubst bbdb-record-set-marker (record marker) "Record cache function: Set and return RECORD's MARKER." (bbdb-cache-set-marker (bbdb-record-cache record) marker)) (defsubst bbdb-record-xfield (record label) "For RECORD return value of xfield LABEL. Return nil if xfield LABEL is undefined." (cdr (assq label (bbdb-record-xfields record)))) ;; The values of xfields are normally strings. The following function ;; comes handy if we want to treat these values as symbols. (defun bbdb-record-xfield-intern (record label) "For RECORD return interned value of xfield LABEL. Return nil if xfield LABEL does not exist." (let ((value (bbdb-record-xfield record label))) ;; If VALUE is not a string, return whatever it is. (if (stringp value) (intern value) value))) (defun bbdb-record-xfield-string (record label) "For RECORD return value of xfield LABEL as string. Return nil if xfield LABEL does not exist." (let ((value (bbdb-record-xfield record label))) (if (string-or-null-p value) value (let ((print-escape-newlines t)) (prin1-to-string value))))) (defsubst bbdb-record-xfield-split (record label) "For RECORD return value of xfield LABEL split as a list. Splitting is based on `bbdb-separator-alist'." (let ((val (bbdb-record-xfield record label))) (cond ((stringp val) (bbdb-split label val)) (val (error "Cannot split `%s'" val))))) (defun bbdb-record-set-xfield (record label value) "For RECORD set xfield LABEL to VALUE. If VALUE is nil or an empty string, remove xfield LABEL from RECORD. Return VALUE." ;; In principle we can also have xfield labels `name' or `mail', etc. ;; Yet the actual code would get rather confused. So we throw an error. (if (memq label '(name firstname lastname affix organization mail aka phone address xfields)) (error "xfield label `%s' illegal" label)) (if (eq label 'mail-alias) (setq bbdb-mail-aliases-need-rebuilt 'edit)) (if (stringp value) (setq value (bbdb-string-trim value t))) (let ((old-xfield (assq label (bbdb-record-xfields record)))) ;; Do nothing if both OLD-XFIELD and VALUE are nil. (cond ((and old-xfield value) ; update (setcdr old-xfield value)) (value ; new xfield (bbdb-pushnewq label bbdb-xfield-label-list) (bbdb-record-set-xfields record (append (bbdb-record-xfields record) (list (cons label value))))) (old-xfield ; remove (bbdb-record-set-xfields record (delq old-xfield (bbdb-record-xfields record)))))) value) (defun bbdb-check-type (object type &optional abort extended) "Return non-nil if OBJECT is of type TYPE. TYPE is a pseudo-code as in `bbdb-record-type'. If ABORT is non-nil, abort with error message if type checking fails. If EXTENDED is non-nil, consider extended atomic types which may include symbols, numbers, markers, and strings." (let (tmp) ;; Add more predicates? Compare info node `(elisp.info)Type Predicates'. (or (cond ((eq type 'symbol) (symbolp object)) ((eq type 'integer) (integerp object)) ((eq type 'marker) (markerp object)) ((eq type 'number) (numberp object)) ((eq type 'string) (stringp object)) ((eq type 'sexp) t) ; matches always ((eq type 'face) (facep object)) ;; not quite a type ((eq type 'bound) (and (symbolp object) (boundp object))) ((eq type 'function) (functionp object)) ((eq type 'vector) (vectorp object)) ((and extended (cond ((symbolp type) (setq tmp (eq type object)) t) ((or (numberp type) (markerp type)) (setq tmp (= type object)) t) ((stringp type) (setq tmp (and (stringp object) (string= type object))) t))) tmp) ((not (consp type)) (error "Atomic type `%s' undefined" type)) ((eq 'const (setq tmp (car type))) (equal (nth 1 type) object)) ((eq tmp 'cons) (and (consp object) (bbdb-check-type (car object) (nth 1 type) abort extended) (bbdb-check-type (cdr object) (nth 2 type) abort extended))) ((eq tmp 'list) (and (listp object) (eq (length (cdr type)) (length object)) (let ((type (cdr type)) (object object) (ok t)) (while type (unless (bbdb-check-type (pop object) (pop type) abort extended) (setq ok nil type nil))) ok))) ((eq tmp 'repeat) (and (listp object) (let ((tp (nth 1 type)) (object object) (ok t)) (while object (unless (bbdb-check-type (pop object) tp abort extended) (setq ok nil object nil))) ok))) ((eq tmp 'vector) (and (vectorp object) (let* ((i 0) (type (cdr type)) (ok (eq (length object) (length type)))) (when ok (while type (if (bbdb-check-type (aref object i) (pop type) abort extended) (setq i (1+ i)) (setq ok nil type nil))) ok)))) ((eq tmp 'or) ; like customize `choice' type (let ((type (cdr type)) ok) (while type (if (bbdb-check-type object (pop type) nil extended) (setq ok t type nil))) ok)) ;; User-defined predicate ((eq tmp 'user-p) (funcall (nth 1 type) object)) (t (error "Compound type `%s' undefined" tmp))) (and abort (error "Type mismatch: expect %s, got `%s'" type object))))) ;; (bbdb-check-type 'bar 'symbol) ;; (bbdb-check-type 'bar 'bar) ;; (bbdb-check-type "foo" 'symbol t) ;; (bbdb-check-type "foo" '(or symbol string)) ;; (bbdb-check-type nil '(const nil)) ;; (bbdb-check-type '(bar . "foo") '(cons symbol string)) ;; (bbdb-check-type '(bar "foo") '(list symbol string)) ;; (bbdb-check-type '("bar" "foo") '(repeat string)) ;; (bbdb-check-type (vector 'bar "foo") '(vector symbol string)) ;; (bbdb-check-type (vector 'bar "foo") 'vector) ;; (bbdb-check-type '(bar (bar . "foo")) '(list symbol (cons symbol string))) ;; (bbdb-check-type '("aa" . "bb") '(or (const nil) (cons string string)) t) ;; (bbdb-check-type nil '(or nil (cons string string)) t t) ;; (bbdb-check-type "foo" '(user-p (lambda (a) (stringp a)))) ;; (bbdb-check-type 'set 'function) (defun bbdb-record-field (record field) "For RECORD return the value of FIELD. FIELD may take the following values firstname Return the first name of RECORD lastname Return the last name of RECORD name Return the full name of RECORD (first name first) name-lf Return the full name of RECORD (last name first) affix Return the list of affixes organization Return the list of organizations aka Return the list of AKAs aka-all Return the list of AKAs plus mail-akas. mail Return the list of email addresses mail-aka Return the list of name parts in mail addresses mail-canon Return the list of canonical mail addresses. phone Return the list of phone numbers address Return the list of addresses uuid Return the uuid of RECORD creation-date Return the creation-date timestamp Return the timestamp xfields Return the list of all xfields Any other symbol is interpreted as the label for an xfield. Then return the value of this xfield. See also `bbdb-record-set-field'." (cond ((eq field 'firstname) (bbdb-record-firstname record)) ((eq field 'lastname) (bbdb-record-lastname record)) ((eq field 'name) (bbdb-record-name record)) ((eq field 'name-lf) (bbdb-record-name-lf record)) ((eq field 'affix) (bbdb-record-affix record)) ((eq field 'organization) (bbdb-record-organization record)) ((eq field 'mail) (bbdb-record-mail record)) ((eq field 'mail-canon) (bbdb-record-mail-canon record)) ; derived (cached) field ((eq field 'mail-aka) (bbdb-record-mail-aka record)) ; derived (cached) field ((eq field 'aka) (bbdb-record-aka record)) ((eq field 'aka-all) (append (bbdb-record-aka record) ; derived field (bbdb-record-mail-aka record))) ((eq field 'phone) (bbdb-record-phone record)) ((eq field 'address) (bbdb-record-address record)) ((eq field 'uuid) (bbdb-record-uuid record)) ((eq field 'creation-date) (bbdb-record-creation-date record)) ((eq field 'timestamp) (bbdb-record-timestamp record)) ;; Return all xfields ((eq field 'xfields) (bbdb-record-xfields record)) ;; Return xfield FIELD (e.g., `notes') or nil if FIELD is not defined. ((symbolp field) (bbdb-record-xfield record field)) (t (error "Unknown field type `%s'" field)))) (define-obsolete-function-alias 'bbdb-record-get-field 'bbdb-record-field "3.0") (defun bbdb-record-set-field (record field value &optional merge check) "For RECORD set FIELD to VALUE. Return VALUE. If MERGE is non-nil, merge VALUE with the current value of FIELD. If CHECK is non-nil, check syntactically whether FIELD may take VALUE. This function also updates the hash table. However, it does not update RECORD in the database. Use `bbdb-change-record' for that. FIELD may take the following values firstname VALUE is the first name of RECORD lastname VALUE is the last name of RECORD name VALUE is the full name of RECORD either as one string or as a cons pair (FIRST . LAST) affix VALUE is the list of affixes organization VALUE is the list of organizations aka VALUE is the list of AKAs mail VALUE is the list of email addresses phone VALUE is the list of phone numbers address VALUE is the list of addresses uuid VALUE is the uuid of RECORD creation-date VALUE is the creation-date timestamp VALUE is the timestamp xfields VALUE is the list of all xfields Any other symbol is interpreted as the label for an xfield. Then VALUE is the value of this xfield. See also `bbdb-record-field'." (bbdb-editable) (if (memq field '(name-lf mail-aka mail-canon aka-all)) (error "`%s' is not allowed as the name of a field" field)) (let ((record-type (cdr bbdb-record-type))) (cond ((eq field 'firstname) ; First name (if merge (error "Does not merge names")) (if check (bbdb-check-type value (bbdb-record-firstname record-type) t)) (bbdb-check-name value (bbdb-record-lastname record) record) (bbdb-record-set-name record value t)) ;; Last name ((eq field 'lastname) (if merge (error "Does not merge names")) (if check (bbdb-check-type value (bbdb-record-lastname record-type) t)) (bbdb-check-name (bbdb-record-firstname record) value record) (bbdb-record-set-name record t value)) ;; Name ((eq field 'name) (if merge (error "Does not merge names")) (if (stringp value) (setq value (bbdb-divide-name value)) (if check (bbdb-check-type value '(cons string string) t))) (let ((fn (car value)) (ln (cdr value))) (bbdb-check-name fn ln record) (bbdb-record-set-name record fn ln))) ;; Affix ((eq field 'affix) (if merge (setq value (bbdb-merge-lists (bbdb-record-affix record) value 'bbdb-string=))) (if check (bbdb-check-type value (bbdb-record-affix record-type) t)) (setq value (bbdb-list-strings value)) (bbdb-record-set-affix record value)) ;; Organization ((eq field 'organization) (if merge (setq value (bbdb-merge-lists (bbdb-record-organization record) value 'bbdb-string=))) (if check (bbdb-check-type value (bbdb-record-organization record-type) t)) (setq value (bbdb-list-strings value)) (bbdb-hash-update record (bbdb-record-organization record) value) (dolist (organization value) (bbdb-pushnew organization bbdb-organization-list)) (bbdb-record-set-organization record value)) ;; AKA ((eq field 'aka) (if merge (setq value (bbdb-merge-lists (bbdb-record-aka record) value 'bbdb-string=))) (if check (bbdb-check-type value (bbdb-record-aka record-type) t)) (setq value (bbdb-list-strings value)) (unless bbdb-allow-duplicates (dolist (aka value) (let ((old (remq record (bbdb-gethash aka '(fl-name lf-name aka))))) (if old (error "Alternate name address \"%s\" is used by \"%s\"" aka (mapconcat 'bbdb-record-name old ", ")))))) (bbdb-hash-update record (bbdb-record-aka record) value) (bbdb-record-set-aka record value)) ;; Mail ((eq field 'mail) (if merge (setq value (bbdb-merge-lists (bbdb-record-mail record) value 'bbdb-string=))) (if check (bbdb-check-type value (bbdb-record-mail record-type) t)) (setq value (bbdb-list-strings value)) (unless bbdb-allow-duplicates (dolist (mail value) (let ((old (remq record (bbdb-gethash mail '(mail))))) (if old (error "Mail address \"%s\" is used by \"%s\"" mail (mapconcat 'bbdb-record-name old ", ")))))) (dolist (aka (bbdb-record-mail-aka record)) (bbdb-remhash aka record)) (dolist (mail (bbdb-record-mail-canon record)) (bbdb-remhash mail record)) (bbdb-record-set-mail record value) (bbdb-puthash-mail record)) ;; Phone ((eq field 'phone) (if merge (setq value (bbdb-merge-lists (bbdb-record-phone record) value 'equal))) (if check (bbdb-check-type value (bbdb-record-phone record-type) t)) (dolist (phone value) (bbdb-pushnew (bbdb-phone-label phone) bbdb-phone-label-list)) (bbdb-record-set-phone record value)) ;; Address ((eq field 'address) (if merge (setq value (bbdb-merge-lists (bbdb-record-address record) value 'equal))) (if check (bbdb-check-type value (bbdb-record-address record-type) t)) (dolist (address value) (bbdb-pushnew (bbdb-address-label address) bbdb-address-label-list) (mapc (lambda (street) (bbdb-pushnewt street bbdb-street-list)) (bbdb-address-streets address)) (bbdb-pushnewt (bbdb-address-city address) bbdb-city-list) (bbdb-pushnewt (bbdb-address-state address) bbdb-state-list) (bbdb-pushnewt (bbdb-address-postcode address) bbdb-postcode-list) (bbdb-pushnewt (bbdb-address-country address) bbdb-country-list)) (bbdb-record-set-address record value)) ;; uuid ((eq field 'uuid) ;; MERGE not meaningful (if check (bbdb-check-type value (bbdb-record-uuid record-type) t)) (let ((old-uuid (bbdb-record-uuid record))) (unless (string= old-uuid value) (remhash old-uuid bbdb-uuid-table) (bbdb-record-set-uuid record value) (puthash value record bbdb-uuid-table)))) ;; creation-date ((eq field 'creation-date) ;; MERGE not meaningful (if check (bbdb-check-type value (bbdb-record-creation-date record-type) t)) (bbdb-record-set-creation-date record value)) ;; timestamp ((eq field 'timestamp) ;; MERGE not meaningful (if check (bbdb-check-type value (bbdb-record-timestamp record-type) t)) (bbdb-record-set-timestamp record value)) ;; all xfields ((eq field 'xfields) (if merge (let ((xfields (bbdb-record-xfields record)) xfield) (dolist (nv value) (if (setq xfield (assq (car nv) xfields)) (setcdr xfield (bbdb-merge-xfield (car nv) (cdr xfield) (cdr nv))) (setq xfields (append xfields (list nv))))) (setq value xfields))) (if check (bbdb-check-type value (bbdb-record-xfields record-type) t)) (let (new-xfields) (dolist (xfield value) ;; Ignore junk (when (and (cdr xfield) (not (equal "" (cdr xfield)))) (push xfield new-xfields) (bbdb-pushnewq (car xfield) bbdb-xfield-label-list))) (bbdb-record-set-xfields record (nreverse new-xfields)))) ;; Single xfield ((symbolp field) (if merge (setq value (bbdb-merge-xfield field (bbdb-record-xfield record field) value))) ;; The following test always succeeds ;; (if check (bbdb-check-type value 'sexp t)) ;; This removes xfield FIELD if its value is nil. (bbdb-record-set-xfield record field value)) (t (error "Unknown field type `%s'" field))))) ;; Currently unused (but possible entry for `bbdb-merge-xfield-function-alist') (defun bbdb-merge-concat (string1 string2 &optional separator) "Return the concatenation of STRING1 and STRING2. SEPARATOR defaults to \"\\n\"." (concat string1 (or separator "\n") string2)) ;; Currently unused (but possible entry for `bbdb-merge-xfield-function-alist') (defun bbdb-merge-concat-remove-duplicates (string1 string2) "Concatenate STRING1 and STRING2, but remove duplicate lines." (let ((lines (split-string string1 "\n"))) (dolist (line (split-string string2 "\n")) (bbdb-pushnew line lines)) (bbdb-concat "\n" lines))) (defun bbdb-merge-string-least (string1 string2) "Return the string out of STRING1 and STRING2 that is `string-lessp'." (if (string-lessp string1 string2) string1 string2)) (defun bbdb-merge-string-most (string1 string2) "Return the string out of STRING1 and STRING2 that is not `string-lessp'." (if (string-lessp string1 string2) string2 string1)) (defun bbdb-merge-lists (l1 l2 cmp) "Merge two lists L1 and L2 based on comparison CMP. An element from L2 is added to L1 if CMP returns nil for all elements of L1. If L1 or L2 are not lists, they are replaced by (list L1) and (list L2)." (let (merge) (unless (listp l1) (setq l1 (list l1))) (dolist (e2 (if (listp l2) l2 (list l2))) (let ((ll1 l1) e1 fail) (while (setq e1 (pop ll1)) (if (funcall cmp e1 e2) (setq ll1 nil fail t))) (unless fail (push e2 merge)))) (append l1 (nreverse merge)))) (defun bbdb-merge-xfield (label value1 value2) "For LABEL merge VALUE1 with VALUE2. If LABEL has an entry in `bbdb-merge-xfield-function-alist', use it. If VALUE1 or VALUE2 is a substring of the other, return the longer one. Otherwise use `bbdb-concat'. Return nil if we have nothing to merge." (if (stringp value1) (setq value1 (bbdb-string-trim value1 t))) (if (stringp value2) (setq value2 (bbdb-string-trim value2 t))) (cond ((and value1 value2) (let ((fun (cdr (assq label bbdb-merge-xfield-function-alist)))) (cond (fun (funcall fun value1 value2)) ((not (and (stringp value1) (stringp value2))) (cons value1 value2)) ; concatenate lists ((string-match (regexp-quote value1) value2) value2) ((string-match (regexp-quote value2) value1) value1) (t (bbdb-concat label value1 value2))))) (value1) (value2))) ;;; Parsing other things (defun bbdb-divide-name (string) "Divide STRING into a first name and a last name. Case is ignored. Return name as (FIRST . LAST). LAST is always a string (possibly empty). FIRST may be nil." (let ((case-fold-search t) first suffix) ;; Separate a suffix. (if (string-match bbdb-lastname-suffix-re string) (setq suffix (concat " " (match-string 1 string)) string (substring string 0 (match-beginning 0)))) (cond ((string-match "\\`\\(.+\\),[ \t\n]*\\(.+\\)\\'" string) ;; If STRING contains a comma, this probably means that STRING ;; is of the form "Last, First". (setq first (match-string 2 string) string (match-string 1 string))) ((string-match bbdb-lastname-re string) (setq first (and (not (zerop (match-beginning 0))) (substring string 0 (match-beginning 0))) string (match-string 1 string)))) (cons (and first (bbdb-string-trim first)) (bbdb-string-trim (concat string suffix))))) (defun bbdb-parse-postcode (string) "Check whether STRING is a legal postcode. Do this only if `bbdb-check-postcode' is non-nil." (if bbdb-check-postcode (let ((postcodes bbdb-legal-postcodes) re done) (while (setq re (pop postcodes)) (if (string-match re string) (setq done t postcodes nil))) (if done string (error "not a valid postcode."))) string)) (defun bbdb-phone-string (phone) "Massage string PHONE into a standard format." ;; Phone numbers should come in two forms: (if (= 2 (length phone)) ;; (1) ["where" "the number"] (if (stringp (aref phone 1)) (aref phone 1) (error "Not a valid phone number: %s" (aref phone 1))) ;; (2) ["where" 415 555 1212 99] (unless (and (integerp (aref phone 2)) (integerp (aref phone 3))) (error "Not an NANP number: %s %s" (aref phone 2) (aref phone 3))) (concat (if (/= 0 (bbdb-phone-area phone)) (format "(%03d) " (bbdb-phone-area phone)) "") (if (/= 0 (bbdb-phone-exchange phone)) (format "%03d-%04d" (bbdb-phone-exchange phone) (bbdb-phone-suffix phone)) "") (if (and (bbdb-phone-extension phone) (/= 0 (bbdb-phone-extension phone))) (format " x%d" (bbdb-phone-extension phone)) "")))) (defsubst bbdb-record-lessp (record1 record2) (string< (bbdb-record-sortkey record1) (bbdb-record-sortkey record2))) (defmacro bbdb-error-retry (&rest body) "Repeatedly execute BODY ignoring errors till no error occurs." `(catch '--bbdb-error-retry-- (while t (condition-case --c-- (throw '--bbdb-error-retry-- (progn ,@body)) (error (ding) (message "Error: %s" (nth 1 --c--)) (sit-for 2)))))) ;;; Reading and Writing the BBDB (defun bbdb-buffer () "Return buffer that visits the BBDB file `bbdb-file'. Ensure that this buffer is in sync with `bbdb-file'. Revert the buffer if necessary. If `bbdb-file-remote' is non-nil and it is newer than `bbdb-file', copy it to `bbdb-file'." (unless (buffer-live-p bbdb-buffer) (if (and bbdb-file-remote (file-newer-than-file-p bbdb-file-remote bbdb-file)) (copy-file bbdb-file-remote bbdb-file t t)) (with-current-buffer (setq bbdb-buffer (find-file-noselect bbdb-file)) ;; Check whether auto-save file is newer than `bbdb-file' ;; Do this only when reading `bbdb-file'. (let ((auto-save-file (make-auto-save-file-name))) (when (and bbdb-check-auto-save-file (file-newer-than-file-p auto-save-file buffer-file-name)) (recover-file buffer-file-name) ; this queries (bury-buffer) ; `recover-file' selects `bbdb-buffer' (auto-save-mode 1) ; turn auto-save back on ;; Delete auto-save file even if the user rejected to recover it, ;; so we do not keep asking. (condition-case nil (delete-file auto-save-file) (file-error nil)))))) ;; Make sure `bbdb-buffer' is not out of sync with disk. (with-current-buffer bbdb-buffer (cond ((verify-visited-file-modtime)) ((bbdb-revert-buffer)) ;; This is the case where `bbdb-file' has changed; the buffer ;; has changed as well; and the user has answered "no" to the ;; "flush your changes and revert" question. The only other ;; alternative is to save the file right now. If they answer ;; no to the following question, they will be asked the ;; preceeding question again and again some large (but finite) ;; number of times. `bbdb-buffer' is called a lot, you see... ((buffer-modified-p) ;; this queries (bbdb-save t t)) (t ; Buffer and file are inconsistent, but we let them stay that way (message "Continuing with inconsistent BBDB buffers"))) ;; `bbdb-revert-buffer' kills all local variables. (unless (assq 'bbdb-records (buffer-local-variables)) ;; We are reading / reverting `bbdb-buffer'. (set (make-local-variable 'revert-buffer-function) 'bbdb-revert-buffer) (setq buffer-file-coding-system bbdb-file-coding-system buffer-read-only bbdb-read-only bbdb-mail-aliases-need-rebuilt 'parse bbdb-changed-records nil) ;; `bbdb-before-save-hook' and `bbdb-after-save-hook' are user variables. ;; To avoid confusion, we hide the hook functions `bbdb-before-save' ;; and `bbdb-after-save' from the user as these are essential for BBDB. (dolist (hook (cons 'bbdb-before-save bbdb-before-save-hook)) (add-hook 'before-save-hook hook nil t)) (dolist (hook (cons 'bbdb-after-save bbdb-after-save-hook)) (add-hook 'after-save-hook hook nil t)) (clrhash bbdb-hashtable) (clrhash bbdb-uuid-table) (if (/= (point-min) (point-max)) (bbdb-parse-records) ; normal case: nonempty db ;; Empty db: the following does not require `insert-before-markers' ;; because there are no db-markers in this buffer. (insert (format (concat ";; -*- mode: Emacs-Lisp; coding: %s; -*-" "\n;;; file-format: %d\n") bbdb-file-coding-system bbdb-file-format)) ;; We pretend that `bbdb-buffer' is still unmodified, ;; so that we will (auto-)save it only if we also add records to it. (set-buffer-modified-p nil) (setq bbdb-end-marker (point-marker) ;; Setting `bbdb-records' makes it buffer-local, ;; so that we can use it as a test whether we have ;; initialized BBDB. bbdb-records nil)) (run-hooks 'bbdb-after-read-db-hook))) ;; return `bbdb-buffer' bbdb-buffer) (defmacro bbdb-with-db-buffer (&rest body) "Execute the forms in BODY with `bbdb-buffer' temporarily current. If `bbdb-debug' was non-nil at compile-time, and `bbdb-buffer' is visible in a window, temporarilly switch to that window. So when we come out, that window has been scrolled to the record we have just modified." (declare (indent 0)) (if bbdb-debug `(let* ((buffer (bbdb-buffer)) (window (get-buffer-window buffer))) (if window (with-selected-window window ,@body) (with-current-buffer buffer ,@body))) `(with-current-buffer (bbdb-buffer) ,@body))) (defun bbdb-editable () "Ensure that BBDB is editable, otherwise throw an error. If BBDB is out of sync try to revert. BBDB is not editable if it is read-only." (if bbdb-read-only (error "BBDB is read-only")) (let ((buffer (bbdb-buffer))) ; this reverts if necessary / possible ;; Is the following possible? Superfluous tests do not hurt. ;; It is relevant only for editing commands in a BBDB buffer, ;; but not for MUA-related editing functions. (if (and (eq major-mode 'bbdb-mode) bbdb-records (not (memq (caar bbdb-records) (with-current-buffer buffer bbdb-records)))) (error "BBDB is out of sync"))) t) ;;;###autoload (defsubst bbdb-records () "Return a list of all BBDB records; read in and parse the db if necessary. This function also notices if the corresponding file on disk has been modified." (with-current-buffer (bbdb-buffer) bbdb-records)) (defun bbdb-revert-buffer (&optional ignore-auto noconfirm) "The `revert-buffer-function' for `bbdb-buffer' visiting `bbdb-file'. IGNORE-AUTO and NOCONFIRM have same meaning as in `revert-buffer'. See also variable `bbdb-auto-revert'. Return t if the reversion was successful (or not needed). Return nil otherwise." (interactive (list (not current-prefix-arg))) ; as in `revert-buffer' (unless (buffer-live-p bbdb-buffer) (error "No live BBDB buffer to revert")) (with-current-buffer bbdb-buffer (cond ((not buffer-file-number) ;; We have not yet created `bbdb-file' (when (or noconfirm (yes-or-no-p "Flush your changes? ")) (erase-buffer) (kill-all-local-variables) ; clear database (bbdb-buffer) ; re-initialize (set-buffer-modified-p nil) (bbdb-undisplay-records t))) ;; If nothing has changed do nothing, return t. ((and (verify-visited-file-modtime) (not (buffer-modified-p)))) ((or (and (not (verify-visited-file-modtime bbdb-buffer)) ;; File changed on disk (or noconfirm (and bbdb-auto-revert (not (buffer-modified-p))) (yes-or-no-p (if (buffer-modified-p) "BBDB changed on disk; flush your changes and revert? " "BBDB changed on disk; revert? ")))) (and (verify-visited-file-modtime bbdb-buffer) ;; File not changed on disk, but buffer modified (buffer-modified-p) (or noconfirm (yes-or-no-p "Flush your changes and revert BBDB? ")))) (unless (file-exists-p bbdb-file) (error "BBDB: file %s no longer exists" bbdb-file)) (kill-all-local-variables) ; clear database ;; `revert-buffer-function' has the permanent-local property ;; So to avoid looping, we need to bind it to nil explicitly. (let (revert-buffer-function) (revert-buffer ignore-auto t)) (bbdb-buffer) ; re-initialize (bbdb-undisplay-records t) t)))) ; return nil if the user rejected to revert (defun bbdb-goto-first-record () "Go to where first record begins, Move to end of file if no records." (goto-char (point-min)) (if (search-forward "\n[" nil 'move) (forward-char -1))) (defun bbdb-parse-records () "Parse BBDB records and initialize various internal variables. If `bbdb-file' uses an outdated format, migrate to `bbdb-file-format'." (save-excursion (save-restriction (widen) (bbdb-goto-first-record) (let* ((file (abbreviate-file-name buffer-file-name)) (file-format (save-excursion (if (re-search-backward "^;+[ \t]*file-\\(format\\|version\\):[ \t]*\\([0-9]+\\)[ \t]*$" nil t) (string-to-number (match-string 2)) ;; No file-format line. (error "BBDB corrupted: no file-format line")))) (migrate (< file-format bbdb-file-format)) records) (if (> file-format bbdb-file-format) (error "%s understands file format %s but not %s." (bbdb-version) bbdb-file-format file-format)) (if (and migrate (not (yes-or-no-p (format (concat "Migrate `%s' to BBDB file format %s " "(back-up recommended)? ") file bbdb-file-format)))) (progn (message "Abort loading %s" file) (sleep-for 2) (setq bbdb-records nil ;; Avoid unexpected surprises buffer-read-only t) 'abort) (or (eobp) (looking-at "\\[") (error "BBDB corrupted: no following bracket")) (unless bbdb-silent (message "Parsing BBDB file `%s'..." file)) ;; narrow the buffer to skip over the rubbish before the first record. (narrow-to-region (point) (point-max)) (let ((modp (buffer-modified-p)) ;; Make sure those parens get cleaned up. ;; This code had better stay simple! (inhibit-quit t) (buffer-undo-list t) buffer-read-only) (goto-char (point-min)) (insert "(\n") (goto-char (point-max)) (insert "\n)") (goto-char (point-min)) (unwind-protect (setq records (read (current-buffer))) (goto-char (point-min)) (delete-char 2) (goto-char (point-max)) (delete-char -2) (set-buffer-modified-p modp))) (widen) ;; Migrate if `bbdb-file' is outdated. (if migrate (setq records (bbdb-migrate records file-format))) ;; We could first set `bbdb-phone-label-list' and ;; `bbdb-address-label-list' to their customized values. Bother? (setq bbdb-records records bbdb-xfield-label-list nil bbdb-organization-list nil bbdb-street-list nil bbdb-city-list nil bbdb-state-list nil bbdb-postcode-list nil bbdb-country-list nil) (bbdb-goto-first-record) (dolist (record records) ;; We assume that the markers for each record need to go at each ;; newline. If this is not the case, things can go *very* wrong. (bbdb-debug (unless (looking-at "\\[") (error "BBDB corrupted: junk between records at %s" (point)))) (bbdb-cache-set-marker (bbdb-record-set-cache record (make-vector bbdb-cache-length nil)) (point-marker)) (forward-line 1) ;; Every record must have a unique uuid in `bbdb-uuid-table'. (if (gethash (bbdb-record-uuid record) bbdb-uuid-table) ;; Is there a more useful action than throwing an error? ;; We are just loading BBDB, so we are not yet ready ;; for sophisticated solutions. (error "Duplicate UUID %s" (bbdb-record-uuid record))) ;; Set the completion lists (dolist (phone (bbdb-record-phone record)) (bbdb-pushnew (bbdb-phone-label phone) bbdb-phone-label-list)) (dolist (address (bbdb-record-address record)) (bbdb-pushnew (bbdb-address-label address) bbdb-address-label-list) (mapc (lambda (street) (bbdb-pushnewt street bbdb-street-list)) (bbdb-address-streets address)) (bbdb-pushnewt (bbdb-address-city address) bbdb-city-list) (bbdb-pushnewt (bbdb-address-state address) bbdb-state-list) (bbdb-pushnewt (bbdb-address-postcode address) bbdb-postcode-list) (bbdb-pushnewt (bbdb-address-country address) bbdb-country-list)) (dolist (xfield (bbdb-record-xfields record)) (bbdb-pushnewq (car xfield) bbdb-xfield-label-list)) (dolist (organization (bbdb-record-organization record)) (bbdb-pushnew organization bbdb-organization-list)) (let ((name (bbdb-concat 'name-first-last (bbdb-record-firstname record) (bbdb-record-lastname record)))) (when (and (not bbdb-allow-duplicates) (bbdb-gethash name '(fl-name aka))) ;; This does not check for duplicate mail fields. ;; Yet under normal circumstances, this should really ;; not be necessary each time BBDB is loaded as BBDB checks ;; whether creating a new record or modifying an existing one ;; results in duplicates. ;; Alternatively, you can use `bbdb-search-duplicates'. (message "Duplicate BBDB record encountered: %s" name) (sit-for 1))) ;; If `bbdb-allow-duplicates' is non-nil, we allow that two records ;; (with different uuids) refer to the same person (same name etc.). ;; Such duplicate records are always hashed. ;; Otherwise, an unhashed record would not be available for things ;; like completion (and we would not know which record to keeep ;; and which one to hide). We trust the user she knows what ;; she wants if she keeps duplicate records in the database though ;; `bbdb-allow-duplicates' is nil. (bbdb-hash-record record)) ;; Note that `bbdb-xfield-label-list' serves two purposes: ;; - check whether an xfield is new to BBDB ;; - list of known xfields for minibuffer completion ;; Only in the latter case, we might want to exclude ;; those xfields that are handled automatically. ;; So the following is not a satisfactory solution. ;; (dolist (label (bbdb-layout-get-option 'multi-line 'omit)) ;; (setq bbdb-xfield-label-list (delq label bbdb-xfield-label-list))) ;; `bbdb-end-marker' allows to put comments at the end of `bbdb-file' ;; that are ignored. (setq bbdb-end-marker (point-marker)) (when migrate (dolist (record bbdb-records) (bbdb-overwrite-record-internal record)) ;; update file format (goto-char (point-min)) (if (re-search-forward (format "^;;; file-\\(version\\|format\\): %d$" file-format) nil t) (replace-match (format ";;; file-format: %d" bbdb-file-format)))) (unless bbdb-silent (message "Parsing BBDB file `%s'...done" file)) bbdb-records))))) (defun bbdb-before-save () "Run before saving `bbdb-file' as buffer-local part of `before-save-hook'." (when (and bbdb-file-remote (or bbdb-file-remote-save-always (y-or-n-p (format "Save the remote BBDB file %s too? " bbdb-file-remote)))) ;; Write the current buffer `bbdb-file' into `bbdb-file-remote'. (let ((coding-system-for-write bbdb-file-coding-system)) (write-region (point-min) (point-max) bbdb-file-remote)))) (defun bbdb-after-save () "Run after saving `bbdb-file' as buffer-local part of `after-save-hook'." (setq bbdb-changed-records nil) (dolist (buffer (buffer-list)) (with-current-buffer buffer (if (eq major-mode 'bbdb-mode) (set-buffer-modified-p nil))))) (defun bbdb-change-record (record &rest ignored) "Update the database after a change of RECORD. Return RECORD if RECORD got changed compared with the database, return nil otherwise. Hash RECORD if it is new. If RECORD is not new, it is the the caller's responsibility to update the hashtables for RECORD. (Up-to-date hashtables are ensured if the fields are modified by calling `bbdb-record-set-field'.) Redisplay RECORD if it is not new. Args IGNORED are ignored and their use is discouraged. They are present only for backward compatibility." (when (and ignored (get 'bbdb-change-record 'bbdb-outdated)) (put 'bbdb-change-record 'bbdb-outdated t) (message "Outdated usage of `bbdb-change-record'") (sit-for 2)) (if bbdb-read-only (error "The Insidious Big Brother Database is read-only.")) ;; The call of `bbdb-records' checks file synchronization. ;; If RECORD refers to an existing record that has been changed, ;; yet in the meanwhile we reverted the BBDB file, then RECORD ;; no longer refers to a record in `bbdb-records'. RECORD will then ;; be treated as new, when we try to merge it with the known record. (let ((tail (memq record (bbdb-records)))) (if tail ; RECORD is not new ;; If the string we currently have for RECORD in `bbdb-buffer' ;; is `equal' to the string we would write to `bbdb-buffer', ;; we really did not change RECORD at all. So we don't update RECORD ;; unless `bbdb-update-unchanged-records' tells us to do so anyway. ;; Also, we only call `bbdb-change-hook' and `bbdb-after-change-hook' ;; if RECORD got changed. (when (or bbdb-update-unchanged-records (not (string= (bbdb-with-db-buffer (buffer-substring-no-properties (bbdb-record-marker record) (1- (if (cdr tail) (bbdb-record-marker (cadr tail)) bbdb-end-marker)))) (let ((cache (bbdb-record-cache record)) (inhibit-quit t)) (bbdb-record-set-cache record nil) (prog1 (bbdb-with-print-loadably (prin1-to-string record)) (bbdb-record-set-cache record cache)))))) (bbdb-record-set-timestamp record (format-time-string bbdb-time-stamp-format nil t)) (run-hook-with-args 'bbdb-change-hook record) (let ((sort (not (equal (bbdb-cache-sortkey (bbdb-record-cache record)) (bbdb-record-set-sortkey record))))) (if (not sort) ;; If we do not need to sort, overwrite RECORD. (bbdb-overwrite-record-internal record) ;; Since we need to sort, delete then insert RECORD. ;; Do not mess with the hash tables here. ;; We assume they got updated by the caller. (bbdb-delete-record-internal record) (bbdb-insert-record-internal record)) (bbdb-pushnewq record bbdb-changed-records) (run-hook-with-args 'bbdb-after-change-hook record) (bbdb-redisplay-record-globally record sort)) record) ;; Record is new and not yet in BBDB. (unless (bbdb-record-cache record) (bbdb-record-set-cache record (make-vector bbdb-cache-length nil))) (unless (bbdb-record-uuid record) (bbdb-record-set-uuid record (bbdb-uuid))) (unless (bbdb-record-creation-date record) (bbdb-record-set-creation-date record (format-time-string bbdb-time-stamp-format nil t)) (run-hook-with-args 'bbdb-create-hook record)) (let ((old-record (gethash (bbdb-record-uuid record) bbdb-uuid-table))) (if old-record ;; RECORD is really OLD-RECORD. Merge and return OLD-RECORD. (if bbdb-merge-records-function (funcall bbdb-merge-records-function record old-record) (bbdb-merge-records record old-record)) ;; RECORD is really new. (bbdb-record-set-timestamp record (format-time-string bbdb-time-stamp-format nil t)) (run-hook-with-args 'bbdb-change-hook record) (bbdb-insert-record-internal record) (bbdb-hash-record record) (bbdb-pushnewq record bbdb-changed-records) (run-hook-with-args 'bbdb-after-change-hook record) record))))) (defun bbdb-delete-record-internal (record &optional completely) "Delete RECORD in the database file. With COMPLETELY non-nil, also undisplay RECORD and remove it from the hash table." (unless (bbdb-record-marker record) (error "BBDB: marker absent")) (if completely (bbdb-redisplay-record-globally record nil t)) (bbdb-with-db-buffer (barf-if-buffer-read-only) (let ((tail (memq record bbdb-records)) (inhibit-quit t)) (unless tail (error "BBDB record absent: %s" record)) (delete-region (bbdb-record-marker record) (if (cdr tail) (bbdb-record-marker (car (cdr tail))) bbdb-end-marker)) (setq bbdb-records (delq record bbdb-records)) (when completely (bbdb-remhash (bbdb-record-name record) record) (bbdb-remhash (bbdb-record-name-lf record) record) (dolist (organization (bbdb-record-organization record)) (bbdb-remhash organization record)) (dolist (mail (bbdb-record-mail-canon record)) (bbdb-remhash mail record)) (dolist (aka (bbdb-record-field record 'aka-all)) (bbdb-remhash aka record)))))) (defun bbdb-insert-record-internal (record) "Insert RECORD into the database file. Return RECORD. Do not call this function directly, call instead `bbdb-change-record' that calls the hooks, too." (unless (bbdb-record-marker record) (bbdb-record-set-marker record (make-marker))) (bbdb-with-db-buffer (barf-if-buffer-read-only) ;; splice record into `bbdb-records' (bbdb-debug (if (memq record bbdb-records) (error "BBDB record not unique: - %s" record))) (if (or (not bbdb-records) ; first record in new database (bbdb-record-lessp record (car bbdb-records))) (push record bbdb-records) (let ((records bbdb-records)) (while (and (cdr records) (bbdb-record-lessp (nth 1 records) record)) (setq records (cdr records))) (setcdr records (cons record (cdr records))))) (let ((next (car (cdr (memq record bbdb-records))))) (goto-char (if next (bbdb-record-marker next) bbdb-end-marker))) ;; Before writing the record, remove the cache (we do not want that ;; written to the file.) After writing, put the cache back and update ;; the cache's marker. (let ((cache (bbdb-record-cache record)) (point (point)) (inhibit-quit t)) (bbdb-debug (if (= point (point-min)) (error "Inserting at point-min (%s)" point)) (if (and (/= point bbdb-end-marker) (not (looking-at "^\\["))) (error "Not inserting before a record (%s)" point))) (bbdb-record-set-cache record nil) (insert-before-markers (bbdb-with-print-loadably (prin1-to-string record)) "\n") (set-marker (bbdb-cache-marker cache) point) (bbdb-record-set-cache record cache)) record)) (defun bbdb-overwrite-record-internal (record) "Overwrite RECORD in the database file. Return RECORD. Do not call this function directly, call instead `bbdb-change-record' that calls the hooks, too." (bbdb-with-db-buffer (barf-if-buffer-read-only) (let* ((tail (memq record bbdb-records)) (_ (unless tail (error "BBDB record absent: %s" record))) (cache (bbdb-record-cache record)) (inhibit-quit t)) (bbdb-debug (if (<= (bbdb-cache-marker cache) (point-min)) (error "Cache marker is %s" (bbdb-cache-marker cache)))) (goto-char (bbdb-cache-marker cache)) (bbdb-debug (if (and (/= (point) bbdb-end-marker) (not (looking-at "\\["))) (error "Not inserting before a record (%s)" (point)))) (bbdb-record-set-cache record nil) (insert (bbdb-with-print-loadably (prin1-to-string record)) "\n") (delete-region (point) (if (cdr tail) (bbdb-record-marker (car (cdr tail))) bbdb-end-marker)) (bbdb-record-set-cache record cache) (bbdb-debug (if (<= (if (cdr tail) (bbdb-record-marker (car (cdr tail))) bbdb-end-marker) (bbdb-record-marker record)) (error "Overwrite failed"))) record))) ;; Record formatting: ;; This does not insert anything into the *BBDB* buffer, ;; which is handled in a second step by the display functions. (defun bbdb-layout-get-option (layout option) "For LAYOUT return value of OPTION according to `bbdb-layout-alist'." (let ((layout-spec (if (listp layout) layout (assq layout bbdb-layout-alist))) option-value) (and layout-spec (setq option-value (assq option layout-spec)) (cdr option-value)))) (defun bbdb-address-continental-p (address) "Return non-nil if ADDRESS is a continental address. This is done by comparing the postcode to `bbdb-continental-postcode-regexp'. This is a possible identifying function for `bbdb-address-format-list' and `bbdb-tex-address-format-list'." (string-match bbdb-continental-postcode-regexp (bbdb-address-postcode address))) ;; This function can provide some guidance for writing ;; your own address formatting function (defun bbdb-format-address-default (address) "Return formatted ADDRESS as a string. This is the default format; it is used in the US, for example. The result looks like this: label: street street ... city, state postcode country. This function is a possible formatting function for `bbdb-address-format-list'." (let ((country (bbdb-address-country address)) (streets (bbdb-address-streets address))) (concat (if streets (concat (mapconcat 'identity streets "\n") "\n")) (bbdb-concat ", " (bbdb-address-city address) (bbdb-concat " " (bbdb-address-state address) (bbdb-address-postcode address))) (unless (or (not country) (string= "" country)) (concat "\n" country))))) (defun bbdb-format-address (address layout) "Format ADDRESS using LAYOUT. Return result as a string. The formatting rules are defined in `bbdb-address-format-list'." (let ((list bbdb-address-format-list) (country (bbdb-address-country address)) elt string) (while (and (not string) (setq elt (pop list))) (let ((identifier (car elt)) (format (nth layout elt)) ;; recognize case for format identifiers case-fold-search str) (when (or (eq t identifier) ; default (and (functionp identifier) (funcall identifier address)) (and country (listp identifier) ;; ignore case for countries (member-ignore-case country identifier))) (cond ((functionp format) (setq string (funcall format address))) ((stringp format) (setq string "") (dolist (form (split-string (substring format 1 -1) (substring format 0 1) t)) (cond ((string-match "%s" form) ; street (mapc (lambda (s) (setq string (concat string (format form s)))) (bbdb-address-streets address))) ((string-match "%c" form) ; city (unless (or (not (setq str (bbdb-address-city address))) (string= "" str)) (setq string (concat string (format (replace-regexp-in-string "%c" "%s" form) str))))) ((string-match "%p" form) ; postcode (unless (or (not (setq str (bbdb-address-postcode address))) (string= "" str)) (setq string (concat string (format (replace-regexp-in-string "%p" "%s" form) str))))) ((string-match "%S" form) ; state (unless (or (not (setq str (bbdb-address-state address))) (string= "" str)) (setq string (concat string (format (replace-regexp-in-string "%S" "%s" form t) str))))) ((string-match "%C" form) ; country (unless (or (not country) (string= "" country)) (setq string (concat string (format (replace-regexp-in-string "%C" "%s" form t) country))))) (t (error "Malformed address format element %s" form))))) (t (error "Malformed address format %s" format)))))) (unless string (error "No match of `bbdb-address-format-list'")) string)) ;;; Record display: ;; This inserts formatted (pieces of) records into the BBDB buffer. (defsubst bbdb-field-property (start field) "Set text property bbdb-field of text between START and point to FIELD." (put-text-property start (point) 'bbdb-field field)) (defsubst bbdb-display-text (text field &optional face) "Insert TEXT at point. Set its text property bbdb-field to FIELD. If FACE is non-nil, also add face FACE." (let ((start (point))) (insert text) (bbdb-field-property start field) (if face (put-text-property start (point) 'face face)))) (defun bbdb-display-list (list field &optional terminator face indent) "Insert elements of LIST at point. For inserted text, set text property bbdb-field to FIELD. If TERMINATOR is non-nil use it to terminate the inserted text. If FACE is non-nil use it as FACE for inserted text. If INDENT and `bbdb-wrap-column' are integers, insert line breaks in between elements of LIST if otherwise inserted text exceeds `bbdb-wrap-column'." ;; `truncate-lines' is fine for one-line layout. But it is annyoing ;; for records that are displayed with multi-line layout. ;; Non-nil `word-wrap' would be much nicer. How can we switch between ;; non-nil `truncate-lines' and non-nil `word-wrap' on a per-record basis? ;; The following code is an alternative solution using `bbdb-wrap-column'. (let* ((separator (nth 1 (or (cdr (assq field bbdb-separator-alist)) bbdb-default-separator))) (indent-flag (and (integerp bbdb-wrap-column) (integerp indent))) (prefix (if indent-flag (concat separator "\n" (make-string indent ?\s)))) elt) (while (setq elt (pop list)) (bbdb-display-text elt (list field elt) face) (cond ((and list indent-flag (> (+ (current-column) (length (car list))) bbdb-wrap-column)) (bbdb-display-text prefix (list field) face)) (list (bbdb-display-text separator (list field) face)) (terminator (bbdb-display-text terminator (list field) face)))))) (defun bbdb-display-name-organization (record) "Insert name, affix, and organization of RECORD. If RECORD has an xfield name-face, its value is used for font-locking name. The value of name-face may be a face that is used directly. The value may also be a key in `bbdb-name-face-alist'. Then the corresponding cdr is used. If none of these schemes succeeds the face `bbdb-face' is used." ;; Should this be further customizable? We could build the following ;; from a customizable list containing function calls and strings. ;; Name (let ((name (if (eq 'last-first (or (bbdb-record-xfield-intern record 'name-format) bbdb-name-format)) (bbdb-record-name-lf record) ;; default: Firstname Lastname (bbdb-record-name record))) (name-face (bbdb-record-xfield record 'name-face))) (if (string= "" name) (setq name "???")) (bbdb-display-text name (list 'name name) (if name-face (cond ((facep name-face) name-face) ((cdr (assoc name-face bbdb-name-face-alist))) (t 'bbdb-name)) 'bbdb-name))) ;; Affix (let ((affix (bbdb-record-affix record))) (when affix (insert ", ") (bbdb-display-list affix 'affix))) ;; Organization (let ((organization (bbdb-record-organization record))) (when organization (insert " - ") (bbdb-display-list organization 'organization nil 'bbdb-organization))) ;; Image (if (and bbdb-image (display-images-p)) (let ((image (cond ((functionp bbdb-image) (funcall bbdb-image record)) ((memq bbdb-image '(name fl-name)) (bbdb-record-name record)) ((eq bbdb-image 'lf-name) (bbdb-record-name-lf record)) (t (bbdb-record-xfield record bbdb-image))))) (when (and image (setq image (locate-file image bbdb-image-path bbdb-image-suffixes)) (setq image (create-image image))) (insert " ") (insert-image image))))) (defun bbdb-display-record-one-line (record layout field-list) "Format RECORD for the one-line FORMAT using LAYOUT. See `bbdb-layout-alist' for more info on layouts. FIELD-LIST is the list of actually displayed FIELDS." ;; Name, affix, and organizations (bbdb-display-name-organization record) (let ((name-end (or (bbdb-layout-get-option layout 'name-end) 40)) (start (line-beginning-position))) (when (> (- (point) start -1) name-end) (put-text-property (+ start name-end -4) (point) 'invisible t) (insert "...")) (indent-to name-end)) ;; rest of the fields (let (formatfun start) (dolist (field field-list) (cond (;; customized formatting (setq formatfun (intern-soft (format "bbdb-display-%s-one-line" field))) (funcall formatfun record)) ;; phone ((eq field 'phone) (let ((phones (bbdb-record-phone record)) phone) (if phones (while (setq phone (pop phones)) (bbdb-display-text (format "%s " (aref phone 0)) `(phone ,phone field-label) 'bbdb-field-name) (bbdb-display-text (format "%s%s" (aref phone 1) (if phones " " "; ")) `(phone ,phone)))))) ;; address ((eq field 'address) (dolist (address (bbdb-record-address record)) (setq start (point)) (insert (bbdb-format-address address 3)) (bbdb-field-property start `(address ,address)) (insert "; "))) ;; mail ((eq field 'mail) (let ((mail (bbdb-record-mail record))) (if mail (bbdb-display-list (if (bbdb-layout-get-option layout 'primary) (list (car mail)) mail) 'mail "; ")))) ;; AKA ((eq field 'aka) (let ((aka (bbdb-record-aka record))) (if aka (bbdb-display-list aka 'aka "; ")))) ;; uuid ((eq field 'uuid) (let ((uuid (bbdb-record-uuid record))) (bbdb-display-text (format "%s; " uuid) `(uuid ,uuid)))) ;; creation-date ((eq field 'creation-date) (let ((creation-date (bbdb-record-creation-date record))) (bbdb-display-text (format "%s; " creation-date) `(creation-date ,creation-date)))) ;; timestamp ((eq field 'timestamp) (let ((timestamp (bbdb-record-timestamp record))) (bbdb-display-text (format "%s; " timestamp) `(timestamp ,timestamp)))) ;; xfields (t (let* ((xfield (assq field (bbdb-record-xfields record))) (value (cdr xfield))) (if value (bbdb-display-text (concat (if (stringp value) (replace-regexp-in-string "\n" "; " value) ;; value of xfield is a sexp (let ((print-escape-newlines t)) (prin1-to-string value))) "; ") `(xfields ,xfield))))))) ;; delete the trailing "; " (if (looking-back "; " nil) (backward-delete-char 2)) (insert "\n"))) (defun bbdb-display-record-multi-line (record layout field-list) "Format RECORD for the multi-line FORMAT using LAYOUT. See `bbdb-layout-alist' for more info on layouts. FIELD-LIST is the list of actually displayed FIELDS." (bbdb-display-name-organization record) (insert "\n") (let* ((indent (or (bbdb-layout-get-option layout 'indentation) 21)) ;; The format string FMT adds three extra characters. ;; So we subtract those from the value of INDENT. (fmt (format " %%%ds: " (- indent 3))) start formatfun) (dolist (field field-list) (setq start (point)) (cond (;; customized formatting (setq formatfun (intern-soft (format "bbdb-display-%s-multi-line" field))) (funcall formatfun record indent)) ;; phone ((eq field 'phone) (dolist (phone (bbdb-record-phone record)) (bbdb-display-text (format fmt (concat "phone (" (bbdb-phone-label phone) ")")) `(phone ,phone field-label) 'bbdb-field-name) (bbdb-display-text (concat (bbdb-phone-string phone) "\n") `(phone ,phone)))) ;; address ((eq field 'address) (dolist (address (bbdb-record-address record)) (bbdb-display-text (format fmt (concat "address (" (bbdb-address-label address) ")")) `(address ,address field-label) 'bbdb-field-name) (setq start (point)) (insert (bbdb-indent-string (bbdb-format-address address 2) indent) "\n") (bbdb-field-property start `(address ,address)))) ;; mail ((eq field 'mail) (let ((mail (bbdb-record-mail record))) (when mail (bbdb-display-text (format fmt "mail") '(mail nil field-label) 'bbdb-field-name) (bbdb-display-list (if (bbdb-layout-get-option layout 'primary) (list (car mail)) mail) 'mail "\n" nil indent)))) ;; AKA ((eq field 'aka) (let ((aka (bbdb-record-aka record))) (when aka (bbdb-display-text (format fmt "AKA") '(aka nil field-label) 'bbdb-field-name) (bbdb-display-list aka 'aka "\n")))) ;; uuid ((eq field 'uuid) (let ((uuid (bbdb-record-uuid record))) (bbdb-display-text (format fmt "uuid") `(uuid ,uuid field-label) 'bbdb-field-name) (bbdb-display-text (format "%s\n" uuid) `(uuid ,uuid)))) ;; creation-date ((eq field 'creation-date) (let ((creation-date (bbdb-record-creation-date record))) (bbdb-display-text (format fmt "creation-date") `(creation-date ,creation-date field-label) 'bbdb-field-name) (bbdb-display-text (format "%s\n" creation-date) `(creation-date ,creation-date)))) ;; timestamp ((eq field 'timestamp) (let ((timestamp (bbdb-record-timestamp record))) (bbdb-display-text (format fmt "timestamp") `(timestamp ,timestamp field-label) 'bbdb-field-name) (bbdb-display-text (format "%s\n" timestamp) `(timestamp ,timestamp)))) ;; xfields (t (let* ((xfield (assq field (bbdb-record-xfields record))) (value (cdr xfield))) (when value (bbdb-display-text (format fmt field) `(xfields ,xfield field-label) 'bbdb-field-name) (setq start (point)) (insert (bbdb-indent-string (if (stringp value) value ;; value of xfield is a sexp (let ((string (pp-to-string value))) (if (string-match "[ \t\n]+\\'" string) (substring-no-properties string 0 (match-beginning 0)) string))) indent) "\n") (bbdb-field-property start `(xfields ,xfield))))))) (insert "\n"))) (defalias 'bbdb-display-record-full-multi-line 'bbdb-display-record-multi-line) (defalias 'bbdb-display-record-pop-up-multi-line 'bbdb-display-record-multi-line) (defun bbdb-display-record (record layout number) "Insert a formatted RECORD into the current buffer at point. LAYOUT can be a symbol describing a layout in `bbdb-layout-alist'. If it is nil, use `bbdb-layout'. NUMBER is the number of RECORD among the displayed records. Move point to the end of the inserted record." (unless layout (setq layout bbdb-layout)) (unless (assq layout bbdb-layout-alist) (error "Unknown layout `%s'" layout)) (let ((display-p (bbdb-layout-get-option layout 'display-p)) (omit-list (bbdb-layout-get-option layout 'omit)) ; omitted fields (order-list (bbdb-layout-get-option layout 'order)); requested field order (all-fields (append '(phone address mail aka) ; default field order (mapcar 'car (bbdb-record-xfields record)) '(uuid creation-date timestamp))) (beg (point)) format-function field-list) (when (or (not display-p) (and display-p (funcall display-p))) (if (functionp omit-list) (setq omit-list (funcall omit-list record layout))) (if (functionp order-list) (setq order-list (funcall order-list record layout))) ;; first omit unwanted fields (when (and omit-list (or (not order-list) (memq t order-list))) (if (listp omit-list) ;; show all fields except those listed here (dolist (omit omit-list) (setq all-fields (delq omit all-fields))) (setq all-fields nil))) ; show nothing ;; then order them (cond ((not order-list) (setq field-list all-fields)) ((not (memq t order-list)) (setq field-list order-list)) (t (setq order-list (reverse order-list) all-fields (delq nil (mapcar (lambda (f) (unless (memq f order-list) f)) all-fields))) (dolist (order order-list) (if (eq t order) (setq field-list (append all-fields field-list)) (push order field-list))))) ;; call the actual format function (setq format-function (intern-soft (format "bbdb-display-record-%s" layout))) (if (functionp format-function) (funcall format-function record layout field-list) (bbdb-display-record-multi-line record layout field-list)) (put-text-property beg (point) 'bbdb-record-number number)))) (defun bbdb-display-records (records &optional layout append select horiz-p) "Display RECORDS using LAYOUT. If APPEND is non-nil append RECORDS to the already displayed records. Otherwise RECORDS overwrite the displayed records. SELECT and HORIZ-P have the same meaning as in `bbdb-pop-up-window'." (interactive (list (bbdb-completing-read-records "Display records: ") (bbdb-layout-prefix))) (if (bbdb-append-display-p) (setq append t)) ;; `bbdb-redisplay-record' calls `bbdb-display-records' ;; with display information already amended to RECORDS. (unless (or (null records) (consp (car records))) ;; add layout and a marker to the local list of records (setq layout (or layout bbdb-layout) records (mapcar (lambda (record) (list record layout (make-marker))) records))) (let ((first-new (caar records)) ; first new record new-name) ;; If `bbdb-multiple-buffers' is non-nil we create a new BBDB buffer ;; when not already within one. The new buffer name starts with a space, ;; i.e. it does not clutter the buffer list. (when (and bbdb-multiple-buffers (not (assq 'bbdb-buffer-name (buffer-local-variables)))) (setq new-name (concat " *BBDB " (if (functionp bbdb-multiple-buffers) (funcall bbdb-multiple-buffers) (buffer-name)) "*")) ;; `bbdb-buffer-name' becomes buffer-local in the current buffer ;; as well as in the buffer `bbdb-buffer-name' (set (make-local-variable 'bbdb-buffer-name) new-name)) (with-current-buffer (get-buffer-create bbdb-buffer-name) ; *BBDB* ;; If we are appending RECORDS to the ones already displayed, ;; then first remove any duplicates, and then sort them. (if append (let ((old-rec (mapcar 'car bbdb-records))) (dolist (record records) (unless (memq (car record) old-rec) (push record bbdb-records))) (setq records (sort bbdb-records (lambda (x y) (bbdb-record-lessp (car x) (car y))))))) (bbdb-mode) ;; Normally `bbdb-records' is the only BBDB-specific buffer-local variable ;; in the *BBDB* buffer. It is intentionally not permanent-local. ;; A value of nil indicates that we need to (re)process the records. (setq bbdb-records records) (if new-name (set (make-local-variable 'bbdb-buffer-name) new-name)) (unless (or bbdb-silent-internal bbdb-silent) (message "Formatting BBDB...")) (let ((record-number 0) buffer-read-only all-records) (erase-buffer) (bbdb-debug (setq all-records (bbdb-records))) (dolist (record records) (bbdb-debug (unless (memq (car record) all-records) (error "Record %s does not exist" (car record)))) (set-marker (nth 2 record) (point)) (bbdb-display-record (nth 0 record) (nth 1 record) record-number) (setq record-number (1+ record-number))) (run-hooks 'bbdb-display-hook)) (unless (or bbdb-silent-internal bbdb-silent) (message "Formatting BBDB...done.")) (set-buffer-modified-p nil) (bbdb-pop-up-window select horiz-p) (if (not first-new) (goto-char (point-min)) ;; Put point on first new record in *BBDB* buffer. (goto-char (nth 2 (assq first-new bbdb-records))) (set-window-start (get-buffer-window (current-buffer)) (point)))))) (defun bbdb-undisplay-records (&optional all-buffers) "Undisplay records in *BBDB* buffer, leaving this buffer empty. If ALL-BUFFERS is non-nil undisplay records in all BBDB buffers." (dolist (buffer (cond (all-buffers (buffer-list)) ((let ((buffer (get-buffer bbdb-buffer-name))) (and (buffer-live-p buffer) (list buffer)))))) (with-current-buffer buffer (when (eq major-mode 'bbdb-mode) (let (buffer-read-only) (erase-buffer)) (setq bbdb-records nil) (set-buffer-modified-p nil))))) (defun bbdb-redisplay-record (record &optional sort delete-p) "Redisplay RECORD in current BBDB buffer. If SORT is t, usually because RECORD has a new sortkey, re-sort the displayed records. If DELETE-P is non-nil RECORD is removed from the BBDB buffer." ;; For deletion in the *BBDB* buffer we use the full information ;; about the record in the database. Therefore, we need to delete ;; the record in the *BBDB* buffer before deleting the record in ;; the database. ;; FIXME: If point is initially inside RECORD, `bbdb-redisplay-record' ;; puts point at the beginning of the redisplayed RECORD. ;; Ideally, `bbdb-redisplay-record' should put point such that it ;; matches the previous value `bbdb-ident-point'. (let ((full-record (assq record bbdb-records))) (unless full-record (error "Record `%s' not displayed" (bbdb-record-name record))) (if (and sort (not delete-p)) ;; FIXME: For records requiring re-sorting it may be more efficient ;; to insert these records in their proper location instead of ;; re-displaying all records. (bbdb-display-records (list record) nil t) (let ((marker (nth 2 full-record)) (end-marker (nth 2 (car (cdr (memq full-record bbdb-records))))) buffer-read-only record-number) ;; If point is inside record, put it at the beginning of the record. (if (and (<= marker (point)) (< (point) (or end-marker (point-max)))) (goto-char marker)) (save-excursion (goto-char marker) (setq record-number (get-text-property (point) 'bbdb-record-number)) (unless delete-p ;; First insert the reformatted record, then delete the old one, ;; so that the marker of this record cannot collapse with the ;; marker of the subsequent record (bbdb-display-record (car full-record) (nth 1 full-record) record-number)) (delete-region (point) (or end-marker (point-max))) ;; If we deleted a record we need to update the subsequent ;; record numbers. (when delete-p (let* ((markers (append (mapcar (lambda (x) (nth 2 x)) (cdr (memq full-record bbdb-records))) (list (point-max)))) (start (pop markers))) (dolist (end markers) (put-text-property start end 'bbdb-record-number record-number) (setq start end record-number (1+ record-number)))) (setq bbdb-records (delq full-record bbdb-records))) (run-hooks 'bbdb-display-hook)))))) (defun bbdb-redisplay-record-globally (record &optional sort delete-p) "Redisplay RECORD in all BBDB buffers. If SORT is t, usually because RECORD has a new sortkey, re-sort the displayed records. If DELETE-P is non-nil RECORD is removed from the BBDB buffers." (dolist (buffer (buffer-list)) (with-current-buffer buffer (if (and (eq major-mode 'bbdb-mode) (memq record (mapcar 'car bbdb-records))) (let ((window (get-buffer-window bbdb-buffer-name))) (if window (with-selected-window window (bbdb-redisplay-record record sort delete-p)) (bbdb-redisplay-record record sort delete-p))))))) (define-obsolete-function-alias 'bbdb-maybe-update-display 'bbdb-redisplay-record-globally "3.0") ;;; window configuration hackery (defun bbdb-pop-up-window (&optional select horiz-p) "Display *BBDB* buffer by popping up a new window. Finds the largest window on the screen, splits it, displaying the *BBDB* buffer in the bottom `bbdb-pop-up-window-size' lines (unless the *BBDB* buffer is already visible, in which case do nothing.) Select this window if SELECT is non-nil. If `bbdb-mua-pop-up' is 'horiz, and the first window matching the predicate HORIZ-P is wider than the car of `bbdb-horiz-pop-up-window-size' then the window will be split horizontally rather than vertically." (let ((buffer (get-buffer bbdb-buffer-name))) (unless buffer (error "No %s buffer to display" bbdb-buffer-name)) (cond ((let ((window (get-buffer-window buffer t))) ;; We already have a BBDB window so that at most we select it (and window (or (not select) (select-window window))))) ;; try horizontal split ((and (eq bbdb-mua-pop-up 'horiz) horiz-p (>= (frame-width) (car bbdb-horiz-pop-up-window-size)) (let ((window-list (window-list)) (b-width (cdr bbdb-horiz-pop-up-window-size)) (search t) s-window) (while (and (setq s-window (pop window-list)) (setq search (not (funcall horiz-p s-window))))) (unless (or search (<= (window-width s-window) (car bbdb-horiz-pop-up-window-size))) (condition-case nil ; `split-window' might fail (let ((window (split-window s-window (if (integerp b-width) (- (window-width s-window) b-width) (round (* (- 1 b-width) (window-width s-window)))) t))) ; horizontal split (set-window-buffer window buffer) (cond (bbdb-dedicated-window (set-window-dedicated-p window bbdb-dedicated-window)) ((fboundp 'display-buffer-record-window) ; GNU Emacs >= 24.1 (set-window-prev-buffers window nil) (display-buffer-record-window 'window window buffer))) (if select (select-window window)) t) (error nil)))))) ((eq t bbdb-pop-up-window-size) (bbdb-pop-up-window-simple buffer select)) (t ;; vertical split (let* ((window (selected-window)) (window-height (window-height window))) ;; find the tallest window... (mapc (lambda (w) (let ((w-height (window-height w))) (if (> w-height window-height) (setq window w window-height w-height)))) (window-list)) (condition-case nil (progn (unless (eql bbdb-pop-up-window-size 1.0) (setq window (split-window ; might fail window (if (integerp bbdb-pop-up-window-size) (- window-height 1 ; for mode line (max window-min-height bbdb-pop-up-window-size)) (round (* (- 1 bbdb-pop-up-window-size) window-height)))))) (set-window-buffer window buffer) ; might fail (cond (bbdb-dedicated-window (set-window-dedicated-p window bbdb-dedicated-window)) ((and (fboundp 'display-buffer-record-window) ; GNU Emacs >= 24.1 (not (eql bbdb-pop-up-window-size 1.0))) (set-window-prev-buffers window nil) (display-buffer-record-window 'window window buffer))) (if select (select-window window))) (error (bbdb-pop-up-window-simple buffer select)))))))) (defun bbdb-pop-up-window-simple (buffer select) "Display BUFFER in some window, selecting it if SELECT is non-nil. If `bbdb-dedicated-window' is non-nil, mark the window as dedicated." (let ((window (if select (progn (pop-to-buffer buffer) (get-buffer-window)) (display-buffer buffer)))) (if bbdb-dedicated-window (set-window-dedicated-p window bbdb-dedicated-window)))) ;;; BBDB mode ;;;###autoload (define-derived-mode bbdb-mode special-mode "BBDB" "Major mode for viewing and editing the Insidious Big Brother Database. Letters no longer insert themselves. Numbers are prefix arguments. You can move around using the usual cursor motion commands. \\ \\[bbdb-add-mail-alias]\t Add new mail alias to visible records or \ remove it. \\[bbdb-edit-field]\t Edit the field on the current line. \\[bbdb-delete-field-or-record]\t Delete the field on the \ current line. If the current line is the\n\t first line of a record, then \ delete the entire record. \\[bbdb-insert-field]\t Insert a new field into the current record. \ Note that this\n\t will let you add new fields of your own as well. \\[bbdb-transpose-fields]\t Swap the field on the current line with the \ previous field. \\[bbdb-dial]\t Dial the current phone field. \\[bbdb-next-record], \\[bbdb-prev-record]\t Move to the next or the previous \ displayed record, respectively. \\[bbdb-create]\t Create a new record. \\[bbdb-toggle-records-layout]\t Toggle whether the current record is displayed in a \ one-line\n\t listing, or a full multi-line listing. \\[bbdb-do-all-records]\\[bbdb-toggle-records-layout]\t Do that \ for all displayed records. \\[bbdb-merge-records]\t Merge the contents of the current record with \ some other, and then\n\t delete the current record. \\[bbdb-omit-record]\t Remove the current record from the display without \ deleting it from\n\t the database. This is often a useful thing to do \ before using one\n\t of the `*' commands. \\[bbdb]\t Search for records in the database (on all fields). \\[bbdb-search-mail]\t Search for records by mail address. \\[bbdb-search-organization]\t Search for records by organization. \\[bbdb-search-xfields]\t Search for records by xfields. \\[bbdb-search-name]\t Search for records by name. \\[bbdb-search-changed]\t Display records that have changed since the database \ was saved. \\[bbdb-mail]\t Compose mail to the person represented by the \ current record. \\[bbdb-do-all-records]\\[bbdb-mail]\t Compose mail \ to everyone whose record is displayed. \\[bbdb-save]\t Save the BBDB file to disk. \\[bbdb-tex]\t Create a TeX listing of the current record. \\[bbdb-do-all-records]\\[bbdb-tex]\t Do that for all \ displayed record. \\[other-window]\t Move to another window. \\[bbdb-info]\t Read the Info documentation for BBDB. \\[bbdb-help]\t Display a one line command summary in the echo area. \\[bbdb-browse-url]\t Visit Web sites listed in the `url' field(s) of the current \ record. For address completion using the names and mail addresses in the database: \t in Mail mode, type \\\\[bbdb-complete-mail]. \t in Message mode, type \\\\[bbdb-complete-mail]. Important variables: \t `bbdb-auto-revert' \t `bbdb-ignore-redundant-mails' \t `bbdb-case-fold-search' \t `bbdb-completion-list' \t `bbdb-default-area-code' \t `bbdb-default-domain' \t `bbdb-layout' \t `bbdb-file' \t `bbdb-phone-style' \t `bbdb-check-auto-save-file' \t `bbdb-pop-up-layout' \t `bbdb-pop-up-window-size' \t `bbdb-add-name' \t `bbdb-add-aka' \t `bbdb-add-mails' \t `bbdb-new-mails-primary' \t `bbdb-read-only' \t `bbdb-mua-pop-up' \t `bbdb-user-mail-address-re' There are numerous hooks. M-x apropos ^bbdb.*hook RET \\{bbdb-mode-map}" (setq truncate-lines t default-directory (file-name-directory bbdb-file) mode-line-buffer-identification (list 24 (buffer-name) " " '(:eval (format "%d/%d/%d" (1+ (or (get-text-property (point) 'bbdb-record-number) -1)) (length bbdb-records) ;; This code gets called a lot. ;; So we keep it as simple as possible. (with-current-buffer bbdb-buffer (length bbdb-records)))) '(:eval (concat " " (bbdb-concat " " (elt bbdb-modeline-info 0) (elt bbdb-modeline-info 2) (elt bbdb-modeline-info 4))))) mode-line-modified ;; For the mode-line we want to be fast. So we skip the checks ;; performed by `bbdb-with-db-buffer'. '(:eval (if (buffer-modified-p bbdb-buffer) (if bbdb-read-only "%*" "**") (if bbdb-read-only "%%" "--")))) ;; `bbdb-revert-buffer' acts on `bbdb-buffer'. Yet this command is usually ;; called from the *BBDB* buffer. (set (make-local-variable 'revert-buffer-function) 'bbdb-revert-buffer) (add-hook 'post-command-hook 'force-mode-line-update nil t)) (defun bbdb-sendmail-menu (record) "Menu items for email addresses of RECORD." (let ((mails (bbdb-record-mail record))) (list (if (cdr mails) ;; Submenu for multiple mail addresses (cons "Send mail to..." (mapcar (lambda (address) (vector address `(bbdb-compose-mail ,(bbdb-dwim-mail record address)) t)) mails)) ;; Single entry for single mail address (vector (concat "Send mail to " (car mails)) `(bbdb-compose-mail ,(bbdb-dwim-mail record (car mails))) t))))) (defun bbdb-field-menu (record field) "Menu items specifically for FIELD of RECORD." (let ((type (car field))) (append (list (format "Commands for %s Field:" (cond ((eq type 'xfields) (format "\"%s\"" (symbol-name (car (nth 1 field))))) ((eq type 'name) "Name") ((eq type 'affix) "Affix") ((eq type 'organization) "Organization") ((eq type 'aka) "Alternate Names") ((eq type 'mail) "Mail Addresses") ((memq type '(address phone)) (format "\"%s\" %s" (aref (nth 1 field) 0) (capitalize (symbol-name type))))))) (cond ((eq type 'phone) (list (vector (concat "Dial " (bbdb-phone-string (nth 1 field))) `(bbdb-dial ',field nil) t))) ((eq type 'xfields) (let* ((field (cadr field)) (type (car field))) (cond ((eq type 'url ) (list (vector (format "Browse \"%s\"" (cdr field)) `(bbdb-browse-url ,record) t))))))) '(["Edit Field" bbdb-edit-field t]) (unless (eq type 'name) '(["Delete Field" bbdb-delete-field-or-record t]))))) (defun bbdb-insert-field-menu (record) "Submenu for inserting a new field for RECORD." (cons "Insert New Field..." (mapcar (lambda (field) (if (stringp field) field (vector (symbol-name field) `(bbdb-insert-field ,record ',field (bbdb-read-field ,record ',field ,current-prefix-arg)) (not (or (and (eq field 'affix) (bbdb-record-affix record)) (and (eq field 'organization) (bbdb-record-organization record)) (and (eq field 'mail) (bbdb-record-mail record)) (and (eq field 'aka) (bbdb-record-aka record)) (assq field (bbdb-record-xfields record))))))) (append '(affix organization aka phone address mail) '("--") bbdb-xfield-label-list)))) (defun bbdb-mouse-menu (event) "BBDB mouse menu for EVENT," (interactive "e") (mouse-set-point event) (let* ((record (bbdb-current-record)) (field (bbdb-current-field)) (menu (if (and record field (functionp bbdb-user-menu-commands)) (funcall bbdb-user-menu-commands record field) bbdb-user-menu-commands))) (if record (popup-menu (append (list (format "Commands for record \"%s\":" (bbdb-record-name record)) ["Delete Record" bbdb-delete-records t] ["Toggle Record Display Layout" bbdb-toggle-records-layout t] (if (and (not (eq 'full-multi-line (nth 1 (assq record bbdb-records)))) (bbdb-layout-get-option 'multi-line 'omit)) ["Fully Display Record" bbdb-display-records-completely t]) ["Omit Record" bbdb-omit-record t] ["Merge Record" bbdb-merge-records t]) (if (bbdb-record-mail record) (bbdb-sendmail-menu record)) (list "--" (bbdb-insert-field-menu record)) (if field (cons "--" (bbdb-field-menu record field))) (if menu (append '("--" "User Defined Commands") menu))))))) (defun bbdb-scan-property (property predicate n) "Scan for change of PROPERTY matching PREDICATE for N times. Return position of beginning of matching interval." (let ((fun (if (< 0 n) 'next-single-property-change 'previous-single-property-change)) (limit (if (< 0 n) (point-max) (point-min))) (nn (abs n)) (i 0) (opoint (point)) npoint) ;; For backward search, move point to beginning of interval with PROPERTY. (if (and (<= n 0) (< (point-min) opoint) (let ((prop (get-text-property opoint property))) (and (eq prop (get-text-property (1- opoint) property)) (funcall predicate prop)))) (setq opoint (previous-single-property-change opoint property nil limit))) (if (zerop n) opoint ; Return beginning of interval point is in (while (and (< i nn) (let (done) (while (and (not done) (setq npoint (funcall fun opoint property nil limit))) (cond ((and (/= opoint npoint) (funcall predicate (get-text-property npoint property))) (setq opoint npoint done t)) ((= opoint npoint) ;; Search reached beg or end of buffer: abort. (setq done t i nn npoint nil)) (t (setq opoint npoint)))) done)) (setq i (1+ i))) npoint))) (defun bbdb-next-record (n) "Move point to the beginning of the next BBDB record. With prefix N move forward N records." (interactive "p") (let ((npoint (bbdb-scan-property 'bbdb-record-number 'integerp n))) (if npoint (goto-char npoint) (error "No %s record" (if (< 0 n) "next" "previous"))))) (defun bbdb-prev-record (n) "Move point to the beginning of the previous BBDB record. With prefix N move backwards N records." (interactive "p") (bbdb-next-record (- n))) (defun bbdb-next-field (n) "Move point to next (sub)field. With prefix N move forward N (sub)fields." (interactive "p") (let ((npoint (bbdb-scan-property 'bbdb-field (lambda (p) (and (nth 1 p) (not (eq (nth 2 p) 'field-label)))) n))) (if npoint (goto-char npoint) (error "No %s field" (if (< 0 n) "next" "previous"))))) (defun bbdb-prev-field (n) "Move point to previous (sub)field. With prefix N move backwards N (sub)fields." (interactive "p") (bbdb-next-field (- n))) (defun bbdb-save (&optional prompt noisy) "Save the BBDB if it is modified. If PROMPT is non-nil prompt before saving. If NOISY is non-nil as in interactive calls issue status messages." (interactive (list nil t)) (bbdb-with-db-buffer (if (buffer-modified-p) (if (or (not prompt) (y-or-n-p (if bbdb-read-only "Save the BBDB, even though it is supposedly read-only? " "Save the BBDB now? "))) (save-buffer)) (if noisy (message "(No BBDB changes need to be saved)"))))) ;;;###autoload (defun bbdb-version (&optional arg) "Return string describing the version of BBDB. With prefix ARG, insert string at point." (interactive (list (or (and current-prefix-arg 1) t))) (let* ((version (if (string-match "\\`[ \t\n]*[1-9]" bbdb-version) bbdb-version (let ((source (find-function-noselect 'bbdb-version))) (if source (with-current-buffer (car source) (prog1 (save-excursion (goto-char (point-min)) (when (re-search-forward "^;;+ *Version: \\(.*\\)" nil t) (match-string-no-properties 1))) (unless (get-buffer-window nil t) (kill-buffer (current-buffer))))))))) (version-string (format "BBDB version %s" (or version "")))) (cond ((numberp arg) (insert (message version-string))) ((eq t arg) (message version-string)) (t version-string)))) (defun bbdb-sort-records () "Sort BBDB database. This is not needed when using BBDB itself. It might be necessary, however, after having used other programs to add records to the BBDB." (interactive) (let* ((records (copy-sequence (bbdb-records)))) (bbdb-with-db-buffer (setq bbdb-records (sort bbdb-records 'bbdb-record-lessp)) (if (equal records bbdb-records) (message "BBDB already sorted properly") (message "BBDB was mis-sorted; fixing...") (bbdb-goto-first-record) (delete-region (point) bbdb-end-marker) (let ((buf (current-buffer)) (inhibit-quit t) ; really, don't mess with this cache) (dolist (record bbdb-records) ;; Before printing the record, remove cache (we do not want that ;; written to the file.) Ater writing, put the cache back ;; and update the cache's marker. (setq cache (bbdb-record-cache record)) (set-marker (bbdb-cache-marker cache) (point)) (bbdb-record-set-cache record nil) (bbdb-with-print-loadably (prin1 record buf)) (bbdb-record-set-cache record cache) (insert ?\n))) (dolist (buffer (buffer-list)) (with-current-buffer buffer (if (eq major-mode 'bbdb-mode) ; Redisplay all records (bbdb-display-records nil nil t)))) (message "BBDB was mis-sorted; fixing...done"))))) ;;;###autoload (defun bbdb-initialize (&rest muas) "Initialize BBDB for MUAS and miscellaneous packages. List MUAS may include the following symbols to initialize the respective mail/news readers, composers, and miscellaneous packages: gnus Gnus mail/news reader. mh-e MH-E mail reader. mu4e Mu4e mail reader. rmail Rmail mail reader. vm VM mail reader. mail Mail (M-x mail). message Message mode. wl Wanderlust mail reader. anniv Anniversaries in Emacs diary. sc Supercite. However, this is not the full story. See bbdb-sc.el for how to fully hook BBDB into Supercite. pgp PGP support: this adds `bbdb-pgp' to `message-send-hook' and `mail-send-hook' so that `bbdb-pgp' runs automatically when a message is sent. Yet see info node `(message)Signing and encryption' why you might not want to rely for encryption on a hook function which runs just before the message is sent, that is, you might want to call the command `bbdb-pgp' manually, then call `mml-preview'. See also `bbdb-mua-auto-update-init'. The latter is a separate function as this allows one to initialize the auto update feature for some MUAs only, for example only for outgoing messages." (dolist (mua muas) (let ((init (assq mua bbdb-init-forms))) (if init ;; Should we make sure that each insinuation happens only once? (eval (cadr init)) (bbdb-warn "Do not know how to insinuate `%s'" mua)))) (run-hooks 'bbdb-initialize-hook)) (provide 'bbdb) ;;; bbdb.el ends here bbdb3-3.2/lisp/makefile-temp000066400000000000000000000157411322420162700157530ustar00rootroot00000000000000# Cheap BBDB makefile -*- Makefile -*- # Copyright (C) 2010-2017 Roland Winkler # # This file is part of the Insidious Big Brother Database (aka BBDB), # # BBDB 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. # # BBDB 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 BBDB. If not, see . ### Commentary: # This file provides a cheap workaround for (most of) those users # who like to use the latest BBDB, but do not have autotools installed. # This file can compile BBDB's lisp code on most systems. Yet it is not # intended to be foolproof! # This file may also come handy for BBDB developers as it knows # about the proper dependencies of the elisp files, so that it keeps # the *.elc files consistently up to date. srcdir = . prefix = /usr/local lispdir = $(DESTDIR)/usr/local/share/emacs/site-lisp/bbdb INSTALL = /usr/bin/install -c INSTALL_DATA = ${INSTALL} -m 644 RM = /bin/rm -f LN_S = /bin/ln -s CP = /bin/cp EMACS = emacs # Command line flags for Emacs. EMACSOPT = # The actual Emacs command run in the targets below. # --batch implies --no-init-file, yet let's be explicit about what we want emacs = LC_ALL=C $(EMACS) --batch --no-init-file --no-site-file \ --directory=./ $(EMACSOPT) emacs_compile = $(emacs) --funcall batch-byte-compile # Mu4e is not part of GNU Emacs. If you want to use BBDB with Mu4e # then the variable MU4EDIR should point to your mu4e lisp directory. MU4EDIR = MU4E = -eval '(unless (string= "$(MU4EDIR)" "") (push "$(MU4EDIR)" load-path))' # VM is not part of GNU Emacs. If you want to use BBDB with VM # then the variable VMDIR should point to your vm/lisp directory. VMDIR = VM = -eval '(unless (string= "$(VMDIR)" "") (push "$(VMDIR)" load-path))' # WL is not part of GNU Emacs. If you want to use BBDB with WL # then the variable WLDIR should point to your wl/lisp directory. WLDIR = WL = -eval '(unless (string= "$(WLDIR)" "") (push "$(WLDIR)" load-path))' .SUFFIXES: .elc .el .tar .Z .gz .uu SRCS = bbdb.el bbdb-site.el bbdb-com.el bbdb-tex.el bbdb-anniv.el \ bbdb-migrate.el bbdb-snarf.el \ bbdb-mua.el bbdb-message.el bbdb-rmail.el \ bbdb-gnus.el bbdb-gnus-aux.el bbdb-mhe.el bbdb-mu4e.el \ bbdb-vm.el bbdb-vm-aux.el bbdb-pgp.el \ bbdb-sc.el bbdb-wl.el \ bbdb-ispell.el bbdb-pkg.el # ELC = $(patsubst %.el,%.elc,$(SRCS)) # GNU Make ELC = bbdb.elc bbdb-site.elc bbdb-com.elc bbdb-tex.elc bbdb-anniv.elc \ bbdb-migrate.elc bbdb-snarf.elc \ bbdb-mua.elc bbdb-message.elc bbdb-rmail.elc \ bbdb-gnus.elc bbdb-gnus-aux.elc bbdb-mhe.elc bbdb-pgp.elc bbdb-sc.elc \ bbdb-ispell.elc bbdb-wl.elc # bbdb-pkg.elc all: bbdb bbdb: bbdb-loaddefs.el $(ELC) mu4e: bbdb-mu4e.elc vm: bbdb-vm.elc bbdb-vm-aux.elc wl: bbdb-wl.elc bbdb-loaddefs.el: $(SRCS) # 2011-12-11: We switched from bbdb-autoloads.el to bbdb-loaddefs.el. # If the user still has an old bbdb-autoloads.el in the BBDB # lisp directory (and keeps loading it from the emacs init file), # we might get strange error messages that things fail. # So we throw an error if these old files are found. @if test -f bbdb-autoloads.el -o -f bbdb-autoloads.elc; then \ (echo "*** ERROR: Old file(s) \`bbdb-autoloads.el(c)' found ***" ; \ echo "*** Delete these files; do not load them from your init file ***") && \ false ; \ fi -$(RM) $@; @echo "(provide 'bbdb-loaddefs)" > $@; @echo "(if (and load-file-name (file-name-directory load-file-name))" >> $@; @echo " (add-to-list 'load-path (file-name-directory load-file-name)))" >> $@; @echo " " >> $@; # Generated autoload-file must have an absolute path, # $(srcdir) can be relative. $(emacs) --load autoload \ --eval '(setq generated-autoload-file "'`pwd`/$@'")' \ --eval '(setq make-backup-files nil)' \ --funcall batch-update-autoloads `pwd` .el.elc: $(emacs_compile) $< # Not perfect, but better than nothing: If we do not have / do not use # autotools, we simply copy bbdb-site.el.in to bbdb-site.el. bbdb-site.el: bbdb-site.el.in $(CP) $< $@ bbdb-site.elc: bbdb-site.el $(emacs_compile) $(@:.elc=.el) bbdb-pkg.el: bbdb-pkg.el.in $(CP) $< $@ bbdb.elc: bbdb.el bbdb-site.elc $(emacs_compile) $(@:.elc=.el) bbdb-com.elc: bbdb-com.el bbdb.elc $(emacs_compile) $(@:.elc=.el) bbdb-mua.elc: bbdb-mua.el bbdb-com.elc $(emacs) -eval '(unless (string= "$(VMDIR)" "") (push "$(VMDIR)" load-path) (load "vm" t t))' \ -eval '(unless (string= "$(MU4EDIR)" "") (push "$(MU4EDIR)" load-path) (load "mu4e" t t))' \ -eval '(unless (string= "$(WLDIR)" "") (push "$(WLDIR)" load-path) (load "wl" t t))' \ --funcall batch-byte-compile $(@:.elc=.el) bbdb-rmail.elc: bbdb-rmail.el bbdb-mua.elc $(emacs_compile) $(@:.elc=.el) bbdb-gnus.elc: bbdb-gnus.el bbdb-mua.elc $(emacs_compile) $(@:.elc=.el) bbdb-gnus-aux.elc: bbdb-gnus-aux.el bbdb-mua.elc $(emacs_compile) $(@:.elc=.el) bbdb-mhe.elc: bbdb-mhe.el bbdb-mua.elc $(emacs_compile) $(@:.elc=.el) bbdb-mu4e.elc: bbdb-mu4e.el bbdb-mua.elc $(emacs) $(MU4E) --funcall batch-byte-compile $(@:.elc=.el) bbdb-wl.elc: bbdb-wl.el bbdb-mua.elc $(emacs_compile) $(@:.elc=.el) bbdb-vm.elc: bbdb-vm.el bbdb-mua.elc $(emacs) $(VM) --funcall batch-byte-compile $(@:.elc=.el) bbdb-vm-aux.elc: bbdb-vm-aux.el bbdb-mua.elc $(emacs) $(VM) --funcall batch-byte-compile $(@:.elc=.el) bbdb-sc.elc: bbdb-sc.el bbdb-mua.elc $(emacs_compile) $(@:.elc=.el) bbdb-tex.elc: bbdb-tex.el bbdb-com.elc $(emacs_compile) $(@:.elc=.el) bbdb-migrate.elc: bbdb-migrate.el bbdb.elc $(emacs_compile) $(@:.elc=.el) bbdb-anniv.elc: bbdb-anniv.el bbdb-com.elc $(emacs_compile) $(@:.elc=.el) bbdb-ispell.elc: bbdb-ispell.el bbdb.elc $(emacs_compile) $(@:.elc=.el) bbdb-snarf.elc: bbdb-snarf.el bbdb-com.elc $(emacs_compile) $(@:.elc=.el) install-el: all $(INSTALL) -d -m 0755 "$(lispdir)/" for elc in *.elc; do \ el=`basename $$elc c`; \ if test -f "$(srcdir)/$$el"; then \ echo "Install $$el in $(lispdir)/"; \ $(INSTALL_DATA) "${srcdir}/$$el" "$(lispdir)/"; \ fi; \ done; for el in bbdb-loaddefs.el; do \ echo "Install $$el in $(lispdir)/"; \ $(INSTALL_DATA) $$el "$(lispdir)/"; \ done; install-elc: all $(INSTALL) -d -m 0755 "$(lispdir)/" for elc in bbdb-loaddefs.el *.elc; do \ echo "Install $$elc in $(lispdir)/"; \ $(INSTALL_DATA) $$elc "$(lispdir)/"; \ done; uninstall: for elc in *.elc; do \ $(RM) "$(lispdir)/$$elc"; \ done for el in *.el; do \ $(RM) "$(lispdir)/$$el"; \ done # Assorted clean-up targets clean: -$(RM) bbdb*.elc TAGS distclean: clean maintainer-clean: distclean -$(RM) bbdb-loaddefs.el # Generated file -$(RM) Makefile extraclean: maintainer-clean -$(RM) *~ \#* TAGS: $(SRCS) etags $(SRCS) bbdb3-3.2/m4/000077500000000000000000000000001322420162700126515ustar00rootroot00000000000000bbdb3-3.2/m4/emacs_mu4e.m4000066400000000000000000000032541322420162700151410ustar00rootroot00000000000000### emacs_mu4e.m4 ## Copyright (C) 2015-2017 Roland Winkler ## ## This file is part of the Insidious Big Brother Database (aka BBDB), ## ## BBDB 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. ## ## BBDB 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 BBDB. If not, see . AC_DEFUN([EMACS_MU4E], [ AC_ARG_WITH([mu4e-dir], AS_HELP_STRING([--with-mu4e-dir=DIR], [where to find Mu4e lisp directory]), # if Mu4e was requested, make sure we have access to the source [if test "x$with_mu4e_dir" != xno -a "x$with_mu4e_dir" != "x"; then AC_MSG_CHECKING([for Mu4e files]) # convert path to absolute and canonicalize it. MU4EDIR=$(${EMACS} -batch --quick -eval "(message \"%s\" (expand-file-name \"${with_mu4e_dir}\"))" 2>&1) MU4E_LOCATE=$(${EMACS} -batch --quick --directory="${MU4EDIR}" -eval "(if (locate-library \"mu4e-vars\") (message \"mu4e\"))" 2>&1) if test "x$MU4E_LOCATE" = "x"; then AC_MSG_ERROR([*** MU4E mu4e-vars.el must exist in directory passed to --with-mu4e-dir.]) fi AC_MSG_RESULT($MU4EDIR) # append MU4EDIR to AM_ELCFLAGS AM_ELCFLAGS="--directory=$MU4EDIR $AM_ELCFLAGS" fi]) # New conditional MU4E AM_CONDITIONAL([MU4E], [test x$MU4EDIR != x]) ]) bbdb3-3.2/m4/emacs_vm.m4000066400000000000000000000032041322420162700147040ustar00rootroot00000000000000### emacs_vm.m4 ## Copyright (C) 2013-2017 Roland Winkler ## ## This file is part of the Insidious Big Brother Database (aka BBDB), ## ## BBDB 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. ## ## BBDB 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 BBDB. If not, see . AC_DEFUN([EMACS_VM], [ AC_ARG_WITH([vm-dir], AS_HELP_STRING([--with-vm-dir=DIR], [where to find VM lisp directory]), # if VM was requested, make sure we have access to the source [if test "x$with_vm_dir" != xno -a "x$with_vm_dir" != "x"; then AC_MSG_CHECKING([for VM files]) # convert path to absolute and canonicalize it. VMDIR=$(${EMACS} -batch --quick -eval "(message \"%s\" (expand-file-name \"${with_vm_dir}\"))" 2>&1) VM_LOCATE=$(${EMACS} -batch --quick --directory="${VMDIR}" -eval "(if (locate-library \"vm-autoloads\") (message \"vm\"))" 2>&1) if test "x$VM_LOCATE" = "x"; then AC_MSG_ERROR([*** VM vm-autoloads.el must exist in directory passed to --with-vm-dir.]) fi AC_MSG_RESULT($VMDIR) # append VMDIR to AM_ELCFLAGS AM_ELCFLAGS="--directory=$VMDIR $AM_ELCFLAGS" fi]) # New conditional VM AM_CONDITIONAL([VM], [test x$VMDIR != x]) ]) bbdb3-3.2/m4/emacs_wl.m4000066400000000000000000000031721322420162700147100ustar00rootroot00000000000000### emacs_wl.m4 ## Copyright (C) 2016-2017 Roland Winkler ## ## This file is part of the Insidious Big Brother Database (aka BBDB), ## ## BBDB 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. ## ## BBDB 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 BBDB. If not, see . AC_DEFUN([EMACS_WL], [ AC_ARG_WITH([wl-dir], AS_HELP_STRING([--with-wl-dir=DIR], [where to find Wl lisp directory]), # if Wl was requested, make sure we have access to the source [if test "x$with_wl_dir" != xno -a "x$with_wl_dir" != "x"; then AC_MSG_CHECKING([for Wl files]) # convert path to absolute and canonicalize it. WLDIR=$(${EMACS} -batch --quick -eval "(message \"%s\" (expand-file-name \"${with_wl_dir}\"))" 2>&1) WL_LOCATE=$(${EMACS} -batch --quick --directory="${WLDIR}" -eval "(if (locate-library \"wl-vars\") (message \"wl\"))" 2>&1) if test "x$WL_LOCATE" = "x"; then AC_MSG_ERROR([*** WL wl-vars.el must exist in directory passed to --with-wl-dir.]) fi AC_MSG_RESULT($WLDIR) # append WLDIR to AM_ELCFLAGS AM_ELCFLAGS="--directory=$WLDIR $AM_ELCFLAGS" fi]) # New conditional WL AM_CONDITIONAL([WL], [test x$WLDIR != x]) ]) bbdb3-3.2/m4/package_date.m4000066400000000000000000000024141322420162700155040ustar00rootroot00000000000000### package_date.m4 ## Copyright (C) 2013-2017 Roland Winkler ## ## This file is part of the Insidious Big Brother Database (aka BBDB), ## ## BBDB 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. ## ## BBDB 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 BBDB. If not, see . # Figure out timestamp information, for substitution. # If we are in a git repo, use the timestamp of the # most recent commit. Otherwise, use the current time. AC_DEFUN([AC_PACKAGE_DATE], [ if git log -1 > /dev/null 2>&1; then PACKAGE_DATE="$(git log -1 --format=format:'%ci')" elif date --rfc-3339=seconds > /dev/null 2>&1; then PACKAGE_DATE="$(date --rfc-3339=seconds)" elif date -u > /dev/null 2>&1; then PACKAGE_DATE="$(date -u)" else PACKAGE_DATE="$(date)" fi AC_SUBST([PACKAGE_DATE]) ]) bbdb3-3.2/tex/000077500000000000000000000000001322420162700131315ustar00rootroot00000000000000bbdb3-3.2/tex/Makefile.am000066400000000000000000000015511322420162700151670ustar00rootroot00000000000000# tex/Makefile.am for BBDB # # Copyright (C) 2013 Christian Egli # Copyright (C) 2013-2017 Roland Winkler # # This file is part of the Insidious Big Brother Database (aka BBDB), # # BBDB 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. # # BBDB 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 BBDB. If not, see . dist_pkgdata_DATA = \ bbdb.sty bbdb3-3.2/tex/bbdb.sty000066400000000000000000000055611322420162700145720ustar00rootroot00000000000000% bbdb.sty --- basic LaTeX style for TeXing BBDB % % Copyright (C) 2017 Free Software Foundation, Inc. % % This file is part of the Insidious Big Brother Database (aka BBDB), % % BBDB 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. % % BBDB 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 BBDB. If not, see . %% Commentary: % % This file defines a basic LaTeX style for TeXing BBDB. \def\bbdb@name#1#2{\textbf{#2, #1}} \def\bbdb@organization#1{#1} \def\bbdb@affix#1{\emph{affix:} #1} \def\bbdb@aka#1{\emph{aka:} #1} \def\bbdb@phone#1#2{\emph{#1:} #2} \def\bbdb@mail#1#2{\ifx\href\undefined \texttt{#2}% \else \href{mailto:#1}{\texttt{#2}}% \fi} \def\bbdb@address#1#2{\emph{#1:} #2} \def\bbdb@xfield#1#2{\emph{#1:} #2} % \def\bbdb@separator#1{\hline} \def\bbdb@separator#1{\\\hline \multicolumn{\LT@cols}{@{}c@{}}{\hrulefill\ #1\rule{0pt}{2.2ex}\ \hrulefill}\\} \RequirePackage{longtable} \newenvironment{bbdb}[1]{% \let\name\bbdb@name \let\organization\bbdb@organization \let\affix\bbdb@affix \let\aka\bbdb@aka \let\phone\bbdb@phone \let\mail\bbdb@mail \let\address\bbdb@address \let\xfield\bbdb@xfield \let\bbdbseparator\bbdb@separator \begin{longtable}[l]{@{}#1@{}}}% {\\ \hline \multicolumn{\LT@cols}{c}{Printed \today}\\ \hline\end{longtable}} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \def\bbdbrecord@name#1#2{{\raggedright\textbf{#2, #1}\dotfill\par}} \def\bbdbrecord@organization#1{#1\par} \def\bbdbrecord@affix#1{\bbdbrecord@par{\emph{affix:} #1}} \def\bbdbrecord@aka#1{\bbdbrecord@par{\emph{aka:} #1}} \def\bbdbrecord@phone#1#2{\hspace*{\fill}\emph{#1:} #2\par} \def\bbdbrecord@mail#1#2{\ifx\href\undefined \texttt{#2}% \else \href{mailto:#1}{\texttt{#2}}% \fi\par} \def\bbdbrecord@par#1{{\leftskip 1em\parindent -\leftskip#1\par}} \def\bbdbrecord@address#1#2{\bbdbrecord@par{\emph{#1:} #2}} \def\bbdbrecord@xfield#1#2{\bbdbrecord@par{\emph{#1:} #2}} \newenvironment{bbdbrecord}{% \smallbreak \parskip 0pt \parindent 0pt \let\name\bbdbrecord@name \let\organization\bbdbrecord@organization \let\affix\bbdbrecord@affix \let\aka\bbdbrecord@aka \let\phone\bbdbrecord@phone \let\mail\bbdbrecord@mail \let\address\bbdbrecord@address \let\xfield\bbdbrecord@xfield}{\medbreak} \newcommand*{\bbdbseparator}[1]{\vspace{3ex}\noindent \fbox{\parbox{\dimexpr\linewidth-2\fboxrule-2\fboxsep}% {\centering\textbf{#1}}}% \vspace{1ex}} % \endinput % Fails when inlining this file.