diff options
1283 files changed, 531540 insertions, 69 deletions
@@ -1,9 +1,16 @@ \#* .\#* +*.dmg +*.sha +*.asc *~ *.sh !autogen.sh *.do +*.o +*.lo +*.la +.deps *.html !/src/404.html *.pdf @@ -1,4 +1,29 @@ +5 Mar 2013 - 0.4 - Backend and export updates + Emacs is now upgraded to version 24.2 + Multilanguage typing works also in Arabic + Hebrew and other right-to-left languages. + Export to ODT via LibreOffice was added + Work in progress on biblatex integration. -20 Feb 2012 - 3rd rewrite - Previous rewrites had no ChangeLog - This marks the start of the first rewrite +19 Feb 2013 - 0.3 - Language capabilities + Included aspell and english dictionary + Included link-grammar checker (experimental) + Added frame zoom of fonts (C-mousewheel) + Now parses also user's own ~/.emacs + Fixes to HTML editing mode + Improved key bindings + +22 Oct 2012 - 0.2 - Apple/OSX usability and updates + Included NXHtml for HTML, PHP and CSS syntax + Enabled semantic mode + Added LUA syntax + Added org to Freemind mindmap export + Improvements for usability on Apple/OSX + Updated org-mode to latest version + +20 Feb 2012 - 0.1 - 3rd rewrite + Previous rewrites had no ChangeLog. + This entry marks the start of the third rewrite. + This release includes a bundle for MacOSX + powered by a collection of elisp configurations + plus old stuff that we might or might not reuse. @@ -1,28 +1,22 @@ -AutOrg is a publishing system for federated distributed documents -based on emacs org-mode and git. It is ready to be built and run on a -local desktop as well deployed on a web-server; it renders all pages -locally, ready for server-side publishing. +AutOrg is a writing, organizing and publishing system for documents +based on emacs org-mode. +It is ready to be run on Apple OSX -** Organization of the tree +All sources are provided too. -*** doc/ +For more informations and a manual go to http://autorg.dyne.org -Contains original documentation. +To start the application on Mac OSX, just move AutOrg in /Applications +then run it. -*** etc/ +To use this on GNU/Linux or other BSD systems, use the code that +is published on code.dyne.org/autorg you can clone it with git: -Configuration files for integration with third parties. + git://code.dyne.org/autorg.git -*** org/ +Inside the elisp directory are found most sources, so far this +consists just of a pre-configured Emacs editor, but its growing. -Optional directory to export ORG files from. You can symlink an -existing directory or use a remote repository for these contents. +For licensing information see the COPYING file. -*** pub/ - -The build directory: all generated contents go there. - -*** src/ - -Source files necessary to build the application. diff --git a/TODO.org b/TODO.org new file mode 100644 index 0000000..17743fb --- a/dev/null +++ b/TODO.org @@ -0,0 +1,32 @@ + +* bibliographic handling: + +http://ebib.sourceforge.net + +chapter 17.2 in +http://orgmode.org/worg/org-tutorials/org-latex-export.html + + +auxiliary + +http://bibdesk.sourceforge.net (OSX) + +http://jabref.sourceforge.net (cross) + + + +* grammar parsing + + +** link + + fix the .el + +** diction + +http://www.gnu.org/software/diction/diction.html + +https://github.com/grundprinzip/emacsdir/blob/master/elisp/diction.el + + + diff --git a/doc/Anonymous Pro.ttf b/doc/Anonymous Pro.ttf Binary files differnew file mode 100644 index 0000000..06aafc0 --- a/dev/null +++ b/doc/Anonymous Pro.ttf diff --git a/doc/OpenFontLicense.txt b/doc/OpenFontLicense.txt new file mode 100644 index 0000000..68d1d00 --- a/dev/null +++ b/doc/OpenFontLicense.txt @@ -0,0 +1,94 @@ +Copyright (c) 2009, Mark Simonson (http://www.ms-studio.com, [email protected]),
+with Reserved Font Name Anonymous Pro.
+
+This Font Software is licensed under the SIL Open Font License, Version 1.1.
+This license is copied below, and is also available with a FAQ at:
+http://scripts.sil.org/OFL
+
+
+-----------------------------------------------------------
+SIL OPEN FONT LICENSE Version 1.1 - 26 February 2007
+-----------------------------------------------------------
+
+PREAMBLE
+The goals of the Open Font License (OFL) are to stimulate worldwide
+development of collaborative font projects, to support the font creation
+efforts of academic and linguistic communities, and to provide a free and
+open framework in which fonts may be shared and improved in partnership
+with others.
+
+The OFL allows the licensed fonts to be used, studied, modified and
+redistributed freely as long as they are not sold by themselves. The
+fonts, including any derivative works, can be bundled, embedded,
+redistributed and/or sold with any software provided that any reserved
+names are not used by derivative works. The fonts and derivatives,
+however, cannot be released under any other type of license. The
+requirement for fonts to remain under this license does not apply
+to any document created using the fonts or their derivatives.
+
+DEFINITIONS
+"Font Software" refers to the set of files released by the Copyright
+Holder(s) under this license and clearly marked as such. This may
+include source files, build scripts and documentation.
+
+"Reserved Font Name" refers to any names specified as such after the
+copyright statement(s).
+
+"Original Version" refers to the collection of Font Software components as
+distributed by the Copyright Holder(s).
+
+"Modified Version" refers to any derivative made by adding to, deleting,
+or substituting -- in part or in whole -- any of the components of the
+Original Version, by changing formats or by porting the Font Software to a
+new environment.
+
+"Author" refers to any designer, engineer, programmer, technical
+writer or other person who contributed to the Font Software.
+
+PERMISSION & CONDITIONS
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of the Font Software, to use, study, copy, merge, embed, modify,
+redistribute, and sell modified and unmodified copies of the Font
+Software, subject to the following conditions:
+
+1) Neither the Font Software nor any of its individual components,
+in Original or Modified Versions, may be sold by itself.
+
+2) Original or Modified Versions of the Font Software may be bundled,
+redistributed and/or sold with any software, provided that each copy
+contains the above copyright notice and this license. These can be
+included either as stand-alone text files, human-readable headers or
+in the appropriate machine-readable metadata fields within text or
+binary files as long as those fields can be easily viewed by the user.
+
+3) No Modified Version of the Font Software may use the Reserved Font
+Name(s) unless explicit written permission is granted by the corresponding
+Copyright Holder. This restriction only applies to the primary font name as
+presented to the users.
+
+4) The name(s) of the Copyright Holder(s) or the Author(s) of the Font
+Software shall not be used to promote, endorse or advertise any
+Modified Version, except to acknowledge the contribution(s) of the
+Copyright Holder(s) and the Author(s) or with their explicit written
+permission.
+
+5) The Font Software, modified or unmodified, in part or in whole,
+must be distributed entirely under this license, and must not be
+distributed under any other license. The requirement for fonts to
+remain under this license does not apply to any document created
+using the Font Software.
+
+TERMINATION
+This license becomes null and void if any of the above conditions are
+not met.
+
+DISCLAIMER
+THE FONT SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT
+OF COPYRIGHT, PATENT, TRADEMARK, OR OTHER RIGHT. IN NO EVENT SHALL THE
+COPYRIGHT HOLDER BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+INCLUDING ANY GENERAL, SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL
+DAMAGES, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF THE USE OR INABILITY TO USE THE FONT SOFTWARE OR FROM
+OTHER DEALINGS IN THE FONT SOFTWARE.
diff --git a/doc/README_AnonymousPro.txt b/doc/README_AnonymousPro.txt new file mode 100644 index 0000000..7232905 --- a/dev/null +++ b/doc/README_AnonymousPro.txt @@ -0,0 +1,55 @@ +Anonymous Pro + +General Information and History + +Anonymous Pro is a family of four fixed-width fonts designed especially with coding in mind. Characters that could be mistaken for one another (O, 0, I, l, 1, etc.) have distinct shapes to make them easier to tell apart in the context of source code. + +Anonymous Pro also features an international, Unicode-based character set, with support for most Western and European Latin-based languages, Greek, and Cyrillic. It also includes special "box drawing" characters for those who need them. + +While Anonymous Pro looks great on Macs and Windows PCs with antialiasing enabled, it also includes embedded bitmaps for specific pixel sizes ("ppems" in font nerd speak) for both the regular and bold weight. (Since slanted bitmaps look pretty bad and hard to read at the supported sizes, I chose to use the upright bitmaps for the italics as well.) Bitmaps are included for these ppems: 10, 11, 12, and 13. See the usage notes below for info on what point sizes these ppems correspond to on Mac and Windows. + +Anonymous Pro is based on an earlier font, Anonymous™, which was my TrueType version of Anonymous 9, a freeware Macintosh bitmap font developed in the mid-'90s by Susan Lesch and David Lamkins. The bitmap version was intended as a more legible alternative to Monaco, the fixed-width Macintosh system font. + +Anonymous Pro differs from Anonymous™ and Anonymous 9 in a few key characters. While the earlier fonts had a one-story lowercase "a" like Monaco, Anonymous Pro features a two-story lowercase "a" to help distinguish it from the "o". In the earlier fonts, the slashed zero, designed to look different than the capital "O", goes the "wrong" way compared to most fonts that have this feature. Susan and David did this intentionally to distinguish it from the slashed capital "Ø" used in some languages. Some people thought this looked odd, so I put it the "right" way, and distinguish it from the "Ø" by keeping the slash inside the character. + +Another significant change was to adjust the size of the characters in relation to the point size. Anonymous™ was approximately two sizes larger than comparable fonts at the same point size. This was in keeping with the old Monaco font, but can be annoying when switching between fonts. Anonymous Pro has been adjusted so that it appears about the same size as comparable fonts set at the same point size. If you have been using Anonymous™, you will need to increase the point size to get the same appearance. + +Finally, unlike Anonymous™, Anonymous Pro is available in one universal TrueType format that will work on Mac OS X, Windows, and Linux. (If you're running a pre-OS X Mac, the new fonts are not compatible, but Anonymous™ will still work.) + +Anonymous Pro is distributed with the Open Font License (OFL). + +USAGE NOTES + +I recommend disabling antialiasing for Anonymous Pro ONLY if you intend to use the sizes which have embedded bitmaps. The fonts simply don't have the kind of high-quality TrueType hints needed for them to display well at other sizes without antialiasing. Here are some OS-specific recommendations: + +MacOS: + +Anonymous Pro will display using Quartz antialiasing unless you disable it system-wide in the Appearance panel or in specific apps that allow it (BBEdit, TextMate, Terminal, Coda, etc.). Bitmaps will be used at the following point sizes: 10, 11, 12, and 13. Note that the 13-point bitmaps are not available when using the system-wide antialiasing suppression, which only works for 12-point text or smaller. + +If you use TextMate, be sure to use version 1.5.8 (1505) or later. There was a bug which misinterpreted the line height when embedded bitmaps are present in a TTF font. (Thanks, Allan, for fixing this!) + +Windows: + +It's best to enable "font smoothing" (Control Panel > Display Properties > Appearance > Effects...). When font smoothing is set to "Standard", the embedded bitmaps will automatically be used for the following point sizes: 7, 8, 9, and 10. For other sizes, or if you prefer non-jagged type, "ClearType" is the best choice. + +Linux: + +From all reports, Anonymous Pro displays well on Linux systems. Here are installation instructions, kindly provided by a Linux user: + +Copy the *.ttf files to a font directory such as +~/.fonts or /usr/share/fonts/ttf. The exact location depends on your +distribution. See /etc/fonts/fonts.conf for details if unsure. + +Run fc-cache using the command: 'sudo fc-cache -f' + + +OTHER INFORMATION + +See "FONTLOG for Anonymous Pro.txt" for the changelog, credits, etc. + +Mark Simonson +September 8, 2010 +Mark Simonson Studio LLC +http://www.ms-studio.com + diff --git a/doc/autorg_logo.png b/doc/autorg_logo.png Binary files differnew file mode 100644 index 0000000..9c729ee --- a/dev/null +++ b/doc/autorg_logo.png diff --git a/elisp/autorg.el b/elisp/autorg.el index 01a962e..93dc2d8 100644 --- a/elisp/autorg.el +++ b/elisp/autorg.el @@ -4,9 +4,91 @@ (provide 'autorg) -;; local emacs extensions -(add-to-list 'load-path "~/.emacs.d") +; load generic keymaps +(require 'keymap) +; remember extension +(require 'remember) + +; flyspell extension +(autoload 'flyspell-mode "flyspell" "On-the-fly spelling checker." t) + +; aspell dictionary list +; (require 'dictionaries) + +; grammar parser +(require 'grammar) + +; frame zooming +(require 'zoom-frm) +(global-set-key (if (boundp 'mouse-wheel-down-event) ; Emacs 22+ + (vector (list 'control mouse-wheel-down-event)) + [C-mouse-wheel]) ; Emacs 20, 21 + 'zoom-in) +(when (boundp 'mouse-wheel-up-event) ; Emacs 22+ + (global-set-key (vector (list 'control mouse-wheel-up-event)) + 'zoom-out)) + +; load org-mode first +(add-to-list 'load-path (concat AutOrgRes "/org-mode/lisp")) +(add-to-list 'load-path (concat AutOrgRes "/org-mode/contrib/lisp")) +'(org-modules (quote (org-bbdb org-bibtex org-gnus org-info +org-jsinfo org-irc org-w3m org-mouse org-eval org-eval-light +org-exp-bibtex org-man org-mtags org-panel org-R +org-special-blocks org-exp-blocks org-mobile org-odt org2blog +org-crypt org-remember org-agenda))) +(require 'org) +(org-remember-insinuate) + +;; export options +'(org-export-html-inline-images t) +'(org-export-html-use-infojs t) +'(org-export-html-with-timestamp t) +'(org-export-html-validation-link + "<p class=\"xhtml-validation\"><a href=\"http://validator.w3.org/check?uri=referer\">Validate XHTML 1.0</a></p>") + +;; extra export formats +(require 'org-export-generic) +'(org-export-blocks (quote ((comment org-export-blocks-format-comment t) + (ditaa org-export-blocks-format-ditaa t) + (dot org-export-blocks-format-dot t) + (r org-export-blocks-format-R nil) + (R org-export-blocks-format-R nil)))) + +;; use texi2dvi to process with bibtex and makeindex +(setq org-latex-to-pdf-process '("texi2dvi --pdf --clean --verbose --batch %f")) + +;; org protocol helps setting communications outside of Emacs +(require 'org-protocol) + +;; Ebib bibliografy manager +(require 'ebib) +(org-add-link-type "ebib" 'ebib) +(require 'natbib) + +;; freemind export +(require 'freemind) + +; Encryption +(require 'epa) +(require 'epa-file) +(epa-file-enable) +(add-to-list 'auto-mode-alist '("\\.gpg\\(~\\|\\.~[0-9]+~\\)?\\'" nil epa-file)) +;; (require 'pgg) +(require 'org-crypt) +(org-crypt-use-before-save-magic) + +; enables semantic mode +; (semantic-mode t) +; + +; load HTML, PHP and related variou syntax support +(load (concat AutOrgRes "/nxhtml/autostart.el")) + +; LUA mode +(autoload 'lua-mode "lua-mode" "Lua editing mode." t) +(add-to-list 'auto-mode-alist '("\\.lua$" . lua-mode)) +(add-to-list 'interpreter-mode-alist '("lua" . lua-mode)) ;; deactivate all menubar scrollbar toolbar ; (tool-bar-mode) @@ -20,29 +102,16 @@ (fset 'yes-or-no-p 'y-or-n-p) (setq inhibit-startup-message t) + ; stop leaving backup~ turds scattered everywhere (setq make-backup-files nil) ; save on exit (defadvice save-buffers-kill-emacs (around no-y-or-n activate) (flet ((yes-or-no-p (&rest args) t) - (y-or-n-p (&rest args) t)) + (y-or-n-p (&rest args) t)) ad-do-it)) -; load color-themes extension -(require 'color-theme) -(color-theme-initialize) -(color-theme-gray30) -; (color-theme-matrix) -; (color-theme-blippblopp) -; (color-theme-dark-laptop) - -; transparency (thanks dreamer!) -(set-frame-parameter (selected-frame) 'alpha '(98 50)) -(add-to-list 'default-frame-alist '(alpha 98 50)) - -; start listening to commandline invokations -(server-start) ; =========================== ;; setup our keyboard mappings @@ -67,16 +136,20 @@ (global-set-key [(meta O) ?H] 'beginning-of-line) (global-set-key [home] 'beginning-of-line) (global-set-key [(meta O) ?F] 'end-of-line) -(global-set-key [end] 'end-of-line) +(global-set-key [end] 'end-of-line) (setq next-line-add-newlines nil) ; C-c c to either comment out a region or uncomment it depending on context. (global-set-key (kbd "C-c c") 'comment-dwim) ; Shift-arrows a la windows... + + + (custom-set-variables ;; custom-set-variables was added by Custom. ;; If you edit it by hand, you could mess it up, so be careful. ;; Your init file should contain only one such instance. ;; If there is more than one, they won't work right. + '(ispell-library-directory (concat AutOrgRes "/dict")) '(browse-url-firefox-program "open") '(column-number-mode t) '(keyboard-coding-system (quote mule-utf-8)) @@ -84,16 +157,17 @@ '(nil nil t) ; '(get-frame-for-buffer-default-instance-limit nil) - '(pc-select-meta-moves-sexps t) - '(pc-select-selection-keys-only t) - '(pc-selection-mode t nil (pc-select)) +; '(pc-select-meta-moves-sexps t) +; '(pc-select-selection-keys-only t) +; '(pc-selection-mode t nil (pc-select)) '(word-count-non-character-regexp "[ ]") - '(x-select-enable-clipboard t)) -;; X selection manipulation -(define-key global-map [(delete)] "\C-d") + '(x-select-enable-clipboard t) +) +;; X selection manipulation +(define-key global-map [(delete)] "\C-d") (defun x-own-selection (s) (x-set-selection `PRIMARY s)) (global-set-key [(shift insert)] '(lambda () (interactive) @@ -111,13 +185,15 @@ (global-set-key "\C-c\C-m" 'execute-extended-command) (global-set-key "\C-xm" 'execute-extended-command) (global-set-key "\C-cm" 'execute-extended-command) +; enables deleting an highlighted block +(delete-selection-mode) ;; By default we starting in text mode. (setq initial-major-mode (lambda () - (text-mode) - (turn-on-auto-fill) + (text-mode) + (turn-on-auto-fill) (setq transient-mark-mode t) (global-font-lock-mode t) (setq font-lock-mode-maximum-decoration t) @@ -125,6 +201,18 @@ (setq revert-without-query (cons "TAGS" revert-without-query)) +; grep directories +(defun grep-on-the-fly () + "grep the whole directory for something defaults to term at cursor position" + (interactive) + (setq default (thing-at-point 'symbol)) + (setq needle (or (read-string (concat "grep for <" default "> ")) default)) + (setq needle (if (equal needle "") default needle)) + (grep (concat "egrep -s -i -n " needle " * /dev/null"))) +(global-set-key "\C-x." 'grep-on-the-fly) +(global-set-key [f8] 'next-error) + + ; internationalisation support (require 'mule) (prefer-coding-system 'mule-utf-8) @@ -146,7 +234,11 @@ (require 'mwheel) ; Make the mouse jump away when you type over it. (mouse-avoidance-mode 'cat-and-mouse) - +;; scroll one line at a time (less "jumpy" than defaults) + (setq mouse-wheel-scroll-amount '(1 ((shift) . 1))) ;; one line at a time +; (setq mouse-wheel-progressive-speed nil) ;; don't accelerate scrolling + (setq mouse-wheel-follow-mouse 't) ;; scroll window under mouse + (setq scroll-step 1) ;; keyboard scroll one line at a time ; IDO lets you open files and switch buffers with fuzzy matching, ; really nice when you have lots of things open. @@ -155,7 +247,34 @@ (ido-mode t) (setq ido-enable-flex-matching t) +; appearance + +; load color-themes extension +(require 'color-theme) +(color-theme-initialize) +(color-theme-classic) +; (color-theme-gray30) +; (color-theme-matrix) +; (color-theme-blippblopp) +; (color-theme-dark-laptop) + ;; set our favourite: Anonymous! (set-face-font -'default "-*-Inconsolata-normal-normal-normal-*-16-*-*-*-*-*-*") +'default "-*-Anonymous-normal-normal-normal-*-13-*-*-*-*-*-*") + +; transparency (thanks dreamer!) +(set-frame-parameter (selected-frame) 'alpha '(95 50)) +(add-to-list 'default-frame-alist '(alpha 95 50)) +; creator tag in exported +(custom-set-variables + '(org-export-latex-hyperref-options-format "\\hypersetup{ + pdfkeywords={%s}, + pdfsubject={%s}, + pdfcreator={AutOrg (org-mode %s) <http://autorg.dyne.org>}} +")) + + + +; start listening to commandline invokations +(server-start) diff --git a/elisp/ebib.el b/elisp/ebib.el new file mode 100644 index 0000000..d9d1d04 --- a/dev/null +++ b/elisp/ebib.el @@ -0,0 +1,4356 @@ +;;; ebib.el --- a BibTeX database manager + +;; Copyright (c) 2003-2012 Joost Kremers +;; All rights reserved. + +;; Author: Joost Kremers <[email protected]> +;; Maintainer: Joost Kremers <[email protected]> +;; Created: 2003 +;; Version: 1.11.0 +;; Keywords: text bibtex + +;; Redistribution and use in source and binary forms, with or without +;; modification, are permitted provided that the following conditions +;; are met: +;; +;; 1. Redistributions of source code must retain the above copyright +;; notice, this list of conditions and the following disclaimer. +;; 2. Redistributions in binary form must reproduce the above copyright +;; notice, this list of conditions and the following disclaimer in the +;; documentation and/or other materials provided with the distribution. +;; 3. The name of the author may not be used to endorse or promote products +;; derived from this software without specific prior written permission. +;; +;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR +;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +;; IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, +;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES ; LOSS OF USE, +;; DATA, OR PROFITS ; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +;;; Commentary: + +;; Ebib is a BibTeX database manager that runs in GNU Emacs. With Ebib, you +;; can create and manage .bib-files, all within Emacs. It supports @string +;; and @preamble definitions, multi-line field values, searching, and +;; integration with Emacs' (La)TeX mode. + +;; See the Ebib manual for usage and installation instructions. + +;; The latest release version of Ebib, contact information and mailing list +;; can be found at <http://ebib.sourceforge.net>. Development sources can be +;; found at <https://github.com/joostkremers/ebib>. + +;; Code: + +(eval-when-compile + (require 'cl)) +(require 'easymenu) +(require 'bibtex) + +;; make sure we can call bibtex-generate-autokey +(declare-function bibtex-generate-autokey "bibtex" nil) +(unless (< emacs-major-version 24) + (bibtex-set-dialect)) ; this initializes some stuff that is needed for bibtex-generate-autokey + +;;;;;;;;;;;;;;;;;;;;;; +;; global variables ;; +;;;;;;;;;;;;;;;;;;;;;; + +;; user customisation + +(defgroup ebib nil "Ebib: a BibTeX database manager" :group 'tex) + +(defcustom ebib-default-type 'article + "*The default type for a newly created BibTeX entry." + :group 'ebib + :type 'symbol) + +(defcustom ebib-preload-bib-files nil + "*List of .bib files to load automatically when Ebib starts." + :group 'ebib + :type '(repeat (file :must-match t))) + +(defcustom ebib-preload-bib-search-dirs '("~") + "*List of directories to search for .bib files to be preloaded." + :group 'ebib + :type '(repeat :tag "Search directories for .bib files" (string :tag "Directory"))) + +(defcustom ebib-create-backups t + "*If set, create a backup file of a .bib file when it is first saved." + :group 'ebib + :type '(choice (const :tag "Create backups" t) + (const :tag "Do not create backups" nil))) + +(defcustom ebib-additional-fields '(crossref + url + annote + abstract + keywords + file + timestamp + doi) + "*List of the additional fields." + :group 'ebib + :type '(repeat (symbol :tag "Field"))) + +(defcustom ebib-layout 'full + "*Ebib window layout. +Full width: Ebib occupies the entire Emacs frame. +Custom width: Ebib occupies the right side of the Emacs frame, +with the left side free for another window." + :group 'ebib + :type '(choice (const :tag "Full width" full) + (const :tag "Custom width" custom))) + +(defcustom ebib-width 80 + "*Width of the Ebib windows. +Only takes effect if EBIB-LAYOUT is set to CUSTOM." + :group 'ebib + :type 'integer) + +(defcustom ebib-index-window-size 10 + "*The number of lines used for the index buffer window." + :group 'ebib + :type 'integer) + +(defcustom ebib-index-display-fields nil + "*List of the fields to display in the index buffer." + :group 'ebib + :type '(repeat (symbol :tag "Index Field"))) + +(defcustom ebib-uniquify-keys nil + "*Create unique keys. +If set, Ebib will not complain about duplicate keys but will +instead create a unique key by adding an identifier to it. +Identifiers are created from consecutive letters of the +alphabet, starting with `b'." + :group 'ebib + :type 'boolean) + +(defcustom ebib-autogenerate-keys nil + "*If set, Ebib generates key automatically. +Uses the function BIBTEX-GENERATE-AUTOKEY, see there for +customization options." + :group 'ebib + :type 'boolean) + +(defcustom ebib-citation-commands '((any + (("cite" "\\cite%<[%A]%>{%K}"))) + (org-mode + (("ebib" "[[ebib:%K][%A]]"))) + (markdown-mode + (("text" "@%K%< [%A]%>") + ("paren" "[%(%<%A %>@%K%<, %A%>%; )]") + ("year" "[-@%K%< %A%>]")))) + "*A list of format strings to insert a citation into a buffer. +These are used with EBIB-INSERT-BIBTEX-KEY and +EBIB-PUSH-BIBTEX-KEY." + :group 'ebib + :type '(repeat (list :tag "Mode" (symbol :tag "Mode name") + (repeat (list :tag "Citation command" + (string :tag "Identifier") + (string :tag "Format string")))))) + +(defcustom ebib-multiline-major-mode 'text-mode + "*The major mode of the multiline edit buffer." + :group 'ebib + :type '(function :tag "Mode function")) + +(defcustom ebib-sort-order nil + "*The fields on which the BibTeX entries are to be sorted in the .bib file. +Sorting is done on different sort levels, and each sort level contains one +or more sort keys." + :group 'ebib + :type '(repeat (repeat :tag "Sort level" (symbol :tag "Sort field")))) + +(defcustom ebib-save-xrefs-first nil + "*If true, entries with a crossref field will be saved first in the .bib-file. +Setting this option has unpredictable results for the sort order +of entries, so it is not compatible with setting the Sort Order option." + :group 'ebib + :type 'boolean) + +(defface ebib-crossref-face '((t (:foreground "red"))) + "*Face used to indicate values inherited from crossreferenced entries." + :group 'ebib) + +(defface ebib-marked-face (if (featurep 'xemacs) + '((t (:foreground "white" :background "red"))) + '((t (:inverse-video t)))) + "*Face to indicate marked entries." + :group 'ebib) + +(defcustom ebib-use-timestamp nil + "*If true, new entries will get a time stamp. +The time stamp will be stored in a field \"timestamp\" that can +be made visible with the command \\[ebib-toggle-hidden] in the +index buffer." + :group 'ebib + :type 'boolean) + +(defcustom ebib-timestamp-format "%a %b %e %T %Y" + "*Format of the time string used in the timestamp. +The format is passed unmodified to FORMAT-TIME-STRING, see the +documentation of that function for details." + :group 'ebib + :type 'string) + +(defcustom ebib-standard-url-field 'url + "*Standard field to store urls in. +In the index buffer, the command ebib-browse-url can be used to +send a url to a browser. This option sets the field from which +this command extracts the url." + :group 'ebib + :type 'symbol) + +(defcustom ebib-url-regexp "\\\\url{\\(.*\\)}\\|https?://[^ '<>\"\n\t\f]+" + "*Regular expression to extract urls from a field." + :group 'ebib + :type 'string) + +(defcustom ebib-browser-command "" + "*Command to call the browser with. +GNU/Emacs has a function call-browser, which is used if this +option is unset." + :group 'ebib + :type '(string :tag "Browser command")) + +(defcustom ebib-standard-doi-field 'doi + "*Standard field to store a DOI (digital object identifier) in. +In the index buffer, the command ebib-browse-doi can be used to +send a suitable url to a browser. This option sets the field from +which this command extracts the doi." + :group 'ebib + :type 'symbol) + +(defcustom ebib-doi-url "http://dx.doi.org/%s" + "*URL for opening a doi. +This value must contain one `%s', which will be replaced with the doi." + :group 'ebib + :type 'string) + +(defcustom ebib-standard-file-field 'file + "*Standard field to store filenames in. +In the index buffer, the command ebib-view-file can be used to +view a file externally. This option sets the field from which +this command extracts the filename." + :group 'ebib + :type 'symbol) + +(defcustom ebib-file-associations '(("pdf" . "xpdf") + ("ps" . "gv")) + "*List of file associations. +Lists file extensions together with external programs to handle +files with those extensions. If the external program is left +blank, Ebib tries to handle the file internally in +Emacs (e.g. with doc-view-mode)." + :group 'ebib + :type '(repeat (cons :tag "File association" + (string :tag "Extension") (string :tag "Command")))) + +(defcustom ebib-file-regexp "[^?|\\:*<>\" \n\t\f]+" + "*Regular expression to extract filenames from a field." + :group 'ebib + :type 'string) + +(defcustom ebib-file-search-dirs '("~") + "*List of directories to search when viewing external files." + :group 'ebib + :type '(repeat :tag "Search directories" (string :tag "Directory"))) + +(defcustom ebib-print-preamble nil + "*Preamble used for the LaTeX file for printing the database. +Each string is added to the preamble on a separate line." + :group 'ebib + :type '(repeat (string :tag "Add to preamble"))) + +(defcustom ebib-print-newpage nil + "*If set, each entry is printed on a separate page." + :group 'ebib + :type 'boolean) + +(defcustom ebib-print-multiline nil + "*If set, multiline fields are included when printing the database." + :group 'ebib + :type 'boolean) + +(defcustom ebib-latex-preamble '("\\bibliographystyle{plain}") + "*Preamble used for the LaTeX file for BibTeXing the database. +Each string is added to the preamble on a separate line." + :group 'ebib + :type '(repeat (string :tag "Add to preamble"))) + +(defcustom ebib-print-tempfile "" + "*Temporary file for use with EBIB-PRINT-DATABASE and EBIB-LATEX-DATABASE." + :group 'ebib + :type '(file)) + +(defcustom ebib-allow-identical-fields nil + "*If set, Ebib handles multiple occurrences of a field gracefully." + :group 'ebib + :type 'boolean) + +(defcustom ebib-keywords-list nil + "*General list of keywords." + :group 'ebib + :type '(repeat (string :tag "Keyword"))) + +(defcustom ebib-keywords-file "" + "*Single or generic file name for storing keywords. +Keywords can be stored in a single keywords file, which is used +for all .bib files, or in per-directory keywords files located in +the same directories as the .bib files. In the latter case, the +keywords file should specify just the generic name and no path." + :group 'ebib + :type '(choice (file :tag "Use single keywords file") + (string :value "ebib-keywords.txt" :tag "Use per-directory keywords file"))) + +(defcustom ebib-keywords-file-save-on-exit 'ask + "*Action to take when new keywords are added during a session. +This option only makes sense if `ebib-keywords-file' is set." + :group 'ebib + :type '(choice (const :tag "Always save on exit" always) + (const :tag "Do not save on exit" nil) + (const :tag "Ask whether to save" ask))) + +(defcustom ebib-keywords-use-only-file nil + "*Whether or not to use only keywords from the keywords file. +If both `ebib-keywords-list' and `ebib-keywords-file' are set, +should the file take precedence or should both sets of keywords +be combined? + +For .bib files that do not have an associated keywords file, +`ebib-keyword-list' is always used, regardless of this setting." + :group 'ebib + :type '(choice (const :tag "Use only keywords file" t) + (const :tag "Use keywords file and list" nil))) + +(defcustom ebib-keywords-separator "; " + "*String for separating keywords in the keywords field." + :group 'ebib + :type '(string :tag "Keyword separator:")) + +(defcustom ebib-keywords-field-keep-sorted nil + "*Keep the keywords field sorted in alphabetical order. +Also automatically remove duplicates." + :group 'ebib + :type '(choice (const :tag "Sort keywords field" t) + (const :tag "Do not sort keywords field" nil))) + +(defvar ebib-unique-field-list nil + "Holds a list of all field names.") + +(defmacro add-to-listq (listvar element &optional append fn) + (if (or (featurep 'xemacs) + (string< emacs-version "22")) + `(add-to-list (quote ,listvar) ,element ,append) + `(add-to-list (quote ,listvar) ,element ,append ,fn))) + +(defun ebib-set-unique-field-list (var value) + "Sets EBIB-UNIQUE-FIELD-LIST on the basis of EBIB-ENTRY-TYPES" + (set-default var value) + (setq ebib-unique-field-list nil) + (mapc #'(lambda (entry) + (mapc #'(lambda (field) + (add-to-listq ebib-unique-field-list field t 'eq)) + (cadr entry)) + (mapc #'(lambda (field) + (add-to-listq ebib-unique-field-list field t 'eq)) + (caddr entry))) + value)) + +(defcustom ebib-entry-types + '((article ;; name of entry type + (author title journal year) ;; obligatory fields + (volume number pages month note)) ;; optional fields + + (book + (author title publisher year) + (editor volume number series address edition month note)) + + (booklet + (title) + (author howpublished address month year note)) + + (inbook + (author title chapter pages publisher year) + (editor volume series address edition month note)) + + (incollection + (author title booktitle publisher year) + (editor volume number series type chapter pages address edition month note)) + + (inproceedings + (author title booktitle year) + (editor pages organization publisher address month note)) + + (manual + (title) + (author organization address edition month year note)) + + (misc + () + (title author howpublished month year note)) + + (mastersthesis + (author title school year) + (address month note)) + + (phdthesis + (author title school year) + (address month note)) + + (proceedings + (title year) + (editor publisher organization address month note)) + + (techreport + (author title institution year) + (type number address month note)) + + (unpublished + (author title note) + (month year))) + + "List of entry type definitions for Ebib" + :group 'ebib + :type '(repeat (list :tag "Entry type" (symbol :tag "Name") + (repeat :tag "Obligatory fields" (symbol :tag "Field")) + (repeat :tag "Optional fields" (symbol :tag "Field")))) + :set 'ebib-set-unique-field-list) + +;; generic for all databases + +;; constants and variables that are set only once +(defconst ebib-bibtex-identifier "[^\"#%'(),={} \t\n\f]*" "Regexp describing a licit BibTeX identifier.") +(defconst ebib-version "1.11.0") +(defvar ebib-initialized nil "T if Ebib has been initialized.") + +;; buffers and highlights +(defvar ebib-index-buffer nil "The index buffer.") +(defvar ebib-entry-buffer nil "The entry buffer.") +(defvar ebib-strings-buffer nil "The strings buffer.") +(defvar ebib-multiline-buffer nil "Buffer for editing multiline strings.") +(defvar ebib-log-buffer nil "Buffer showing warnings and errors during loading of .bib files") +(defvar ebib-index-highlight nil "Highlight to mark the current entry.") +(defvar ebib-fields-highlight nil "Highlight to mark the current field.") +(defvar ebib-strings-highlight nil "Highlight to mark the current string.") + +;; general bookkeeping +(defvar ebib-minibuf-hist nil "Holds the minibuffer history for Ebib") +(defvar ebib-saved-window-config nil "Stores the window configuration when Ebib is called.") +(defvar ebib-pre-ebib-window nil "The window that was active when Ebib was called.") +(defvar ebib-pre-multiline-buffer nil "The buffer in the window before switching to the multiline edit buffer.") +(defvar ebib-export-filename nil "Filename to export entries to.") +(defvar ebib-push-buffer nil "Buffer to push entries to.") +(defvar ebib-search-string nil "Stores the last search string.") +(defvar ebib-editing nil "Indicates what the user is editing. +Its value can be 'strings, 'fields, or 'preamble.") +(defvar ebib-multiline-raw nil "Indicates whether the multiline text being edited is raw.") +(defvar ebib-log-error nil "Indicates whether an error was logged.") +(defvar ebib-local-bibtex-filenames nil + "A buffer-local variable holding a list of the name(s) of that buffer's .bib file(s)") +(make-variable-buffer-local 'ebib-local-bibtex-filenames) +(defvar ebib-syntax-table (make-syntax-table) "Syntax table used for reading .bib files.") +(modify-syntax-entry ?\[ "." ebib-syntax-table) +(modify-syntax-entry ?\] "." ebib-syntax-table) +(modify-syntax-entry ?\( "." ebib-syntax-table) +(modify-syntax-entry ?\) "." ebib-syntax-table) +(modify-syntax-entry ?\" "w" ebib-syntax-table) + +;; keywords +;; +;; `ebib-keywords-files-alist' lists directories with keywords +;; files plus the keywords in them. if there is a single keywords +;; file, then there is only one entry. entries have three +;; elements: the dir (or full filename in case of a single +;; keywords file), a list of saved keywords, and a list of new +;; keywords added during the current session. +(defvar ebib-keywords-files-alist nil "Alist of keywords files.") + +;; `ebib-keywords-list-per-session' is composed of the keywords +;; in `ebib-keywords-list' and whatever new keywords are added by +;; the user during the current session. these new additions are +;; discarded when ebib is closed. +(defvar ebib-keywords-list-per-session nil "List of keywords for the current session.") + +;; the databases + +;; each database is represented by a struct +(defstruct edb + (database (make-hash-table :test 'equal)) ; hashtable containing the database itself + (keys-list nil) ; sorted list of the keys in the database + (cur-entry nil) ; sublist of KEYS-LIST that starts with the current entry + (marked-entries nil) ; list of marked entries + (n-entries 0) ; number of entries stored in this database + (strings (make-hash-table :test 'equal)) ; hashtable with the @STRING definitions + (strings-list nil) ; sorted list of the @STRING abbreviations + (preamble nil) ; string with the @PREAMBLE definition + (filename nil) ; name of the BibTeX file that holds this database + (name nil) ; name of the database + (modified nil) ; has this database been modified? + (make-backup nil) ; do we need to make a backup of the .bib file? + (virtual nil)) ; is this a virtual database? + +;; the master list and the current database +(defvar ebib-databases nil "List of structs containing the databases.") +(defvar ebib-cur-db nil "The database that is currently active.") + +;;;;;; bookkeeping required when editing field values or @STRING definitions + +(defvar ebib-hide-hidden-fields t "If set to T, hidden fields are not shown.") + +;; this variable is set when the user enters the entry buffer +(defvar ebib-cur-entry-fields nil "The fields of the type of the current entry.") + +;; these two are set by EBIB-FILL-ENTRY-BUFFER +(defvar ebib-cur-entry-hash nil "The hash table containing the data of the current entry.") +(defvar ebib-current-field nil "The current field.") + +;; and this one by EBIB-FILL-STRINGS-BUFFER +(defvar ebib-current-string nil "The current @STRING definition.") + +;; the prefix key and the multiline key are stored in a variable so that the +;; user can customise them. +(defvar ebib-prefix-key ?\;) +(defvar ebib-multiline-key ?\|) + +;; this is an AucTeX variable, but we want to check its value, so let's +;; keep the compiler from complaining. +(eval-when-compile + (defvar TeX-master)) + +;; this is to keep XEmacs from complaining. +(eval-when-compile + (if (featurep 'xemacs) + (defvar mark-active))) + +;; XEmacs has line-number, not line-number-at-pos. +(eval-and-compile + (if (featurep 'xemacs) + (defalias 'line-number-at-pos 'line-number))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; useful macros and functions ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defmacro nor (&rest args) + "Returns T if none of its arguments are true." + `(not (or ,@args))) + +;; we sometimes (often, in fact ;-) need to do something with a string, but +;; take special action (or do nothing) if that string is empty. IF-STR +;; makes that easier: + +(defmacro if-str (bindvar then &rest else) + "Execute THEN only if STRING is nonempty. +Format: (if-str (var value) then-form [else-forms]) VAR is bound +to VALUE, which is evaluated. If VAR is a nonempty string, +THEN-FORM is executed. If VAR is either \"\" or nil, ELSE-FORM is +executed. Returns the value of THEN or of ELSE." + (declare (indent 2)) + `(let ,(list bindvar) + (if (nor (null ,(car bindvar)) + (equal ,(car bindvar) "")) + ,then + ,@else))) + +(defmacro last1 (lst &optional n) + "Returns the last (or Nth last) element of LST." + `(car (last ,lst ,n))) + +;; we sometimes need to walk through lists. these functions yield the +;; element directly preceding or following ELEM in LIST. in order to work +;; properly, ELEM must be unique in LIST, obviously. if ELEM is the +;; first/last element of LIST, or if it is not contained in LIST at all, +;; the result is nil. +(defun next-elem (elem list) + (cadr (member elem list))) + +(defun prev-elem (elem list) + (if (or (equal elem (car list)) + (not (member elem list))) + nil + (last1 list (1+ (length (member elem list)))))) + +(defun read-string-at-point (chars) + "Reads a string at POINT delimited by CHARS and returns it. +CHARS is a string of characters that should not occur in the string." + (save-excursion + (skip-chars-backward (concat "^" chars)) + (let ((beg (point))) + (looking-at-goto-end (concat "[^" chars "]*")) + (buffer-substring-no-properties beg (point))))) + +(defun remove-from-string (string remove) + "Returns a copy of STRING with all the occurrences of REMOVE taken out. +REMOVE can be a regex." + (apply 'concat (split-string string remove))) + +(defun in-string (char string) + "Returns T if CHAR is in STRING, otherwise NIL." + (catch 'found + (do ((len (length string)) + (i 0 (1+ i))) + ((= i len) nil) + (if (eq char (aref string i)) + (throw 'found t))))) + +(defun ensure-extension (string ext) + "Makes sure STRING has the extension EXT, by appending it if necessary. +EXT should be an extension without the dot." + (if (string-match (concat "\\." ext "$") string) + string + (concat string "." ext))) + +(defmacro with-buffer-writable (&rest body) + "Makes the current buffer writable and executes the commands in BODY. +After BODY is executed, the buffer modified flag is unset." + (declare (indent defun)) + `(unwind-protect + (let ((buffer-read-only nil)) + ,@body) + (set-buffer-modified-p nil))) + +(defmacro safe-write-region (start end filename &optional append visit lockname mustbenew) + "XEmacs does not have the MUSTBENEW argument, so this is a way to implement it." + (if (featurep 'xemacs) + `(if (and (file-exists-p ,filename) + (not (y-or-n-p (format "File %s already exists; overwrite anyway? " ,filename)))) + (error "File %s exist" ,filename) + (write-region ,start ,end ,filename ,append ,visit ,lockname)) + `(write-region ,start ,end ,filename ,append ,visit ,lockname ,mustbenew))) + +(defun symbol-or-string (x) + "Returns the symbol-name of X if X is a symbol, otherwise return X. +Much like SYMBOL-NAME, except it does not throw an error if X is +not a symbol." + (if (symbolp x) + (symbol-name x) + x)) + +;; XEmacs doesn't know about propertize... +(if (not (fboundp 'propertize)) + (defun propertize (string &rest properties) + "Return a copy of STRING with text properties added. +First argument is the string to copy. Remaining arguments form a +sequence of PROPERTY VALUE pairs for text properties to add to +the result." + (let ((new-string (copy-sequence string))) + (add-text-properties 0 (length new-string) properties new-string) + new-string))) + +(defun region-active () + (if (featurep 'xemacs) + (region-active-p) + mark-active)) + +;; RAW-P determines if STRING is raw. note that we cannot do this by +;; simply checking whether STRING begins with { and ends with } (or +;; begins and ends with "), because something like "{abc} # D # {efg}" +;; would then be incorrectly recognised as non-raw. so we need to do +;; the following: take out everything that is between braces or +;; quotes, and see if anything is left. if there is, the original +;; string was raw, otherwise it was not. +;; +;; so i first check whether the string begins with { or ". if not, we +;; certainly have a raw string. (RAW-P recognises this through the default +;; clause of the COND.) if the first character is { or ", we first take out +;; every occurrence of backslash-escaped { and } or ", so that the rest of +;; the function does not get confused over them. +;; +;; then, if the first character is {, i use REMOVE-FROM-STRING to take out +;; every occurrence of the regex "{[^{]*?}", which translates to "the +;; smallest string that starts with { and ends with }, and does not contain +;; another {. IOW, it takes out the innermost braces and their +;; contents. because braces may be embedded, we have to repeat this step +;; until no more balanced braces are found in the string. (note that it +;; would be unwise to check for just the occurrence of { or }, because that +;; would throw RAW-P in an infinite loop if a string contains an unbalanced +;; brace.) +;; +;; for strings beginning with " i do the same, except that it is not +;; necessary to repeat this in a WHILE loop, for the simple reason that +;; strings surrounded with double quotes cannot be embedded; i.e., +;; "ab"cd"ef" is not a valid (BibTeX) string, while {ab{cd}ef} is. +;; +;; note: because these strings are to be fed to BibTeX and ultimately +;; (La)TeX, it might seem that we don't need to worry about strings +;; containing unbalanced braces, because (La)TeX would choke on them. but +;; the user may inadvertently enter such a string, and we therefore need to +;; be able to handle it. (alternatively, we could perform a check on +;; strings and warn the user.) + +(defun raw-p (string) + "Non-nil if STRING is raw." + (when (stringp string) + (cond + ((eq (string-to-char string) ?\{) + ;; we remove all occurrences of `\{' and of `\}' from the string: + (let ((clear-str (remove-from-string (remove-from-string string "[\\][{]") + "[\\][}]"))) + (while (and (in-string ?\{ clear-str) (in-string ?\} clear-str)) + (setq clear-str (remove-from-string clear-str "{[^{]*?}"))) + (> (length clear-str) 0))) + ((eq (string-to-char string) ?\") + (let ((clear-str (remove-from-string string "[\\][\"]"))) ; remove occurrences of `\"' + (setq clear-str (remove-from-string clear-str "\"[^\"]*?\"")) + (> (length clear-str) 0))) + (t t)))) + +(defun to-raw (string) + "Converts a string to its raw counterpart." + (if (and (stringp string) + (not (raw-p string))) + (substring string 1 -1) + string)) + +(defun from-raw (string) + "Converts a raw string to a non-raw one." + (if (raw-p string) + (concat "{" string "}") + string)) + +(defun multiline-p (string) + "True if STRING is multiline." + (if (stringp string) + (string-match "\n" string))) + +(defun first-line (string) + "Returns the first line of a multi-line string." + (string-match "\n" string) + (substring string 0 (match-beginning 0))) + +(defun sort-in-buffer (limit str) + "Moves POINT to the right position to insert STR in a buffer with lines sorted A-Z." + (let ((upper limit) + middle) + (when (> limit 0) + (let ((lower 0)) + (goto-char (point-min)) + (while (progn + (setq middle (/ (+ lower upper 1) 2)) + (goto-char (point-min)) + (forward-line (1- middle)) ; if this turns out to be where we need to be, + (beginning-of-line) ; this puts POINT at the right spot. + ;; if upper and lower differ by only 1, we have found the + ;; position to insert the entry in. + (> (- upper lower) 1)) + (save-excursion + (let ((beg (point))) + (end-of-line) + (if (string< (buffer-substring-no-properties beg (point)) str) + (setq lower middle) + (setq upper middle))))))))) + +(defun match-all (match-str string) + "Highlights all the matches of MATCH-STR in STRING. +The return value is a list of two elements: the first is the +modified string, the second either t or nil, indicating whether a +match was found at all." + (do ((counter 0 (match-end 0))) + ((not (string-match match-str string counter)) (values string (not (= counter 0)))) + (add-text-properties (match-beginning 0) (match-end 0) '(face highlight) string))) + +(defun looking-at-goto-end (str &optional match) + "Like LOOKING-AT but moves point to the end of the matching string. +MATCH acts just like the argument to MATCH-END, and defaults to 0." + (or match (setq match 0)) + (let ((case-fold-search t)) + (if (looking-at str) + (goto-char (match-end match))))) + +;; this needs to be wrapped in an eval-and-compile, to keep Emacs from +;; complaining that ebib-execute-helper isn't defined when it compiles +;; ebib-execute-when. +(eval-and-compile + (defun ebib-execute-helper (env) + "Helper function for EBIB-EXECUTE-WHEN." + (cond + ((eq env 'entries) + '(and ebib-cur-db + (edb-cur-entry ebib-cur-db))) + ((eq env 'marked-entries) + '(and ebib-cur-db + (edb-marked-entries ebib-cur-db))) + ((eq env 'database) + 'ebib-cur-db) + ((eq env 'real-db) + '(and ebib-cur-db + (not (edb-virtual ebib-cur-db)))) + ((eq env 'virtual-db) + '(and ebib-cur-db + (edb-virtual ebib-cur-db))) + ((eq env 'no-database) + '(not ebib-cur-db)) + (t t)))) + +(defmacro ebib-execute-when (&rest forms) + "Macro to facilitate writing Ebib functions. +This functions essentially like a COND clause: the basic format +is (ebib-execute-when FORMS ...), where each FORM is built up +as (ENVIRONMENTS BODY). ENVIRONMENTS is a list of symbols (not +quoted) that specify under which conditions BODY is to be +executed. Valid symbols are: + +entries: execute when there are entries in the database, +marked-entries: execute when there are marked entries in the database, +database: execute if there is a database, +no-database: execute if there is no database, +real-db: execute when there is a database and it is real, +virtual-db: execute when there is a database and it is virtual, +default: execute if all else fails. + +Just like with COND, only one form is actually executed, the +first one that matches. If ENVIRONMENT contains more than one +condition, BODY is executed if they all match (i.e., the +conditions are AND'ed.)" + (declare (indent defun)) + `(cond + ,@(mapcar #'(lambda (form) + (cons (if (= 1 (length (car form))) + (ebib-execute-helper (caar form)) + `(and ,@(mapcar #'(lambda (env) + (ebib-execute-helper env)) + (car form)))) + (cdr form))) + forms))) + +;; the numeric prefix argument is 1 if the user gave no prefix argument at +;; all. the raw prefix argument is not always a number. so we need to do +;; our own conversion. +(defun ebib-prefix (num) + (when (numberp num) + num)) + +(defun ebib-called-with-prefix () + "Returns T if the command was called with a prefix key." + (if (featurep 'xemacs) + (member (character-to-event ebib-prefix-key) (append (this-command-keys) nil)) + (member (event-convert-list (list ebib-prefix-key)) + (append (this-command-keys-vector) nil)))) + +(defmacro ebib-called-interactively () + "Returns T if the command was called interactively. +This is a compatibility macro for Emacs 23, in which +called-interactively-p doesn't take an argument, while in Emacs +24, it takes one obligatory argument." + (if (< emacs-major-version 24) + '(interactive-p) + '(called-interactively-p 'any))) + +(defmacro ebib-export-to-db (num message copy-fn) + "Exports data to another database. +NUM is the number of the database to which the data is to be copied. + +MESSAGE is a string displayed in the echo area if the export was +succesful. It must contain a %d directive, which is used to +display the database number to which the entry was exported. + +COPY-FN is the function that actually copies the relevant +data. It must take as argument the database to which the data is +to be copied. COPY-FN must return T if the copying was +successful, and NIL otherwise." + (let ((goal-db (make-symbol "goal-db"))) + `(let ((,goal-db (nth (1- ,num) ebib-databases))) + (cond + ((not ,goal-db) + (error "Database %d does not exist" ,num)) + ((edb-virtual ,goal-db) + (error "Database %d is virtual" ,num)) + (t (when (funcall ,copy-fn ,goal-db) + (ebib-set-modified t ,goal-db) + (message ,message ,num))))))) + +(defmacro ebib-cur-entry-key () + "Returns the key of the current entry in EBIB-CUR-DB." + `(car (edb-cur-entry ebib-cur-db))) + +(defmacro ebib-export-to-file (prompt-string message insert-fn) + "Exports data to a file. +PROMPT-STRING is the string that is used to ask for the filename +to export to. INSERT-FN must insert the data to be exported into +the current buffer: it is called within a WITH-TEMP-BUFFER, whose +contents is appended to the file the user enters. + +MESSAGE is shown in the echo area when the export was +successful. It must contain a %s directive, which is used to +display the actual filename." + (let ((filename (make-symbol "filename"))) + `(let ((insert-default-directory (not ebib-export-filename))) + (if-str (,filename (read-file-name + ,prompt-string "~/" nil nil ebib-export-filename)) + (with-temp-buffer + (funcall ,insert-fn) + (append-to-file (point-min) (point-max) ,filename) + (setq ebib-export-filename ,filename)))))) + +(defun ebib-temp-window () + "Returns a window to be used for temporary use." + (if (eq ebib-layout 'full) + (get-buffer-window ebib-entry-buffer) + ebib-pre-ebib-window)) + +(defun ebib-get-obl-fields (entry-type) + "Returns the obligatory fields of ENTRY-TYPE." + (nth 1 (assoc entry-type ebib-entry-types))) + +(defun ebib-get-opt-fields (entry-type) + "Returns the optional fields of ENTRY-TYPE." + (nth 2 (assoc entry-type ebib-entry-types))) + +(defun ebib-get-all-fields (entry-type) + "Returns all the fields of ENTRY-TYPE." + (cons 'type* (append (ebib-get-obl-fields entry-type) + (ebib-get-opt-fields entry-type) + ebib-additional-fields))) + +(defun ebib-retrieve-entry (entry-key database) + "Returns the hash table of the fields stored in DATABASE under ENTRY-KEY. +DATABASE can also be a list of databases. In that case, the first +matching entry is returned." + (catch 'found + (mapc #'(lambda (db) + (let ((entry (gethash entry-key (edb-database db)))) + (when entry + (throw 'found entry)))) + (if (not (listp database)) + (list database) + database)) + nil)) ; if no entry was found, we must return nil + +(defun ebib-erase-buffer (buffer) + (set-buffer buffer) + (with-buffer-writable + (erase-buffer))) + +(defun ebib-make-highlight (begin end buffer) + (let (highlight) + (if (featurep 'xemacs) + (progn + (setq highlight (make-extent begin end buffer)) + (set-extent-face highlight 'highlight)) + (progn + (setq highlight (make-overlay begin end buffer)) + (overlay-put highlight 'face 'highlight))) + highlight)) + +(defun ebib-move-highlight (highlight begin end buffer) + (if (featurep 'xemacs) + (set-extent-endpoints highlight begin end buffer) + (move-overlay highlight begin end buffer))) + +(defun ebib-highlight-start (highlight) + (if (featurep 'xemacs) + (extent-start-position highlight) + (overlay-start highlight))) + +(defun ebib-highlight-end (highlight) + (if (featurep 'xemacs) + (extent-end-position highlight) + (overlay-end highlight))) + +(defun ebib-delete-highlight (highlight) + (if (featurep 'xemacs) + (detach-extent highlight) + (delete-overlay highlight))) + +(defun ebib-set-index-highlight () + (set-buffer ebib-index-buffer) + (beginning-of-line) + (let ((beg (point))) + (if ebib-index-display-fields + (end-of-line) + (skip-chars-forward "^ ")) + (ebib-move-highlight ebib-index-highlight beg (point) ebib-index-buffer) + (beginning-of-line))) + +(defun ebib-set-fields-highlight () + (set-buffer ebib-entry-buffer) + (beginning-of-line) + (let ((beg (point))) + (looking-at-goto-end "[^ \t\n\f]*") + (ebib-move-highlight ebib-fields-highlight beg (point) ebib-entry-buffer) + (beginning-of-line))) + +(defun ebib-set-strings-highlight () + (set-buffer ebib-strings-buffer) + (beginning-of-line) + (let ((beg (point))) + (looking-at-goto-end "[^ \t\n\f]*") + (ebib-move-highlight ebib-strings-highlight beg (point) ebib-strings-buffer) + (beginning-of-line))) + +(defun ebib-display-entry (entry-key) + "Displays ENTRY-KEY in the index buffer at POINT." + (set-buffer ebib-index-buffer) + (insert (format "%-30s %s\n" + entry-key + (if ebib-index-display-fields + (let ((cur-entry-hash (ebib-retrieve-entry entry-key ebib-cur-db))) + (mapconcat #'(lambda (field) + (or + (to-raw (gethash field cur-entry-hash)) + "")) + ebib-index-display-fields + " ")) + "")))) + +(defun ebib-redisplay-current-field () + "Redisplays the contents of the current field in the entry buffer." + (set-buffer ebib-entry-buffer) + (if (eq ebib-current-field 'crossref) + (progn + (ebib-fill-entry-buffer) + (setq ebib-current-field 'crossref) + (re-search-forward "^crossref") + (ebib-set-fields-highlight)) + (with-buffer-writable + (goto-char (ebib-highlight-start ebib-fields-highlight)) + (let ((beg (point))) + (end-of-line) + (delete-region beg (point))) + (insert (format "%-17s " (symbol-name ebib-current-field)) + (ebib-get-field-highlighted ebib-current-field ebib-cur-entry-hash)) + (ebib-set-fields-highlight)))) + +(defun ebib-redisplay-current-string () + "Redisplays the current string definition in the strings buffer." + (set-buffer ebib-strings-buffer) + (with-buffer-writable + (let ((str (to-raw (gethash ebib-current-string (edb-strings ebib-cur-db))))) + (goto-char (ebib-highlight-start ebib-strings-highlight)) + (let ((beg (point))) + (end-of-line) + (delete-region beg (point))) + (insert (format "%-18s %s" ebib-current-string + (if (multiline-p str) + (concat "+" (first-line str)) + (concat " " str)))) + (ebib-set-strings-highlight)))) + +(defun ebib-move-to-field (field direction) + "Moves the fields overlay to the line containing FIELD. +If DIRECTION is positive, searches forward, if DIRECTION is +negative, searches backward. If DIRECTION is 1 or -1, searches +from POINT, if DIRECTION is 2 or -2, searches from beginning or +end of buffer. If FIELD is not found in the entry buffer, the +overlay is not moved. FIELD must be a symbol." + + ;;Note: this function does NOT change the value of EBIB-CURRENT-FIELD! + + (set-buffer ebib-entry-buffer) + (if (eq field 'type*) + (goto-char (point-min)) + (multiple-value-bind (fn start limit) (if (>= direction 0) + (values 're-search-forward (point-min) (point-max)) + (values 're-search-backward (point-max) (point-min))) + ;; make sure we can get back to our original position, if the field + ;; cannot be found in the buffer: + (let ((current-pos (point))) + (when (eq (logand direction 1) 0) ; if direction is even + (goto-char start)) + (unless (funcall fn (concat "^" (symbol-name field)) limit t) + (goto-char current-pos))))) + (ebib-set-fields-highlight)) + +(defun ebib-create-collection (hashtable) + "Creates a list from the keys in HASHTABLE that can be used as COLLECTION in COMPLETING-READ. +The keys of HASHTABLE must be either symbols or strings." + (let ((result nil)) + (maphash #'(lambda (x y) + (setq result (cons (cons (symbol-or-string x) + 0) + result))) + hashtable) + result)) + +(defun ebib-get-field-value (field entry-key &optional db) + "Returns the value of FIELD in the entry ENTRY-KEY in DB. +Actually returns a list with the value of FIELD as the first +element. The second element is T if the value was obtained from a +cross-referenced entry. + +If DB is nil, it defaults to the current database." + (unless db + (setq db ebib-cur-db)) + (let ((entry (ebib-retrieve-entry entry-key db))) + (if entry + (or + (let ((val (copy-sequence (gethash field entry)))) + (if val + (values val nil))) + (let ((xref (ebib-retrieve-entry (to-raw (gethash 'crossref entry)) db))) + (if xref + (values (gethash field xref) t)))) + (values nil nil)))) + +(defun ebib-get-field-highlighted (field current-entry &optional match-str) + ;; note: we need to work on a copy of the string, otherwise the highlights + ;; are made to the string as stored in the database. hence copy-sequence. + (let ((case-fold-search t) + (string (copy-sequence (gethash field current-entry))) + (raw " ") + (multiline " ") + (matched nil)) + ;; we have to do a couple of things now: + ;; - remove {} or "" around the string, if they're there + ;; - search for match-str + ;; - properly adjust the string if it's multiline + ;; but all this is not necessary if there was no string + (if (null string) + (let* ((xref (to-raw (gethash 'crossref current-entry))) + (xref-entry (ebib-retrieve-entry xref ebib-cur-db))) + (when xref-entry + (setq string (copy-sequence (gethash field xref-entry))) + (if string + (setq string (propertize (to-raw string) 'face 'ebib-crossref-face 'fontified t)) + (setq string "")))) + (if (raw-p string) + (setq raw "*") + (setq string (to-raw string))) ; we have to make the string look nice + (when match-str + (multiple-value-setq (string matched) (match-all match-str string)))) + (when (multiline-p string) + ;; IIUC PROPERTIZE shouldn't be necessary here, as the variable + ;; multiline is local and therefore the object it refers to should + ;; be GC'ed when the function returns. but for some reason, the + ;; plus sign is persistent, and if it's been highlighted as the + ;; result of a search, it stays that way. + (setq multiline (propertize "+" 'face nil)) + (setq string (first-line string))) + (when (and matched + (string= multiline "+")) + (add-text-properties 0 1 '(face highlight) multiline)) + (concat raw multiline string))) + +(defun ebib-format-fields (entry fn &optional match-str) + (let* ((entry-type (gethash 'type* entry)) + (obl-fields (ebib-get-obl-fields entry-type)) + (opt-fields (ebib-get-opt-fields entry-type))) + (funcall fn (format "%-19s %s\n" "type" entry-type)) + (mapc #'(lambda (fields) + (funcall fn "\n") + (mapcar #'(lambda (field) + (unless (and (get field 'ebib-hidden) + ebib-hide-hidden-fields) + (funcall fn (format "%-17s " field)) + (funcall fn (or + (ebib-get-field-highlighted field entry match-str) + "")) + (funcall fn "\n"))) + fields)) + (list obl-fields opt-fields ebib-additional-fields)))) + +(defun ebib-fill-entry-buffer (&optional match-str) + "Fills the entry buffer with the fields of the current entry. +MATCH-STRING is a regexp that will be highlighted when it occurs in the +field contents." + (set-buffer ebib-entry-buffer) + (with-buffer-writable + (erase-buffer) + (when (and ebib-cur-db ; do we have a database? + (edb-keys-list ebib-cur-db) ; does it contain entries? + (gethash (car (edb-cur-entry ebib-cur-db)) + (edb-database ebib-cur-db))) ; does the current entry exist? + (ebib-format-fields (gethash (car (edb-cur-entry ebib-cur-db)) + (edb-database ebib-cur-db)) 'insert match-str) + (setq ebib-current-field 'type*) + (setq ebib-cur-entry-hash (ebib-retrieve-entry (ebib-cur-entry-key) ebib-cur-db)) + (goto-char (point-min)) + (ebib-set-fields-highlight)))) +;; (skip-chars-forward "^ ")))) + +(defun ebib-set-modified (mod &optional db) + "Sets the modified flag of the database DB to MOD. +If DB is nil, it defaults to the current database, and the +modified flag of the index buffer is also (re)set. MOD must be +either T or NIL." + (unless db + (setq db ebib-cur-db)) + (setf (edb-modified db) mod) + (when (eq db ebib-cur-db) + (with-current-buffer ebib-index-buffer + (set-buffer-modified-p mod)))) + +(defun ebib-modified-p () + "Checks if any of the databases in Ebib were modified. +Returns the first modified database, or NIL if none was modified." + (let ((db (car ebib-databases))) + (while (and db + (not (edb-modified db))) + (setq db (next-elem db ebib-databases))) + db)) + +(defun ebib-create-new-database (&optional db) + "Creates a new database instance and returns it. +If DB is set to a database, the new database is a copy of DB." + (let ((new-db + (if (edb-p db) + (copy-edb db) + (make-edb)))) + (setq ebib-databases (append ebib-databases (list new-db))) + new-db)) + +(defun ebib-match-paren-forward (limit) + "Moves forward to the closing parenthesis matching the opening parenthesis at POINT. +This function handles parentheses () and braces {}. Does not +search/move beyond LIMIT. Returns T if a matching parenthesis was +found, NIL otherwise. If point was not at an opening parenthesis +at all, NIL is returned and point is not moved. If point was at +an opening parenthesis but no matching closing parenthesis was +found, an error is logged and point is moved one character +forward to allow parsing to continue." + (cond + ((eq (char-after) ?\{) + (ebib-match-brace-forward limit)) + ((eq (char-after) ?\() + ;; we wrap this in a condition-case because we need to log the error + ;; message outside of the save-restriction, otherwise we get the wrong + ;; line number. + (condition-case nil + (save-restriction + (narrow-to-region (point) limit) + ;; this is really a hack. we want to allow unbalanced parentheses in + ;; field values (bibtex does), so we cannot use forward-list + ;; here. for the same reason, looking for the matching paren by hand + ;; is pretty complicated. however, balanced parentheses can only be + ;; used to enclose entire entries (or @STRINGs or @PREAMBLEs) so we + ;; can be pretty sure we'll find it right before the next @ at the + ;; start of a line, or right before the end of the file. + (re-search-forward "^@" nil 0) + (skip-chars-backward "@ \n\t\f") + (forward-char -1) + (if (eq (char-after) ?\)) + t + (goto-char (1+ (point-min))) + (error ""))) + (error (ebib-log 'error "Error in line %d: Matching closing parenthesis not found!" (line-number-at-pos)) + nil))) + (t nil))) + +(defun ebib-match-delim-forward (limit) + "Moves forward to the closing delimiter matching the opening delimiter at POINT. +This function handles braces {} and double quotes \"\". Does not +search/move beyond LIMIT. Returns T if a matching delimiter was +found, NIL otherwise. If point was not at an opening delimiter at +all, NIL is returned and point is not moved. If point was at an +opening delimiter but no matching closing delimiter was found, an +error is logged and point is moved one character forward to allow +parsing to continue." + (cond + ((eq (char-after) ?\") + (ebib-match-quote-forward limit)) + ((eq (char-after) ?\{) + (ebib-match-brace-forward limit)) + (t nil))) + +(defun ebib-match-brace-forward (limit) + "Moves forward to the closing brace matching the opening brace at POINT. +Does not search/move beyond LIMIT. Returns T if a matching brace +was found, NIL otherwise. If point was not at an opening brace at +all, NIL is returned and point is not moved. If point was at an +opening brace but no matching closing brace was found, an error +is logged and point is moved one character forward to allow +parsing to continue." + (when (eq (char-after) ?\{) ; make sure we're really on a brace, otherwise return nil + (condition-case nil + (save-restriction + (narrow-to-region (point) limit) + (progn + (forward-list) + ;; all of ebib expects that point moves to the closing + ;; parenthesis, not right after it, so we adjust. + (forward-char -1) + t)) ; return t because a matching brace was found + (error (progn + (ebib-log 'error "Error in line %d: Matching closing brace not found!" (line-number-at-pos)) + (forward-char 1) + nil))))) + +(defun ebib-match-quote-forward (limit) + "Moves to the closing double quote matching the quote at POINT. +Does not search/move beyond LIMIT. Returns T if a matching quote +was found, NIL otherwise. If point was not at a double quote at +all, NIL is returned and point is not moved. If point was at a +quote but no matching closing quote was found, an error is logged +and point is moved one character forward to allow parsing to +continue." + (when (eq (char-after (point)) ?\") ; make sure we're on a double quote. + (condition-case nil + (save-restriction + (narrow-to-region (point) limit) + (while (progn + (forward-char) ; move forward because we're on a double quote + (skip-chars-forward "^\"") ; search the next double quote + (eq (char-before) ?\\))) ; if it's preceded by a backslash, keep on searching + (or (eq (char-after) ?\") + (progn + (goto-char (1+ (point-min))) + (error "")))) + (error (ebib-log 'error "Error in line %d: Matching closing quote not found!" (line-number-at-pos)) + nil)))) + +(defun ebib-insert-entry (entry-key fields db &optional sort timestamp) + "Stores the entry defined by ENTRY-KEY and FIELDS into DB. +Optional argument SORT indicates whether the KEYS-LIST must be +sorted after insertion. Default is NIL. Optional argument +TIMESTAMP indicates whether a timestamp is to be added to the +entry. Note that for a timestamp to be added, EBIB-USE-TIMESTAMP +must also be set to T." + (when (and timestamp ebib-use-timestamp) + (puthash 'timestamp (from-raw (format-time-string ebib-timestamp-format)) fields)) + (puthash entry-key fields (edb-database db)) + (ebib-set-modified t db) + (setf (edb-n-entries db) (1+ (edb-n-entries db))) + (setf (edb-keys-list db) + (if sort + (sort (cons entry-key (edb-keys-list db)) 'string<) + (cons entry-key (edb-keys-list db))))) + +(defun ebib-insert-string (abbr string db &optional sort) + "Stores the @STRING definition defined by ABBR and STRING into DB. +Optional argument SORT indicates whether the STRINGS-LIST must be sorted +after insertion. When loading or merging a file, for example, it is more +economic to sort KEYS-LIST manually after all entries in the file have been +added." + (puthash abbr (from-raw string) (edb-strings db)) + (ebib-set-modified t db) + (setf (edb-strings-list db) + (if sort + (sort (cons abbr (edb-strings-list db)) 'string<) + (cons abbr (edb-strings-list db))))) + +(defun ebib-search-key-in-buffer (entry-key) + "Searches ENTRY-KEY in the index buffer. +Moves point to the first character of the key and returns point." + (goto-char (point-min)) + (re-search-forward (concat "^" entry-key)) + (beginning-of-line) + (point)) + +;; when we sort entries, we either use string< on the entry keys, or +;; ebib-entry<, if the user has defined a sort order. + +(defun ebib-entry< (x y) + "Returns T if entry X is smaller than entry Y. +The entries are compared based on the fields listed in EBIB-SORT-ORDER. X +and Y should be keys of entries in the current database." + (let* ((sort-list ebib-sort-order) + (sortstring-x (to-raw (ebib-get-sortstring x (car sort-list)))) + (sortstring-y (to-raw (ebib-get-sortstring y (car sort-list))))) + (while (and sort-list + (string= sortstring-x sortstring-y)) + (setq sort-list (cdr sort-list)) + (setq sortstring-x (to-raw (ebib-get-sortstring x (car sort-list)))) + (setq sortstring-y (to-raw (ebib-get-sortstring y (car sort-list))))) + (if (and sortstring-x sortstring-y) + (string< sortstring-x sortstring-y) + (string< x y)))) + +(defun ebib-get-sortstring (entry-key sortkey-list) + "Returns the field value on which the entry ENTRY-KEY is to be sorted. +ENTRY-KEY must be the key of an entry in the current database. SORTKEY-LIST +is a list of fields that are considered in order for the sort value." + (let ((sort-string nil)) + (while (and sortkey-list + (null (setq sort-string (gethash (car sortkey-list) + (ebib-retrieve-entry entry-key ebib-cur-db))))) + (setq sortkey-list (cdr sortkey-list))) + sort-string)) + +(defvar ebib-info-flag nil "Flag to indicate whether Ebib called Info or not.") + +(defadvice Info-exit (after ebib-info-exit activate) + "Quit info and return to Ebib, if Info was called from there." + (when ebib-info-flag + (setq ebib-info-flag nil) + (ebib))) + +(defun read-file-to-list (filename) + "Return a list of lines from file FILENAME." + (if (and filename ; protect against 'filename' being 'nil' + (file-readable-p filename)) + (with-temp-buffer + (insert-file-contents filename) + (split-string (buffer-string) "\n" t)))) ; 't' is omit nulls, blank lines in this case + +(defun ebib-keywords-load-keywords (db) + "Check if there is a keywords file for DB and make sure it is loaded." + (unless (or (string= ebib-keywords-file "") + (file-name-directory ebib-keywords-file)) + (let ((dir (expand-file-name (file-name-directory (edb-filename db))))) + (if dir + (let ((keyword-list (read-file-to-list (concat dir ebib-keywords-file)))) + ;; note: even if keyword-list is empty, we store it, because the user + ;; may subsequently add keywords. + (add-to-list 'ebib-keywords-files-alist ; add the dir if not in the list yet + (list dir keyword-list nil) ; the extra empty list is for new keywords + t #'(lambda (x y) (equal (car x) (car y))))))))) + +(defun ebib-keywords-add-keyword (keyword db) + "Add KEYWORD to the list of keywords for DB." + (if (string= ebib-keywords-file "") ; only the general list exists + (add-to-list 'ebib-keywords-list-per-session keyword t) + (let ((dir (or (file-name-directory ebib-keywords-file) ; a single keywords file + (file-name-directory (edb-filename db))))) ; per-directory keywords files + (push keyword (third (assoc dir ebib-keywords-files-alist)))))) + +(defun ebib-keywords-for-database (db) + "Return the list of keywords for database DB. +When the keywords come from a file, add the keywords in +EBIB-KEYWORDS-LIST, unless EBIB-KEYWORDS-USE-ONLY-FILE is set." + (if (string= ebib-keywords-file "") ; only the general list exists + ebib-keywords-list-per-session + (let* ((dir (or (file-name-directory ebib-keywords-file) ; a single keywords file + (file-name-directory (edb-filename db)))) ; per-directory keywords files + (lst (assoc dir ebib-keywords-files-alist))) + (append (second lst) (third lst))))) + +(defun ebib-keywords-get-file (db) + "Return the name of the keywords file for DB." + (if (file-name-directory ebib-keywords-file) + ebib-keywords-file + (concat (file-name-directory (edb-filename db)) ebib-keywords-file))) + +(defun ebib-keywords-save-to-file (keyword-file-descr) + "Save all keywords in KEYWORD-FILE-DESCR to the associated file. +KEYWORD-FILE-DESCR is an element of EBIB-KEYWORDS-FILES-ALIST, +that is, it consists of a list of three elements, the first is +the directory of the keywords file, the second the existing +keywords and the third the keywords added in this session." + (let ((file (if (file-name-directory ebib-keywords-file) + ebib-keywords-file + (concat (car keyword-file-descr) ebib-keywords-file)))) + (if (file-writable-p file) + (with-temp-buffer + (mapc #'(lambda (keyword) + (insert (format "%s\n" keyword))) + (append (second keyword-file-descr) (third keyword-file-descr))) + (write-region (point-min) (point-max) file)) + (ebib-log 'warning "Could not write to keyword file `%s'" file)))) + +(defun ebib-keywords-save-new-keywords (db) + "Check if new keywords were added to DB and save them as required." + (let ((lst (ebib-keywords-new-p db)) + (file (ebib-keywords-get-file db))) + (when (and (third lst) ; if there are new keywords + (or (eq ebib-keywords-file-save-on-exit 'always) + (and (eq ebib-keywords-file-save-on-exit 'ask) + (y-or-n-p "New keywords have been added. Save ")))) + (ebib-keywords-save-to-file lst) + ;; now move the new keywords to the list of existing keywords + (setf (cadr lst) (append (second lst) (third lst))) + (setf (caddr lst) nil)))) + +(defun ebib-keywords-save-cur-db () + "Save new keywords for the current database." + (interactive) + (ebib-keywords-save-new-keywords ebib-cur-db)) + +(defun ebib-keywords-new-p (&optional db) + "Check whether there are new keywords. +Returns NIL if there are no new keywords, or a list containing +all the elements in EBIB-KEYWORDS-FILES-ALIST that contain new +keywords. + +Optional argument DB specifies the database to check for." + (if db + (let* ((dir (or (file-name-directory ebib-keywords-file) ; a single keywords file + (file-name-directory (edb-filename db)))) ; per-directory keywords files + (lst (assoc dir ebib-keywords-files-alist))) + (if (third lst) + lst)) + (delq nil (mapcar #'(lambda (elt) ; this would be easier with cl-remove + (if (third elt) + elt)) + ebib-keywords-files-alist)))) + +(defun ebib-keywords-save-all-new () + "Check if new keywords were added during the session and save them as required." + (interactive) + (let ((new (ebib-keywords-new-p))) + (when (and new + (or (eq ebib-keywords-file-save-on-exit 'always) + (ebib-called-interactively) + (and (eq ebib-keywords-file-save-on-exit 'ask) + (y-or-n-p (format "New keywords were added. Save '%s'? " + (file-name-nondirectory ebib-keywords-file)))))) ; strip path for succinctness + (mapc #'(lambda (elt) + (ebib-keywords-save-to-file elt)) + new)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; main program execution ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;###autoload +(defun ebib (&optional key) + "Ebib, a BibTeX database manager. +Optional argument key specifies the entry of the current database +that is to be displayed." + (interactive) + (if (or (equal (window-buffer) ebib-index-buffer) + (equal (window-buffer) ebib-entry-buffer)) + (error "Ebib already active") + ;; we save the buffer from which ebib is called + (setq ebib-push-buffer (current-buffer)) + ;; initialize ebib if required + (unless ebib-initialized + (ebib-init) + (if ebib-preload-bib-files + (mapc #'(lambda (file) + (ebib-load-bibtex-file (locate-file file ebib-preload-bib-search-dirs))) + ebib-preload-bib-files))) + ;; if ebib is visible, we just switch to the index buffer + (let ((index-window (get-buffer-window ebib-index-buffer))) + (if index-window + (select-window index-window nil) + (ebib-setup-windows))) + ;; if ebib is called with an argument, we look for it + (when key + (let ((exists? (member key (edb-keys-list ebib-cur-db)))) + (if exists? + (progn + (setf (edb-cur-entry ebib-cur-db) exists?) + (set-buffer ebib-index-buffer) + (goto-char (point-min)) + (re-search-forward (format "^%s " (ebib-cur-entry-key))) + (ebib-select-entry)) + (message "No entry `%s' in current database " key)))))) + +(defun ebib-setup-windows () + "Creates the window configuration we want for Ebib in the +current window." + ;; we save the current window configuration. + (setq ebib-saved-window-config (current-window-configuration)) + (if (eq ebib-layout 'full) + (delete-other-windows) + (setq ebib-pre-ebib-window (selected-window)) + (let ((ebib-window (split-window (selected-window) (- (window-width) ebib-width) t))) + (select-window ebib-window nil))) + (let* ((index-window (selected-window)) + (entry-window (split-window index-window ebib-index-window-size))) + (switch-to-buffer ebib-index-buffer) + (set-window-buffer entry-window ebib-entry-buffer) + (unless (eq ebib-layout 'full) + (set-window-dedicated-p index-window t) + (set-window-dedicated-p entry-window t)))) + +(defun ebib-init () + "Initialises Ebib. +This function sets all variables to their initial values, creates the +buffers and reads the rc file." + (setq ebib-cur-entry-hash nil + ebib-current-field nil + ebib-minibuf-hist nil + ebib-saved-window-config nil) + (put 'timestamp 'ebib-hidden t) + (load "~/.ebibrc" t) + (ebib-create-buffers) + (if (file-name-directory ebib-keywords-file) ; returns nil if there is no directory part + (add-to-list 'ebib-keywords-files-alist (list (file-name-directory ebib-keywords-file) + (read-file-to-list ebib-keywords-file) nil))) + (setq ebib-keywords-list-per-session (copy-tree ebib-keywords-list)) + (setq ebib-index-highlight (ebib-make-highlight 1 1 ebib-index-buffer)) + (setq ebib-fields-highlight (ebib-make-highlight 1 1 ebib-entry-buffer)) + (setq ebib-strings-highlight (ebib-make-highlight 1 1 ebib-strings-buffer)) + (setq ebib-initialized t)) + +(defun ebib-create-buffers () + "Creates the buffers for Ebib." + ;; first we create a buffer for multiline editing. this one does *not* + ;; have a name beginning with a space, because undo-info is normally + ;; present in an edit buffer. + (setq ebib-multiline-buffer (get-buffer-create "*Ebib-edit*")) + (set-buffer ebib-multiline-buffer) + (funcall ebib-multiline-major-mode) + (ebib-multiline-mode t) + ;; then we create a buffer to hold the fields of the current entry. + (setq ebib-entry-buffer (get-buffer-create " *Ebib-entry*")) + (set-buffer ebib-entry-buffer) + (ebib-entry-mode) + ;; then we create a buffer to hold the @STRING definitions + (setq ebib-strings-buffer (get-buffer-create " *Ebib-strings*")) + (set-buffer ebib-strings-buffer) + (ebib-strings-mode) + ;; the log buffer + (setq ebib-log-buffer (get-buffer-create " *Ebib-log*")) + (set-buffer ebib-log-buffer) + (erase-buffer) + (insert "Ebib log messages\n\n(Press C-v or SPACE to scroll down, M-v or `b' to scroll up, `q' to quit.)\n\n") + (ebib-log-mode) + ;; and lastly we create a buffer for the entry keys. + (setq ebib-index-buffer (get-buffer-create " none")) + (set-buffer ebib-index-buffer) + (ebib-index-mode)) + +(defun ebib-quit () + "Quits Ebib. +The Ebib buffers are killed, all variables except the keymaps are set to nil." + (interactive) + (when (if (ebib-modified-p) + (yes-or-no-p "There are modified databases. Quit anyway? ") + (y-or-n-p "Quit Ebib? ")) + (ebib-keywords-save-all-new) + (mapc #'(lambda (buffer) + (kill-buffer buffer)) + (list ebib-entry-buffer + ebib-index-buffer + ebib-strings-buffer + ebib-multiline-buffer + ebib-log-buffer)) + (setq ebib-databases nil + ebib-index-buffer nil + ebib-entry-buffer nil + ebib-initialized nil + ebib-index-highlight nil + ebib-fields-highlight nil + ebib-strings-highlight nil + ebib-export-filename nil + ebib-pre-ebib-window nil + ebib-keywords-files-alist nil + ebib-keywords-list-per-session nil) + (set-window-configuration ebib-saved-window-config) + (message ""))) + +(defun ebib-kill-emacs-query-function () + "Ask if the user wants to save any modified databases and added +keywords when Emacs is killed." + (when (or (not (ebib-modified-p)) + (if (y-or-n-p "Save all unsaved Ebib databases? ") + (progn + (ebib-save-all-databases) + t) + (yes-or-no-p "Ebib holds modified databases. Kill anyway? "))) + (ebib-keywords-save-all-new) + t)) + +(add-hook 'kill-emacs-query-functions 'ebib-kill-emacs-query-function) + +;;;;;;;;;;;;;;;; +;; index-mode ;; +;;;;;;;;;;;;;;;; + +(eval-and-compile + (define-prefix-command 'ebib-prefix-map) + (suppress-keymap ebib-prefix-map) + (defvar ebib-prefixed-functions '(ebib-delete-entry + ebib-latex-entries + ebib-mark-entry + ebib-print-entries + ebib-push-bibtex-key + ebib-export-entry))) + +;; macro to redefine key bindings. + +(defmacro ebib-key (buffer key &optional command) + (cond + ((eq buffer 'index) + (let ((one `(define-key ebib-index-mode-map ,key (quote ,command))) + (two (when (or (null command) + (member command ebib-prefixed-functions)) + `(define-key ebib-prefix-map ,key (quote ,command))))) + (if two + `(progn ,one ,two) + one))) + ((eq buffer 'entry) + `(define-key ebib-entry-mode-map ,key (quote ,command))) + ((eq buffer 'strings) + `(define-key ebib-strings-mode-map ,key (quote ,command))) + ((eq buffer 'mark-prefix) + `(progn + (define-key ebib-index-mode-map (format "%c" ebib-prefix-key) nil) + (define-key ebib-index-mode-map ,key 'ebib-prefix-map) + (setq ebib-prefix-key (string-to-char ,key)))) + ((eq buffer 'multiline) + `(progn + (define-key ebib-multiline-mode-map "\C-c" nil) + (mapc #'(lambda (command) + (define-key ebib-multiline-mode-map (format "\C-c%s%c" ,key (car command)) (cdr command))) + '((?q . ebib-quit-multiline-edit) + (?c . ebib-cancel-multiline-edit) + (?s . ebib-save-from-multiline-edit))) + (setq ebib-multiline-key (string-to-char ,key)))))) + +(defvar ebib-index-mode-map + (let ((map (make-keymap))) + (suppress-keymap map) + map) + "Keymap for the ebib index buffer.") + +;; we define the keys with ebib-key rather than with define-key, because +;; that automatically sets up ebib-prefix-map as well. +(ebib-key index [up] ebib-prev-entry) +(ebib-key index [down] ebib-next-entry) +(ebib-key index [right] ebib-next-database) +(ebib-key index [left] ebib-prev-database) +(ebib-key index [prior] ebib-index-scroll-down) +(ebib-key index [next] ebib-index-scroll-up) +(ebib-key index [home] ebib-goto-first-entry) +(ebib-key index [end] ebib-goto-last-entry) +(ebib-key index [return] ebib-select-entry) +(ebib-key index " " ebib-index-scroll-up) +(ebib-key index "/" ebib-search) +(ebib-key index "&" ebib-virtual-db-and) +(ebib-key index "|" ebib-virtual-db-or) +(ebib-key index "~" ebib-virtual-db-not) +(ebib-key index ";" ebib-prefix-map) +(ebib-key index "?" ebib-info) +(ebib-key index "a" ebib-add-entry) +(ebib-key index "b" ebib-index-scroll-down) +(ebib-key index "c" ebib-close-database) +(ebib-key index "d" ebib-delete-entry) +(ebib-key index "e" ebib-edit-entry) +(ebib-key index "E" ebib-edit-keyname) +(ebib-key index "f" ebib-view-file) +(ebib-key index "F" ebib-follow-crossref) +(ebib-key index "g" ebib-goto-first-entry) +(ebib-key index "G" ebib-goto-last-entry) +(ebib-key index "h" ebib-index-help) +(ebib-key index "i" ebib-browse-doi) +(ebib-key index "j" ebib-next-entry) +(ebib-key index "J" ebib-switch-to-database) +(ebib-key index "k" ebib-prev-entry) +(ebib-key index "K" ebib-generate-autokey) +(ebib-key index "l" ebib-show-log) +(ebib-key index "m" ebib-mark-entry) +(ebib-key index "n" ebib-search-next) +(ebib-key index "N" ebib-search-crossref) +(ebib-key index [(control n)] ebib-next-entry) +(ebib-key index [(meta n)] ebib-index-scroll-up) +(ebib-key index "o" ebib-load-bibtex-file) +(ebib-key index "p" ebib-push-bibtex-key) +(ebib-key index [(control p)] ebib-prev-entry) +(ebib-key index [(meta p)] ebib-index-scroll-down) +(ebib-key index "P" ebib-edit-preamble) +(ebib-key index "q" ebib-quit) +(ebib-key index "s" ebib-save-current-database) +(ebib-key index "S" ebib-edit-strings) +(ebib-key index "u" ebib-browse-url) +(ebib-key index "V" ebib-print-filter) +(ebib-key index "x" ebib-export-entry) +(ebib-key index "\C-xb" ebib-leave-ebib-windows) +(ebib-key index "\C-xk" ebib-quit) +(ebib-key index "X" ebib-export-preamble) +(ebib-key index "z" ebib-leave-ebib-windows) +(ebib-key index "Z" ebib-lower) + +(defun ebib-switch-to-database-nth (key) + (interactive (list (if (featurep 'xemacs) + (event-key last-command-event) + last-command-event))) + (ebib-switch-to-database (- (if (featurep 'xemacs) + (char-to-int key) + key) 48))) + +(mapc #'(lambda (key) + (define-key ebib-index-mode-map (format "%d" key) + 'ebib-switch-to-database-nth)) + '(1 2 3 4 5 6 7 8 9)) + +(define-derived-mode ebib-index-mode + fundamental-mode "Ebib-index" + "Major mode for the Ebib index buffer." + (setq buffer-read-only t) + (setq truncate-lines t)) + +(easy-menu-define ebib-index-menu ebib-index-mode-map "Ebib index menu" + '("Ebib" + ["Open Database..." ebib-load-bibtex-file t] + ["Merge Database..." ebib-merge-bibtex-file (and ebib-cur-db (not (edb-virtual ebib-cur-db)))] + ["Save Database" ebib-save-current-database (and ebib-cur-db + (edb-modified ebib-cur-db))] + ["Save All Databases" ebib-save-all-databases (ebib-modified-p)] + ["Save Database As..." ebib-write-database ebib-cur-db] + ["Close Database" ebib-close-database ebib-cur-db] + "--" + ["Save New Keywords For Database" ebib-keywords-save-cur-db (ebib-keywords-new-p ebib-cur-db)] + ["Save All New Keywords" ebib-keywords-save-all-new (ebib-keywords-new-p)] + "--" + ("Entry" + ["Add" ebib-add-entry (and ebib-cur-db (not (edb-virtual ebib-cur-db)))] + ["Edit" ebib-edit-entry (and ebib-cur-db + (edb-cur-entry ebib-cur-db) + (not (edb-virtual ebib-cur-db)))] + ["Delete" ebib-delete-entry (and ebib-cur-db + (edb-cur-entry ebib-cur-db) + (not (edb-virtual ebib-cur-db)))]) + ["Edit Strings" ebib-edit-strings (and ebib-cur-db (not (edb-virtual ebib-cur-db)))] + ["Edit Preamble" ebib-edit-preamble (and ebib-cur-db (not (edb-virtual ebib-cur-db)))] + "--" + ["Open URL" ebib-browse-url (gethash ebib-standard-url-field ebib-cur-entry-hash)] + ["Open DOI" ebib-browse-doi (gethash ebib-standard-doi-field ebib-cur-entry-hash)] + ["View File" ebib-view-file (gethash ebib-standard-file-field ebib-cur-entry-hash)] + ("Print Entries" + ["As Bibliography" ebib-latex-entries (and ebib-cur-db (not (edb-virtual ebib-cur-db)))] + ["As Index Cards" ebib-print-entries ebib-cur-db] + ["Print Multiline Fields" ebib-toggle-print-multiline :enable t + :style toggle :selected ebib-print-multiline] + ["Print Cards on Separate Pages" ebib-toggle-print-newpage :enable t + :style toggle :selected ebib-print-newpage]) + "--" + ("Options" + ["Show Hidden Fields" ebib-toggle-hidden :enable t + :style toggle :selected (not ebib-hide-hidden-fields)] + ["Use Timestamp" ebib-toggle-timestamp :enable t + :style toggle :selected ebib-use-timestamp] + ["Save Cross-Referenced Entries First" ebib-toggle-xrefs-first :enable t + :style toggle :selected ebib-save-xrefs-first] + ["Allow Identical Fields" ebib-toggle-identical-fields :enable t + :style toggle :selected ebib-allow-identical-fields] + ["Full Layout" ebib-toggle-layout :enable t + :style toggle :selected (eq ebib-layout 'full)] + ["Modify Entry Types" ebib-customize-entry-types t] + ["Customize Ebib" ebib-customize t]) + ["View Log Buffer" ebib-show-log t] + ["Lower Ebib" ebib-lower t] + ["Quit" ebib-quit t] + ["Help on Ebib" ebib-info t])) + +(easy-menu-add ebib-index-menu ebib-index-mode-map) + +(defun ebib-fill-index-buffer () + "Fills the index buffer with the list of keys in EBIB-CUR-DB. +If EBIB-CUR-DB is nil, the buffer is just erased and its name set +to \"none\"." + (set-buffer ebib-index-buffer) + (let ((buffer-read-only nil)) + (erase-buffer) + (if ebib-cur-db + (progn + ;; we may call this function when there are no entries in the + ;; database. if so, we don't need to do this: + (when (edb-cur-entry ebib-cur-db) + (mapc #'(lambda (entry) + (ebib-display-entry entry) + (when (member entry (edb-marked-entries ebib-cur-db)) + (save-excursion + (let ((beg (progn + (beginning-of-line) + (forward-line -1) + (point)))) + (skip-chars-forward "^ ") + (add-text-properties beg (point) '(face ebib-marked-face)))))) + (edb-keys-list ebib-cur-db)) + (goto-char (point-min)) + (re-search-forward (format "^%s " (ebib-cur-entry-key))) + (beginning-of-line) + (ebib-set-index-highlight)) + (set-buffer-modified-p (edb-modified ebib-cur-db)) + (rename-buffer (concat (format " %d:" (1+ (- (length ebib-databases) + (length (member ebib-cur-db ebib-databases))))) + (edb-name ebib-cur-db)))) + (rename-buffer " none")))) + +(defun ebib-customize () + "Switches to Ebib's customisation group." + (interactive) + (ebib-lower) + (customize-group 'ebib)) + +(defun ebib-customize-entry-types () + "Customizes EBIB-ENTRY-TYPES." + (interactive) + (ebib-lower) + (customize-variable 'ebib-entry-types)) + +(defun ebib-log (type format-string &rest args) + "Writes a message to Ebib's log buffer. +TYPE (a symbol) is the type of message. It can be LOG, which +writes the message to the log buffer only; MESSAGE, which writes +the message to the log buffer and outputs it with the function +MESSAGE; WARNING, which logs the message and sets the variable +EBIB-LOG-ERROR to 0; or ERROR, which logs the message and sets +the variable EBIB-LOG-ERROR to 1. The latter two can be used to +signal the user to check the log for warnings or errors. + +This function adds a newline to the message being logged." + (with-current-buffer ebib-log-buffer + (cond + ((eq type 'warning) + (or ebib-log-error ; if ebib-error-log is already set to 1, we don't want to overwrite it! + (setq ebib-log-error 0))) + ((eq type 'error) + (setq ebib-log-error 1)) + ((eq type 'message) + (apply 'message format-string args))) + (insert (apply 'format (concat format-string "\n") args)))) + +(defun ebib-load-bibtex-file (&optional file) + "Loads a BibTeX file into Ebib." + (interactive) + (unless file + (setq file (ensure-extension (read-file-name "File to open: " "~/") "bib"))) + (setq ebib-cur-db (ebib-create-new-database)) + (setf (edb-filename ebib-cur-db) (expand-file-name file)) + (setf (edb-name ebib-cur-db) (file-name-nondirectory (edb-filename ebib-cur-db))) + (setq ebib-log-error nil) ; we haven't found any errors + (ebib-log 'log "%s: Opening file %s" (format-time-string "%d %b %Y, %H:%M:%S") (edb-filename ebib-cur-db)) + ;; first, we empty the buffers + (ebib-erase-buffer ebib-index-buffer) + (ebib-erase-buffer ebib-entry-buffer) + (if (file-readable-p file) + ;; if the user entered the name of an existing file, we load it + ;; by putting it in a buffer and then parsing it. + (with-temp-buffer + (with-syntax-table ebib-syntax-table + (insert-file-contents file) + ;; if the user makes any changes, we'll want to create a back-up. + (setf (edb-make-backup ebib-cur-db) t) + (let ((result (ebib-find-bibtex-entries nil))) + (setf (edb-n-entries ebib-cur-db) (car result)) + (when (edb-keys-list ebib-cur-db) + (setf (edb-keys-list ebib-cur-db) (sort (edb-keys-list ebib-cur-db) 'string<))) + (when (edb-strings-list ebib-cur-db) + (setf (edb-strings-list ebib-cur-db) (sort (edb-strings-list ebib-cur-db) 'string<))) + (setf (edb-cur-entry ebib-cur-db) (edb-keys-list ebib-cur-db)) + ;; and fill the buffers. note that filling a buffer also makes + ;; that buffer active. therefore we do EBIB-FILL-INDEX-BUFFER + ;; later. + (ebib-set-modified nil) + (ebib-fill-entry-buffer) + ;; and now we tell the user the result + (ebib-log 'message "%d entries, %d @STRINGs and %s @PREAMBLE found in file." + (car result) + (cadr result) + (if (caddr result) + "a" + "no"))))) + ;; if the file does not exist, we need to issue a message. + (ebib-log 'message "(New file)")) + ;; add keywords for the new database + (ebib-keywords-load-keywords ebib-cur-db) + (if ebib-keywords-files-alist + (ebib-log 'log "Using keywords from %s." (ebib-keywords-get-file ebib-cur-db)) + (ebib-log 'log "Using general keyword list.")) + ;; fill the index buffer. (this even works if there are no keys + ;; in the database, for example when the user opened a new file + ;; or if no BibTeX entries were found. + (ebib-fill-index-buffer) + (when ebib-log-error + (message "%s found! Press `l' to check Ebib log buffer." (nth ebib-log-error '("Warnings" "Errors")))) + (ebib-log 'log "")) ; this adds a newline to the log buffer + +(defun ebib-merge-bibtex-file () + "Merges a BibTeX file into the database." + (interactive) + (unless (edb-virtual ebib-cur-db) + (if (not ebib-cur-db) + (error "No database loaded. Use `o' to open a database") + (let ((file (read-file-name "File to merge: "))) + (setq ebib-log-error nil) ; we haven't found any errors + (ebib-log 'log "%s: Merging file %s" (format-time-string "%d-%b-%Y: %H:%M:%S") (edb-filename ebib-cur-db)) + (with-temp-buffer + (with-syntax-table ebib-syntax-table + (insert-file-contents file) + (let ((n (ebib-find-bibtex-entries t))) + (setf (edb-keys-list ebib-cur-db) (sort (edb-keys-list ebib-cur-db) 'string<)) + (setf (edb-n-entries ebib-cur-db) (length (edb-keys-list ebib-cur-db))) + (when (edb-strings-list ebib-cur-db) + (setf (edb-strings-list ebib-cur-db) (sort (edb-strings-list ebib-cur-db) 'string<))) + (setf (edb-cur-entry ebib-cur-db) (edb-keys-list ebib-cur-db)) + (ebib-fill-entry-buffer) + (ebib-fill-index-buffer) + (ebib-set-modified t) + (ebib-log 'message "%d entries, %d @STRINGs and %s @PREAMBLE found in file." + (car n) + (cadr n) + (if (caddr n) + "a" + "no")) + (when ebib-log-error + (message "%s found! Press `l' to check Ebib log buffer." (nth ebib-log-error '("Warnings" "Errors")))) + (ebib-log 'log "")))))))) ; this adds a newline to the log buffer + +(defun ebib-find-bibtex-entries (timestamp) + "Finds the BibTeX entries in the current buffer. +The search is started at the beginnig of the buffer. All entries +found are stored in the hash table DATABASE of +EBIB-CUR-DB. Returns a three-element list: the first element is +the number of entries found, the second the number of @STRING +definitions, and the third is T or NIL, indicating whether a +@PREAMBLE was found. + +TIMESTAMP indicates whether a timestamp is to be added to each +entry. Note that a timestamp is only added if EBIB-USE-TIMESTAMP +is set to T." + (let ((n-entries 0) + (n-strings 0) + (preamble nil)) + (goto-char (point-min)) + (while (re-search-forward "^@" nil t) ; find the next entry + (let ((beg (point))) + (when (looking-at-goto-end (concat "\\(" ebib-bibtex-identifier "\\)[[:space:]]*[\(\{]") 1) + (let ((entry-type (downcase (buffer-substring-no-properties beg (point))))) + (looking-at-goto-end "[[:space:]]*[\(\{]") + (cond + ((equal entry-type "string") ; string and preamble must be treated differently + (if (ebib-read-string) + (setq n-strings (1+ n-strings)))) + ((equal entry-type "preamble") + (when (ebib-read-preamble) + (setq preamble t))) + ((equal entry-type "comment") ; ignore comments + (ebib-log 'log "Comment at line %d ignored" (line-number-at-pos)) + (ebib-match-paren-forward (point-max))) + ((assoc (intern-soft entry-type) ebib-entry-types) ; if the entry type has been defined + (if (ebib-read-entry entry-type timestamp) + (setq n-entries (1+ n-entries)))) + ;; anything else we report as an unknown entry type. + (t (ebib-log 'warning "Line %d: Unknown entry type `%s'. Skipping." (line-number-at-pos) entry-type) + (ebib-match-paren-forward (point-max)))))))) + (list n-entries n-strings preamble))) + +(defun ebib-read-string () + "Reads the @STRING definition beginning at the line POINT is on. +If a proper abbreviation and string are found, they are stored in the +database. Returns the string if one was read, nil otherwise." + (let ((limit (save-excursion ; we find the matching end parenthesis + (backward-char) + (ebib-match-paren-forward (point-max)) + (point)))) + (skip-chars-forward "\"#%'(),={} \n\t\f" limit) + (let ((beg (point))) + (when (looking-at-goto-end (concat "\\(" ebib-bibtex-identifier "\\)[ \t\n\f]*=") 1) + (if-str (abbr (buffer-substring-no-properties beg (point))) + (progn + (skip-chars-forward "^\"{" limit) + (let ((beg (point))) + (if-str (string (if (ebib-match-delim-forward limit) + (buffer-substring-no-properties beg (1+ (point))) + nil)) + (if (member abbr (edb-strings-list ebib-cur-db)) + (ebib-log 'warning (format "Line %d: @STRING definition `%s' duplicated. Skipping." + (line-number-at-pos) abbr)) + (ebib-insert-string abbr string ebib-cur-db)))))))))) + +(defun ebib-read-preamble () + "Reads the @PREAMBLE definition and stores it in EBIB-PREAMBLE. +If there was already another @PREAMBLE definition, the new one is +added to the existing one with a hash sign `#' between them." + (let ((beg (point))) + (forward-char -1) + (when (ebib-match-paren-forward (point-max)) + (let ((text (buffer-substring-no-properties beg (point)))) + (if (edb-preamble ebib-cur-db) + (setf (edb-preamble ebib-cur-db) (concat (edb-preamble ebib-cur-db) "\n# " text)) + (setf (edb-preamble ebib-cur-db) text)))))) + +(defun ebib-read-entry (entry-type &optional timestamp) + "Reads a BibTeX entry and stores it in DATABASE of EBIB-CUR-DB. +Returns the new EBIB-KEYS-LIST if an entry was found, nil +otherwise. Optional argument TIMESTAMP indicates whether a +timestamp is to be added. (Whether a timestamp is actually added, +also depends on EBIB-USE-TIMESTAMP.)" + (let ((entry-limit (save-excursion + (backward-char) + (ebib-match-paren-forward (point-max)) + (point))) + (beg (progn + (skip-chars-forward " \n\t\f") ; note the space! + (point)))) + (when (looking-at-goto-end (concat "\\(" + ebib-bibtex-identifier + "\\)[ \t\n\f]*,") + 1) ; this delimits the entry key + (let ((entry-key (buffer-substring-no-properties beg (point)))) + (if (member entry-key (edb-keys-list ebib-cur-db)) + (ebib-log 'warning "Line %d: Entry `%s' duplicated. Skipping." (line-number-at-pos) entry-key) + (let ((fields (ebib-find-bibtex-fields (intern-soft entry-type) entry-limit))) + (when fields ; if fields were found, we store them, and return T. + (ebib-insert-entry entry-key fields ebib-cur-db nil timestamp) + t))))))) + +(defun ebib-find-bibtex-fields (entry-type limit) + "Finds the fields of the BibTeX entry that starts on the line POINT is on. +Returns a hash table containing all the fields and values, or NIL +if none were found. ENTRY-TYPE is the type of the entry, which +will be recorded in the hash table. Before the search starts, +POINT is moved back to the beginning of the line." + (beginning-of-line) + ;; we assign a function to fn in order to avoid putting the test on + ;; ebib-allow-identical-fields in the while loop, where it would get + ;; tested with every field being read. + (let ((fn (if (not ebib-allow-identical-fields) + (symbol-function 'puthash) + #'(lambda (field-type field-contents fields) + (let ((existing-contents (gethash field-type fields))) + (puthash field-type (if existing-contents + (from-raw (concat (to-raw existing-contents) + ebib-keywords-separator + (to-raw field-contents))) + field-contents) + fields)))))) + (let ((fields (make-hash-table :size 15))) + (while (progn + (skip-chars-forward "^," limit) ; we must move to the next comma, + (eq (char-after) ?,)) ; and make sure we are really on a comma. + (skip-chars-forward "\"#%'(),={} \n\t\f" limit) + (let ((beg (point))) + (when (looking-at-goto-end (concat "\\(" ebib-bibtex-identifier "\\)[ \t\n\f]*=") 1) + (let ((field-type (intern (downcase (buffer-substring-no-properties beg (point)))))) + (unless (eq field-type 'type*) ; the 'type*' key holds the entry type, so we can't use it + (let ((field-contents (ebib-read-field-contents limit))) + (when field-contents + (funcall fn field-type field-contents fields)))))))) + (when (> (hash-table-count fields) 0) + (puthash 'type* entry-type fields) + fields)))) + +(defun ebib-read-field-contents (limit) + "Reads the contents of a BibTeX field from a .bib file. +LIMIT indicates the end of the entry, beyond which the function will not +search." + (skip-chars-forward "#%'(),=} \n\t\f" limit) + (let ((beg (point))) + (buffer-substring-no-properties beg (ebib-find-end-of-field limit)))) + +(defun ebib-find-end-of-field (limit) + "Moves POINT to the end of a field's contents and returns POINT. +The contents of a field is delimited by a comma or by the closing brace of +the entry. The latter is at position LIMIT." + (while (and (not (eq (char-after) ?\,)) + (< (point) limit)) + (ebib-match-delim-forward limit) ; check if we're on a delimiter and if so, jump to the matching closing delimiter + (forward-char 1)) + (if (= (point) limit) + (skip-chars-backward " \n\t\f")) + (point)) + +(defun ebib-leave-ebib-windows () + "Leaves the Ebib windows, lowering them if necessary." + (interactive) + (ebib-lower t)) + +(defun ebib-lower (&optional soft) + "Hides the Ebib windows. +If optional argument SOFT is non-nil, just switch to a non-Ebib +buffer if Ebib is not occupying the entire frame." + (interactive) + (unless (member (window-buffer) (list ebib-index-buffer + ebib-entry-buffer + ebib-strings-buffer + ebib-multiline-buffer + ebib-log-buffer)) + (error "Ebib is not active ")) + (if (and soft + (not (eq ebib-layout 'full))) + (select-window ebib-pre-ebib-window nil) + (set-window-configuration ebib-saved-window-config)) + (mapc #'(lambda (buffer) + (bury-buffer buffer)) + (list ebib-index-buffer + ebib-entry-buffer + ebib-strings-buffer + ebib-multiline-buffer + ebib-log-buffer))) + +(defun ebib-prev-entry () + "Moves to the previous BibTeX entry." + (interactive) + (ebib-execute-when + ((entries) + ;; if the current entry is the first entry, + (if (eq (edb-cur-entry ebib-cur-db) (edb-keys-list ebib-cur-db)) + (beep) ; just beep. + (setf (edb-cur-entry ebib-cur-db) (last (edb-keys-list ebib-cur-db) + (1+ (length (edb-cur-entry ebib-cur-db))))) + (goto-char (ebib-highlight-start ebib-index-highlight)) + (forward-line -1) + (ebib-set-index-highlight) + (ebib-fill-entry-buffer))) + ((default) + (beep)))) + +(defun ebib-next-entry () + "Moves to the next BibTeX entry." + (interactive) + (ebib-execute-when + ((entries) + (if (= (length (edb-cur-entry ebib-cur-db)) 1) ; if we're on the last entry, + (beep) ; just beep. + (setf (edb-cur-entry ebib-cur-db) + (last (edb-keys-list ebib-cur-db) (1- (length (edb-cur-entry ebib-cur-db))))) + (goto-char (ebib-highlight-start ebib-index-highlight)) + (forward-line 1) + (ebib-set-index-highlight) + (ebib-fill-entry-buffer))) + ((default) + (beep)))) + +(defun ebib-add-entry () + "Adds a new entry to the database." + (interactive) + (ebib-execute-when + ((real-db) + (if-str (entry-key (if ebib-autogenerate-keys + "<new-entry>" + (read-string "New entry key: "))) + (progn + (if (member entry-key (edb-keys-list ebib-cur-db)) + (if ebib-uniquify-keys + (setq entry-key (ebib-uniquify-key entry-key)) + (error "Key already exists"))) + (set-buffer ebib-index-buffer) + (sort-in-buffer (1+ (edb-n-entries ebib-cur-db)) entry-key) + ;; we create the hash table *before* the call to + ;; ebib-display-entry, because that function refers to the + ;; hash table if ebib-index-display-fields is set. + (let ((fields (make-hash-table))) + (puthash 'type* ebib-default-type fields) + (ebib-insert-entry entry-key fields ebib-cur-db t t)) + (with-buffer-writable + (ebib-display-entry entry-key)) + (forward-line -1) ; move one line up to position the cursor on the new entry. + (ebib-set-index-highlight) + (setf (edb-cur-entry ebib-cur-db) (member entry-key (edb-keys-list ebib-cur-db))) + (ebib-fill-entry-buffer) + (ebib-edit-entry) + (ebib-set-modified t)))) + ((no-database) + (error "No database open. Use `o' to open a database first")) + ((default) + (beep)))) + +(defun ebib-uniquify-key (key) + "Creates a unique key from KEY." + (let* ((suffix ?b) + (unique-key (concat key (list suffix)))) + (while (member unique-key (edb-keys-list ebib-cur-db)) + (setq suffix (1+ suffix)) + (setq unique-key (concat key (list suffix)))) + unique-key)) + +(defun ebib-generate-autokey () + "Automatically generate a key for the current entry. +This function uses the function BIBTEX-GENERATE-AUTOKEY to +generate the key, see that function's documentation for details." + (interactive) + (ebib-execute-when + ((real-db entries) + (let ((new-key + (with-temp-buffer + (ebib-format-entry (ebib-cur-entry-key) ebib-cur-db nil) + (let ((x-ref (ebib-get-field-value 'crossref (ebib-cur-entry-key)))) + (if x-ref + (ebib-format-entry (to-raw (car x-ref)) ebib-cur-db nil))) + (goto-char (point-min)) + (bibtex-generate-autokey)))) + (if (equal new-key "") + (error (format "Cannot create key")) + (ebib-update-keyname new-key)))) + ((default) + (beep)))) + +(defun ebib-close-database () + "Closes the current BibTeX database." + (interactive) + (ebib-execute-when + ((database) + (when (if (edb-modified ebib-cur-db) + (yes-or-no-p "Database modified. Close it anyway? ") + (y-or-n-p "Close database? ")) + (ebib-keywords-save-new-keywords ebib-cur-db) + (let ((to-be-deleted ebib-cur-db) + (new-db (next-elem ebib-cur-db ebib-databases))) + (setq ebib-databases (delete to-be-deleted ebib-databases)) + (if ebib-databases ; do we still have another database loaded? + (progn + (setq ebib-cur-db (or new-db + (last1 ebib-databases))) + (unless (edb-cur-entry ebib-cur-db) + (setf (edb-cur-entry ebib-cur-db) (edb-keys-list ebib-cur-db))) + (ebib-fill-entry-buffer) + (ebib-fill-index-buffer)) + ;; otherwise, we have to clean up a little and empty all the buffers. + (setq ebib-cur-db nil) + (mapc #'(lambda (buf) ; this is just to avoid typing almost the same thing three times... + (set-buffer (car buf)) + (with-buffer-writable + (erase-buffer)) + (ebib-delete-highlight (cadr buf))) + (list (list ebib-entry-buffer ebib-fields-highlight) + (list ebib-index-buffer ebib-index-highlight) + (list ebib-strings-buffer ebib-strings-highlight))) + ;; multiline edit buffer + (set-buffer ebib-multiline-buffer) + (with-buffer-writable + (erase-buffer)) + (set-buffer ebib-index-buffer) + (rename-buffer " none")) + (message "Database closed.")))))) + +(defun ebib-goto-first-entry () + "Moves to the first BibTeX entry in the database." + (interactive) + (ebib-execute-when + ((entries) + (setf (edb-cur-entry ebib-cur-db) (edb-keys-list ebib-cur-db)) + (set-buffer ebib-index-buffer) + (goto-char (point-min)) + (ebib-set-index-highlight) + (ebib-fill-entry-buffer)) + ((default) + (beep)))) + +(defun ebib-goto-last-entry () + "Moves to the last entry in the BibTeX database." + (interactive) + (ebib-execute-when + ((entries) + (setf (edb-cur-entry ebib-cur-db) (last (edb-keys-list ebib-cur-db))) + (set-buffer ebib-index-buffer) + (goto-char (point-min)) + (forward-line (1- (edb-n-entries ebib-cur-db))) + (ebib-set-index-highlight) + (ebib-fill-entry-buffer)) + ((default) + (beep)))) + +(defun ebib-edit-entry () + "Edits the current BibTeX entry." + (interactive) + (ebib-execute-when + ((real-db entries) + (setq ebib-cur-entry-fields (ebib-get-all-fields (gethash 'type* ebib-cur-entry-hash))) + (select-window (get-buffer-window ebib-entry-buffer) nil)) + ((default) + (beep)))) + +(defun ebib-edit-keyname () + "Changes the key of a BibTeX entry." + (interactive) + (ebib-execute-when + ((real-db entries) + (let ((cur-keyname (ebib-cur-entry-key))) + (if-str (new-keyname (read-string (format "Change `%s' to: " cur-keyname) + cur-keyname)) + (ebib-update-keyname new-keyname)))) + ((default) + (beep)))) + +(defun ebib-update-keyname (new-key) + "Changes the key of the current BibTeX entry to NEW-KEY." + (if (member new-key (edb-keys-list ebib-cur-db)) + (if ebib-uniquify-keys + (setq new-key (ebib-uniquify-key new-key)) + (error (format "Key `%s' already exists" new-key)))) + (let ((cur-key (ebib-cur-entry-key))) + (unless (string= cur-key new-key) + (let ((fields (ebib-retrieve-entry cur-key ebib-cur-db)) + (marked (member cur-key (edb-marked-entries ebib-cur-db)))) + (ebib-remove-entry-from-db cur-key ebib-cur-db) + (ebib-remove-key-from-buffer cur-key) + (ebib-insert-entry new-key fields ebib-cur-db t nil) + (setf (edb-cur-entry ebib-cur-db) (member new-key (edb-keys-list ebib-cur-db))) + (sort-in-buffer (edb-n-entries ebib-cur-db) new-key) + (with-buffer-writable + (ebib-display-entry new-key)) + (forward-line -1) ; move one line up to position the cursor on the new entry. + (ebib-set-index-highlight) + (ebib-set-modified t) + (when marked (ebib-mark-entry)))))) + +(defun ebib-mark-entry () + "Marks or unmarks the current entry." + (interactive) + (if (ebib-called-with-prefix) + (ebib-execute-when + ((marked-entries) + (setf (edb-marked-entries ebib-cur-db) nil) + (ebib-fill-index-buffer) + (message "All entries unmarked")) + ((entries) + (setf (edb-marked-entries ebib-cur-db) (copy-sequence (edb-keys-list ebib-cur-db))) + (ebib-fill-index-buffer) + (message "All entries marked")) + ((default) + (beep))) + (ebib-execute-when + ((entries) + (set-buffer ebib-index-buffer) + (with-buffer-writable + (if (member (ebib-cur-entry-key) (edb-marked-entries ebib-cur-db)) + (progn + (setf (edb-marked-entries ebib-cur-db) + (delete (ebib-cur-entry-key) (edb-marked-entries ebib-cur-db))) + (remove-text-properties (ebib-highlight-start ebib-index-highlight) + (ebib-highlight-end ebib-index-highlight) + '(face ebib-marked-face))) + (setf (edb-marked-entries ebib-cur-db) (sort (cons (ebib-cur-entry-key) + (edb-marked-entries ebib-cur-db)) + 'string<)) + (add-text-properties (ebib-highlight-start ebib-index-highlight) + (ebib-highlight-end ebib-index-highlight) + '(face ebib-marked-face))))) + ((default) + (beep))))) + +(defun ebib-index-scroll-down () + "Moves one page up in the database." + (interactive) + (ebib-execute-when + ((entries) + (scroll-down) + (ebib-select-entry)) + ((default) + (beep)))) + +(defun ebib-index-scroll-up () + "Moves one page down in the database." + (interactive) + (ebib-execute-when + ((entries) + (scroll-up) + (ebib-select-entry)) + ((default) + (beep)))) + +(defun ebib-format-entry (key db timestamp) + "Formats entry KEY from database DB into the current buffer in BibTeX format. +If TIMESTAMP is T, a timestamp is added to the entry if +EBIB-USE-TIMESTAMP is T." + (let ((entry (ebib-retrieve-entry key db))) + (when entry + (insert (format "@%s{%s,\n" (gethash 'type* entry) key)) + (maphash #'(lambda (key value) + (unless (or (eq key 'type*) + (and (eq key 'timestamp) timestamp ebib-use-timestamp)) + (insert (format "\t%s = %s,\n" key value)))) + entry) + (if (and timestamp ebib-use-timestamp) + (insert (format "\ttimestamp = {%s}" (format-time-string ebib-timestamp-format))) + (delete-char -2)) ; the final ",\n" must be deleted + (insert "\n}\n\n")))) + +(defun ebib-format-strings (db) + "Formats the @STRING commands in database DB." + (maphash #'(lambda (key value) + (insert (format "@STRING{%s = %s}\n" key value))) + (edb-strings db)) + (insert "\n")) + +(defun ebib-compare-xrefs (x y) + (gethash 'crossref (ebib-retrieve-entry x ebib-cur-db))) + +(defun ebib-format-database (db) + "Writes database DB into the current buffer in BibTeX format." + (when (edb-preamble db) + (insert (format "@PREAMBLE{%s}\n\n" (edb-preamble db)))) + (ebib-format-strings db) + (let ((sorted-list (copy-tree (edb-keys-list db)))) + (cond + (ebib-save-xrefs-first + (setq sorted-list (sort sorted-list 'ebib-compare-xrefs))) + (ebib-sort-order + (setq sorted-list (sort sorted-list 'ebib-entry<)))) + (mapc #'(lambda (key) (ebib-format-entry key db nil)) sorted-list))) + +(defun ebib-make-backup (file) + "Create a backup of FILE. +Honour EBIB-CREATE-BACKUPS and BACKUP-DIRECTORY-ALIST." + (when ebib-create-backups + (let ((backup-file (make-backup-file-name file))) + (if (file-writable-p backup-file) + (copy-file file backup-file t) + (ebib-log 'error "Could not create backup file `%s'" backup-file))))) + +(defun ebib-save-database (db) + "Saves the database DB." + (when (and (edb-make-backup db) + (file-exists-p (edb-filename db))) + (ebib-make-backup (edb-filename db)) + (setf (edb-make-backup db) nil)) + (with-temp-buffer + (ebib-format-database db) + (write-region (point-min) (point-max) (edb-filename db))) + (ebib-set-modified nil db)) + +(defun ebib-write-database () + "Writes the current database to a different file. +Can also be used to change a virtual database into a real one." + (interactive) + (ebib-execute-when + ((database) + (if-str (new-filename (expand-file-name (read-file-name "Save to file: " "~/"))) + (progn + (with-temp-buffer + (ebib-format-database ebib-cur-db) + (safe-write-region (point-min) (point-max) new-filename nil nil nil t)) + ;; if SAFE-WRITE-REGION was cancelled by the user because he + ;; didn't want to overwrite an already existing file with his + ;; new database, it throws an error, so the next lines will not + ;; be executed. hence we can safely set (EDB-FILENAME DB) and + ;; (EDB-NAME DB). + (setf (edb-filename ebib-cur-db) new-filename) + (setf (edb-name ebib-cur-db) (file-name-nondirectory new-filename)) + (rename-buffer (concat (format " %d:" (1+ (- (length ebib-databases) + (length (member ebib-cur-db ebib-databases))))) + (edb-name ebib-cur-db))) + (ebib-execute-when + ((virtual-db) + (setf (edb-virtual ebib-cur-db) nil) + (setf (edb-database ebib-cur-db) + (let ((new-db (make-hash-table :test 'equal))) + (mapc #'(lambda (key) + (let ((entry (gethash key (edb-database ebib-cur-db)))) + (when entry + (puthash key (copy-hash-table entry) new-db)))) + (edb-keys-list ebib-cur-db)) + new-db)))) + (ebib-set-modified nil)))) + ((default) + (beep)))) + +(defun ebib-save-current-database () + "Saves the current database." + (interactive) + (ebib-execute-when + ((real-db) + (if (not (edb-modified ebib-cur-db)) + (message "No changes need to be saved.") + (ebib-save-database ebib-cur-db))) + ((virtual-db) + (error "Cannot save a virtual database. Use `w' to write to a file.")))) + +(defun ebib-save-all-databases () + "Saves all currently open databases if they were modified." + (interactive) + (mapc #'(lambda (db) + (when (edb-modified db) + (ebib-save-database db))) + ebib-databases) + (message "All databases saved.")) + +(defun ebib-print-filename () + "Displays the filename of the current database in the minibuffer." + (interactive) + (message (edb-filename ebib-cur-db))) + +(defun ebib-follow-crossref () + "Follow the crossref field and jump to that entry. +If the current entry's crossref field is empty, search for the +first entry with the current entry's key in its crossref field." + (interactive) + (let ((new-cur-entry (to-raw (gethash 'crossref + (ebib-retrieve-entry (ebib-cur-entry-key) ebib-cur-db))))) + (if new-cur-entry + (progn + (setf (edb-cur-entry ebib-cur-db) + (or (member new-cur-entry (edb-keys-list ebib-cur-db)) + (edb-cur-entry ebib-cur-db))) + (ebib-fill-entry-buffer) + (ebib-fill-index-buffer)) + (setq ebib-search-string (ebib-cur-entry-key)) + (ebib-search-next)))) + +(defun ebib-toggle-hidden () + "Toggle viewing hidden fields." + (interactive) + (setq ebib-hide-hidden-fields (not ebib-hide-hidden-fields)) + (ebib-fill-entry-buffer)) + +(defun ebib-toggle-timestamp () + "Toggle using timestamp for new entries." + (interactive) + (setq ebib-use-timestamp (not ebib-use-timestamp))) + +(defun ebib-toggle-xrefs-first () + "Toggle saving of crossreferenced entries first." + (interactive) + (setq ebib-save-xrefs-first (not ebib-save-xrefs-first))) + +(defun ebib-toggle-identical-fields () + "Toggle whether Ebib allows identical fields when opening a .bib file." + (interactive) + (setq ebib-allow-identical-fields (not ebib-allow-identical-fields))) + +(defun ebib-toggle-layout () + "Toggles the Ebib layout." + (interactive) + (if (eq ebib-layout 'full) + (setq ebib-layout 'custom) + (setq ebib-layout 'full)) + (ebib-lower) + (ebib)) + +(defun ebib-toggle-print-newpage () + "Toggle whether index cards are printed with a newpage after each card." + (interactive) + (setq ebib-print-newpage (not ebib-print-newpage))) + +(defun ebib-toggle-print-multiline () + "Toggle whether multiline fields are printed." + (interactive) + (setq ebib-print-multiline (not ebib-print-multiline))) + +(defun ebib-delete-entry () + "Deletes the current entry from the database." + (interactive) + (if (ebib-called-with-prefix) + (ebib-execute-when + ((real-db marked-entries) + (when (y-or-n-p "Delete all marked entries? ") + (mapc #'(lambda (entry) + (ebib-remove-entry-from-db entry ebib-cur-db (not (string= entry (ebib-cur-entry-key))))) + (edb-marked-entries ebib-cur-db)) + (message "Marked entries deleted.") + (ebib-set-modified t) + (ebib-fill-entry-buffer) + (ebib-fill-index-buffer))) + ((default) + (beep))) + (ebib-execute-when + ((real-db entries) + (let ((cur-entry (ebib-cur-entry-key))) + (when (y-or-n-p (format "Delete %s? " cur-entry)) + (ebib-remove-entry-from-db cur-entry ebib-cur-db) + (ebib-remove-key-from-buffer cur-entry) + (ebib-fill-entry-buffer) + (ebib-set-modified t) + (message (format "Entry `%s' deleted." cur-entry))))) + ((default) + (beep))))) + +(defun ebib-remove-entry-from-db (entry-key db &optional new-cur-entry) + "Removes ENTRY-KEY from DB. +Optional argument NEW-CUR-ENTRY is the key of the entry that is +to become the new current entry. It it is NIL, the entry after +the deleted one becomes the new current entry. If it is T, the +current entry is not changed." + (remhash entry-key (edb-database db)) + (setf (edb-n-entries db) (1- (edb-n-entries db))) + (cond + ((null new-cur-entry) (setq new-cur-entry (cadr (edb-cur-entry db)))) + ((stringp new-cur-entry) t) + (t (setq new-cur-entry (ebib-cur-entry-key)))) + (setf (edb-keys-list db) (delete entry-key (edb-keys-list db))) + (setf (edb-marked-entries db) (delete entry-key (edb-marked-entries db))) + (setf (edb-cur-entry db) (member new-cur-entry (edb-keys-list db))) + (unless (edb-cur-entry db) ; if (edb-cur-entry db) is nil, we deleted the last entry. + (setf (edb-cur-entry db) (last (edb-keys-list db))))) + +(defun ebib-remove-key-from-buffer (entry-key) + "Removes ENTRY-KEY from the index buffer and highlights the current entry." + (with-buffer-writable + (let ((beg (ebib-search-key-in-buffer entry-key))) + (forward-line 1) + (delete-region beg (point)))) + (ebib-execute-when + ((entries) + (ebib-search-key-in-buffer (ebib-cur-entry-key)) + (ebib-set-index-highlight)))) + +(defun ebib-select-entry () + "Makes the entry at POINT the current entry." + (interactive) + (ebib-execute-when + ((entries) + (beginning-of-line) + (let ((beg (point))) + (let* ((key (save-excursion + (skip-chars-forward "^ ") + (buffer-substring-no-properties beg (point)))) + (new-cur-entry (member key (edb-keys-list ebib-cur-db)))) + (when new-cur-entry + (setf (edb-cur-entry ebib-cur-db) new-cur-entry) + (ebib-set-index-highlight) + (ebib-fill-entry-buffer))))) + ((default) + (beep)))) + +;; the exporting functions will have to be redesigned completely. for now (1 Feb +;; 2012) we just define a new function ebib-export-entries. in the long run, +;; this should be the general exporting function, calling other functions as the +;; need arises. + +(defun ebib-export-entries (entries &optional source-db filename) + "Exports ENTRIES from SOURCE-DB to FILENAME. +ENTRIES is a list of entry keys. If FILENAME is not provided, the +user is asked for one." + (unless filename + (setq filename (read-file-name + "File to export entries to:" "~/" nil nil ebib-export-filename))) + (unless source-db + (setq source-db ebib-cur-db)) + (with-temp-buffer + (insert "\n") + (mapc #'(lambda (key) + (ebib-format-entry key ebib-cur-db nil)) + entries) + (append-to-file (point-min) (point-max) filename) + (setq ebib-export-filename filename))) + +(defun ebib-export-entry (prefix) + "Copies entries to another database. +The prefix argument indicates which database to copy the entry +to. If no prefix argument is present, a filename is asked to +which the entry is appended." + (interactive "P") + (let ((num (ebib-prefix prefix))) + (if (ebib-called-with-prefix) + (ebib-export-marked-entries num) + (ebib-export-single-entry num)))) + +(defun ebib-export-single-entry (num) + "Copies the current entry to another database. +NUM indicates which database to copy the entry to. If it is NIL, +a filename is asked to which the entry is appended." + (ebib-execute-when + ((real-db entries) + (if num + (ebib-export-to-db num (format "Entry `%s' copied to database %%d." (ebib-cur-entry-key)) + #'(lambda (db) + (let ((entry-key (ebib-cur-entry-key))) + (if (member entry-key (edb-keys-list db)) + (error "Entry key `%s' already exists in database %d" entry-key num) + (ebib-insert-entry entry-key + (copy-hash-table (ebib-retrieve-entry entry-key + ebib-cur-db)) + db t t) + ;; if this is the first entry in the target DB, + ;; its CUR-ENTRY must be set! + (when (null (edb-cur-entry db)) + (setf (edb-cur-entry db) (edb-keys-list db))) + t)))) ; we must return T, WHEN does not always do this. + (ebib-export-to-file (format "Export `%s' to file: " (ebib-cur-entry-key)) + (format "Entry `%s' exported to %%s." (ebib-cur-entry-key)) + #'(lambda () + (insert "\n") + (ebib-format-entry (ebib-cur-entry-key) ebib-cur-db t))))) + ((default) + (beep)))) + +(defun ebib-export-marked-entries (num) + "Copies the marked entries to another database. +NUM indicates which database to copy the entry to. If it is NIL, +a filename is asked to which the entry is appended." + (ebib-execute-when + ((real-db marked-entries) + (if num + (ebib-export-to-db + num "Entries copied to database %d." + #'(lambda (db) + (mapc #'(lambda (entry-key) + (if (member entry-key (edb-keys-list db)) + (error "Entry key `%s' already exists in database %d" entry-key num) + (ebib-insert-entry entry-key + (copy-hash-table (ebib-retrieve-entry entry-key + ebib-cur-db)) + db t t))) + (edb-marked-entries ebib-cur-db)) + ;; if the target DB was empty before, its CUR-ENTRY must be set! + (when (null (edb-cur-entry db)) + (setf (edb-cur-entry db) (edb-keys-list db))) + t)) ; we must return T, WHEN does not always do this. + (ebib-export-to-file "Export to file: " "Entries exported to %s." + #'(lambda () + (mapc #'(lambda (entry-key) + (insert "\n") + (ebib-format-entry entry-key ebib-cur-db t)) + (edb-marked-entries ebib-cur-db)))))) + ((default) + (beep)))) + +(defun ebib-search () + "Search the current Ebib database. +The search is conducted with STRING-MATCH and can therefore be a +regexp. Searching starts with the current entry." + (interactive) + (ebib-execute-when + ((entries) + (if-str (search-str (read-string "Search database for: ")) + (progn + (setq ebib-search-string search-str) + ;; first we search the current entry + (if (ebib-search-in-entry ebib-search-string + (ebib-retrieve-entry (ebib-cur-entry-key) ebib-cur-db)) + (ebib-fill-entry-buffer ebib-search-string) + ;; if the search string wasn't found in the current entry, we continue searching. + (ebib-search-next))))) + ((default) + (beep)))) + +(defun ebib-search-next () + "Searches the next occurrence of EBIB-SEARCH-STRING. +Searching starts at the entry following the current entry. If a +match is found, the matching entry is shown and becomes the new +current entry." + (interactive) + (ebib-execute-when + ((entries) + (if (null ebib-search-string) + (message "No search string") + (let ((cur-search-entry (cdr (edb-cur-entry ebib-cur-db)))) + (while (and cur-search-entry + (null (ebib-search-in-entry ebib-search-string + (gethash (car cur-search-entry) + (edb-database ebib-cur-db))))) + (setq cur-search-entry (cdr cur-search-entry))) + (if (null cur-search-entry) + (message (format "`%s' not found" ebib-search-string)) + (setf (edb-cur-entry ebib-cur-db) cur-search-entry) + (set-buffer ebib-index-buffer) + (goto-char (point-min)) + (re-search-forward (format "^%s " (ebib-cur-entry-key))) + (beginning-of-line) + (ebib-set-index-highlight) + (ebib-fill-entry-buffer ebib-search-string))))) + ((default) + (beep)))) + +(defun ebib-search-in-entry (search-str entry &optional field) + "Searches one entry of the ebib database. +Returns a list of fields in ENTRY that match the regexp +SEARCH-STR, or NIL if no matches were found. If FIELD is given, +only that field is searched." + (let ((case-fold-search t) ; we want to ensure a case-insensitive search + (result nil)) + (if field + (let ((value (gethash field entry))) + (when (and (stringp value) ; the type* field has a symbol as value + (string-match search-str value)) + (setq result (list field)))) + (maphash #'(lambda (field value) + (when (and (stringp value) ; the type* field has a symbol as value + (string-match search-str value)) + (setq result (cons field result)))) + entry)) + result)) + +(defun ebib-edit-strings () + "Edits the @STRING definitions in the database." + (interactive) + (ebib-execute-when + ((real-db) + (ebib-fill-strings-buffer) + (select-window (get-buffer-window ebib-entry-buffer) nil) + (set-window-dedicated-p (selected-window) nil) + (switch-to-buffer ebib-strings-buffer) + (unless (eq ebib-layout 'full) + (set-window-dedicated-p (selected-window) t)) + (goto-char (point-min))) + ((default) + (beep)))) + +(defun ebib-edit-preamble () + "Edits the @PREAMBLE definition in the database." + (interactive) + (ebib-execute-when + ((real-db) + (select-window (ebib-temp-window) nil) + (ebib-multiline-edit 'preamble (edb-preamble ebib-cur-db))) + ((default) + (beep)))) + +(defun ebib-export-preamble (prefix) + "Exports the @PREAMBLE definition. +If a prefix argument is given, it is taken as the database to +export the preamble to. If the goal database already has a +preamble, the new preamble will be appended to it. If no prefix +argument is given, the user is asked to enter a filename to which +the preamble is appended." + (interactive "P") + (ebib-execute-when + ((real-db) + (if (null (edb-preamble ebib-cur-db)) + (error "No @PREAMBLE defined") + (let ((num (ebib-prefix prefix))) + (if num + (ebib-export-to-db num "@PREAMBLE copied to database %d" + #'(lambda (db) + (let ((text (edb-preamble ebib-cur-db))) + (if (edb-preamble db) + (setf (edb-preamble db) (concat (edb-preamble db) "\n# " text)) + (setf (edb-preamble db) text))))) + (ebib-export-to-file "Export @PREAMBLE to file: " + "@PREAMBLE exported to %s" + #'(lambda () + (insert (format "\n@preamble{%s}\n\n" (edb-preamble ebib-cur-db))))))))) + ((default) + (beep)))) + +(defun ebib-print-entries () + "Creates a LaTeX file listing the entries. +Either prints the entire database, or the marked entries." + (interactive) + (ebib-execute-when + ((entries) + (let ((entries (or (when (or (ebib-called-with-prefix) + (equal '(menu-bar) (elt (this-command-keys-vector) 0))) + (edb-marked-entries ebib-cur-db)) + (edb-keys-list ebib-cur-db)))) + (if-str (tempfile (if (not (string= "" ebib-print-tempfile)) + ebib-print-tempfile + (read-file-name "Use temp file: " "~/" nil nil))) + (progn + (with-temp-buffer + (insert "\\documentclass{article}\n\n") + (when ebib-print-preamble + (mapc #'(lambda (string) + (insert (format "%s\n" string))) + ebib-print-preamble)) + (insert "\n\\begin{document}\n\n") + (mapc #'(lambda (entry-key) + (insert "\\begin{tabular}{p{0.2\\textwidth}p{0.8\\textwidth}}\n") + (let ((entry (ebib-retrieve-entry entry-key ebib-cur-db))) + (insert (format "\\multicolumn{2}{l}{\\texttt{%s (%s)}}\\\\\n" + entry-key (symbol-name (gethash 'type* entry)))) + (insert "\\hline\n") + (mapc #'(lambda (field) + (if-str (value (gethash field entry)) + (when (or (not (multiline-p value)) + ebib-print-multiline) + (insert (format "%s: & %s\\\\\n" + field (to-raw value)))))) + (cdr (ebib-get-all-fields (gethash 'type* entry))))) + (insert "\\end{tabular}\n\n") + (insert (if ebib-print-newpage + "\\newpage\n\n" + "\\bigskip\n\n"))) + entries) + (insert "\\end{document}\n") + (write-region (point-min) (point-max) tempfile)) + (ebib-lower) + (find-file tempfile))))) + ((default) + (beep)))) + +(defun ebib-latex-entries () + "Creates a LaTeX file that \\nocites entries from the database. +Operates either on all entries or on the marked entries." + (interactive) + (ebib-execute-when + ((real-db entries) + (if-str (tempfile (if (not (string= "" ebib-print-tempfile)) + ebib-print-tempfile + (read-file-name "Use temp file: " "~/" nil nil))) + (progn + (with-temp-buffer + (insert "\\documentclass{article}\n\n") + (when ebib-print-preamble + (mapc #'(lambda (string) + (insert (format "%s\n" string))) + ebib-latex-preamble)) + (insert "\n\\begin{document}\n\n") + (if (and (or (ebib-called-with-prefix) + (equal '(menu-bar) (elt (this-command-keys-vector) 0))) + (edb-marked-entries ebib-cur-db)) + (mapc #'(lambda (entry) + (insert (format "\\nocite{%s}\n" entry))) + (edb-marked-entries ebib-cur-db)) + (insert "\\nocite{*}\n")) + (insert (format "\n\\bibliography{%s}\n\n" (expand-file-name (edb-filename ebib-cur-db)))) + (insert "\\end{document}\n") + (write-region (point-min) (point-max) tempfile)) + (ebib-lower) + (find-file tempfile)))) + ((default) + (beep)))) + +(defun ebib-switch-to-database (num) + (interactive "NSwitch to database number: ") + (let ((new-db (nth (1- num) ebib-databases))) + (if new-db + (progn + (setq ebib-cur-db new-db) + (ebib-fill-entry-buffer) + (ebib-fill-index-buffer)) + (error "Database %d does not exist" num)))) + +(defun ebib-next-database () + (interactive) + (ebib-execute-when + ((database) + (let ((new-db (next-elem ebib-cur-db ebib-databases))) + (unless new-db + (setq new-db (car ebib-databases))) + (setq ebib-cur-db new-db) + (ebib-fill-entry-buffer) + (ebib-fill-index-buffer))))) + +(defun ebib-prev-database () + (interactive) + (ebib-execute-when + ((database) + (let ((new-db (prev-elem ebib-cur-db ebib-databases))) + (unless new-db + (setq new-db (last1 ebib-databases))) + (setq ebib-cur-db new-db) + (ebib-fill-entry-buffer) + (ebib-fill-index-buffer))))) + +(defun ebib-browse-url (num) + "Asks a browser to load the URL in the standard URL field. +The standard URL field (see user option EBIB-STANDARD-URL-FIELD) +may contain more than one URL, if they're whitespace-separated. +In that case, a numeric prefix argument can be used to specify +which URL to choose." + (interactive "p") + (ebib-execute-when + ((entries) + (let ((urls (to-raw (gethash ebib-standard-url-field + (ebib-retrieve-entry (ebib-cur-entry-key) ebib-cur-db))))) + (if urls + (ebib-call-browser urls num) + (error "Field `%s' is empty" ebib-standard-url-field)))) + ((default) + (beep)))) + +(defun ebib-browse-doi () + "Open the DOI in the standard DOI field in a browser. +The stardard DOI field (see user option EBIB-STANDARD-DOI-FIELD) +may contain only one DOI. + +The DOI is combined with the value of EBIB-DOI-URL before being +sent to the browser." + (interactive) + (ebib-execute-when + ((entries) + (let ((doi (to-raw (gethash ebib-standard-doi-field + (ebib-retrieve-entry (ebib-cur-entry-key) ebib-cur-db))))) + (if doi + (ebib-call-browser (format ebib-doi-url doi) 1) ; '1' was 'num' + (error "No DOI found in field `%s'" ebib-standard-doi-field)))) + ((default) + (beep)))) + +(defun ebib-call-browser (urls n) + "Passes the Nth URL in URLS to a browser. +URLS must be a string of whitespace-separated URLs." + ;; first we extract all valid urls and then pick the nth one + (let ((url (nth (1- n) + (let ((start 0) + (result nil)) + (while (string-match ebib-url-regexp urls start) + (add-to-list 'result (match-string 0 urls) t) + (setq start (match-end 0))) + result)))) + (if url + (cond + ;; first see if the url is contained in \url{...} + ((string-match "\\\\url{\\(.*?\\)}" url) + (setq url (match-string 1 url))) + ;; then check for http(s), or whatever the user customized + ((string-match ebib-url-regexp url) + (setq url (match-string 0 url))) + ;; this clause probably won't be reached, but just in case + (t (error "Not a URL: `%s'" url))) + ;; otherwise, we didn't find a url + (error "No URL found in `%s'" urls)) + (when url + (if (string= ebib-browser-command "") + (progn + (message "Calling BROWSE-URL on `%s'" url) + (browse-url url)) + (message "Executing `%s %s'" ebib-browser-command url) + (start-process "Ebib-browser" nil ebib-browser-command url))))) + +(defun ebib-view-file (num) + "Views a file in the standard file field. +The standard file field (see option EBIB-STANDARD-FILE-FIELD) may +contain more than one filename if they're whitespace-separated. +In that case, a numeric prefix argument can be used to specify +which file to choose." + (interactive "p") + (ebib-execute-when + ((entries) + (let ((filename (to-raw (gethash ebib-standard-file-field + (ebib-retrieve-entry (ebib-cur-entry-key) ebib-cur-db))))) + (if filename + (ebib-call-file-viewer filename num) + (error "Field `%s' is empty" ebib-standard-file-field)))) + ((default) + (beep)))) + +(defun ebib-call-file-viewer (files n) + "Passes the Nth file in FILES to an external viewer. +FILES must be a string of whitespace-separated filenames." + (let* ((file (nth (1- n) + (let ((start 0) + (result nil)) + (while (string-match ebib-file-regexp files start) + (add-to-list 'result (match-string 0 files) t) + (setq start (match-end 0))) + result))) + (ext (file-name-extension file))) + (let ((file-full-path (or + (locate-file file ebib-file-search-dirs) + (locate-file (file-name-nondirectory file) ebib-file-search-dirs)))) + (if file-full-path + (if-str (viewer (cdr (assoc ext ebib-file-associations))) + (progn + (message "Executing `%s %s'" viewer file-full-path) + (start-process (concat "ebib " ext " viewer process") nil viewer file-full-path)) + (message "Opening `%s'" file-full-path) + (ebib-lower) + (find-file file-full-path)) + (error "File not found: `%s'" file))))) + +(defun ebib-virtual-db-and (not) + "Filters entries into a virtual database. +If the current database is a virtual database already, perform a +logical AND on the entries." + (interactive "p") + (ebib-execute-when + ((entries) + (ebib-filter-to-virtual-db 'and not)) + ((default) + (beep)))) + +(defun ebib-virtual-db-or (not) + "Filters entries into a virtual database. +If the current database is a virtual database already, perform a +logical OR with the entries in the original database." + (interactive "p") + (ebib-execute-when + ((entries) + (ebib-filter-to-virtual-db 'or not)) + ((default) + (beep)))) + +(defun ebib-virtual-db-not () + "Negates the current virtual database." + (interactive) + (ebib-execute-when + ((virtual-db) + (setf (edb-virtual ebib-cur-db) + (if (eq (car (edb-virtual ebib-cur-db)) 'not) + (cadr (edb-virtual ebib-cur-db)) + `(not ,(edb-virtual ebib-cur-db)))) + (ebib-run-filter (edb-virtual ebib-cur-db) ebib-cur-db) + (ebib-fill-entry-buffer) + (ebib-fill-index-buffer)) + ((default) + (beep)))) + +(defun ebib-filter-to-virtual-db (bool not) + "Filters the current database to a virtual database. +BOOL is the operator to be used, either `and' or `or'. If NOT<0, +a logical `not' is applied to the selection." + (let ((field (completing-read (format "Filter: %s(contains <field> <regexp>)%s. Enter field: " + (if (< not 0) "(not " "") + (if (< not 0) ")" "")) + (cons '("any" 0) + (mapcar #'(lambda (x) + (cons (symbol-name x) 0)) + (append ebib-unique-field-list ebib-additional-fields))) + nil t))) + (setq field (intern-soft field)) + (let ((regexp (read-string (format "Filter: %s(contains %s <regexp>)%s. Enter regexp: " + (if (< not 0) "(not " "") + field + (if (< not 0) ")" ""))))) + (ebib-execute-when + ((virtual-db) + (setf (edb-virtual ebib-cur-db) `(,bool ,(edb-virtual ebib-cur-db) + ,(if (>= not 0) + `(contains ,field ,regexp) + `(not (contains ,field ,regexp)))))) + ((real-db) + (setq ebib-cur-db (ebib-create-virtual-db field regexp not)))) + (ebib-run-filter (edb-virtual ebib-cur-db) ebib-cur-db) + (ebib-fill-entry-buffer) + (ebib-fill-index-buffer)))) + +(defun ebib-create-virtual-db (field regexp not) + "Creates a virtual database based on EBIB-CUR-DB." + ;; a virtual database is a database whose edb-virtual field contains an + ;; expression that selects entries. this function only sets that + ;; expression, it does not actually filter the entries. + (let ((new-db (ebib-create-new-database ebib-cur-db))) + (setf (edb-virtual new-db) (if (>= not 0) + `(contains ,field ,regexp) + `(not (contains ,field ,regexp)))) + (setf (edb-filename new-db) nil) + (setf (edb-name new-db) (concat "V:" (edb-name new-db))) + (setf (edb-modified new-db) nil) + (setf (edb-make-backup new-db) nil) + new-db)) + +(defmacro contains (field regexp) + ;; Note: the variable ENTRY is *not* bound in this macro! The function + ;; calling CONTAINS *must* set ENTRY to an actual Ebib entry. The point + ;; of this macro is to facilitate defining filters for virtual databases. + ;; It enables us to define filters of the form: + + ;; (and (not (contains author "Chomsky")) (contains year "1995")) + + `(ebib-search-in-entry ,regexp entry ,(unless (eq field 'any) `(quote ,field)))) + +(defun ebib-run-filter (filter db) + "Runs FILTER on DB" + (setf (edb-keys-list db) + (sort (let ((result nil)) + (maphash #'(lambda (key value) + (let ((entry value)) ; this is necessary for actually running the filter + (when (eval filter) + (setq result (cons key result))))) + (edb-database db)) + result) + 'string<)) + (setf (edb-n-entries db) (length (edb-keys-list db))) + (setf (edb-cur-entry db) (edb-keys-list db))) + +(defun ebib-print-filter (num) + "Displays the filter of the current virtual database. +With any prefix argument, reapplies the filter to the +database. This can be useful when the source database was +modified." + (interactive "P") + (ebib-execute-when + ((virtual-db) + (when num + (ebib-run-filter (edb-virtual ebib-cur-db) ebib-cur-db) + (ebib-fill-entry-buffer) + (ebib-fill-index-buffer)) + (message "%S" (edb-virtual ebib-cur-db))) + ((default) + (beep)))) + +(defun ebib-show-log () + "Displays the contents of the log buffer." + (interactive) + (select-window (get-buffer-window ebib-entry-buffer) nil) + (set-window-dedicated-p (selected-window) nil) + (switch-to-buffer ebib-log-buffer) + (unless (eq ebib-layout 'full) + (set-window-dedicated-p (selected-window) t))) + +(defun ebib-create-citation-command (format-string &optional key) + "Create a citation command using FORMAT-STRING. +If FORMAT-STRING contains a %K directive, it is replaced with +KEY. Furthermore, FORMAT-STRING may contain any number of %A +directives for additional arguments to the citation. The user is +asked to supply a string for each of them, which may be empty. + +Each %A directive may be wrapped in a %<...%> pair, containing +optional material both before and after %A. If the user supplies +an empty string for such an argument, the optional material +surrounding it is not included in the citation command." + (when (and (string-match "%K" format-string) + key) + (setq format-string (replace-match key t t format-string))) + (loop for n = 1 then (1+ n) + until (null (string-match "%<\\(.*?\\)%A\\(.*?\\)%>\\|%A" format-string)) do + (setq format-string (replace-match (if-str (argument (read-from-minibuffer (format "Argument %s%s: " n (if key + (concat " for " key) + "")))) + (concat "\\1" argument "\\2") + "") + t nil format-string)) + finally return format-string)) + +(defun ebib-split-citation-string (format-string) + "Split up FORMAT-STRING. +The return value is a list of (BEFORE REPEATER SEPARATOR AFTER), +where BEFORE is the part before the repeating part of +FORMAT-STRING, REPEATER the repeating part, SEPARATOR the string +to be placed between each instance of REPEATER and AFTER the part +after the last instance of REPEATER." + (let (before repeater separator after) + ;; first check if the format string has a repeater and if so, separate each component + (cond + ((string-match "\\(.*?\\)%(\\(.*\\)%\\(.*?\\))\\(.*\\)" format-string) + (setq before (match-string 1 format-string) + repeater (match-string 2 format-string) + separator (match-string 3 format-string) + after (match-string 4 format-string))) + ((string-match "\\(.*?\\)\\(%K\\)\\(.*\\)" format-string) + (setq before (match-string 1 format-string) + repeater (match-string 2 format-string) + after (match-string 3 format-string)))) + (values before repeater separator after))) + +(defun ebib-push-bibtex-key () + "Pushes the current entry to a LaTeX buffer. +The user is prompted for the buffer to push the entry into." + (interactive) + (let ((called-with-prefix (ebib-called-with-prefix))) + (ebib-execute-when + ((entries) + (let ((buffer (read-buffer (if called-with-prefix + "Push marked entries to buffer: " + "Push entry to buffer: ") + ebib-push-buffer t))) + (when buffer + (setq ebib-push-buffer buffer) + (let* ((format-list (or (cadr (assoc (buffer-local-value 'major-mode (get-buffer buffer)) ebib-citation-commands)) + (cadr (assoc 'any ebib-citation-commands)))) + (citation-command + (if-str (format-string (cadr (assoc + (completing-read "Command to use: " format-list nil nil nil ebib-minibuf-hist) + format-list))) + (multiple-value-bind (before repeater separator after) (ebib-split-citation-string format-string) + (cond + ((and called-with-prefix ; if there are marked entries and the user wants to push those + (edb-marked-entries ebib-cur-db)) + (concat (ebib-create-citation-command before) + (mapconcat #'(lambda (key) ; then deal with the entries one by one + (ebib-create-citation-command repeater key)) + (edb-marked-entries ebib-cur-db) + (if separator separator (read-from-minibuffer "Separator: "))) + (ebib-create-citation-command after))) + (t ; otherwise just take the current entry + (ebib-create-citation-command (concat before repeater after) (ebib-cur-entry-key))))) + (if (edb-marked-entries ebib-cur-db) ; if the user doesn't provide a command + (mapconcat #'(lambda (key) ; we just insert the entry key or keys + key) + (edb-marked-entries ebib-cur-db) + (read-from-minibuffer "Separator: ")) + (ebib-cur-entry-key))))) + (when citation-command + (with-current-buffer buffer + (insert citation-command)) + (message "Pushed entries to buffer %s" buffer)))))) + ((default) + (beep))))) + +(defun ebib-index-help () + "Shows the info node of Ebib's index buffer." + (interactive) + (setq ebib-info-flag t) + (ebib-lower) + (info "(ebib) The Index Buffer")) + +(defun ebib-info () + "Shows Ebib's info node." + (interactive) + (setq ebib-info-flag t) + (ebib-lower) + (info "(ebib)")) + +;;;;;;;;;;;;;;;; +;; entry-mode ;; +;;;;;;;;;;;;;;;; + +(defvar ebib-entry-mode-map + (let ((map (make-keymap))) + (suppress-keymap map) + (define-key map [up] 'ebib-prev-field) + (define-key map [down] 'ebib-next-field) + (define-key map [prior] 'ebib-goto-prev-set) + (define-key map [next] 'ebib-goto-next-set) + (define-key map [home] 'ebib-goto-first-field) + (define-key map [end] 'ebib-goto-last-field) + (define-key map [return] 'ebib-edit-field) + (define-key map " " 'ebib-goto-next-set) + (define-key map "b" 'ebib-goto-prev-set) + (define-key map "c" 'ebib-copy-field-contents) + (define-key map "d" 'ebib-delete-field-contents) + (define-key map "e" 'ebib-edit-field) + (define-key map "f" 'ebib-view-file-in-field) + (define-key map "g" 'ebib-goto-first-field) + (define-key map "G" 'ebib-goto-last-field) + (define-key map "h" 'ebib-entry-help) + (define-key map "j" 'ebib-next-field) + (define-key map "k" 'ebib-prev-field) + (define-key map "l" 'ebib-edit-multiline-field) + (define-key map [(control n)] 'ebib-next-field) + (define-key map [(meta n)] 'ebib-goto-prev-set) + (define-key map [(control p)] 'ebib-prev-field) + (define-key map [(meta p)] 'ebib-goto-next-set) + (define-key map "q" 'ebib-quit-entry-buffer) + (define-key map "r" 'ebib-toggle-raw) + (define-key map "s" 'ebib-insert-abbreviation) + (define-key map "u" 'ebib-browse-url-in-field) + (define-key map "x" 'ebib-cut-field-contents) + (define-key map "\C-xb" 'undefined) + (define-key map "\C-xk" 'undefined) + (define-key map "y" 'ebib-yank-field-contents) + map) + "Keymap for the Ebib entry buffer.") + +(define-derived-mode ebib-entry-mode + fundamental-mode "Ebib-entry" + "Major mode for the Ebib entry buffer." + (setq buffer-read-only t) + (setq truncate-lines t)) + +(defun ebib-quit-entry-buffer () + "Quits editing the entry. +If the key of the current entry is <new-entry>, a new key is +automatically generated using BIBTEX-GENERATE-AUTOKEY." + (interactive) + (select-window (get-buffer-window ebib-index-buffer) nil) + (if (equal (ebib-cur-entry-key) "<new-entry>") + (ebib-generate-autokey))) + +(defun ebib-find-visible-field (field direction) + "Finds the first visible field before or after FIELD. +If DIRECTION is negative, search the preceding fields, otherwise +search the succeeding fields. If FIELD is visible itself, return +that. If there is no preceding/following visible field, return +NIL. If EBIB-HIDE-HIDDEN-FIELDS is NIL, return FIELD." + (when ebib-hide-hidden-fields + (let ((fn (if (>= direction 0) + 'next-elem + 'prev-elem))) + (while (and field + (get field 'ebib-hidden)) + (setq field (funcall fn field ebib-cur-entry-fields))))) + field) + +(defun ebib-prev-field () + "Moves to the previous field." + (interactive) + (let ((new-field (ebib-find-visible-field (prev-elem ebib-current-field ebib-cur-entry-fields) -1))) + (if (null new-field) + (beep) + (setq ebib-current-field new-field) + (ebib-move-to-field ebib-current-field -1)))) + +(defun ebib-next-field () + "Moves to the next field." + (interactive) + (let ((new-field (ebib-find-visible-field (next-elem ebib-current-field ebib-cur-entry-fields) 1))) + (if (null new-field) + (when (ebib-called-interactively) ; i call this function after editing a field, and we don't want a beep then + (beep)) + (setq ebib-current-field new-field) + (ebib-move-to-field ebib-current-field 1)))) + +(defun ebib-goto-first-field () + "Moves to the first field." + (interactive) + (let ((new-field (ebib-find-visible-field (car ebib-cur-entry-fields) 1))) + (if (null new-field) + (beep) + (setq ebib-current-field new-field) + (ebib-move-to-field ebib-current-field -1)))) + +(defun ebib-goto-last-field () + "Moves to the last field." + (interactive) + (let ((new-field (ebib-find-visible-field (last1 ebib-cur-entry-fields) -1))) + (if (null new-field) + (beep) + (setq ebib-current-field new-field) + (ebib-move-to-field ebib-current-field 1)))) + +(defun ebib-goto-next-set () + "Moves to the next set of fields." + (interactive) + (cond + ((eq ebib-current-field 'type*) (ebib-next-field)) + ((member ebib-current-field ebib-additional-fields) (ebib-goto-last-field)) + (t (let* ((entry-type (gethash 'type* ebib-cur-entry-hash)) + (obl-fields (ebib-get-obl-fields entry-type)) + (opt-fields (ebib-get-opt-fields entry-type)) + (new-field nil)) + (when (member ebib-current-field obl-fields) + (setq new-field (ebib-find-visible-field (car opt-fields) 1))) + ;; new-field is nil if there are no opt-fields + (when (or (member ebib-current-field opt-fields) + (null new-field)) + (setq new-field (ebib-find-visible-field (car ebib-additional-fields) 1))) + (if (null new-field) + ;; if there was no further set to go to, go to the last field + ;; of the current set + (ebib-goto-last-field) + (setq ebib-current-field new-field) + (ebib-move-to-field ebib-current-field 1)))))) + +(defun ebib-goto-prev-set () + "Moves to the previous set of fields." + (interactive) + (unless (eq ebib-current-field 'type*) + (let* ((entry-type (gethash 'type* ebib-cur-entry-hash)) + (obl-fields (ebib-get-obl-fields entry-type)) + (opt-fields (ebib-get-opt-fields entry-type)) + (new-field nil)) + (if (member ebib-current-field obl-fields) + (ebib-goto-first-field) + (when (member ebib-current-field ebib-additional-fields) + (setq new-field (ebib-find-visible-field (last1 opt-fields) -1))) + (when (or (member ebib-current-field opt-fields) + (null new-field)) + (setq new-field (ebib-find-visible-field (last1 obl-fields) -1))) + (if (null new-field) + (ebib-goto-first-field) + (setq ebib-current-field new-field) + (ebib-move-to-field ebib-current-field -1)))))) + +;; the following edit functions make use of completion. since we don't want +;; the completion buffer to be shown in the index window, we need to switch +;; focus to an appropriate window first. we do this in an unwind-protect to +;; make sure we always get back to the entry buffer. + +(defun ebib-edit-entry-type () + "Edits the entry type." + (unwind-protect + (progn + (if (eq ebib-layout 'full) + (other-window 1) + (select-window ebib-pre-ebib-window) nil) + (if-str (new-type (completing-read "type: " ebib-entry-types nil t)) + (progn + (puthash 'type* (intern-soft new-type) ebib-cur-entry-hash) + (ebib-fill-entry-buffer) + (setq ebib-cur-entry-fields (ebib-get-all-fields (gethash 'type* ebib-cur-entry-hash))) + (ebib-set-modified t)))) + (select-window (get-buffer-window ebib-entry-buffer) nil))) + +(defun ebib-edit-crossref () + "Edits the crossref field." + (unwind-protect + (progn + (if (eq ebib-layout 'full) + (other-window 1) + (select-window ebib-pre-ebib-window) nil) + (let ((collection (ebib-create-collection (edb-database ebib-cur-db)))) + (if-str (key (completing-read "Key to insert in `crossref': " collection nil t)) + (progn + (puthash 'crossref (from-raw key) ebib-cur-entry-hash) + (ebib-set-modified t))))) + (select-window (get-buffer-window ebib-entry-buffer) nil) + ;; we now redisplay the entire entry buffer, so that the crossref'ed + ;; fields show up. this also puts the cursor back on the type field. + (ebib-fill-entry-buffer) + (setq ebib-current-field 'crossref) + (re-search-forward "^crossref") + (ebib-set-fields-highlight))) + +(defun ebib-sort-keywords (keywords) + "Sort the KEYWORDS string, remove duplicates, and return it as a string." + (mapconcat 'identity + (sort (delete-dups (split-string keywords ebib-keywords-separator t)) + 'string<) + ebib-keywords-separator)) + +(defun ebib-edit-keywords () + "Edit the keywords field." + (unwind-protect + (progn + (if (eq ebib-layout 'full) + (other-window 1) + (select-window ebib-pre-ebib-window) nil) + ;; now we ask the user for keywords. note that we shadow the + ;; binding of `minibuffer-local-completion-map' so that we can + ;; unbind <SPC>, since keywords may contain spaces. note also that + ;; in emacs 24, we can use `make-composed-keymap' for this purpose, + ;; but in emacs 23.1, this function is not available. + (let ((minibuffer-local-completion-map `(keymap (keymap (32)) ,@minibuffer-local-completion-map)) + (collection (ebib-keywords-for-database ebib-cur-db))) + (loop for keyword = (completing-read "Add a new keyword (ENTER to finish): " collection) + until (string= keyword "") + do (let* ((conts (to-raw (gethash 'keywords ebib-cur-entry-hash))) + (new-conts (if conts + (concat conts ebib-keywords-separator keyword) + keyword))) + (puthash 'keywords (from-raw (if ebib-keywords-field-keep-sorted + (ebib-sort-keywords new-conts) + new-conts)) + ebib-cur-entry-hash) + (ebib-set-modified t) + (ebib-redisplay-current-field) + (unless (member keyword collection) + (ebib-keywords-add-keyword keyword ebib-cur-db)))))) + (select-window (get-buffer-window ebib-entry-buffer) nil))) + +(defun ebib-edit-field (pfx) + "Edits a field of a BibTeX entry. +With a prefix argument, the `keyword' field can be edited +directly. For other fields, the prefix argument has no meaning." + (interactive "P") + (cond + ((eq ebib-current-field 'type*) (ebib-edit-entry-type)) + ((eq ebib-current-field 'crossref) (ebib-edit-crossref)) + ((and (eq ebib-current-field 'keywords) + (not pfx)) + (ebib-edit-keywords)) + ((eq ebib-current-field 'annote) (ebib-edit-multiline-field)) + (t + (let ((init-contents (gethash ebib-current-field ebib-cur-entry-hash)) + (raw nil)) + (if (multiline-p init-contents) + (ebib-edit-multiline-field) + (when init-contents + (if (raw-p init-contents) + (setq raw t) + (setq init-contents (to-raw init-contents)))) + (if-str (new-contents (read-string (format "%s: " (symbol-name ebib-current-field)) + (if init-contents + (cons init-contents 0) + nil) + ebib-minibuf-hist)) + (puthash ebib-current-field (if raw + new-contents + (concat "{" new-contents "}")) + ebib-cur-entry-hash) + (remhash ebib-current-field ebib-cur-entry-hash)) + (ebib-redisplay-current-field) + ;; we move to the next field, but only if ebib-edit-field was + ;; called interactively, otherwise we get a strange bug in + ;; ebib-toggle-raw... + (if (ebib-called-interactively) (ebib-next-field)) + (ebib-set-modified t)))))) + +(defun ebib-browse-url-in-field (num) + "Browses a URL in the current field. +The field may contain a whitespace-separated set of URLs. The +prefix argument indicates which URL is to be sent to the +browser." + (interactive "p") + (let ((urls (to-raw (gethash ebib-current-field ebib-cur-entry-hash)))) + (if urls + (ebib-call-browser urls num) + (error "Field `%s' is empty" ebib-current-field)))) + +(defun ebib-view-file-in-field (num) + "Views a file in the current field. +The field may contain a whitespace-separated set of +filenames. The prefix argument indicates which file is to be +viewed." + (interactive "p") + (let ((files (to-raw (gethash ebib-current-field ebib-cur-entry-hash)))) + (if files + (ebib-call-file-viewer files num) + (error "Field `%s' is empty" ebib-current-field)))) + +(defun ebib-copy-field-contents () + "Copies the contents of the current field to the kill ring." + (interactive) + (unless (eq ebib-current-field 'type*) + (let ((contents (car (ebib-get-field-value ebib-current-field (ebib-cur-entry-key))))) + (when (stringp contents) + (kill-new contents) + (message "Field contents copied."))))) + +(defun ebib-cut-field-contents () + "Kills the contents of the current field. The killed text is put in the kill ring." + (interactive) + (unless (eq ebib-current-field 'type*) + (let ((contents (gethash ebib-current-field ebib-cur-entry-hash))) + (when (stringp contents) + (remhash ebib-current-field ebib-cur-entry-hash) + (kill-new contents) + (ebib-redisplay-current-field) + (ebib-set-modified t) + (message "Field contents killed."))))) + +(defun ebib-yank-field-contents (arg) + "Inserts the last killed text into the current field. +If the current field already has a contents, nothing is inserted, +unless the previous command was also ebib-yank-field-contents, +then the field contents is replaced with the previous yank. That +is, multiple uses of this command function like the combination +of C-y/M-y. Prefix arguments also work the same as with C-y/M-y." + (interactive "P") + (if (or (eq ebib-current-field 'type*) ; we cannot yank into the type* or crossref fields + (eq ebib-current-field 'crossref) + (unless (eq last-command 'ebib-yank-field-contents) + (gethash ebib-current-field ebib-cur-entry-hash))) ; nor into a field already filled + (progn + (setq this-command t) + (beep)) + (let ((new-contents (current-kill (cond + ((listp arg) (if (eq last-command 'ebib-yank-field-contents) + 1 + 0)) + ((eq arg '-) -2) + (t (1- arg)))))) + (when new-contents + (puthash ebib-current-field new-contents ebib-cur-entry-hash) + (ebib-redisplay-current-field) + (ebib-set-modified t))))) + +(defun ebib-delete-field-contents () + "Deletes the contents of the current field. +The deleted text is not put in the kill ring." + (interactive) + (if (eq ebib-current-field 'type*) + (beep) + (when (y-or-n-p "Delete field contents? ") + (remhash ebib-current-field ebib-cur-entry-hash) + (ebib-redisplay-current-field) + (ebib-set-modified t) + (message "Field contents deleted.")))) + +(defun ebib-toggle-raw () + "Toggles the raw status of the current field contents." + (interactive) + (unless (or (eq ebib-current-field 'type*) + (eq ebib-current-field 'crossref) + (eq ebib-current-field 'keywords)) + (let ((contents (gethash ebib-current-field ebib-cur-entry-hash))) + (if (not contents) ; if there is no value, + (progn + (ebib-edit-field nil) ; the user can enter one, which we must then make raw + (let ((new-contents (gethash ebib-current-field ebib-cur-entry-hash))) + (when new-contents + ;; note: we don't have to check for empty string, since that is + ;; already done in ebib-edit-field + (puthash ebib-current-field (to-raw new-contents) ebib-cur-entry-hash)))) + (if (raw-p contents) + (puthash ebib-current-field (from-raw contents) ebib-cur-entry-hash) + (puthash ebib-current-field (to-raw contents) ebib-cur-entry-hash))) + (ebib-redisplay-current-field) + (ebib-set-modified t)))) + +(defun ebib-edit-multiline-field () + "Edits the current field in multiline-mode." + (interactive) + (unless (or (eq ebib-current-field 'type*) + (eq ebib-current-field 'crossref)) + (let ((text (gethash ebib-current-field ebib-cur-entry-hash))) + (if (raw-p text) + (setq ebib-multiline-raw t) + (setq text (to-raw text)) + (setq ebib-multiline-raw nil)) + (select-window (ebib-temp-window) nil) + (ebib-multiline-edit 'fields text)))) + +(defun ebib-insert-abbreviation () + "Inserts an abbreviation from the ones defined in the database." + (interactive) + (if (gethash ebib-current-field ebib-cur-entry-hash) + (beep) + (when (edb-strings-list ebib-cur-db) + (unwind-protect + (progn + (other-window 1) + (let* ((collection (ebib-create-collection (edb-strings ebib-cur-db))) + (string (completing-read "Abbreviation to insert: " collection nil t))) + (when string + (puthash ebib-current-field string ebib-cur-entry-hash) + (ebib-set-modified t)))) + (other-window 1) + ;; we can't do this earlier, because we would be writing to the index buffer... + (ebib-redisplay-current-field) + (ebib-next-field))))) + +(defun ebib-entry-help () + "Shows the info node for Ebib's entry buffer." + (interactive) + (setq ebib-info-flag t) + (ebib-lower) + (info "(ebib) The Entry Buffer")) + +;;;;;;;;;;;;;;;;;; +;; strings-mode ;; +;;;;;;;;;;;;;;;;;; + +(defvar ebib-strings-mode-map + (let ((map (make-keymap))) + (suppress-keymap map) + (define-key map [up] 'ebib-prev-string) + (define-key map [down] 'ebib-next-string) + (define-key map [prior] 'ebib-strings-page-up) + (define-key map [next] 'ebib-strings-page-down) + (define-key map [home] 'ebib-goto-first-string) + (define-key map [end] 'ebib-goto-last-string) + (define-key map " " 'ebib-strings-page-down) + (define-key map "a" 'ebib-add-string) + (define-key map "b" 'ebib-strings-page-up) + (define-key map "c" 'ebib-copy-string-contents) + (define-key map "d" 'ebib-delete-string) + (define-key map "e" 'ebib-edit-string) + (define-key map "g" 'ebib-goto-first-string) + (define-key map "G" 'ebib-goto-last-string) + (define-key map "h" 'ebib-strings-help) + (define-key map "j" 'ebib-next-string) + (define-key map "k" 'ebib-prev-string) + (define-key map "l" 'ebib-edit-multiline-string) + (define-key map [(control n)] 'ebib-next-string) + (define-key map [(meta n)] 'ebib-strings-page-down) + (define-key map [(control p)] 'ebib-prev-string) + (define-key map [(meta p)] 'ebib-strings-page-up) + (define-key map "q" 'ebib-quit-strings-buffer) + (define-key map "x" 'ebib-export-string) + (define-key map "X" 'ebib-export-all-strings) + (define-key map "\C-xb" 'disabled) + (define-key map "\C-xk" 'disabled) + map) + "Keymap for the ebib strings buffer.") + +(define-derived-mode ebib-strings-mode + fundamental-mode "Ebib-strings" + "Major mode for the Ebib strings buffer." + (setq buffer-read-only t) + (setq truncate-lines t)) + +(defun ebib-quit-strings-buffer () + "Quits editing the @STRING definitions." + (interactive) + (set-window-dedicated-p (selected-window) nil) + (switch-to-buffer ebib-entry-buffer) + (unless (eq ebib-layout 'full) + (set-window-dedicated-p (selected-window) t)) + (select-window (get-buffer-window ebib-index-buffer) nil)) + +(defun ebib-prev-string () + "Moves to the previous string." + (interactive) + (if (equal ebib-current-string (car (edb-strings-list ebib-cur-db))) ; if we're on the first string + (beep) + ;; go to the beginnig of the highlight and move upward one line. + (goto-char (ebib-highlight-start ebib-strings-highlight)) + (forward-line -1) + (setq ebib-current-string (prev-elem ebib-current-string (edb-strings-list ebib-cur-db))) + (ebib-set-strings-highlight))) + +(defun ebib-next-string () + "Moves to the next string." + (interactive) + (if (equal ebib-current-string (last1 (edb-strings-list ebib-cur-db))) + (when (ebib-called-interactively) (beep)) + (goto-char (ebib-highlight-start ebib-strings-highlight)) + (forward-line 1) + (setq ebib-current-string (next-elem ebib-current-string (edb-strings-list ebib-cur-db))) + (ebib-set-strings-highlight))) + +(defun ebib-goto-first-string () + "Moves to the first string." + (interactive) + (setq ebib-current-string (car (edb-strings-list ebib-cur-db))) + (goto-char (point-min)) + (ebib-set-strings-highlight)) + +(defun ebib-goto-last-string () + "Moves to the last string." + (interactive) + (setq ebib-current-string (last1 (edb-strings-list ebib-cur-db))) + (goto-char (point-max)) + (forward-line -1) + (ebib-set-strings-highlight)) + +(defun ebib-strings-page-up () + "Moves 10 entries up in the database." + (interactive) + (let ((number-of-strings (length (edb-strings-list ebib-cur-db))) + (remaining-number-of-strings (length (member ebib-current-string (edb-strings-list ebib-cur-db))))) + (if (<= (- number-of-strings remaining-number-of-strings) 10) + (ebib-goto-first-string) + (setq ebib-current-string (nth + (- number-of-strings remaining-number-of-strings 10) + (edb-strings-list ebib-cur-db))) + (goto-char (ebib-highlight-start ebib-strings-highlight)) + (forward-line -10) + (ebib-set-strings-highlight))) + (message ebib-current-string)) + +(defun ebib-strings-page-down () + "Moves 10 entries down in the database." + (interactive) + (let ((number-of-strings (length (edb-strings-list ebib-cur-db))) + (remaining-number-of-strings (length (member ebib-current-string (edb-strings-list ebib-cur-db))))) + (if (<= remaining-number-of-strings 10) + (ebib-goto-last-string) + (setq ebib-current-string (nth + (- number-of-strings remaining-number-of-strings -10) + (edb-strings-list ebib-cur-db))) + (goto-char (ebib-highlight-start ebib-strings-highlight)) + (forward-line 10) + (ebib-set-strings-highlight))) + (message ebib-current-string)) + +(defun ebib-fill-strings-buffer () + "Fills the strings buffer with the @STRING definitions." + (set-buffer ebib-strings-buffer) + (with-buffer-writable + (erase-buffer) + (dolist (elem (edb-strings-list ebib-cur-db)) + (let ((str (to-raw (gethash elem (edb-strings ebib-cur-db))))) + (insert (format "%-18s %s\n" elem + (if (multiline-p str) + (concat "+" (first-line str)) + (concat " " str))))))) + (goto-char (point-min)) + (setq ebib-current-string (car (edb-strings-list ebib-cur-db))) + (ebib-set-strings-highlight) + (set-buffer-modified-p nil)) + +(defun ebib-edit-string () + "Edits the value of an @STRING definition +When the user enters an empty string, the value is not changed." + (interactive) + (let ((init-contents (to-raw (gethash ebib-current-string (edb-strings ebib-cur-db))))) + (if (multiline-p init-contents) + (ebib-edit-multiline-string) + (if-str (new-contents (read-string (format "%s: " ebib-current-string) + (if init-contents + (cons init-contents 0) + nil) + ebib-minibuf-hist)) + (progn + (puthash ebib-current-string (from-raw new-contents) (edb-strings ebib-cur-db)) + (ebib-redisplay-current-string) + (ebib-next-string) + (ebib-set-modified t)) + (error "@STRING definition cannot be empty"))))) + +(defun ebib-copy-string-contents () + "Copies the contents of the current string to the kill ring." + (interactive) + (let ((contents (gethash ebib-current-string (edb-strings ebib-cur-db)))) + (kill-new contents) + (message "String value copied."))) + +(defun ebib-delete-string () + "Deletes the current @STRING definition from the database." + (interactive) + (when (y-or-n-p (format "Delete @STRING definition %s? " ebib-current-string)) + (remhash ebib-current-string (edb-strings ebib-cur-db)) + (with-buffer-writable + (let ((beg (progn + (goto-char (ebib-highlight-start ebib-strings-highlight)) + (point)))) + (forward-line 1) + (delete-region beg (point)))) + (let ((new-cur-string (next-elem ebib-current-string (edb-strings-list ebib-cur-db)))) + (setf (edb-strings-list ebib-cur-db) (delete ebib-current-string (edb-strings-list ebib-cur-db))) + (when (null new-cur-string) ; deleted the last string + (setq new-cur-string (last1 (edb-strings-list ebib-cur-db))) + (forward-line -1)) + (setq ebib-current-string new-cur-string)) + (ebib-set-strings-highlight) + (ebib-set-modified t) + (message "@STRING definition deleted."))) + +(defun ebib-add-string () + "Creates a new @STRING definition." + (interactive) + (if-str (new-abbr (read-string "New @STRING abbreviation: ")) + (progn + (if (member new-abbr (edb-strings-list ebib-cur-db)) + (error (format "%s already exists" new-abbr))) + (if-str (new-string (read-string (format "Value for %s: " new-abbr))) + (progn + (ebib-insert-string new-abbr new-string ebib-cur-db t) + (sort-in-buffer (length (edb-strings-list ebib-cur-db)) new-abbr) + (with-buffer-writable + (insert (format "%-19s %s\n" new-abbr new-string))) + (forward-line -1) + (ebib-set-strings-highlight) + (setq ebib-current-string new-abbr) + (ebib-set-modified t)))))) + +(defun ebib-export-string (prefix) + "Exports the current @STRING. +The prefix argument indicates which database to copy the string +to. If no prefix argument is present, a filename is asked to +which the string is appended." + (interactive "P") + (let ((num (ebib-prefix prefix))) + (if num + (ebib-export-to-db num (format "@STRING definition `%s' copied to database %%d" ebib-current-string) + #'(lambda (db) + (let ((abbr ebib-current-string) + (string (gethash ebib-current-string (edb-strings ebib-cur-db)))) + (if (member abbr (edb-strings-list db)) + (error "@STRING definition already exists in database %d" num) + (ebib-insert-string abbr string db t))))) + (ebib-export-to-file (format "Export @STRING definition `%s' to file: " ebib-current-string) + (format "@STRING definition `%s' exported to %%s" ebib-current-string) + #'(lambda () + (insert (format "\n@string{%s = %s}\n" + ebib-current-string + (gethash ebib-current-string (edb-strings ebib-cur-db))))))))) + +(defun ebib-export-all-strings (prefix) + "Exports all @STRING definitions. +If a prefix argument is given, it is taken as the database to +copy the definitions to. Without prefix argument, asks for a file +to append them to." + (interactive "P") + (when ebib-current-string ; there is always a current string, unless there are no strings + (let ((num (ebib-prefix prefix))) + (if num + (ebib-export-to-db + num "All @STRING definitions copied to database %d" + #'(lambda (db) + (mapc #'(lambda (abbr) + (if (member abbr (edb-strings-list db)) + (message "@STRING definition `%s' already exists in database %d" abbr num) + (ebib-insert-string abbr (gethash abbr (edb-strings ebib-cur-db)) db t))) + (edb-strings-list ebib-cur-db)))) + (ebib-export-to-file "Export all @STRING definitions to file: " + "All @STRING definitions exported to %s" + #'(lambda () + (insert (format "\n")) ; to keep things tidy. + (ebib-format-strings ebib-cur-db))))))) + +(defun ebib-edit-multiline-string () + "Edits the current string in multiline-mode." + (interactive) + (select-window (ebib-temp-window) nil) + (ebib-multiline-edit 'string (to-raw (gethash ebib-current-string (edb-strings ebib-cur-db))))) + +(defun ebib-strings-help () + "Shows the info node on Ebib's strings buffer." + (interactive) + (setq ebib-info-flag t) + (ebib-lower) + (info "(ebib) The Strings Buffer")) + +;;;;;;;;;;;;;;;;;;;; +;; multiline edit ;; +;;;;;;;;;;;;;;;;;;;; + +(define-minor-mode ebib-multiline-mode + "Minor mode for Ebib's multiline edit buffer." + :init-value nil :lighter nil :global nil + :keymap '(("\C-c|q" . ebib-quit-multiline-edit) + ("\C-c|c" . ebib-cancel-multiline-edit) + ("\C-c|s" . ebib-save-from-multiline-edit) + ("\C-c|h" . ebib-multiline-help))) + +(easy-menu-define ebib-multiline-menu ebib-multiline-mode-map "Ebib multiline menu" + '("Ebib" + ["Store Text and Exit" ebib-quit-multiline-edit t] + ["Cancel Edit" ebib-cancel-multiline-edit t] + ["Save Text" ebib-save-from-multiline-edit t] + ["Help" ebib-multiline-help t])) + +(easy-menu-add ebib-multiline-menu ebib-multiline-mode-map) + +(defun ebib-multiline-edit (type &optional starttext) + "Switches to Ebib's multiline edit buffer. +STARTTEXT is a string that contains the initial text of the buffer." + ;; note: the buffer is put in the currently active window! + (setq ebib-pre-multiline-buffer (current-buffer)) + (switch-to-buffer ebib-multiline-buffer) + (set-buffer-modified-p nil) + (erase-buffer) + (setq ebib-editing type) + (when starttext + (insert starttext) + (goto-char (point-min)) + (set-buffer-modified-p nil))) + +(defun ebib-quit-multiline-edit () + "Quits the multiline edit buffer, saving the text." + (interactive) + (ebib-store-multiline-text) + (ebib-leave-multiline-edit-buffer) + (cond + ((eq ebib-editing 'fields) + (ebib-next-field)) + ((eq ebib-editing 'strings) + (ebib-next-string))) + (message "Text stored.")) + +(defun ebib-cancel-multiline-edit () + "Quits the multiline edit buffer and discards the changes." + (interactive) + (catch 'no-cancel + (when (buffer-modified-p) + (unless (y-or-n-p "Text has been modified. Abandon changes? ") + (throw 'no-cancel nil))) + (ebib-leave-multiline-edit-buffer))) + +(defun ebib-leave-multiline-edit-buffer () + "Leaves the multiline edit buffer. +Restores the previous buffer in the window that the multiline +edit buffer was shown in." + (switch-to-buffer ebib-pre-multiline-buffer) + (cond + ((eq ebib-editing 'preamble) + (select-window (get-buffer-window ebib-index-buffer) nil)) + ((eq ebib-editing 'fields) + ;; in full-frame layout, select-window isn't necessary, but it doesn't hurt either. + (select-window (get-buffer-window ebib-entry-buffer) nil) + (ebib-redisplay-current-field)) + ((eq ebib-editing 'strings) + ;; in full-frame layout, select-window isn't necessary, but it doesn't hurt either. + (select-window (get-buffer-window ebib-strings-buffer) nil) + (ebib-redisplay-current-string)))) + +(defun ebib-save-from-multiline-edit () + "Saves the database from within the multiline edit buffer. +The text being edited is stored before saving the database." + (interactive) + (ebib-store-multiline-text) + (ebib-save-database ebib-cur-db) + (set-buffer-modified-p nil)) + +(defun ebib-store-multiline-text () + "Stores the text being edited in the multiline edit buffer." + (let ((text (buffer-substring-no-properties (point-min) (point-max)))) + (cond + ((eq ebib-editing 'preamble) + (if (equal text "") + (setf (edb-preamble ebib-cur-db) nil) + (setf (edb-preamble ebib-cur-db) text))) + ((eq ebib-editing 'fields) + (if (equal text "") + (remhash ebib-current-field ebib-cur-entry-hash) + (when (not ebib-multiline-raw) + (setq text (from-raw text))) + (puthash ebib-current-field text ebib-cur-entry-hash))) + ((eq ebib-editing 'strings) + (if (equal text "") + ;; with ERROR, we avoid execution of EBIB-SET-MODIFIED and + ;; MESSAGE, but we also do not switch back to the strings + ;; buffer. this may not be so bad, actually, because the user + ;; may want to change his edit. + (error "@STRING definition cannot be empty ") + (setq text (from-raw text)) ; strings cannot be raw + (puthash ebib-current-string text (edb-strings ebib-cur-db)))))) + (ebib-set-modified t)) + +(defun ebib-multiline-help () + "Show the info node on Ebib's multiline edit buffer." + (interactive) + (setq ebib-info-flag t) + (ebib-lower) + (info "(ebib) The Multiline Edit Buffer")) + +;;;;;;;;;;;;;;;;;;; +;; ebib-log-mode ;; +;;;;;;;;;;;;;;;;;;; + +(defvar ebib-log-mode-map + (let ((map (make-keymap))) + (suppress-keymap map) + (define-key map " " 'scroll-up) + (define-key map "b" 'scroll-down) + (define-key map "q" 'ebib-quit-log-buffer) + map) + "Keymap for the ebib log buffer.") + +(define-derived-mode ebib-log-mode + fundamental-mode "Ebib-log" + "Major mode for the Ebib log buffer." + (local-set-key "\C-xb" 'ebib-quit-log-buffer) + (local-set-key "\C-xk" 'ebib-quit-log-buffer)) + +(defun ebib-quit-log-buffer () + "Exits the log buffer." + (interactive) + (set-window-dedicated-p (selected-window) nil) + (switch-to-buffer ebib-entry-buffer) + (unless (eq ebib-layout 'full) + (set-window-dedicated-p (selected-window) t)) + (select-window (get-buffer-window ebib-index-buffer) nil)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; functions for non-Ebib buffers ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun ebib-import () + "Searches for BibTeX entries in the current buffer. +The entries are added to the current database (i.e. the database +that was active when Ebib was lowered. Works on the whole buffer, +or on the region if it is active." + (interactive) + (if (not ebib-cur-db) + (error "No database loaded. Use `o' to open a database") + (if (edb-virtual ebib-cur-db) + (error "Cannot import to a virtual database") + (with-syntax-table ebib-syntax-table + (save-excursion + (save-restriction + (if (region-active) + (narrow-to-region (region-beginning) + (region-end))) + (let ((buffer (current-buffer))) + (with-temp-buffer + (insert-buffer-substring buffer) + (let ((n (ebib-find-bibtex-entries t))) + (setf (edb-keys-list ebib-cur-db) (sort (edb-keys-list ebib-cur-db) 'string<)) + (setf (edb-n-entries ebib-cur-db) (length (edb-keys-list ebib-cur-db))) + (when (edb-strings-list ebib-cur-db) + (setf (edb-strings-list ebib-cur-db) (sort (edb-strings-list ebib-cur-db) 'string<))) + (setf (edb-cur-entry ebib-cur-db) (edb-keys-list ebib-cur-db)) + (ebib-fill-entry-buffer) + (ebib-fill-index-buffer) + (ebib-set-modified t) + (message (format "%d entries, %d @STRINGs and %s @PREAMBLE found in buffer." + (car n) + (cadr n) + (if (caddr n) + "a" + "no")))))))))))) + +(defun ebib-get-db-from-filename (filename) + "Returns the database struct associated with FILENAME." + (when (file-name-absolute-p filename) + (setq filename (expand-file-name filename))) ; expand ~, . and .. + (catch 'found + (mapc #'(lambda (db) + (if (string= filename + ;; if filename is absolute, we want to compare + ;; to the absolute filename of the database, + ;; otherwise we should use only the + ;; non-directory component. + (if (file-name-absolute-p filename) + (edb-filename db) + (file-name-nondirectory (edb-filename db)))) + (throw 'found db))) + ebib-databases) + nil)) + +(defun ebib-get-local-databases () + "Returns a list of .bib files associated with the file in the current LaTeX buffer. +Each element in the list is a string holding the name of the .bib +file. This function simply searches the current LaTeX file or its +master file for a \\bibliography command and returns the file(s) +given in its argument. If no \\bibliography command is found, +returns the symbol NONE." + (let ((texfile-buffer (current-buffer)) + texfile) + ;; if AucTeX's TeX-master is used and set to a string, we must + ;; search that file for a \bibliography command, as it's more + ;; likely to be in there than in the file we're in. + (and (boundp 'TeX-master) + (stringp TeX-master) + (setq texfile (ensure-extension TeX-master "tex"))) + (with-temp-buffer + (if (and texfile (file-readable-p texfile)) + (insert-file-contents texfile) + (insert-buffer-substring texfile-buffer)) + (save-excursion + (goto-char (point-min)) + (if (re-search-forward "\\\\\\(no\\)*bibliography{\\(.*?\\)}" nil t) + (mapcar #'(lambda (file) + (ensure-extension file "bib")) + (split-string (buffer-substring-no-properties (match-beginning 2) (match-end 2)) ",[ ]*")) + 'none))))) + +(defun ebib-create-collection-from-db () + "Create a collection of BibTeX keys. +The source of the collection is either curent database or, if the +current buffer is a LaTeX file containing a \\bibliography +command, the BibTeX files in that command (if they are open in +Ebib)." + (or ebib-local-bibtex-filenames + (setq ebib-local-bibtex-filenames (ebib-get-local-databases))) + (let (collection) + (if (eq ebib-local-bibtex-filenames 'none) + (if (null (edb-cur-entry ebib-cur-db)) + (error "No entries found in current database") + (setq collection (ebib-create-collection (edb-database ebib-cur-db)))) + (mapc #'(lambda (file) + (let ((db (ebib-get-db-from-filename file))) + (cond + ((null db) + (message "Database %s not loaded" file)) + ((null (edb-cur-entry db)) + (message "No entries in database %s" file)) + (t (setq collection (append (ebib-create-collection (edb-database db)) + collection)))))) + ebib-local-bibtex-filenames)) + collection)) + +(defun ebib-insert-bibtex-key () + "Inserts a BibTeX key at POINT. +The user is prompted for a BibTeX key and has to choose one from +the database(s) associated with the current LaTeX file, or from +the current database if there is no \\bibliography command. Tab +completion works." + (interactive) + (ebib-execute-when + ((database) + (let ((collection (ebib-create-collection-from-db))) + (when collection + (let* ((key (completing-read "Key to insert: " collection nil t nil ebib-minibuf-hist)) + (format-list (or (cadr (assoc (buffer-local-value 'major-mode (current-buffer)) ebib-citation-commands)) + (cadr (assoc 'any ebib-citation-commands)))) + (citation-command + (if-str (format-string (cadr (assoc + (completing-read "Command to use: " format-list nil nil nil ebib-minibuf-hist) + format-list))) + (multiple-value-bind (before repeater separator after) (ebib-split-citation-string format-string) + (concat (ebib-create-citation-command before) + (ebib-create-citation-command repeater key) + (ebib-create-citation-command after))) + key))) ; if the user didn't provide a command, we insert just the entry key + (when citation-command + (insert (format "%s" citation-command))))))) + ((default) + (error "No database loaded")))) + +(defun ebib-entry-summary () + "Shows the fields of the key at POINT. +The key is searched in the database associated with the LaTeX +file, or in the current database if no \\bibliography command can +be found." + (interactive) + (ebib-execute-when + ((database) + (or ebib-local-bibtex-filenames + (setq ebib-local-bibtex-filenames (ebib-get-local-databases))) + (let ((key (read-string-at-point "\"#%'(),={} \n\t\f")) + entry + database) + (if (eq ebib-local-bibtex-filenames 'none) + (if (not (member key (edb-keys-list ebib-cur-db))) + (error "Entry `%s' is not in the current database" key) + (setq entry (gethash key (edb-database ebib-cur-db))) + (setq database ebib-cur-db)) + (multiple-value-setq (entry database) + (catch 'found + (mapc #'(lambda (file) + (let ((db (ebib-get-db-from-filename file))) + (if (null db) + (message "Database %s not loaded" file) + (if (member key (edb-keys-list db)) + (throw 'found (values (gethash key (edb-database db)) db)))))) + ebib-local-bibtex-filenames) + (list nil nil)))) + (if (null entry) + (error "Entry `%s' not found" key) + (let ((index-window (get-buffer-window ebib-index-buffer))) + (if (not index-window) + (with-help-window "*Help*" + (ebib-format-fields entry 'princ)) + (with-selected-window index-window + (setq ebib-cur-db database) + (ebib-fill-index-buffer) + (setf (edb-cur-entry ebib-cur-db) (member key (edb-keys-list ebib-cur-db))) + (goto-char (point-min)) + (re-search-forward (format "^%s " key)) + (beginning-of-line) + (ebib-set-index-highlight)) + (ebib-fill-entry-buffer)))))) + ((default) + (error "No database(s) loaded")))) + +(defun ebib-create-bib-from-bbl () + "Create a .bib file for the current LaTeX document. +The LaTeX document must have a .bbl file associated with it. All +bibitems are extracted from this file and a new .bib file is +created containing only these entries." + (interactive) + (ebib-execute-when + ((database) + (or ebib-local-bibtex-filenames + (setq ebib-local-bibtex-filenames (ebib-get-local-databases))) + (let* ((filename-sans-extension (file-name-sans-extension (buffer-file-name))) + (bbl-file (concat filename-sans-extension ".bbl")) + (bib-file (concat filename-sans-extension ".bib"))) + (unless (file-exists-p bbl-file) + (error "No .bbl file exists. Run BibTeX first")) + (when (or (not (file-exists-p bib-file)) + (y-or-n-p (format "%s already exists. Overwrite? " (file-name-nondirectory bib-file)))) + (when (file-exists-p bib-file) + (delete-file bib-file)) + (let ((databases + (delq nil (mapcar #'(lambda (file) + (ebib-get-db-from-filename file)) + ebib-local-bibtex-filenames)))) + (with-temp-buffer + (insert-file-contents bbl-file) + (ebib-export-entries (ebib-read-entries-from-bbl) databases bib-file)))))) + ((default) + (beep)))) + +(defun ebib-read-entries-from-bbl () + (interactive) + (goto-char (point-min)) + (let (entries) + (while (re-search-forward "\\\\bibitem\\[.*?\\]{\\(.*?\\)}" nil t) + (add-to-list 'entries (match-string 1) t)) + entries)) + +(provide 'ebib) + +;;; ebib ends here diff --git a/elisp/flyspell.el b/elisp/flyspell.el new file mode 100644 index 0000000..ce93e82 --- a/dev/null +++ b/elisp/flyspell.el @@ -0,0 +1,2460 @@ +;;; <pre> +;;; flyspell.el --- on-the-fly spell checker + +;; Copyright (C) 1998, 2000, 2003, 2004, 2005 Free Software Foundation, Inc. + +;; Author: Manuel Serrano <[email protected]> +;; Version: 1.7p +;; Keywords: convenience + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: +;; +;; Flyspell is a minor Emacs mode performing on-the-fly spelling +;; checking. +;; +;; To enable Flyspell minor mode, type M-x flyspell-mode. +;; This applies only to the current buffer. +;; +;; To enable Flyspell in text representing computer programs, type +;; M-x flyspell-prog-mode. +;; In that mode only text inside comments is checked. +;; +;; Note: consider setting the variable ispell-parser to `tex' to +;; avoid TeX command checking; use `(setq ispell-parser 'tex)'. +;; +;; Some user variables control the behavior of flyspell. They are +;; those defined under the `User variables' comment. + +;;; Code: +(require 'ispell) + +;*---------------------------------------------------------------------*/ +;* Group ... */ +;*---------------------------------------------------------------------*/ +(defgroup flyspell nil + "Spell checking on the fly." + :tag "FlySpell" + :prefix "flyspell-" + :group 'ispell + :group 'processes) + +;*---------------------------------------------------------------------*/ +;* Which emacs are we currently running */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-emacs + (cond + ((string-match "XEmacs" emacs-version) + 'xemacs) + (t + 'emacs)) + "The type of Emacs we are currently running.") + +(defvar flyspell-use-local-map + (or (eq flyspell-emacs 'xemacs) + (not (string< emacs-version "20")))) + +;*---------------------------------------------------------------------*/ +;* User configuration ... */ +;*---------------------------------------------------------------------*/ +(defcustom flyspell-highlight-flag t + "*How Flyspell should indicate misspelled words. +Non-nil means use highlight, nil means use minibuffer messages." + :group 'flyspell + :type 'boolean) + +(defcustom flyspell-mark-duplications-flag t + "*Non-nil means Flyspell reports a repeated word as an error." + :group 'flyspell + :type 'boolean) + +(defcustom flyspell-sort-corrections nil + "*Non-nil means, sort the corrections alphabetically before popping them." + :group 'flyspell + :version "21.1" + :type 'boolean) + +(defcustom flyspell-duplicate-distance -1 + "*The maximum distance for finding duplicates of unrecognized words. +This applies to the feature that when a word is not found in the dictionary, +if the same spelling occurs elsewhere in the buffer, +Flyspell uses a different face (`flyspell-duplicate-face') to highlight it. +This variable specifies how far to search to find such a duplicate. +-1 means no limit (search the whole buffer). +0 means do not search for duplicate unrecognized spellings." + :group 'flyspell + :version "21.1" + :type 'number) + +(defcustom flyspell-delay 3 + "*The number of seconds to wait before checking, after a \"delayed\" command." + :group 'flyspell + :type 'number) + +(defcustom flyspell-persistent-highlight t + "*Non-nil means misspelled words remain highlighted until corrected. +If this variable is nil, only the most recently detected misspelled word +is highlighted." + :group 'flyspell + :type 'boolean) + +(defcustom flyspell-highlight-properties t + "*Non-nil means highlight incorrect words even if a property exists for this word." + :group 'flyspell + :type 'boolean) + +(defcustom flyspell-default-delayed-commands + '(self-insert-command + delete-backward-char + backward-or-forward-delete-char + delete-char + scrollbar-vertical-drag + backward-delete-char-untabify) + "The standard list of delayed commands for Flyspell. +See `flyspell-delayed-commands'." + :group 'flyspell + :version "21.1" + :type '(repeat (symbol))) + +(defcustom flyspell-delayed-commands nil + "List of commands that are \"delayed\" for Flyspell mode. +After these commands, Flyspell checking is delayed for a short time, +whose length is specified by `flyspell-delay'." + :group 'flyspell + :type '(repeat (symbol))) + +(defcustom flyspell-default-deplacement-commands + '(next-line + previous-line + scroll-up + scroll-down) + "The standard list of deplacement commands for Flyspell. +See `flyspell-deplacement-commands'." + :group 'flyspell + :version "21.1" + :type '(repeat (symbol))) + +(defcustom flyspell-default-ignored-commands + '(fill-paragraph) + "The standard list of ignored commands for Flyspell. + See `flyspell-delayed-commands'." + :group 'flyspell + :version "21.3" + :type '(repeat (symbol))) + + (defcustom flyspell-ignored-commands nil + "List of commands that are \"ignored\" for Flyspell mode. + The changes in the text made by these commands are ignored. This list is meant for commands that change text in a way that does not affect individual words, such as `fill-paragraph'." + :group 'flyspell + :version "21.3" + :type '(repeat (symbol))) + +(defcustom flyspell-deplacement-commands nil + "List of commands that are \"deplacement\" for Flyspell mode. +After these commands, Flyspell checking is performed only if the previous +command was not the very same command." + :group 'flyspell + :version "21.1" + :type '(repeat (symbol))) + +(defcustom flyspell-issue-welcome-flag t + "*Non-nil means that Flyspell should display a welcome message when started." + :group 'flyspell + :type 'boolean) + +(defcustom flyspell-issue-message-flag t + "*Non-nil means that Flyspell emits messages when checking words." + :group 'flyspell + :type 'boolean) + +(defcustom flyspell-incorrect-hook nil + "*List of functions to be called when incorrect words are encountered. +Each function is given three arguments: the beginning and the end +of the incorrect region. The third is either the symbol 'doublon' or the list +of possible corrections as returned by 'ispell-parse-output'. + +If any of the functions return non-Nil, the word is not highlighted as +incorrect." + :group 'flyspell + :version "21.1" + :type 'hook) + +(defcustom flyspell-default-dictionary nil + "A string that is the name of the default dictionary. +This is passed to the `ispell-change-dictionary' when flyspell is started. +If the variable `ispell-local-dictionary' or `ispell-dictionary' is non-nil +when flyspell is started, the value of that variable is used instead +of `flyspell-default-dictionary' to select the default dictionary. +Otherwise, if `flyspell-default-dictionary' is nil, it means to use +Ispell's ultimate default dictionary." + :group 'flyspell + :version "21.1" + :type '(choice string (const :tag "Default" nil))) + +(defcustom flyspell-tex-command-regexp + "\\(\\(begin\\|end\\)[ \t]*{\\|\\(cite[a-z*]*\\|label\\|ref\\|eqref\\|usepackage\\|documentclass\\)[ \t]*\\(\\[[^]]*\\]\\)?{[^{}]*\\)" + "A string that is the regular expression that matches TeX commands." + :group 'flyspell + :version "21.1" + :type 'string) + +(defcustom flyspell-check-tex-math-command nil + "*Non nil means check even inside TeX math environment. +TeX math environments are discovered by the TEXMATHP that implemented +inside the texmathp.el Emacs package. That package may be found at: +http://strw.leidenuniv.nl/~dominik/Tools" + :group 'flyspell + :type 'boolean) + +(defcustom flyspell-dictionaries-that-consider-dash-as-word-delimiter + '("francais" "deutsch8" "norsk") + "List of dictionary names that consider `-' as word delimiter." + :group 'flyspell + :version "21.1" + :type '(repeat (string))) + +(defcustom flyspell-abbrev-p + nil + "*If non-nil, add correction to abbreviation table." + :group 'flyspell + :version "21.1" + :type 'boolean) + +(defcustom flyspell-use-global-abbrev-table-p + nil + "*If non-nil, prefer global abbrev table to local abbrev table." + :group 'flyspell + :version "21.1" + :type 'boolean) + +;;;###autoload +(defcustom flyspell-mode-line-string " Fly" + "*String displayed on the modeline when flyspell is active. +Set this to nil if you don't want a modeline indicator." + :group 'flyspell + :type '(choice string (const :tag "None" nil))) + +(defcustom flyspell-large-region 1000 + "*The threshold that determines if a region is small. +The `flyspell-region' function is invoked if the region is small, the +word are checked one after the other using regular flyspell check +means. If the region is large, a new Ispell process is spawned to get +speed. + +if flyspell-large-region is nil, regions are treated as small." + :group 'flyspell + :version "21.1" + :type '(choice number boolean)) + +(defcustom flyspell-insert-function (function insert) + "*Function for inserting word by flyspell upon correction." + :group 'flyspell + :type 'function) + +(defcustom flyspell-before-incorrect-word-string nil + "String used to indicate an incorrect word starting." + :group 'flyspell + :type '(choice string (const nil))) + +(defcustom flyspell-after-incorrect-word-string nil + "String used to indicate an incorrect word ending." + :group 'flyspell + :type '(choice string (const nil))) + +(defcustom flyspell-use-meta-tab t + "*Non-nil means that flyspell uses META-TAB to correct word." + :group 'flyspell + :type 'boolean) + +(defcustom flyspell-auto-correct-binding + (cond + ((eq flyspell-emacs 'xemacs) + [(control \;)]) + (t + [?\C-\;])) + "The key binding for flyspell auto correction." + :group 'flyspell) + +;*---------------------------------------------------------------------*/ +;* Mode specific options */ +;* ------------------------------------------------------------- */ +;* Mode specific options enable users to disable flyspell on */ +;* certain word depending of the emacs mode. For instance, when */ +;* using flyspell with mail-mode add the following expression */ +;* in your .emacs file: */ +;* (add-hook 'mail-mode */ +;* '(lambda () (setq flyspell-generic-check-word-p */ +;* 'mail-mode-flyspell-verify))) */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-generic-check-word-p nil + "Function providing per-mode customization over which words are flyspelled. +Returns t to continue checking, nil otherwise. +Flyspell mode sets this variable to whatever is the `flyspell-mode-predicate' +property of the major mode name.") +(make-variable-buffer-local 'flyspell-generic-check-word-p) + +;*--- mail mode -------------------------------------------------------*/ +(put 'mail-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify) +(put 'message-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify) +(defun mail-mode-flyspell-verify () + "This function is used for `flyspell-generic-check-word-p' in Mail mode." + (let ((header-end (save-excursion + (goto-char (point-min)) + (re-search-forward + (concat "^" + (regexp-quote mail-header-separator) + "$") + nil t) + (point))) + (signature-begin (save-excursion + (goto-char (point-max)) + (re-search-backward message-signature-separator + nil t) + (point)))) + (cond ((< (point) header-end) + (and (save-excursion (beginning-of-line) + (looking-at "^Subject:")) + (> (point) (match-end 0)))) + ((> (point) signature-begin) + nil) + (t + (save-excursion + (beginning-of-line) + (not (looking-at "[>}|]\\|To:"))))))) + +;*--- texinfo mode ----------------------------------------------------*/ +(put 'texinfo-mode 'flyspell-mode-predicate 'texinfo-mode-flyspell-verify) +(defun texinfo-mode-flyspell-verify () + "This function is used for `flyspell-generic-check-word-p' in Texinfo mode." + (save-excursion + (forward-word -1) + (not (looking-at "@")))) + +;*--- tex mode --------------------------------------------------------*/ +(put 'tex-mode 'flyspell-mode-predicate 'tex-mode-flyspell-verify) +(defun tex-mode-flyspell-verify () + "This function is used for `flyspell-generic-check-word-p' in LaTeX mode." + (and + (not (save-excursion + (re-search-backward "^[ \t]*%%%[ \t]+Local" (point-min) t))) + (not (save-excursion + (let ((this (point-marker)) + (e (progn (end-of-line) (point-marker)))) + (beginning-of-line) + (if (re-search-forward "\\\\\\(cite\\|label\\|ref\\){[^}]*}" e t) + (and (>= this (match-beginning 0)) + (<= this (match-end 0)) ))))))) + +;*--- sgml mode -------------------------------------------------------*/ +(put 'sgml-mode 'flyspell-mode-predicate 'sgml-mode-flyspell-verify) +(put 'html-mode 'flyspell-mode-predicate 'sgml-mode-flyspell-verify) + +(defun sgml-mode-flyspell-verify () + "This function is used for `flyspell-generic-check-word-p' in SGML mode." + (not (save-excursion + (let ((this (point-marker)) + (s (progn (beginning-of-line) (point-marker))) + (e (progn (end-of-line) (point-marker)))) + (or (progn + (goto-char this) + (and (re-search-forward "[^<]*>" e t) + (= (match-beginning 0) this))) + (progn + (goto-char this) + (and (re-search-backward "<[^>]*" s t) + (= (match-end 0) this))) + (and (progn + (goto-char this) + (and (re-search-forward "[^&]*;" e t) + (= (match-beginning 0) this))) + (progn + (goto-char this) + (and (re-search-backward "&[^;]*" s t) + (= (match-end 0) this))))))))) + +;*---------------------------------------------------------------------*/ +;* Programming mode */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-prog-text-faces + '(font-lock-string-face font-lock-comment-face font-lock-doc-face) + "Faces corresponding to text in programming-mode buffers.") + +(defun flyspell-generic-progmode-verify () + "Used for `flyspell-generic-check-word-p' in programming modes." + (let ((f (get-text-property (point) 'face))) + (memq f flyspell-prog-text-faces))) + +;;;###autoload +(defun flyspell-prog-mode () + "Turn on `flyspell-mode' for comments and strings." + (interactive) + (setq flyspell-generic-check-word-p 'flyspell-generic-progmode-verify) + (flyspell-mode 1) + (run-hooks 'flyspell-prog-mode-hook)) + +;*---------------------------------------------------------------------*/ +;* Overlay compatibility */ +;*---------------------------------------------------------------------*/ +(autoload 'make-overlay "overlay" "Overlay compatibility kit." t) +(autoload 'overlayp "overlay" "Overlay compatibility kit." t) +(autoload 'overlays-in "overlay" "Overlay compatibility kit." t) +(autoload 'delete-overlay "overlay" "Overlay compatibility kit." t) +(autoload 'overlays-at "overlay" "Overlay compatibility kit." t) +(autoload 'overlay-put "overlay" "Overlay compatibility kit." t) +(autoload 'overlay-get "overlay" "Overlay compatibility kit." t) +(autoload 'previous-overlay-change "overlay" "Overlay compatibility kit." t) + +;*---------------------------------------------------------------------*/ +;* The minor mode declaration. */ +;*---------------------------------------------------------------------*/ +(eval-when-compile (defvar flyspell-local-mouse-map)) + +;;;###autoload +(defvar flyspell-mode nil) +(make-variable-buffer-local 'flyspell-mode) + +(defvar flyspell-mouse-map + (let ((map (make-sparse-keymap))) + (if flyspell-use-meta-tab + (define-key map "\M-\t" #'flyspell-auto-correct-word)) + (define-key map (if (featurep 'xemacs) [button2] [down-mouse-2]) + #'flyspell-correct-word) + (if (not (featurep 'xemacs)) + (define-key map [(shift down-mouse-2)] #'flyspell-correct-word)) + (define-key map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word) + (define-key map [(control \,)] 'flyspell-goto-next-error) + (define-key map [(control \.)] 'flyspell-auto-correct-word) + map)) + +;;;###autoload +(defvar flyspell-mode-map (make-sparse-keymap)) + +;; mouse, keyboard bindings and misc definition +(when (or (assoc 'flyspell-mode minor-mode-map-alist) + (setq minor-mode-map-alist + (cons (cons 'flyspell-mode flyspell-mode-map) + minor-mode-map-alist))) + (if flyspell-use-meta-tab + (define-key flyspell-mode-map "\M-\t" 'flyspell-auto-correct-word)) + (cond + ((eq flyspell-emacs 'xemacs) + (define-key flyspell-mode-map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word) + (define-key flyspell-mode-map [(control \,)] 'flyspell-goto-next-error) + (define-key flyspell-mode-map [(control \.)] 'flyspell-auto-correct-word)) + (flyspell-use-local-map + (define-key flyspell-mode-map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word) + (define-key flyspell-mode-map [?\C-\,] 'flyspell-goto-next-error) + (define-key flyspell-mode-map [?\C-\.] 'flyspell-auto-correct-word)))) + + +;; the name of the overlay property that defines the keymap +(defvar flyspell-overlay-keymap-property-name 'keymap) + +;; dash character machinery +(defvar flyspell-consider-dash-as-word-delimiter-flag nil + "*Non-nil means that the `-' char is considered as a word delimiter.") +(make-variable-buffer-local 'flyspell-consider-dash-as-word-delimiter-flag) +(defvar flyspell-dash-dictionary nil) +(make-variable-buffer-local 'flyspell-dash-dictionary) +(defvar flyspell-dash-local-dictionary nil) +(make-variable-buffer-local 'flyspell-dash-local-dictionary) + +;*---------------------------------------------------------------------*/ +;* Highlighting */ +;*---------------------------------------------------------------------*/ +(defface flyspell-incorrect-face + (if (eq flyspell-emacs 'xemacs) + '((((class color)) (:foreground "OrangeRed" :bold t :underline t)) + (t (:bold t))) + '((((class color)) (:foreground "OrangeRed" :weight bold :underline t)) + (t (:weight bold)))) + "Face used for marking a misspelled word in Flyspell." + :group 'flyspell) + +(defface flyspell-duplicate-face + (if (eq flyspell-emacs 'xemacs) + '((((class color)) (:foreground "Gold3" :bold t :underline t)) + (t (:bold t))) + '((((class color)) (:foreground "Gold3" :weight bold :underline t)) + (t (:weight bold)))) + "Face used for marking a misspelled word that appears twice in the buffer. +See also `flyspell-duplicate-distance'." + :group 'flyspell) + +(defvar flyspell-overlay nil) + +;*---------------------------------------------------------------------*/ +;* flyspell-mode ... */ +;*---------------------------------------------------------------------*/ +;;;###autoload +(defun flyspell-mode (&optional arg) + "Minor mode performing on-the-fly spelling checking. +Ispell is automatically spawned on background for each entered words. +The default flyspell behavior is to highlight incorrect words. +With no argument, this command toggles Flyspell mode. +With a prefix argument ARG, turn Flyspell minor mode on iff ARG is positive. + +Bindings: +\\[ispell-word]: correct words (using Ispell). +\\[flyspell-auto-correct-word]: automatically correct word. +\\[flyspell-auto-correct-previous-word]: automatically correct the last misspelled word. +\\[flyspell-correct-word] (or down-mouse-2): popup correct words. + +Hooks: +This runs `flyspell-mode-hook' after flyspell is entered. + +Remark: +`flyspell-mode' uses `ispell-mode'. Thus all Ispell options are +valid. For instance, a personal dictionary can be used by +invoking `ispell-change-dictionary'. + +Consider using the `ispell-parser' to check your text. For instance +consider adding: +\(add-hook 'tex-mode-hook (function (lambda () (setq ispell-parser 'tex)))) +in your .emacs file. + +\\[flyspell-region] checks all words inside a region. +\\[flyspell-buffer] checks the whole buffer." + (interactive "P") + (let ((old-flyspell-mode flyspell-mode)) + ;; Mark the mode as on or off. + (setq flyspell-mode (not (or (and (null arg) flyspell-mode) + (<= (prefix-numeric-value arg) 0)))) + ;; Do the real work. + (unless (eq flyspell-mode old-flyspell-mode) + (if flyspell-mode + (flyspell-mode-on) + (flyspell-mode-off)) + ;; Force modeline redisplay. + (set-buffer-modified-p (buffer-modified-p))))) + +;*---------------------------------------------------------------------*/ +;* Autoloading */ +;*---------------------------------------------------------------------*/ +;;;###autoload +(if (fboundp 'add-minor-mode) + (add-minor-mode 'flyspell-mode + 'flyspell-mode-line-string + flyspell-mode-map + nil + 'flyspell-mode) + (or (assoc 'flyspell-mode minor-mode-alist) + (setq minor-mode-alist + (cons '(flyspell-mode flyspell-mode-line-string) + minor-mode-alist))) + + (or (assoc 'flyspell-mode minor-mode-map-alist) + (setq minor-mode-map-alist + (cons (cons 'flyspell-mode flyspell-mode-map) + minor-mode-map-alist)))) + +;*---------------------------------------------------------------------*/ +;* flyspell-buffers ... */ +;* ------------------------------------------------------------- */ +;* For remembering buffers running flyspell */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-buffers nil) + +;*---------------------------------------------------------------------*/ +;* flyspell-minibuffer-p ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-minibuffer-p (buffer) + "Is BUFFER a minibuffer?" + (let ((ws (get-buffer-window-list buffer t))) + (and (consp ws) (window-minibuffer-p (car ws))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-version ... */ +;*---------------------------------------------------------------------*/ +;;;###autoload +(defun flyspell-version () + "The flyspell version" + (interactive) + "1.7p") + +;*---------------------------------------------------------------------*/ +;* flyspell-accept-buffer-local-defs ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-accept-buffer-local-defs () + ;; strange problem. If buffer in current window has font-lock turned on, + ;; but SET-BUFFER was called to point to an invisible buffer, this ispell + ;; call will reset the buffer to the buffer in the current window. However, + ;; it only happens at startup (fix by Albert L. Ting). + (let ((buf (current-buffer))) + (ispell-accept-buffer-local-defs) + (set-buffer buf)) + (if (not (and (eq flyspell-dash-dictionary ispell-dictionary) + (eq flyspell-dash-local-dictionary ispell-local-dictionary))) + ;; the dictionary has changed + (progn + (setq flyspell-dash-dictionary ispell-dictionary) + (setq flyspell-dash-local-dictionary ispell-local-dictionary) + (if (member (or ispell-local-dictionary ispell-dictionary) + flyspell-dictionaries-that-consider-dash-as-word-delimiter) + (setq flyspell-consider-dash-as-word-delimiter-flag t) + (setq flyspell-consider-dash-as-word-delimiter-flag nil))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-mode-on ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-mode-on () + "Turn Flyspell mode on. Do not use this; use `flyspell-mode' instead." + (setq ispell-highlight-face 'flyspell-incorrect-face) + ;; local dictionaries setup + (ispell-change-dictionary + (or ispell-local-dictionary ispell-dictionary flyspell-default-dictionary)) + ;; we have to force ispell to accept the local definition or + ;; otherwise it could be too late, the local dictionary may + ;; be forgotten! + (flyspell-accept-buffer-local-defs) + ;; we put the `flyspell-delayed' property on some commands + (flyspell-delay-commands) + ;; we put the `flyspell-deplacement' property on some commands + (flyspell-deplacement-commands) + ;; we put the `flyspell-ignored' property on some commands + (flyspell-ignore-commands) + ;; we bound flyspell action to post-command hook + (if (eq flyspell-emacs 'xemacs) + (make-local-hook 'post-command-hook)) + (add-hook 'post-command-hook (function flyspell-post-command-hook) t t) + ;; we bound flyspell action to pre-command hook + (if (eq flyspell-emacs 'xemacs) + (make-local-hook 'pre-command-hook)) + (add-hook 'pre-command-hook (function flyspell-pre-command-hook) t t) + ;; we bound flyspell action to after-change hook + (make-local-variable 'after-change-functions) + (setq after-change-functions + (cons 'flyspell-after-change-function after-change-functions)) + ;; set flyspell-generic-check-word-p based on the major mode + (let ((mode-predicate (get major-mode 'flyspell-mode-predicate))) + (if mode-predicate + (setq flyspell-generic-check-word-p mode-predicate))) + ;; work around the fact that the `local-map' text-property replaces the + ;; buffer's local map rather than shadowing it. + (set (make-local-variable 'flyspell-mouse-map) + (let ((map (copy-keymap flyspell-mouse-map))) + (set-keymap-parent map (current-local-map)) + (if (and (eq flyspell-emacs 'emacs) + (not (string< emacs-version "20"))) + (define-key map '[tool-bar] nil)) + map)) + (set (make-local-variable 'flyspell-mode-map) + (let ((map (copy-keymap flyspell-mode-map))) + (set-keymap-parent map (current-local-map)) + (if (and (eq flyspell-emacs 'emacs) + (not (string< emacs-version "20"))) + (define-key map '[tool-bar] nil)) + map)) + ;; the welcome message + (if (and flyspell-issue-message-flag + flyspell-issue-welcome-flag + (interactive-p)) + (let ((binding (where-is-internal 'flyspell-auto-correct-word + nil 'non-ascii))) + (message + (if binding + (format "Welcome to flyspell. Use %s or Mouse-2 to correct words." + (key-description binding)) + "Welcome to flyspell. Use Mouse-2 to correct words.")))) + ;; we end with the flyspell hooks + (run-hooks 'flyspell-mode-hook)) + +;*---------------------------------------------------------------------*/ +;* flyspell-delay-commands ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-delay-commands () + "Install the standard set of Flyspell delayed commands." + (mapcar 'flyspell-delay-command flyspell-default-delayed-commands) + (mapcar 'flyspell-delay-command flyspell-delayed-commands)) + +;*---------------------------------------------------------------------*/ +;* flyspell-delay-command ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-delay-command (command) + "Set COMMAND to be delayed, for Flyspell. +When flyspell `post-command-hook' is invoked because a delayed command +as been used the current word is not immediately checked. +It will be checked only after `flyspell-delay' seconds." + (interactive "SDelay Flyspell after Command: ") + (put command 'flyspell-delayed t)) + +;*---------------------------------------------------------------------*/ +;* flyspell-deplacement-commands ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-deplacement-commands () + "Install the standard set of Flyspell deplacement commands." + (mapcar 'flyspell-deplacement-command flyspell-default-deplacement-commands) + (mapcar 'flyspell-deplacement-command flyspell-deplacement-commands)) + +;*---------------------------------------------------------------------*/ +;* flyspell-deplacement-command ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-deplacement-command (command) + "Set COMMAND that implement cursor movements, for Flyspell. +When flyspell `post-command-hook' is invoked because of a deplacement command +as been used the current word is checked only if the previous command was +not the very same deplacement command." + (interactive "SDeplacement Flyspell after Command: ") + (put command 'flyspell-deplacement t)) + +;*---------------------------------------------------------------------*/ +;* flyspell-ignore-commands ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-ignore-commands () + "Install the standard set of Flyspell ignored commands." + (mapcar 'flyspell-ignore-command flyspell-default-ignored-commands) + (mapcar 'flyspell-ignore-command flyspell-ignored-commands)) + +;*---------------------------------------------------------------------*/ +;* flyspell-ignore-command ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-ignore-command (command) + "Set COMMAND to be ignored, for Flyspell. +When flyspell `post-command-hook' is invoked because of an +ignored command having been used, the changes in the text made by +that command are ignored. This feature is meant for commands that +change text in a way that does not affect individual words, such +as `fill-paragraph'." + (interactive "SMake Flyspell ignore changes made by Command: ") + (put command 'flyspell-ignored t)) + +;*---------------------------------------------------------------------*/ +;* flyspell-word-cache ... */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-word-cache-start nil) +(defvar flyspell-word-cache-end nil) +(defvar flyspell-word-cache-word nil) +(defvar flyspell-word-cache-result '_) +(make-variable-buffer-local 'flyspell-word-cache-start) +(make-variable-buffer-local 'flyspell-word-cache-end) +(make-variable-buffer-local 'flyspell-word-cache-word) +(make-variable-buffer-local 'flyspell-word-cache-result) + +;*---------------------------------------------------------------------*/ +;* The flyspell pre-hook, store the current position. In the */ +;* post command hook, we will check, if the word at this position */ +;* has to be spell checked. */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-pre-buffer nil) +(defvar flyspell-pre-point nil) +(defvar flyspell-pre-column nil) +(defvar flyspell-pre-pre-buffer nil) +(defvar flyspell-pre-pre-point nil) + +;*---------------------------------------------------------------------*/ +;* flyspell-previous-command ... */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-previous-command nil + "The last interactive command checked by Flyspell.") + +;*---------------------------------------------------------------------*/ +;* flyspell-pre-command-hook ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-pre-command-hook () + "Save the current buffer and point for Flyspell's post-command hook." + (interactive) + (setq flyspell-pre-buffer (current-buffer)) + (setq flyspell-pre-point (point)) + (setq flyspell-pre-column (current-column))) + +;*---------------------------------------------------------------------*/ +;* flyspell-mode-off ... */ +;*---------------------------------------------------------------------*/ +;;;###autoload +(defun flyspell-mode-off () + "Turn Flyspell mode off." + ;; we remove the hooks + (remove-hook 'post-command-hook (function flyspell-post-command-hook) t) + (remove-hook 'pre-command-hook (function flyspell-pre-command-hook) t) + (setq after-change-functions (delq 'flyspell-after-change-function + after-change-functions)) + ;; we remove all the flyspell hilightings + (flyspell-delete-all-overlays) + ;; we have to erase pre cache variables + (setq flyspell-pre-buffer nil) + (setq flyspell-pre-point nil) + ;; we mark the mode as killed + (setq flyspell-mode nil)) + +;*---------------------------------------------------------------------*/ +;* flyspell-check-pre-word-p ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-check-pre-word-p () + "Return non-nil if we should check the word before point. +More precisely, it applies to the word that was before point +before the current command." + (cond + ((or (not (numberp flyspell-pre-point)) + (not (bufferp flyspell-pre-buffer)) + (not (buffer-live-p flyspell-pre-buffer))) + nil) + ((and (eq flyspell-pre-pre-point flyspell-pre-point) + (eq flyspell-pre-pre-buffer flyspell-pre-buffer)) + nil) + ((or (and (= flyspell-pre-point (- (point) 1)) + (eq (char-syntax (char-after flyspell-pre-point)) ?w)) + (= flyspell-pre-point (point)) + (= flyspell-pre-point (+ (point) 1))) + nil) + ((and (symbolp this-command) + (not executing-kbd-macro) + (or (get this-command 'flyspell-delayed) + (and (get this-command 'flyspell-deplacement) + (eq flyspell-previous-command this-command))) + (or (= (current-column) 0) + (= (current-column) flyspell-pre-column) + (eq (char-syntax (char-after flyspell-pre-point)) ?w))) + nil) + ((not (eq (current-buffer) flyspell-pre-buffer)) + t) + ((not (and (numberp flyspell-word-cache-start) + (numberp flyspell-word-cache-end))) + t) + (t + (or (< flyspell-pre-point flyspell-word-cache-start) + (> flyspell-pre-point flyspell-word-cache-end))))) + +;*---------------------------------------------------------------------*/ +;* The flyspell after-change-hook, store the change position. In */ +;* the post command hook, we will check, if the word at this */ +;* position has to be spell checked. */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-changes nil) + +;*---------------------------------------------------------------------*/ +;* flyspell-after-change-function ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-after-change-function (start stop len) + "Save the current buffer and point for Flyspell's post-command hook." + (interactive) + (unless (and (symbolp this-command) (get this-command 'flyspell-ignored)) + (setq flyspell-changes (cons (cons start stop) flyspell-changes)))) + +;*---------------------------------------------------------------------*/ +;* flyspell-check-changed-word-p ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-check-changed-word-p (start stop) + "Return t when the changed word has to be checked. +The answer depends of several criteria. +Mostly we check word delimiters." + (cond + ((and (memq (char-after start) '(?\n ? )) (> stop start)) + t) + ((not (numberp flyspell-pre-point)) + t) + ((and (>= flyspell-pre-point start) (<= flyspell-pre-point stop)) + nil) + ((let ((pos (point))) + (or (>= pos start) (<= pos stop) (= pos (1+ stop)))) + nil) + (t + t))) + +;*---------------------------------------------------------------------*/ +;* flyspell-check-word-p ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-check-word-p () + "Return t when the word at `point' has to be checked. +The answer depends of several criteria. +Mostly we check word delimiters." + (cond + ((<= (- (point-max) 1) (point-min)) + ;; the buffer is not filled enough + nil) + ((and (and (> (current-column) 0) + (not (eq (current-column) flyspell-pre-column))) + (save-excursion + (backward-char 1) + (and (looking-at (flyspell-get-not-casechars)) + (or flyspell-consider-dash-as-word-delimiter-flag + (not (looking-at "\\-")))))) + ;; yes because we have reached or typed a word delimiter. + t) + ((symbolp this-command) + (cond + ((get this-command 'flyspell-deplacement) + (not (eq flyspell-previous-command this-command))) + ((get this-command 'flyspell-delayed) + ;; the current command is not delayed, that + ;; is that we must check the word now + (if (or (fboundp 'about-xemacs) (featurep 'xemacs)) + (sit-for flyspell-delay nil) + (sit-for flyspell-delay 0 nil))) + (t t))) + (t t))) + +;*---------------------------------------------------------------------*/ +;* flyspell-debug-signal-no-check ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-debug-signal-no-check (msg obj) + (setq debug-on-error t) + (save-excursion + (let ((buffer (get-buffer-create "*flyspell-debug*"))) + (set-buffer buffer) + (erase-buffer) + (insert "NO-CHECK:\n") + (insert (format " %S : %S\n" msg obj))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-debug-signal-pre-word-checked ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-debug-signal-pre-word-checked () + (setq debug-on-error t) + (save-excursion + (let ((buffer (get-buffer-create "*flyspell-debug*"))) + (set-buffer buffer) + (insert "PRE-WORD:\n") + (insert (format " pre-point : %S\n" flyspell-pre-point)) + (insert (format " pre-buffer : %S\n" flyspell-pre-buffer)) + (insert (format " cache-start: %S\n" flyspell-word-cache-start)) + (insert (format " cache-end : %S\n" flyspell-word-cache-end)) + (goto-char (point-max))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-debug-signal-word-checked ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-debug-signal-word-checked () + (setq debug-on-error t) + (save-excursion + (let ((oldbuf (current-buffer)) + (buffer (get-buffer-create "*flyspell-debug*")) + (point (point))) + (set-buffer buffer) + (insert "WORD:\n") + (insert (format " this-cmd : %S\n" this-command)) + (insert (format " delayed : %S\n" (and (symbolp this-command) + (get this-command 'flyspell-delayed)))) + (insert (format " ignored : %S\n" (and (symbolp this-command) + (get this-command 'flyspell-ignored)))) + (insert (format " point : %S\n" point)) + (insert (format " prev-char : [%c] %S\n" + (progn + (set-buffer oldbuf) + (let ((c (if (> (point) (point-min)) + (save-excursion + (backward-char 1) + (char-after (point))) + ? ))) + (set-buffer buffer) + c)) + (progn + (set-buffer oldbuf) + (let ((c (if (> (point) (point-min)) + (save-excursion + (backward-char 1) + (and (and (looking-at (flyspell-get-not-casechars)) 1) + (and (or flyspell-consider-dash-as-word-delimiter-flag + (not (looking-at "\\-"))) 2)))))) + (set-buffer buffer) + c)))) + (insert (format " because : %S\n" + (cond + ((not (and (symbolp this-command) + (get this-command 'flyspell-delayed))) + ;; the current command is not delayed, that + ;; is that we must check the word now + 'not-delayed) + ((progn + (set-buffer oldbuf) + (let ((c (if (> (point) (point-min)) + (save-excursion + (backward-char 1) + (and (looking-at (flyspell-get-not-casechars)) + (or flyspell-consider-dash-as-word-delimiter-flag + (not (looking-at "\\-")))))))) + (set-buffer buffer) + c)) + ;; yes because we have reached or typed a word delimiter. + 'separator) + ((not (integerp flyspell-delay)) + ;; yes because the user had set up a no-delay configuration. + 'no-delay) + (t + 'sit-for)))) + (goto-char (point-max))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-debug-signal-changed-checked ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-debug-signal-changed-checked () + (setq debug-on-error t) + (save-excursion + (let ((buffer (get-buffer-create "*flyspell-debug*")) + (point (point))) + (set-buffer buffer) + (insert "CHANGED WORD:\n") + (insert (format " point : %S\n" point)) + (goto-char (point-max))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-post-command-hook ... */ +;* ------------------------------------------------------------- */ +;* It is possible that we check several words: */ +;* 1- the current word is checked if the predicate */ +;* FLYSPELL-CHECK-WORD-P is true */ +;* 2- the word that used to be the current word before the */ +;* THIS-COMMAND is checked if: */ +;* a- the previous word is different from the current word */ +;* b- the previous word as not just been checked by the */ +;* previous FLYSPELL-POST-COMMAND-HOOK */ +;* 3- the words changed by the THIS-COMMAND that are neither the */ +;* previous word nor the current word */ +;*---------------------------------------------------------------------*/ +(defun flyspell-post-command-hook () + "The `post-command-hook' used by flyspell to check a word on-the-fly." + (interactive) + (when flyspell-mode + (with-local-quit + (let ((command this-command)) + (if (flyspell-check-pre-word-p) + (save-excursion + '(flyspell-debug-signal-pre-word-checked) + (set-buffer flyspell-pre-buffer) + (save-excursion + (goto-char flyspell-pre-point) + (flyspell-word)))) + (if (flyspell-check-word-p) + (progn + '(flyspell-debug-signal-word-checked) + (flyspell-word) + ;; we remember which word we have just checked. + ;; this will be used next time we will check a word + ;; to compare the next current word with the word + ;; that as been registered in the pre-command-hook + ;; that is these variables are used within the predicate + ;; FLYSPELL-CHECK-PRE-WORD-P + (setq flyspell-pre-pre-buffer (current-buffer)) + (setq flyspell-pre-pre-point (point))) + (progn + (setq flyspell-pre-pre-buffer nil) + (setq flyspell-pre-pre-point nil) + ;; when a word is not checked because of a delayed command + ;; we do not disable the ispell cache. + (if (and (symbolp this-command) (get this-command 'flyspell-delayed)) + (progn + (setq flyspell-word-cache-end -1) + (setq flyspell-word-cache-result '_))))) + (while (consp flyspell-changes) + (let ((start (car (car flyspell-changes))) + (stop (cdr (car flyspell-changes)))) + (if (flyspell-check-changed-word-p start stop) + (save-excursion + '(flyspell-debug-signal-changed-checked) + (goto-char start) + (flyspell-word))) + (setq flyspell-changes (cdr flyspell-changes)))) + (setq flyspell-previous-command command))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-notify-misspell ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-notify-misspell (start end word poss) + (let ((replacements (if (stringp poss) + poss + (if flyspell-sort-corrections + (sort (car (cdr (cdr poss))) 'string<) + (car (cdr (cdr poss))))))) + (if flyspell-issue-message-flag + (message (format "mispelling `%s' %S" word replacements))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-word-search-backward ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-word-search-backward (word bound) + (save-excursion + (let ((r '()) + p) + (while (and (not r) (setq p (search-backward word bound t))) + (let ((lw (flyspell-get-word '()))) + (if (and (consp lw) (string-equal (car lw) word)) + (setq r p) + (goto-char p)))) + r))) + +;*---------------------------------------------------------------------*/ +;* flyspell-word-search-forward ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-word-search-forward (word bound) + (save-excursion + (let ((r '()) + p) + (while (and (not r) (setq p (search-forward word bound t))) + (let ((lw (flyspell-get-word '()))) + (if (and (consp lw) (string-equal (car lw) word)) + (setq r p) + (goto-char (1+ p))))) + r))) + +;*---------------------------------------------------------------------*/ +;* flyspell-word ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-word (&optional following) + "Spell check a word." + (interactive (list current-prefix-arg)) + (if (interactive-p) + (setq following ispell-following-word)) + (save-excursion + ;; use the correct dictionary + (flyspell-accept-buffer-local-defs) + (let* ((cursor-location (point)) + (flyspell-word (flyspell-get-word following)) + start end poss word) + (if (or (eq flyspell-word nil) + (and (fboundp flyspell-generic-check-word-p) + (not (funcall flyspell-generic-check-word-p)))) + t + (progn + ;; destructure return flyspell-word info list. + (setq start (car (cdr flyspell-word)) + end (car (cdr (cdr flyspell-word))) + word (car flyspell-word)) + ;; before checking in the directory, we check for doublons. + (cond + ((and (or (not (eq ispell-parser 'tex)) + (and (> start (point-min)) + (not (eq (char-after (1- start)) ?})) + (not (eq (char-after (1- start)) ?\\)))) + flyspell-mark-duplications-flag + (save-excursion + (goto-char (1- start)) + (let ((p (flyspell-word-search-backward + word + (- start (1+ (- end start)))))) + (and p (/= p (1- start)))))) + ;; yes, this is a doublon + (flyspell-highlight-incorrect-region start end 'doublon) + nil) + ((and (eq flyspell-word-cache-start start) + (eq flyspell-word-cache-end end) + (string-equal flyspell-word-cache-word word)) + ;; this word had been already checked, we skip + flyspell-word-cache-result) + ((and (eq ispell-parser 'tex) + (flyspell-tex-command-p flyspell-word)) + ;; this is a correct word (because a tex command) + (flyspell-unhighlight-at start) + (if (> end start) + (flyspell-unhighlight-at (- end 1))) + t) + (t + ;; we setup the cache + (setq flyspell-word-cache-start start) + (setq flyspell-word-cache-end end) + (setq flyspell-word-cache-word word) + ;; now check spelling of word. + (process-send-string ispell-process "%\n") + ;; put in verbose mode + (process-send-string ispell-process + (concat "^" word "\n")) + ;; we mark the ispell process so it can be killed + ;; when emacs is exited without query + (if (fboundp 'process-kill-without-query) + (process-kill-without-query ispell-process)) + ;; wait until ispell has processed word + (while (progn + (accept-process-output ispell-process) + (not (string= "" (car ispell-filter))))) + ;; (process-send-string ispell-process "!\n") + ;; back to terse mode. + (setq ispell-filter (cdr ispell-filter)) + (if (consp ispell-filter) + (setq poss (ispell-parse-output (car ispell-filter)))) + (let ((res (cond ((eq poss t) + ;; correct + (setq flyspell-word-cache-result t) + (flyspell-unhighlight-at start) + (if (> end start) + (flyspell-unhighlight-at (- end 1))) + t) + ((and (stringp poss) flyspell-highlight-flag) + ;; correct + (setq flyspell-word-cache-result t) + (flyspell-unhighlight-at start) + (if (> end start) + (flyspell-unhighlight-at (- end 1))) + t) + ((null poss) + (setq flyspell-word-cache-result t) + (flyspell-unhighlight-at start) + (if (> end start) + (flyspell-unhighlight-at (- end 1))) + t) + ((or (and (< flyspell-duplicate-distance 0) + (or (save-excursion + (goto-char start) + (flyspell-word-search-backward + word + (point-min))) + (save-excursion + (goto-char end) + (flyspell-word-search-forward + word + (point-max))))) + (and (> flyspell-duplicate-distance 0) + (or (save-excursion + (goto-char start) + (flyspell-word-search-backward + word + (- start + flyspell-duplicate-distance))) + (save-excursion + (goto-char end) + (flyspell-word-search-forward + word + (+ end + flyspell-duplicate-distance)))))) + (setq flyspell-word-cache-result nil) + (if flyspell-highlight-flag + (flyspell-highlight-duplicate-region + start end) + (message (format "duplicate `%s'" word))) + nil) + (t + (setq flyspell-word-cache-result nil) + ;; incorrect highlight the location + (if flyspell-highlight-flag + (flyspell-highlight-incorrect-region + start end poss) + (flyspell-notify-misspell start end word poss)) + nil)))) + ;; return to original location + (goto-char cursor-location) + (if ispell-quit (setq ispell-quit nil)) + res)))))))) + +;* {*---------------------------------------------------------------------*} */ +;* {* flyspell-tex-math-initialized ... *} */ +;* {*---------------------------------------------------------------------*} */ +;* (defvar flyspell-tex-math-initialized nil) */ +;* */ +;* {*---------------------------------------------------------------------*} */ +;* {* flyspell-math-tex-command-p ... *} */ +;* {* ------------------------------------------------------------- *} */ +;* {* This function uses the texmathp package to check if (point) *} */ +;* {* is within a tex command. In order to avoid using *} */ +;* {* condition-case each time we use the variable *} */ +;* {* flyspell-tex-math-initialized to make a special case the first *} */ +;* {* time that function is called. *} */ +;* {*---------------------------------------------------------------------*} */ +;* (defun flyspell-math-tex-command-p () */ +;* (cond */ +;* (flyspell-check-tex-math-command */ +;* nil) */ +;* ((eq flyspell-tex-math-initialized t) */ +;* (texmathp)) */ +;* ((eq flyspell-tex-math-initialized 'error) */ +;* nil) */ +;* (t */ +;* (setq flyspell-tex-math-initialized t) */ +;* (condition-case nil */ +;* (texmathp) */ +;* (error (progn */ +;* (setq flyspell-tex-math-initialized 'error) */ +;* nil)))))) */ + +;*---------------------------------------------------------------------*/ +;* flyspell-math-tex-command-p ... */ +;* ------------------------------------------------------------- */ +;* This function uses the texmathp package to check if point */ +;* is within a TeX math environment. `texmathp' can yield errors */ +;* if the document is currently not valid TeX syntax. */ +;*---------------------------------------------------------------------*/ +(defun flyspell-math-tex-command-p () + (when (fboundp 'texmathp) + (if flyspell-check-tex-math-command + nil + (condition-case nil + (texmathp) + (error nil))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-tex-command-p ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-tex-command-p (word) + "Return t if WORD is a TeX command." + (or (save-excursion + (let ((b (car (cdr word)))) + (and (re-search-backward "\\\\" (- (point) 100) t) + (or (= (match-end 0) b) + (and (goto-char (match-end 0)) + (looking-at flyspell-tex-command-regexp) + (>= (match-end 0) b)))))) + (flyspell-math-tex-command-p))) + +;*---------------------------------------------------------------------*/ +;* flyspell-casechars-cache ... */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-casechars-cache nil) +(defvar flyspell-ispell-casechars-cache nil) +(make-variable-buffer-local 'flyspell-casechars-cache) +(make-variable-buffer-local 'flyspell-ispell-casechars-cache) + +;*---------------------------------------------------------------------*/ +;* flyspell-get-casechars ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-get-casechars () + "This function builds a string that is the regexp of word chars. +In order to avoid one useless string construction, +this function changes the last char of the `ispell-casechars' string." + (let ((ispell-casechars (ispell-get-casechars))) + (cond + ((eq ispell-parser 'tex) + (setq flyspell-ispell-casechars-cache ispell-casechars) + (setq flyspell-casechars-cache + (concat (substring ispell-casechars + 0 + (- (length ispell-casechars) 1)) + "]")) + flyspell-casechars-cache) + (t + (setq flyspell-ispell-casechars-cache ispell-casechars) + (setq flyspell-casechars-cache ispell-casechars) + flyspell-casechars-cache)))) + +;*---------------------------------------------------------------------*/ +;* flyspell-get-not-casechars-cache ... */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-not-casechars-cache nil) +(defvar flyspell-ispell-not-casechars-cache nil) +(make-variable-buffer-local 'flyspell-not-casechars-cache) +(make-variable-buffer-local 'flyspell-ispell-not-casechars-cache) + +;*---------------------------------------------------------------------*/ +;* flyspell-get-not-casechars ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-get-not-casechars () + "This function builds a string that is the regexp of non-word chars." + (let ((ispell-not-casechars (ispell-get-not-casechars))) + (cond + ((eq ispell-parser 'tex) + (setq flyspell-ispell-not-casechars-cache ispell-not-casechars) + (setq flyspell-not-casechars-cache + (concat (substring ispell-not-casechars + 0 + (- (length ispell-not-casechars) 1)) + "]")) + flyspell-not-casechars-cache) + (t + (setq flyspell-ispell-not-casechars-cache ispell-not-casechars) + (setq flyspell-not-casechars-cache ispell-not-casechars) + flyspell-not-casechars-cache)))) + +;*---------------------------------------------------------------------*/ +;* flyspell-get-word ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-get-word (following &optional extra-otherchars) + "Return the word for spell-checking according to Ispell syntax. +If optional argument FOLLOWING is non-nil or if `flyspell-following-word' +is non-nil when called interactively, then the following word +\(rather than preceding\) is checked when the cursor is not over a word. +Optional second argument contains otherchars that can be included in word +many times. + +Word syntax described by `flyspell-dictionary-alist' (which see)." + (let* ((flyspell-casechars (flyspell-get-casechars)) + (flyspell-not-casechars (flyspell-get-not-casechars)) + (ispell-otherchars (ispell-get-otherchars)) + (ispell-many-otherchars-p (ispell-get-many-otherchars-p)) + (word-regexp (concat flyspell-casechars + "+\\(" + (if (not (string= "" ispell-otherchars)) + (concat ispell-otherchars "?")) + (if extra-otherchars + (concat extra-otherchars "?")) + flyspell-casechars + "+\\)" + (if (or ispell-many-otherchars-p + extra-otherchars) + "*" "?"))) + did-it-once prevpt + start end word) + ;; find the word + (if (not (looking-at flyspell-casechars)) + (if following + (re-search-forward flyspell-casechars (point-max) t) + (re-search-backward flyspell-casechars (point-min) t))) + ;; move to front of word + (re-search-backward flyspell-not-casechars (point-min) 'start) + (while (and (or (and (not (string= "" ispell-otherchars)) + (looking-at ispell-otherchars)) + (and extra-otherchars (looking-at extra-otherchars))) + (not (bobp)) + (or (not did-it-once) + ispell-many-otherchars-p) + (not (eq prevpt (point)))) + (if (and extra-otherchars (looking-at extra-otherchars)) + (progn + (backward-char 1) + (if (looking-at flyspell-casechars) + (re-search-backward flyspell-not-casechars (point-min) 'move))) + (setq did-it-once t + prevpt (point)) + (backward-char 1) + (if (looking-at flyspell-casechars) + (re-search-backward flyspell-not-casechars (point-min) 'move) + (backward-char -1)))) + ;; Now mark the word and save to string. + (if (not (re-search-forward word-regexp (point-max) t)) + nil + (progn + (setq start (match-beginning 0) + end (point) + word (buffer-substring-no-properties start end)) + (list word start end))))) + +(defun flyspell-get-word.old (following) + "Return the word for spell-checking according to Ispell syntax. +If argument FOLLOWING is non-nil or if `ispell-following-word' +is non-nil when called interactively, then the following word +\(rather than preceding\) is checked when the cursor is not over a word. +Optional second argument contains other chars that can be included in word +many times. + +Word syntax described by `ispell-dictionary-alist' (which see)." + (let* ((flyspell-casechars (flyspell-get-casechars)) + (flyspell-not-casechars (flyspell-get-not-casechars)) + (ispell-otherchars (ispell-get-otherchars)) + (ispell-many-otherchars-p (ispell-get-many-otherchars-p)) + (word-regexp (if (string< "" ispell-otherchars) + (concat flyspell-casechars + "+\\(" + ispell-otherchars + (if (> (length ispell-otherchars) 0) "?") + flyspell-casechars + "+\\)" + (if ispell-many-otherchars-p + "*" "?")) + (concat flyspell-casechars "+"))) + did-it-once + start end word) + ;; find the word + (if (not (looking-at flyspell-casechars)) + (if following + (re-search-forward flyspell-casechars (point-max) t) + (re-search-backward flyspell-casechars (point-min) t))) + ;; move to front of word + (re-search-backward flyspell-not-casechars (point-min) 'start) + (let ((pos nil)) + (if (string< "" ispell-otherchars) + (while (and (looking-at ispell-otherchars) + (not (bobp)) + (or (not did-it-once) + ispell-many-otherchars-p) + (not (eq pos (point)))) + (setq pos (point)) + (setq did-it-once t) + (backward-char 1) + (if (looking-at flyspell-casechars) + (re-search-backward flyspell-not-casechars (point-min) 'move) + (backward-char -1))))) + ;; Now mark the word and save to string. + (if (eq (re-search-forward word-regexp (point-max) t) nil) + nil + (progn + (setq start (match-beginning 0) + end (point) + word (buffer-substring-no-properties start end)) + (list word start end))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-small-region ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-small-region (beg end) + "Flyspell text between BEG and END." + (save-excursion + (if (> beg end) + (let ((old beg)) + (setq beg end) + (setq end old))) + (goto-char beg) + (let ((count 0)) + (while (< (point) end) + (if (and flyspell-issue-message-flag (= count 100)) + (progn + (message "Spell Checking...%d%%" + (* 100 (/ (float (- (point) beg)) (- end beg)))) + (setq count 0)) + (setq count (+ 1 count))) + (flyspell-word) + (sit-for 0) + (let ((cur (point))) + (forward-word 1) + (if (and (< (point) end) (> (point) (+ cur 1))) + (backward-char 1))))) + (backward-char 1) + (if flyspell-issue-message-flag (message "Spell Checking completed.")) + (flyspell-word))) + +;*---------------------------------------------------------------------*/ +;* flyspell-external-ispell-process ... */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-external-ispell-process '() + "The external Flyspell Ispell process.") + +;*---------------------------------------------------------------------*/ +;* flyspell-external-ispell-buffer ... */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-external-ispell-buffer '()) +(defvar flyspell-large-region-buffer '()) +(defvar flyspell-large-region-beg (point-min)) +(defvar flyspell-large-region-end (point-max)) + +;*---------------------------------------------------------------------*/ +;* flyspell-external-point-words ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-external-point-words () + (let ((buffer flyspell-external-ispell-buffer)) + (set-buffer buffer) + (beginning-of-buffer) + (let ((size (- flyspell-large-region-end flyspell-large-region-beg)) + (start flyspell-large-region-beg) + (pword "") + (pcount 1)) + ;; now we are done with ispell, we have to find the word in + ;; the initial buffer + (while (< (point) (- (point-max) 1)) + ;; we have to fetch the incorrect word + (if (re-search-forward "\\([^\n]+\\)\n" (point-max) t) + (let ((word (match-string 1))) + (if (string= word pword) + (setq pcount (1+ pcount)) + (progn + (setq pword word) + (setq pcount 1))) + (goto-char (match-end 0)) + (if flyspell-issue-message-flag + (message "Spell Checking...%d%% [%s]" + (* 100 (/ (float (point)) (point-max))) + word)) + (set-buffer flyspell-large-region-buffer) + (goto-char flyspell-large-region-beg) + (let ((keep t) + (n 0)) + (while (and (or (< n pcount) keep) + (search-forward word flyspell-large-region-end t)) + (progn + (goto-char (- (point) 1)) + (setq n (1+ n)) + (setq keep (flyspell-word)))) + (if (= n pcount) + (setq flyspell-large-region-beg (point)))) + (set-buffer buffer)) + (goto-char (point-max))))) + ;; we are done + (if flyspell-issue-message-flag (message "Spell Checking completed.")) + ;; ok, we are done with pointing out incorrect words, we just + ;; have to kill the temporary buffer + (kill-buffer flyspell-external-ispell-buffer) + (setq flyspell-external-ispell-buffer nil))) + +;*---------------------------------------------------------------------*/ +;* flyspell-process-localwords ... */ +;* ------------------------------------------------------------- */ +;* This function is used to prevent checking words declared */ +;* explictitly correct on large regions. */ +;*---------------------------------------------------------------------*/ +(defun flyspell-process-localwords () + "Parse Localwords in the buffer and remove them from the mispellings +buffer before flyspell attempts to check them." + (let (localwords + (current-buffer curbuf) + (mispellings-buffer buffer) + (ispell-casechars (ispell-get-casechars))) + ;; Get localwords from the original buffer + (save-excursion + (set-buffer current-buffer) +;* (flyspell-delete-all-overlays) */ + (beginning-of-buffer) + ;; Localwords parsing stolen form ispell.el + (while (search-forward ispell-words-keyword nil t) + (let ((end (save-excursion (end-of-line) (point))) + string) + ;; buffer-local words separated by a space, and can contain + ;; any character other than a space. Not rigorous enough. + (while (re-search-forward " *\\([^ ]+\\)" end t) + (setq string (buffer-substring-no-properties (match-beginning 1) + (match-end 1))) + ;; This can fail when string contains a word with illegal chars. + ;; Error handling needs to be added between ispell and emacs. + (if (and (< 1 (length string)) + (equal 0 (string-match ispell-casechars string))) + (setq localwords (add-to-list 'localwords string))))))) + ;; Remove localwords matches + (set-buffer mispellings-buffer) + (while localwords + (beginning-of-buffer) + (delete-matching-lines (concat "^" (car localwords) "$")) + (setq localwords (cdr localwords))) + (end-of-buffer))) + +;*---------------------------------------------------------------------*/ +;* flyspell-large-region ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-large-region (beg end) + (let* ((curbuf (current-buffer)) + (buffer (get-buffer-create "*flyspell-region*"))) + (setq flyspell-external-ispell-buffer buffer) + (setq flyspell-large-region-buffer curbuf) + (setq flyspell-large-region-beg beg) + (setq flyspell-large-region-end end) + (set-buffer buffer) + (erase-buffer) + ;; this is done, we can start checking... + (if flyspell-issue-message-flag (message "Checking region...")) + (set-buffer curbuf) + (let ((c (apply 'call-process-region beg + end + ispell-program-name + nil + buffer + nil + (if (boundp 'ispell-list-command) + ispell-list-command + "-l") + (let (args) + ;; Local dictionary becomes the global dictionary in use. + (if ispell-local-dictionary + (setq ispell-dictionary ispell-local-dictionary)) + (setq args (ispell-get-ispell-args)) + (if ispell-dictionary ; use specified dictionary + (setq args + (append (list "-d" ispell-dictionary) args))) + (if ispell-personal-dictionary ; use specified pers dict + (setq args + (append args + (list "-p" + (expand-file-name + ispell-personal-dictionary))))) + (setq args (append args ispell-extra-args)) + args)))) + (if (= c 0) + (progn + (flyspell-process-localwords) + (with-current-buffer curbuf + (flyspell-delete-region-overlays beg end)) + (flyspell-external-point-words)) + (error "Can't check region..."))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-region ... */ +;* ------------------------------------------------------------- */ +;* Because `ispell -a' is too slow, it is not possible to use */ +;* it on large region. Then, when ispell is invoked on a large */ +;* text region, a new `ispell -l' process is spawned. The */ +;* pointed out words are then searched in the region a checked with */ +;* regular flyspell means. */ +;*---------------------------------------------------------------------*/ +;;;###autoload +(defun flyspell-region (beg end) + "Flyspell text between BEG and END." + (interactive "r") + (if (= beg end) + () + (save-excursion + (if (> beg end) + (let ((old beg)) + (setq beg end) + (setq end old))) + (if (and flyspell-large-region (> (- end beg) flyspell-large-region)) + (flyspell-large-region beg end) + (flyspell-small-region beg end))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-buffer ... */ +;*---------------------------------------------------------------------*/ +;;;###autoload +(defun flyspell-buffer () + "Flyspell whole buffer." + (interactive) + (flyspell-region (point-min) (point-max))) + +;*---------------------------------------------------------------------*/ +;* old next error position ... */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-old-buffer-error nil) +(defvar flyspell-old-pos-error nil) + +;*---------------------------------------------------------------------*/ +;* flyspell-goto-next-error ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-goto-next-error () + "Go to the next previously detected error. +In general FLYSPELL-GOTO-NEXT-ERROR must be used after +FLYSPELL-BUFFER." + (interactive) + (let ((pos (point)) + (max (point-max))) + (if (and (eq (current-buffer) flyspell-old-buffer-error) + (eq pos flyspell-old-pos-error)) + (progn + (if (= flyspell-old-pos-error max) + ;; goto beginning of buffer + (progn + (message "Restarting from beginning of buffer") + (goto-char (point-min))) + (forward-word 1)) + (setq pos (point)))) + ;; seek the next error + (while (and (< pos max) + (let ((ovs (overlays-at pos)) + (r '())) + (while (and (not r) (consp ovs)) + (if (flyspell-overlay-p (car ovs)) + (setq r t) + (setq ovs (cdr ovs)))) + (not r))) + (setq pos (1+ pos))) + ;; save the current location for next invocation + (setq flyspell-old-pos-error pos) + (setq flyspell-old-buffer-error (current-buffer)) + (goto-char pos) + (if (= pos max) + (message "No more miss-spelled word!")))) + +;*---------------------------------------------------------------------*/ +;* flyspell-overlay-p ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-overlay-p (o) + "A predicate that return true iff O is an overlay used by flyspell." + (and (overlayp o) (overlay-get o 'flyspell-overlay))) + +;*---------------------------------------------------------------------*/ +;* flyspell-delete-region-overlays ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-delete-region-overlays (beg end) + "Delete overlays used by flyspell in a given region." + (let ((l (overlays-in beg end))) + (while (consp l) + (progn + (if (flyspell-overlay-p (car l)) + (delete-overlay (car l))) + (setq l (cdr l)))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-delete-all-overlays ... */ +;* ------------------------------------------------------------- */ +;* Remove all the overlays introduced by flyspell. */ +;*---------------------------------------------------------------------*/ +(defun flyspell-delete-all-overlays () + "Delete all the overlays used by flyspell." + (flyspell-delete-region-overlays (point-min) (point-max))) + +;*---------------------------------------------------------------------*/ +;* flyspell-unhighlight-at ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-unhighlight-at (pos) + "Remove the flyspell overlay that are located at POS." + (if flyspell-persistent-highlight + (let ((overlays (overlays-at pos))) + (while (consp overlays) + (if (flyspell-overlay-p (car overlays)) + (delete-overlay (car overlays))) + (setq overlays (cdr overlays)))) + (if (flyspell-overlay-p flyspell-overlay) + (delete-overlay flyspell-overlay)))) + +;*---------------------------------------------------------------------*/ +;* flyspell-properties-at-p ... */ +;* ------------------------------------------------------------- */ +;* Is there an highlight properties at position pos? */ +;*---------------------------------------------------------------------*/ +(defun flyspell-properties-at-p (pos) + "Return t if there is a text property at POS, not counting `local-map'. +If variable `flyspell-highlight-properties' is set to nil, +text with properties are not checked. This function is used to discover +if the character at POS has any other property." + (let ((prop (text-properties-at pos)) + (keep t)) + (while (and keep (consp prop)) + (if (and (eq (car prop) 'local-map) (consp (cdr prop))) + (setq prop (cdr (cdr prop))) + (setq keep nil))) + (consp prop))) + +;*---------------------------------------------------------------------*/ +;* make-flyspell-overlay ... */ +;*---------------------------------------------------------------------*/ +(defun make-flyspell-overlay (beg end face mouse-face) + "Allocate an overlay to highlight an incorrect word. +BEG and END specify the range in the buffer of that word. +FACE and MOUSE-FACE specify the `face' and `mouse-face' properties +for the overlay." + (let ((flyspell-overlay (make-overlay beg end nil t nil))) + (overlay-put flyspell-overlay 'face face) + (overlay-put flyspell-overlay 'mouse-face mouse-face) + (overlay-put flyspell-overlay 'flyspell-overlay t) + (overlay-put flyspell-overlay 'evaporate t) + (overlay-put flyspell-overlay 'help-echo "mouse-2: correct word at point") + (if flyspell-use-local-map + (overlay-put flyspell-overlay + flyspell-overlay-keymap-property-name + flyspell-mouse-map)) + (when (eq face 'flyspell-incorrect-face) + (and (stringp flyspell-before-incorrect-word-string) + (overlay-put flyspell-overlay 'before-string + flyspell-before-incorrect-word-string)) + (and (stringp flyspell-after-incorrect-word-string) + (overlay-put flyspell-overlay 'after-string + flyspell-after-incorrect-word-string))) + flyspell-overlay)) + +;*---------------------------------------------------------------------*/ +;* flyspell-highlight-incorrect-region ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-highlight-incorrect-region (beg end poss) + "Set up an overlay on a misspelled word, in the buffer from BEG to END." + (unless (run-hook-with-args-until-success + 'flyspell-incorrect-hook beg end poss) + (if (or flyspell-highlight-properties (not (flyspell-properties-at-p beg))) + (progn + ;; we cleanup all the overlay that are in the region, not + ;; beginning at the word start position + (if (< (1+ beg) end) + (let ((os (overlays-in (1+ beg) end))) + (while (consp os) + (if (flyspell-overlay-p (car os)) + (delete-overlay (car os))) + (setq os (cdr os))))) + ;; we cleanup current overlay at the same position + (if (and (not flyspell-persistent-highlight) + (overlayp flyspell-overlay)) + (delete-overlay flyspell-overlay) + (let ((os (overlays-at beg))) + (while (consp os) + (if (flyspell-overlay-p (car os)) + (delete-overlay (car os))) + (setq os (cdr os))))) + ;; now we can use a new overlay + (setq flyspell-overlay + (make-flyspell-overlay beg end + 'flyspell-incorrect-face + 'highlight)))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-highlight-duplicate-region ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-highlight-duplicate-region (beg end) + "Set up an overlay on a duplicated word, in the buffer from BEG to END." + (if (or flyspell-highlight-properties (not (flyspell-properties-at-p beg))) + (progn + ;; we cleanup current overlay at the same position + (if (and (not flyspell-persistent-highlight) + (overlayp flyspell-overlay)) + (delete-overlay flyspell-overlay) + (let ((overlays (overlays-at beg))) + (while (consp overlays) + (if (flyspell-overlay-p (car overlays)) + (delete-overlay (car overlays))) + (setq overlays (cdr overlays))))) + ;; now we can use a new overlay + (setq flyspell-overlay + (make-flyspell-overlay beg end + 'flyspell-duplicate-face + 'highlight))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-auto-correct-cache ... */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-auto-correct-pos nil) +(defvar flyspell-auto-correct-region nil) +(defvar flyspell-auto-correct-ring nil) +(defvar flyspell-auto-correct-word nil) +(make-variable-buffer-local 'flyspell-auto-correct-pos) +(make-variable-buffer-local 'flyspell-auto-correct-region) +(make-variable-buffer-local 'flyspell-auto-correct-ring) +(make-variable-buffer-local 'flyspell-auto-correct-word) + +;*---------------------------------------------------------------------*/ +;* flyspell-check-previous-highlighted-word ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-check-previous-highlighted-word (&optional arg) + "Correct the closer misspelled word. +This function scans a mis-spelled word before the cursor. If it finds one +it proposes replacement for that word. With prefix arg, count that many +misspelled words backwards." + (interactive) + (let ((pos1 (point)) + (pos (point)) + (arg (if (or (not (numberp arg)) (< arg 1)) 1 arg)) + ov ovs) + (if (catch 'exit + (while (and (setq pos (previous-overlay-change pos)) + (not (= pos pos1))) + (setq pos1 pos) + (if (> pos (point-min)) + (progn + (setq ovs (overlays-at (1- pos))) + (while (consp ovs) + (setq ov (car ovs)) + (setq ovs (cdr ovs)) + (if (and (overlay-get ov 'flyspell-overlay) + (= 0 (setq arg (1- arg)))) + (throw 'exit t))))))) + (save-excursion + (goto-char pos) + (ispell-word)) + (error "No word to correct before point")))) + +;*---------------------------------------------------------------------*/ +;* flyspell-display-next-corrections ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-display-next-corrections (corrections) + (let ((string "Corrections:") + (l corrections) + (pos '())) + (while (< (length string) 80) + (if (equal (car l) flyspell-auto-correct-word) + (setq pos (cons (+ 1 (length string)) pos))) + (setq string (concat string " " (car l))) + (setq l (cdr l))) + (while (consp pos) + (let ((num (car pos))) + (put-text-property num + (+ num (length flyspell-auto-correct-word)) + 'face + 'flyspell-incorrect-face + string)) + (setq pos (cdr pos))) + (if (fboundp 'display-message) + (display-message 'no-log string) + (message string)))) + +;*---------------------------------------------------------------------*/ +;* flyspell-abbrev-table ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-abbrev-table () + (if flyspell-use-global-abbrev-table-p + global-abbrev-table + local-abbrev-table)) + +;*---------------------------------------------------------------------*/ +;* flyspell-define-abbrev ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-define-abbrev (name expansion) + (let ((table (flyspell-abbrev-table))) + (when table + (define-abbrev table name expansion)))) + +;*---------------------------------------------------------------------*/ +;* flyspell-auto-correct-word ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-auto-correct-word () + "Correct the current word. +This command proposes various successive corrections for the current word." + (interactive) + (let ((pos (point)) + (old-max (point-max))) + ;; use the correct dictionary + (flyspell-accept-buffer-local-defs) + (if (and (eq flyspell-auto-correct-pos pos) + (consp flyspell-auto-correct-region)) + ;; we have already been using the function at the same location + (let* ((start (car flyspell-auto-correct-region)) + (len (cdr flyspell-auto-correct-region))) + (flyspell-unhighlight-at start) + (delete-region start (+ start len)) + (setq flyspell-auto-correct-ring (cdr flyspell-auto-correct-ring)) + (let* ((word (car flyspell-auto-correct-ring)) + (len (length word))) + (rplacd flyspell-auto-correct-region len) + (goto-char start) + (if flyspell-abbrev-p + (if (flyspell-already-abbrevp (flyspell-abbrev-table) + flyspell-auto-correct-word) + (flyspell-change-abbrev (flyspell-abbrev-table) + flyspell-auto-correct-word + word) + (flyspell-define-abbrev flyspell-auto-correct-word word))) + (funcall flyspell-insert-function word) + (flyspell-word) + (flyspell-display-next-corrections flyspell-auto-correct-ring)) + (flyspell-ajust-cursor-point pos (point) old-max) + (setq flyspell-auto-correct-pos (point))) + ;; fetch the word to be checked + (let ((word (flyspell-get-word nil))) + (setq flyspell-auto-correct-region nil) + (if (consp word) + (let ((start (car (cdr word))) + (end (car (cdr (cdr word)))) + (word (car word)) + poss) + (setq flyspell-auto-correct-word word) + ;; now check spelling of word. + (process-send-string ispell-process "%\n") ;put in verbose mode + (process-send-string ispell-process (concat "^" word "\n")) + ;; wait until ispell has processed word + (while (progn + (accept-process-output ispell-process) + (not (string= "" (car ispell-filter))))) + (setq ispell-filter (cdr ispell-filter)) + (if (consp ispell-filter) + (setq poss (ispell-parse-output (car ispell-filter)))) + (cond + ((or (eq poss t) (stringp poss)) + ;; don't correct word + t) + ((null poss) + ;; ispell error + (error "Ispell: error in Ispell process")) + (t + ;; the word is incorrect, we have to propose a replacement + (let ((replacements (if flyspell-sort-corrections + (sort (car (cdr (cdr poss))) 'string<) + (car (cdr (cdr poss)))))) + (if (consp replacements) + (progn + (let ((replace (car replacements))) + (let ((new-word replace)) + (if (not (equal new-word (car poss))) + (progn + ;; the save the current replacements + (setq flyspell-auto-correct-region + (cons start (length new-word))) + (let ((l replacements)) + (while (consp (cdr l)) + (setq l (cdr l))) + (rplacd l (cons (car poss) replacements))) + (setq flyspell-auto-correct-ring + replacements) + (flyspell-unhighlight-at start) + (delete-region start end) + (funcall flyspell-insert-function new-word) + (if flyspell-abbrev-p + (if (flyspell-already-abbrevp + (flyspell-abbrev-table) word) + (flyspell-change-abbrev + (flyspell-abbrev-table) + word + new-word) + (flyspell-define-abbrev word + new-word))) + (flyspell-word) + (flyspell-display-next-corrections + (cons new-word flyspell-auto-correct-ring)) + (flyspell-ajust-cursor-point pos + (point) + old-max)))))))))) + (ispell-pdict-save t))) + (setq flyspell-auto-correct-pos (point)))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-auto-correct-previous-pos ... */ +;*---------------------------------------------------------------------*/ +(defvar flyspell-auto-correct-previous-pos nil + "Holds the start of the first incorrect word before point.") + +;*---------------------------------------------------------------------*/ +;* flyspell-auto-correct-previous-hook ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-auto-correct-previous-hook () + "Hook to track successive calls to `flyspell-auto-correct-previous-word'. +Sets flyspell-auto-correct-previous-pos to nil" + (interactive) + (remove-hook 'pre-command-hook (function flyspell-auto-correct-previous-hook) t) + (unless (eq this-command (function flyspell-auto-correct-previous-word)) + (setq flyspell-auto-correct-previous-pos nil))) + +;*---------------------------------------------------------------------*/ +;* flyspell-auto-correct-previous-word ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-auto-correct-previous-word (position) + "*Auto correct the first mispelled word that occurs before point." + (interactive "d") + + (add-hook 'pre-command-hook + (function flyspell-auto-correct-previous-hook) t t) + + (save-excursion + (unless flyspell-auto-correct-previous-pos + ;; only reset if a new overlay exists + (setq flyspell-auto-correct-previous-pos nil) + + (let ((overlay-list (overlays-in (point-min) position)) + (new-overlay 'dummy-value)) + + ;; search for previous (new) flyspell overlay + (while (and new-overlay + (or (not (flyspell-overlay-p new-overlay)) + ;; check if its face has changed + (not (eq (get-char-property + (overlay-start new-overlay) 'face) + 'flyspell-incorrect-face)))) + (setq new-overlay (car-safe overlay-list)) + (setq overlay-list (cdr-safe overlay-list))) + + ;; if nothing new exits new-overlay should be nil + (if new-overlay;; the length of the word may change so go to the start + (setq flyspell-auto-correct-previous-pos + (overlay-start new-overlay))))) + + (when flyspell-auto-correct-previous-pos + (save-excursion + (goto-char flyspell-auto-correct-previous-pos) + (let ((ispell-following-word t));; point is at start + (if (numberp flyspell-auto-correct-previous-pos) + (goto-char flyspell-auto-correct-previous-pos)) + (flyspell-auto-correct-word)) + ;; the point may have moved so reset this + (setq flyspell-auto-correct-previous-pos (point)))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-correct-word ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-correct-word (event) + "Pop up a menu of possible corrections for a misspelled word. +The word checked is the word at the mouse position." + (interactive "e") + ;; use the correct dictionary + (flyspell-accept-buffer-local-defs) + ;; retain cursor location (I don't know why but save-excursion here fails). + (let ((save (point))) + (mouse-set-point event) + (let ((cursor-location (point)) + (word (flyspell-get-word nil)) + (case-fold-search nil)) + (if (consp word) + (let ((start (car (cdr word))) + (end (car (cdr (cdr word)))) + (word (car word)) + poss replace) + ;; now check spelling of word. + (process-send-string ispell-process "%\n") ;put in verbose mode + (process-send-string ispell-process (concat "^" word "\n")) + ;; wait until ispell has processed word + (while (progn + (accept-process-output ispell-process) + (not (string= "" (car ispell-filter))))) + (setq ispell-filter (cdr ispell-filter)) + (if (consp ispell-filter) + (setq poss (ispell-parse-output (car ispell-filter)))) + (cond + ((or (eq poss t) (stringp poss)) + ;; don't correct word + t) + ((null poss) + ;; ispell error + (error "Ispell: error in Ispell process")) + ((string-match "GNU" (emacs-version)) + ;; the word is incorrect, we have to propose a replacement + (setq replace (flyspell-emacs-popup event poss word)) + (cond ((eq replace 'ignore) + (goto-char save) + nil) + ((eq replace 'save) + (goto-char save) + (process-send-string ispell-process + (concat "*" word "\n")) + (flyspell-unhighlight-at cursor-location) + (setq ispell-pdict-modified-p '(t))) + ((or (eq replace 'buffer) (eq replace 'session)) + (process-send-string ispell-process + (concat "@" word "\n")) + (if (null ispell-pdict-modified-p) + (setq ispell-pdict-modified-p + (list ispell-pdict-modified-p))) + (flyspell-unhighlight-at cursor-location) + (goto-char save) + (if (eq replace 'buffer) + (ispell-add-per-file-word-list word))) + (replace + (flyspell-unhighlight-at cursor-location) + (let ((new-word (if (atom replace) + replace + (car replace))) + (cursor-location + (+ (- (length word) (- end start)) + cursor-location))) + (if (not (equal new-word (car poss))) + (let ((old-max (point-max))) + (delete-region start end) + (funcall flyspell-insert-function new-word) + (if flyspell-abbrev-p + (flyspell-define-abbrev word new-word)) + (flyspell-ajust-cursor-point save + cursor-location + old-max))))) + (t + (goto-char save) + nil))) + ((eq flyspell-emacs 'xemacs) + (flyspell-xemacs-popup + event poss word cursor-location start end save) + (goto-char save))) + (ispell-pdict-save t)))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-xemacs-correct ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-xemacs-correct (replace poss word cursor-location start end save) + "The xemacs popup menu callback." + (cond ((eq replace 'ignore) + nil) + ((eq replace 'save) + (process-send-string ispell-process (concat "*" word "\n")) + (process-send-string ispell-process "#\n") + (flyspell-unhighlight-at cursor-location) + (setq ispell-pdict-modified-p '(t))) + ((or (eq replace 'buffer) (eq replace 'session)) + (process-send-string ispell-process (concat "@" word "\n")) + (flyspell-unhighlight-at cursor-location) + (if (null ispell-pdict-modified-p) + (setq ispell-pdict-modified-p + (list ispell-pdict-modified-p))) + (if (eq replace 'buffer) + (ispell-add-per-file-word-list word))) + (replace + (let ((old-max (point-max)) + (new-word (if (atom replace) + replace + (car replace))) + (cursor-location (+ (- (length word) (- end start)) + cursor-location))) + (if (not (equal new-word (car poss))) + (progn + (delete-region start end) + (goto-char start) + (funcall flyspell-insert-function new-word) + (if flyspell-abbrev-p + (flyspell-define-abbrev word new-word)))) + (flyspell-ajust-cursor-point save cursor-location old-max))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-ajust-cursor-point ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-ajust-cursor-point (save cursor-location old-max) + (if (>= save cursor-location) + (let ((new-pos (+ save (- (point-max) old-max)))) + (goto-char (cond + ((< new-pos (point-min)) + (point-min)) + ((> new-pos (point-max)) + (point-max)) + (t new-pos)))) + (goto-char save))) + +;*---------------------------------------------------------------------*/ +;* flyspell-emacs-popup ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-emacs-popup (event poss word) + "The Emacs popup menu." + (if (not event) + (let* ((mouse-pos (mouse-position)) + (mouse-pos (if (nth 1 mouse-pos) + mouse-pos + (set-mouse-position (car mouse-pos) + (/ (frame-width) 2) 2) + (unfocus-frame) + (mouse-position)))) + (setq event (list (list (car (cdr mouse-pos)) + (1+ (cdr (cdr mouse-pos)))) + (car mouse-pos))))) + (let* ((corrects (if flyspell-sort-corrections + (sort (car (cdr (cdr poss))) 'string<) + (car (cdr (cdr poss))))) + (cor-menu (if (consp corrects) + (mapcar (lambda (correct) + (list correct correct)) + corrects) + '())) + (affix (car (cdr (cdr (cdr poss))))) + (base-menu (let ((save (if (consp affix) + (list + (list (concat "Save affix: " (car affix)) + 'save) + '("Accept (session)" session) + '("Accept (buffer)" buffer)) + '(("Save word" save) + ("Accept (session)" session) + ("Accept (buffer)" buffer))))) + (if (consp cor-menu) + (append cor-menu (cons "" save)) + save))) + (menu (cons "flyspell correction menu" base-menu))) + (car (x-popup-menu event + (list (format "%s [%s]" word (or ispell-local-dictionary + ispell-dictionary)) + menu))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-xemacs-popup ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-xemacs-popup (event poss word cursor-location start end save) + "The XEmacs popup menu." + (let* ((corrects (if flyspell-sort-corrections + (sort (car (cdr (cdr poss))) 'string<) + (car (cdr (cdr poss))))) + (cor-menu (if (consp corrects) + (mapcar (lambda (correct) + (vector correct + (list 'flyspell-xemacs-correct + correct + (list 'quote poss) + word + cursor-location + start + end + save) + t)) + corrects) + '())) + (affix (car (cdr (cdr (cdr poss))))) + (menu (let ((save (if (consp affix) + (vector + (concat "Save affix: " (car affix)) + (list 'flyspell-xemacs-correct + ''save + (list 'quote poss) + word + cursor-location + start + end + save) + t) + (vector + "Save word" + (list 'flyspell-xemacs-correct + ''save + (list 'quote poss) + word + cursor-location + start + end + save) + t))) + (session (vector "Accept (session)" + (list 'flyspell-xemacs-correct + ''session + (list 'quote poss) + word + cursor-location + start + end + save) + t)) + (buffer (vector "Accept (buffer)" + (list 'flyspell-xemacs-correct + ''buffer + (list 'quote poss) + word + cursor-location + start + end + save) + t))) + (if (consp cor-menu) + (append cor-menu (list "-" save session buffer)) + (list save session buffer))))) + (popup-menu (cons (format "%s [%s]" word (or ispell-local-dictionary + ispell-dictionary)) + menu)))) + +;*---------------------------------------------------------------------*/ +;* Some example functions for real autocorrecting */ +;*---------------------------------------------------------------------*/ +(defun flyspell-maybe-correct-transposition (beg end poss) + "Check replacements for transposed characters. + +If the text between BEG and END is equal to a correction suggested by +Ispell, after transposing two adjacent characters, correct the text, +and return t. + +The third arg POSS is either the symbol 'doublon' or a list of +possible corrections as returned by 'ispell-parse-output'. + +This function is meant to be added to 'flyspell-incorrect-hook'." + (when (consp poss) + (catch 'done + (save-excursion + (goto-char (1+ beg)) + (while (< (point) end) + (transpose-chars 1) + (when (member (buffer-substring beg end) (car (cdr (cdr poss)))) + (throw 'done t)) + (transpose-chars -1) + (forward-char)) + nil)))) + +(defun flyspell-maybe-correct-doubling (beg end poss) + "Check replacements for doubled characters. + +If the text between BEG and END is equal to a correction suggested by +Ispell, after removing a pair of doubled characters, correct the text, +and return t. + +The third arg POSS is either the symbol 'doublon' or a list of +possible corrections as returned by 'ispell-parse-output'. + +This function is meant to be added to 'flyspell-incorrect-hook'." + (when (consp poss) + (catch 'done + (save-excursion + (let ((last (char-after beg)) + this) + (goto-char (1+ beg)) + (while (< (point) end) + (setq this (char-after)) + (if (not (char-equal this last)) + (forward-char) + (delete-char 1) + (when (member (buffer-substring beg (1- end)) (car (cdr (cdr poss)))) + (throw 'done t)) + ;; undo + (insert-char this 1)) + (setq last this)) + nil))))) + +;*---------------------------------------------------------------------*/ +;* flyspell-already-abbrevp ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-already-abbrevp (table word) + (let ((sym (abbrev-symbol word table))) + (and sym (symbolp sym)))) + +;*---------------------------------------------------------------------*/ +;* flyspell-change-abbrev ... */ +;*---------------------------------------------------------------------*/ +(defun flyspell-change-abbrev (table old new) + (set (abbrev-symbol old table) new)) + +;*---------------------------------------------------------------------*/ +;* flyspell-auto-correct-previous-word advice ... */ +;*---------------------------------------------------------------------*/ +(defadvice flyspell-auto-correct-previous-word + (around easymacs-flyspell-auto-correct) + "Correct current word if misspelled, else previous + misspelling. Protect against accidentally changing a word + that cannot be seen, because it is somewhere off the screen." + (let ((top) (bot)) + (save-excursion + (move-to-window-line 0) + (setq top (point)) + (move-to-window-line -1) + (setq bot (point))) + (save-restriction + (narrow-to-region top bot) + (save-excursion + (re-search-forward "\\s \\|\\'" nil t) + (overlay-recenter (point)) + ad-do-it)))) + +(ad-activate 'flyspell-auto-correct-previous-word) + +(provide 'flyspell) +;;; flyspell.el ends here +;;; </pre> diff --git a/elisp/folding.el b/elisp/folding.el new file mode 100644 index 0000000..60a5ec4 --- a/dev/null +++ b/elisp/folding.el @@ -0,0 +1,5416 @@ +;;; folding.el --- A folding-editor-like minor mode. + +;; This file is not part of Emacs + +;; Copyright (C) 2000-2012 +;; Jari Aalto +;; Copyright (C) 1995, 1996, 1997, 1998, 1999 +;; Jari Aalto, Anders Lindgren. +;; Copyright (C) 1994 +;; Jari Aalto +;; Copyright (C) 1992, 1993 +;; Jamie Lokier, All rights reserved. +;; +;; Author: Jamie Lokier <jamie A T imbolc.ucc dt ie> +;; Jari Aalto <jari aalto A T cante dt net> +;; Anders Lindgren <andersl A T csd.uu dt se> +;; Maintainer: Jari Aalto <jari aalto A T cante dt net> +;; Created: 1992 +;; Keywords: tools +;; +;; [Latest XEmacs CVS tree commit and revision] +;; Vcs-Version: $Revision: 3.42 $ +;; Vcs-Date: $Date: 2007/05/07 10:50:05 $ +;; +;; [Latest devel version] +;; Vcs-URL: http://savannah.nongnu.org/projects/emacs-tiny-tools + +(defconst folding-version-time "2012.0226.1623" + "Last edit time in format YYYY.MMDD.HHMM.") + +;;{{{ GPL + +;; 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, +;; or (at your option) any later version. +;; +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. +;; +;; Visit <http://www.gnu.org/copyleft/gpl.html> for more information + +;;}}} + +;;; Commentary: + +;;{{{ Introduction + +;; Preface +;; +;; This package provides a minor mode, compatible with all major +;; editing modes, for folding (hiding) parts of the edited text or +;; program. +;; +;; Folding mode handles a document as a tree, where each branch +;; is bounded by special markers `{{{' and `}}}'. A branch can be +;; placed inside another branch, creating a complete hierarchical +;; structure. +;; +;; Folding mode can CLOSE a fold, leaving only the initial `{{{' +;; and possibly a comment visible. +;; +;; It can also ENTER a fold, which means that only the current +;; fold will be visible, all text above `{{{' and below `}}}' +;; will be invisible. +;; +;; Please note, that the maintainers do not recommend to use only +;; folding for you your code layout and navigation. Folding.el is +;; on its best when it can "chunk" large sections of code inside +;; folds. The larger the chunks, the more the usability of +;; folding will increase. Folding.el is not meant to hide +;; individual functions: you may be better served by hideshow.el +;; or imenu.el (which can parse the function indexes) + +;;}}} +;;{{{ Installation + +;; Installation +;; +;; To install Folding mode, put this file (folding.el) on your +;; Emacs `load-path' (or extend the load path to include the +;; directory containing this file) and optionally byte compile it. +;; +;; The best way to install folding is the autoload installation, +;; so that folding is loaded into your emacs only when you turn on +;; `folding-mode'. This statement speeds up loading your .emacs +;; +;; (autoload 'folding-mode "folding" "Folding mode" t) +;; (autoload 'turn-off-folding-mode "folding" "Folding mode" t) +;; (autoload 'turn-on-folding-mode "folding" "Folding mode" t) +;; +;; But if you always use folding, then perhaps you want more +;; traditional installation. Here Folding mode starts +;; automatically when you load a folded file. +;; +;; ;; (setq folding-default-keys-function +;; ;; 'folding-bind-backward-compatible-keys) +;; +;; (if (load "folding" 'nomessage 'noerror) +;; (folding-mode-add-find-file-hook)) +;; +;; Folding uses a keymap which conforms with the new Emacs +;; (started 19.29) style. The key bindings are prefixed with +;; "C-c@" instead of old "C-c". To use the old keyboard bindings, +;; uncomment the lines in the the above installation example +;; +;; The same folding marks can be used in `vim' editor command +;; "set fdm=marker". +;; +;; Uninstallation +;; +;; To remove folding, call `M-x' `folding-uninstall'. +;; +;; To read the manual +;; +;; At any point you can reach the manual with `M-x' +;; `finder-commentary' RET folding RET. + +;;}}} +;;{{{ DOCUMENTATION + +;; Compatibility +;; +;; Folding supports following Emacs flavors: +;; +;; Unix Emacs 19.28+ and Win32 Emacs 19.34+ +;; Unix XEmacs 19.14+ and Win32 XEmacs 21.0+ +;; +;; Compatibility not for old NT Emacs releases +;; +;; NOTE: folding version starting from 2.47 gets around this bug +;; by using adviced kill/yank functions. The advice functions are +;; only instantiated under problematic NT Emacs versions. +;; +;; Windows NT/9x 19.34 - 20.3.1 (i386-*-nt4.0) versions contained +;; a bug which affected using folding. At the time the bug was +;; reported by Trey Jackson <trey A T cs berkeley edu> +;; +;; If you kill folded area and yank it back, the ^M marks are +;; removed for some reason. +;; +;; Before kill +;; ;;{{{ fold... +;; +;; After yank +;; ;;{{{ fold all lines together }}} +;; +;; Relates packages or modes +;; +;; Folding.el was designed to be a content organizer and it is most +;; suitable for big files. Sometimes people misunderstand the +;; package's capabilities and try to use folding.el in wrong places, +;; where some other package would do a better job. Trying to wrap +;; individual functions inside fold-marks is not where folding is +;; it's best. Grouping several functions inside a logical fold-block +;; in the other is. So, to choose a best tool for your need, +;; here are some suggestions,: +;; +;; o Navigating between or hiding individual functions - +;; use combination of imenu.el, speedbar.el and +;; hideshow.el +;; o Organizing large blocks - use folding.el +;; o For text, `outline-mode' is more non-intrusive than folding. +;; Look at Emacs NEWS file (`C-x' `n') and you can see beatifully +;; laid content. +;; +;; Tutorial +;; +;; To start folding mode, give the command: `M-x' `folding-mode' +;; `RET'. The mode line should contain the string "Fld" indicating +;; that folding mode is activated. +;; +;; When loading a document containing fold marks, Folding mode is +;; automatically started and all folds are closed. For example when +;; loading my init file, only the following lines (plus a few lines +;; of comments) are visible: +;; +;; ;;{{{ General... +;; ;;{{{ Keyboard... +;; ;;{{{ Packages... +;; ;;{{{ Major modes... +;; ;;{{{ Minor modes... +;; ;;{{{ Debug... +;; +;; To enter a fold, use `C-c @ >'. To show it without entering, +;; use `C-c @ C-s', which produces this display: +;; +;; ;;{{{ Minor modes +;; +;; ;;{{{ Follow mode... +;; ;;{{{ Font-lock mode... +;; ;;{{{ Folding... +;; +;; ;;}}} +;; +;; To show everything, just as the file would look like if +;; Folding mode hadn't been activated, give the command `M-x' +;; `folding-open-buffer' `RET', normally bound to `C-c' `@' +;; `C-o'. To close all folds and go to the top level, the +;; command `folding-whole-buffer' could be used. +;; +;; Mouse support +;; +;; Folding mode v2.0 introduced mouse support. Folds can be shown +;; or hidden by simply clicking on a fold mark using mouse button +;; 3. The mouse routines have been designed to call the original +;; function bound to button 3 when the user didn't click on a +;; fold mark. +;; +;; The menu +;; +;; A menu is placed in the "Tools" menu. Should no Tools menu exist +;; (Emacs 19.28) the menu will be placed in the menu bar. +;; +;; ISearch +;; +;; When searching using the incremental search (C-s) facilities, +;; folds will be automagically entered and closed. +;; +;; Problems +;; +;; Uneven fold marks +;; +;; Oops, I just deleted some text, and a fold mark got deleted! +;; What should I do? Trust me, you will eventually do this +;; sometime. the easiest way is to open the buffer using +;; `folding-open-buffer' (C-c @ C-o) and add the fold mark by +;; hand. To find mismatching fold marks, the package `occur' is +;; useful. The command: +;; +;; M-x occur RET {{{\|}}} RET +;; +;; will extract all lines containing folding marks and present +;; them in a separate buffer. +;; +;; Even though all folding marks are correct, Folding mode +;; sometimes gets confused, especially when entering and leaving +;; folds very often. To get it back on track, press C-g a few +;; times and give the command `folding-open-buffer' (C-c @ C-o). +;; +;; Fold must have a label +;; +;; When you make a fold, be sure to write some text for the name +;; of the fold, otherwise there may be an error "extraneous fold +;; mark..." Write like this: +;; +;; ;;{{{ Note +;; ;;}}} +;; +;; instead of +;; +;; ;;{{{ +;; ;;}}} +;; +;; folding-whole-buffer doesn't fold whole buffer +;; +;; If you call commands `folding-open-buffer' and +;; `folding-whole-buffer' and notice that there are open fold +;; sections in the buffer, then you have mismatch of folds +;; somewhere. Run ` M-x' `occur' and type regexp `{{{\|}}}' to +;; check where is the extra open or closing fold mark. +;; +;; Folding and outline modes +;; +;; Folding mode is not the same as Outline mode, a major and +;; minor mode which is part of the Emacs distribution. The two +;; packages do, however, resemble each other very much. The main +;; differences between the two packages are: +;; < |
