+++ /dev/null
-;; Ebib v1.2.1
-;;
-;; Copyright (c) 2003-2007 Joost Kremers
-;; All rights reserved.
-;;
-;; 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.
-
-(require 'cl)
-
-(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)))
-
-;;;;;;;;;;;;;;;;;;;;;;
-;; global variables ;;
-;;;;;;;;;;;;;;;;;;;;;;
-
-;; user customisation
-
-(defgroup ebib nil "Ebib: a BibTeX database manager" :version "21.4.2" :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-additional-fields '(crossref url annote abstract keywords timestamp)
- "*Holds a list of the additional fields."
- :group 'ebib
- :type '(repeat (symbol :tag "Field")))
-
-(defcustom ebib-index-window-size 10
- "*The number of lines used for the keys buffer window."
- :group 'ebib
- :type 'integer)
-
-(defcustom ebib-insertion-strings '((1 . "\\cite{%s}"))
- "*The string to insert when calling EBIB-INSERT-BIBTEX-KEY.
-
-The directive \"%s\" is replaced with the entry key."
- :group 'ebib
- :type '(repeat (cons :tag "Insertion string" (integer :tag "Number") (string))))
-
-(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)
-
-(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 `H' command 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 given directly to FORMAT-TIME-STRING, see the
-documentation of that function for details."
- :group 'ebib
- :type 'string)
-
-(defcustom ebib-print-preamble nil
- "*List of strings to be added to the LaTeX preamble used for printing the database."
- :group 'ebib
- :type '(repeat (string :tag "Add to preamble")))
-
-(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}")
-"*List of strings to be added to the LaTeX preamble used for LaTeXing the database."
- :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))
-
-(defvar ebib-entry-types-hash (make-hash-table)
- "Holds the hash table containing the entry type definitions.")
-(defvar ebib-unique-field-list nil
- "Holds a list of all field names.")
-
-(defun ebib-set-entry-types-hash (var value)
- "Sets EBIB-ENTRY-TYPES-HASH on the basis of EBIB-ENTRY-TYPES"
- (set-default var value)
- (clrhash ebib-entry-types-hash)
- (setq ebib-unique-field-list nil)
- (mapc '(lambda (entry)
- (puthash (car entry) (cdr entry) ebib-entry-types-hash)
- (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-entry-types-hash)
-
-;; generic for all databases
-
-;; constants and variables that are set only once
-(defconst ebib-bibtex-identifier "[^\"#%'(),={} \t\n\f]*" "Regex describing a licit BibTeX identifier.")
-(defconst ebib-version "1.2.1")
-(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-help-buffer nil "Buffer showing Ebib help.")
-(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-export-filename nil "Filename to export 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-before-help nil "Stores the buffer the user was in when he displayed the help message.")
-(defvar ebib-local-bibtex-filename nil "A buffer-local variable holding the name of that buffer's .bib file")
-(make-variable-buffer-local 'ebib-local-bibtex-filename)
-
-;; 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
- (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.")
-
-;; these two variables are set when the user enters the entry buffer
-(defvar ebib-cur-entry-hash nil "The hash table containing the data of the current entry.")
-(defvar ebib-cur-entry-fields nil "The fields of the type of the current entry.")
-
-;; and these two are set by EBIB-FILL-ENTRY-BUFFER and EBIB-FILL-STRINGS-BUFFER, respectively
-(defvar ebib-current-field nil "The current field.")
-(defvar ebib-current-string nil "The current @STRING definition.")
-
-;; we define these variables here, but only give them a value at the end of
-;; the file, because the long strings mess up Emacs' syntax highlighting.
-(defvar ebib-index-buffer-help nil "Help for the index buffer.")
-(defvar ebib-entry-buffer-help nil "Help for the entry buffer.")
-(defvar ebib-strings-buffer-help nil "Help for the strings buffer.")
-
-;; 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)))
-
-;;;;;;;;;;;;;;;;;;;;
-;; things we need ;;
-;;;;;;;;;;;;;;;;;;;;
-
-;; macro to define key bindings.
-
-(defmacro ebib-key (buffer key command)
- (cond
- ((eq buffer 'index)
- `(define-key ebib-index-mode-map (quote ,key) (quote ,command)))
- ((eq buffer 'entry)
- `(define-key ebib-entry-mode-map (quote ,key) (quote ,command)))
- ((eq buffer 'strings)
- `(define-key ebib-strings-mode-map (quote ,key) (quote ,command)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; 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)))
-
-;; 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 '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,
-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))
-
-(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 disabled ()
- (interactive)
- "Does nothing except beep. Used to disable C-x k and C-x b"
- (beep))
-
-(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 ebib-get-obl-fields (entry-type)
- "Returns the obligatory fields of ENTRY-TYPE."
- (car (gethash entry-type ebib-entry-types-hash)))
-
-(defun ebib-get-opt-fields (entry-type)
- "Returns the optional fields of ENTRY-TYPE."
- (cadr (gethash entry-type ebib-entry-types-hash)))
-
-(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 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 ebib-erase-buffer (buffer)
- (set-buffer buffer)
- (with-buffer-writable
- (erase-buffer)))
-
-(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))
-
-(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-line middle) ; if this turns out to be where we need to be,
- (beginning-of-line) ; this puts POINT at the right spot.
- (> (- upper lower) 1)) ; if upper and lower differ by only 1, we have found the
- ; position to insert the entry in.
- (save-excursion
- (let ((beg (point)))
- (end-of-line)
- (if (string< (buffer-substring-no-properties beg (point)) str)
- (setq lower middle)
- (setq upper middle)))))))))
-
-(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)))
- (end-of-line)
- (ebib-move-highlight ebib-index-highlight beg (point) ebib-index-buffer)))
-
-(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)))
-
-(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)))
-
-(defun ebib-redisplay-current-field ()
- "Redisplays the contents of the current field in the entry buffer."
- (set-buffer ebib-entry-buffer)
- (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 (evenp direction)
- (goto-char start))
- (unless (funcall fn (concat "^" (symbol-name field)) limit t)
- (goto-char current-pos)))))
- (ebib-set-fields-highlight))
-
-(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)))))
-
-(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 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 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)
- (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 COPY-SEQUENCE 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 (copy-sequence "+")) ; (propertize "+" nil 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*)
- (goto-char (point-min))
- (ebib-set-fields-highlight))))
-
-(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)
- (save-excursion
- (set-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))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; main program execution ;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun ebib ()
- "Ebib, a BibTeX database manager."
- (interactive)
- (if (or (equal (window-buffer) ebib-index-buffer)
- (equal (window-buffer) ebib-entry-buffer))
- (error "Ebib already active")
- (unless ebib-initialized
- (ebib-init)
- (if ebib-preload-bib-files
- (mapc '(lambda (file)
- (ebib-load-bibtex-file file))
- ebib-preload-bib-files)))
- ;; we save the current window configuration.
- (setq ebib-saved-window-config (current-window-configuration))
- ;; create the window configuration we want for ebib.
- (delete-other-windows)
- (switch-to-buffer ebib-index-buffer)
- (let* ((keys-window (selected-window))
- (entry-window (split-window keys-window ebib-index-window-size)))
- (set-window-buffer entry-window ebib-entry-buffer))))
-
-(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)
- (ebib-multiline-edit-mode)
- ;; 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)
- ;; then we create the help buffer
- (setq ebib-help-buffer (get-buffer-create " *Ebib-help*"))
- (set-buffer ebib-help-buffer)
- (ebib-help-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-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)
- (when (file-readable-p "~/.ebibrc")
- (load "~/.ebibrc"))
- (ebib-create-buffers)
- (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-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-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? "))
- (kill-buffer ebib-entry-buffer)
- (kill-buffer ebib-index-buffer)
- (kill-buffer ebib-multiline-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)
- (set-window-configuration ebib-saved-window-config)
- (message "")))
-
-(defun ebib-kill-emacs-query-function ()
- "Ask if the user wants to save the database loaded in Ebib when Emacs is
-killed and the database has been modified."
- (if (not (ebib-modified-p))
- t
- (if (y-or-n-p "Save all unsaved Ebib databases? ")
- (progn
- (ebib-save-all-databases)
- t)
- (yes-or-no-p "Ebib database was modified. Kill anyway? "))))
-
-(add-hook 'kill-emacs-query-functions 'ebib-kill-emacs-query-function)
-
-;; the next two functions are used in loading the database. a database is
-;; loaded by reading the raw file into a temp buffer and then reading all
-;; the entries in it. for this we need to be able to search a matching
-;; parenthesis and a matching double quote.
-
-(defun ebib-match-paren-forward (limit)
- "Moves forward to the closing parenthesis matching the opening parenthesis at POINT.
-
-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, point is moved
-to LIMIT."
- (if (nor (eq (char-after) ?\{)
- (eq (char-after) ?\"))
- nil
- (save-restriction
- (narrow-to-region (point-min) limit)
- (condition-case nil
- (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
- (goto-char (point-max)) ; point-max because the narrowing is still in effect
- 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, point is moved to LIMIT."
- (when (eq (char-after (point)) ?\") ; make sure we're on a double quote.
- (while
- (progn
- (forward-char) ; we need to move forward because we're on a double quote.
- (skip-chars-forward "^\"" limit) ; find the next double quote.
- (and (eq (char-before) ?\\) ; if it's preceded by a backslash,
- (< (point) limit)))) ; and we're still below LIMIT, keep on searching.
- (eq (char-after (point)) ?\"))) ; return T or NIL based on whether we've found a quote.
-
-(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)))))
-
-(defmacro ebib-retrieve-entry (entry-key db)
- "Returns the hash table of the fields stored in DB under ENTRY-KEY."
- `(gethash ,entry-key (edb-database ,db)))
-
-(defmacro ebib-cur-entry-key ()
- "Returns the key of the current entry in EBIB-CUR-DB."
- `(car (edb-cur-entry ebib-cur-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))
- (search-forward 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))
-
-;;;;;;;;;;;;;;;
-;; index-mode ;;
-;;;;;;;;;;;;;;;
-
-(defvar ebib-index-mode-map
- (let ((map (make-keymap 'ebib-index-mode-map)))
- (suppress-keymap map)
- (define-key map [up] 'ebib-prev-entry)
- (define-key map [down] 'ebib-next-entry)
- (define-key map [right] 'ebib-next-database)
- (define-key map [left] 'ebib-prev-database)
- (define-key map [home] 'ebib-goto-first-entry)
- (define-key map [end] 'ebib-goto-last-entry)
- (define-key map [prior] 'ebib-index-scroll-down)
- (define-key map [next] 'ebib-index-scroll-up)
- (define-key map [return] 'ebib-select-entry)
- (define-key map " " 'ebib-index-scroll-up)
- (define-key map "a" 'ebib-add-entry)
- (define-key map "b" 'ebib-index-scroll-down)
- (define-key map "c" 'ebib-close-database)
- (define-key map "C" 'ebib-customize)
- (define-key map "d" 'ebib-delete-entry)
- (define-key map "e" 'ebib-edit-entry)
- (define-key map "E" 'ebib-edit-keyname)
- (define-key map "f" 'ebib-print-filename)
- (define-key map "F" 'ebib-follow-crossref)
- (define-key map "g" 'ebib-goto-first-entry)
- (define-key map "G" 'ebib-goto-last-entry)
- (define-key map "h" 'ebib-index-help)
- (define-key map "H" 'ebib-toggle-hidden)
- (define-key map "j" 'ebib-next-entry)
- (define-key map "J" 'ebib-switch-to-database)
- (define-key map "k" 'ebib-prev-entry)
- (define-key map "L" 'ebib-latex-database)
- (define-key map "M" 'ebib-merge-bibtex-file)
- (define-key map "n" 'ebib-search-next)
- (define-key map "o" 'ebib-load-bibtex-file)
- (define-key map "p" 'ebib-edit-preamble)
- (define-key map "P" 'ebib-print-database)
- (define-key map "q" 'ebib-quit)
- (define-key map "s" 'ebib-save-current-database)
- (define-key map "S" 'ebib-save-all-databases)
- (define-key map "t" 'ebib-edit-strings)
- (define-key map "V" 'ebib-print-filter)
- (define-key map "w" 'ebib-write-database)
- (define-key map "x" 'ebib-export-entry)
- (define-key map "X" 'ebib-export-preamble)
- (define-key map "z" 'ebib-lower)
- (define-key map "/" 'ebib-search)
- (define-key map "&" 'ebib-virtual-db-and)
- (define-key map "|" 'ebib-virtual-db-or)
- (define-key map "~" 'ebib-virtual-db-not)
- (define-key map [(control n)] 'ebib-next-entry)
- (define-key map [(meta n)] 'ebib-index-scroll-up)
- (define-key map [(control p)] 'ebib-prev-entry)
- (define-key map [(meta p)] 'ebib-index-scroll-down)
- (define-key map "\C-xb" 'ebib-lower)
- (define-key map "\C-xk" 'ebib-quit)
- map)
- "Keymap for the ebib index buffer.")
-
-(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))
-
-(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)
- ;; the two inserts look funny, but we cannot use format here
- ;; because in xemacs, format does not retain text properties.
- (mapcar '(lambda (x) (insert x) (insert "\n")) (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 ()
- (interactive)
- (ebib-lower)
- (customize-group 'ebib))
-
-(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)))
- ;; 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
- (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
- (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.
- (message "(New file)"))
- ;; what we have to do in *any* case, is fill the index buffer. (this
- ;; even works if there are no keys in the database, e.g. when the
- ;; user opened a new file or if no BibTeX entries were found.
- (ebib-fill-index-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: ")))
- (with-temp-buffer
- (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)
- (message "%d entries, %d @STRINGs and %s @PREAMBLE found in file."
- (car n)
- (cadr n)
- (if (caddr n)
- "a"
- "no"))))))))
-
-(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."
- (modify-syntax-entry ?\" "w")
- (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 "[\(\{]"))
- (let ((entry-type (downcase (buffer-substring-no-properties beg (1- (point))))))
- (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") (ebib-read-preamble)
- (setq preamble t))
- ((equal entry-type "comment") (ebib-match-paren-forward (point-max))) ; ignore comments
- ((gethash (intern-soft entry-type) ebib-entry-types-hash) ; if the entry type has been defined
- (if (ebib-read-entry entry-type timestamp)
- (setq n-entries (1+ n-entries))))
- (t (message "Unknown entry type `%s'. Skipping." entry-type) ; we found something we don't know
- (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 (cond
- ((eq (char-after) ?\" ) (if (ebib-match-quote-forward limit)
- (buffer-substring-no-properties beg (1+ (point)))
- nil))
- ((eq (char-after) ?\{ ) (if (ebib-match-paren-forward limit)
- (buffer-substring-no-properties beg (1+ (point)))
- nil))
- (t nil)))
- (if (member abbr (edb-strings-list ebib-cur-db))
- (message (format "@STRING definition `%s' duplicated" 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)
- (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))
- (message "Entry `%s' duplicated " 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)
- (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-get-field-contents limit)))
- (when field-contents
- (puthash field-type field-contents fields))))))))
- (when (> (hash-table-count fields) 0)
- (puthash 'type* entry-type fields)
- fields)))
-
-(defun ebib-get-field-contents (limit)
- "Gets the contents of a BibTeX field.
-
-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))
- (cond
- ((eq (char-after) ?\{) (ebib-match-paren-forward limit))
- ((eq (char-after) ?\") (ebib-match-quote-forward limit)))
- (forward-char 1))
- (if (= (point) limit)
- (skip-chars-backward " \n\t\f"))
- (point))
-
-(defun ebib-lower ()
- "Hides the Ebib buffers, but does not delete them."
- (interactive)
- (if (nor (equal (window-buffer) ebib-index-buffer)
- (equal (window-buffer) ebib-entry-buffer)
- (equal (window-buffer) ebib-strings-buffer)
- (equal (window-buffer) ebib-multiline-buffer)
- (equal (window-buffer) ebib-help-buffer))
- (error "Ebib is not active ")
- (set-window-configuration ebib-saved-window-config)
- (bury-buffer ebib-entry-buffer)
- (bury-buffer ebib-index-buffer)
- (bury-buffer ebib-multiline-buffer)
- (bury-buffer ebib-strings-buffer)
- (bury-buffer ebib-help-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 (read-string "New entry key: "))
- (progn
- (if (member entry-key (edb-keys-list ebib-cur-db))
- (error "Key already exists")
- (set-buffer ebib-index-buffer)
- (sort-in-buffer (1+ (edb-n-entries ebib-cur-db)) entry-key)
- (with-buffer-writable
- (insert (format "%s\n" entry-key))) ; add the entry in the buffer.
- (forward-line -1) ; move one line up to position the cursor on the new entry.
- (ebib-set-index-highlight)
- (let ((fields (make-hash-table)))
- (puthash 'type* ebib-default-type fields)
- (ebib-insert-entry entry-key fields ebib-cur-db t t))
- (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-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? "))
- (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-line (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-hash (ebib-retrieve-entry (ebib-cur-entry-key) ebib-cur-db))
- (setq ebib-cur-entry-fields (ebib-get-all-fields (gethash 'type* ebib-cur-entry-hash)))
- (other-window 1)
- (switch-to-buffer ebib-entry-buffer)
- (goto-char (ebib-highlight-end ebib-fields-highlight)))
- ((default)
- (beep))))
-
-(defun ebib-edit-keyname ()
- "Change 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))
- (if (member new-keyname (edb-keys-list ebib-cur-db))
- (error (format "Key `%s' already exists" new-keyname))
- (unless (string= cur-keyname new-keyname)
- (let ((fields (ebib-retrieve-entry cur-keyname ebib-cur-db)))
- (ebib-remove-entry-from-db cur-keyname ebib-cur-db)
- (ebib-remove-key-from-buffer cur-keyname)
- (ebib-insert-entry new-keyname fields ebib-cur-db t nil)
- (setf (edb-cur-entry ebib-cur-db) (member new-keyname (edb-keys-list ebib-cur-db)))
- (sort-in-buffer (edb-n-entries ebib-cur-db) new-keyname)
- (with-buffer-writable
- (insert (format "%s\n" new-keyname))) ; add the entry in the buffer.
- (forward-line -1) ; move one line up to position the cursor on the new entry.
- (ebib-set-index-highlight)
- (ebib-set-modified t)))))))
- ((default)
- (beep))))
-
-(defun ebib-index-scroll-down ()
- "Move one page up in the database."
- (interactive)
- (ebib-execute-when
- ((entries)
- (scroll-down)
- (ebib-select-entry))
- ((default)
- (beep))))
-
-(defun ebib-index-scroll-up ()
- "Move 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)
- "Format 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)
- "Format 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-list (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-save-database (db)
- "Saves the database DB."
- (ebib-execute-when
- ((real-db)
- (when (and (edb-make-backup db)
- (file-exists-p (edb-filename db)))
- (rename-file (edb-filename db) (concat (edb-filename db) "~") t)
- (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 (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)
- (let ((source-db (edb-database ebib-cur-db)))
- (setf (edb-database ebib-cur-db) (make-hash-table :test 'equal))
- (mapc '(lambda (key)
- (let ((entry (gethash key source-db)))
- (when entry
- (puthash key (copy-hash-table entry) (edb-database ebib-cur-db)))))
- (edb-keys-list ebib-cur-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)
- (ebib-execute-when
- ((database)
- (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 ()
- "Goes to the entry mentioned in the crossref field of the current entry."
- (interactive)
- (let ((new-cur-entry (to-raw (gethash 'crossref
- (ebib-retrieve-entry (ebib-cur-entry-key) ebib-cur-db)))))
- (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))
-
-(defun ebib-toggle-hidden ()
- (interactive)
- (setq ebib-hide-hidden-fields (not ebib-hide-hidden-fields))
- (ebib-fill-entry-buffer))
-
-(defun ebib-delete-entry ()
- "Deletes the current entry from the database."
- (interactive)
- (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 (ebib-cur-entry-key) (edb-keys-list 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
- (end-of-line)
- (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))))
-
-(defun ebib-export-entry (prefix)
- "Copies the current entry 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")
- (ebib-execute-when
- ((real-db entries)
- (let ((num (ebib-prefix prefix)))
- (if num
- (let ((goal-db (nth (1- num) ebib-databases))
- (entry-key (ebib-cur-entry-key)))
- (cond
- ((not goal-db)
- (error "Database %d does not exist" num))
- ((edb-virtual goal-db)
- (error "Database %d is virtual" num))
- (t
- (if (member entry-key (edb-keys-list goal-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))
- goal-db t t)
- (ebib-set-modified t goal-db)
- ;; if this is the first entry in GOAL-DB, its CUR-ENTRY must be set!
- (when (null (edb-cur-entry goal-db))
- (setf (edb-cur-entry goal-db) (edb-keys-list goal-db)))
- (message "Entry `%s' copied to database `%d'" entry-key num)))))
- ;; if no prefix arg was given, we export to a file
- (let ((insert-default-directory (not ebib-export-filename)))
- (if-str (filename (read-file-name
- (format "Export %s to file: " (ebib-cur-entry-key))
- "~/" nil nil ebib-export-filename))
- (with-temp-buffer
- (insert (format "\n")) ; to keep things tidy.
- (ebib-format-entry (ebib-cur-entry-key) ebib-cur-db t)
- (append-to-file (point-min) (point-max) filename)
- (setq ebib-export-filename filename)))))))
- ((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 ()
- "Search 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)
- (other-window 1)
- (switch-to-buffer ebib-strings-buffer)
- (goto-char (point-min)))
- ((default)
- (beep))))
-
-(defun ebib-edit-preamble ()
- "Edits the @PREAMBLE definition in the database."
- (interactive)
- (ebib-execute-when
- ((real-db)
- (other-window 1) ; we want the multiline edit buffer to appear in the lower window
- (ebib-multiline-edit 'preamble (edb-preamble ebib-cur-db)))
- ((default)
- (beep))))
-
-(defun ebib-export-preamble (prefix)
- "Export the @PREAMBLE definition.
-
-If a prefix argument was 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 ((text (edb-preamble ebib-cur-db))
- (num (ebib-prefix prefix)))
- (if num
- ;; we have a prefix argument
- (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
- (if (edb-preamble goal-db)
- (setf (edb-preamble goal-db) (concat (edb-preamble goal-db) "\n# " text))
- (setf (edb-preamble goal-db) text))
- (message (format "@PREAMBLE copied to database %d" num))
- (ebib-set-modified t goal-db))))
- ;; if no prefix argument was given, we export to a file
- (let ((insert-default-directory (not ebib-export-filename)))
- (if-str (filename (read-file-name
- "Export @PREAMBLE to file: "
- "~/" nil nil ebib-export-filename))
- (with-temp-buffer
- (insert (format "\n@PREAMBLE{%s}\n\n" (edb-preamble ebib-cur-db)))
- (append-to-file (point-min) (point-max) filename)
- (message (format "@PREAMBLE exported to file %s"
- (file-name-nondirectory filename)))
- (setq ebib-export-filename filename))))))))
- ((default)
- (beep))))
-
-(defun ebib-print-database ()
- "Creates a LaTeX file from the contents of the database."
- (interactive)
- (ebib-execute-when
- ((entries)
- (if-str (tempfile (if (not (string= "" ebib-print-tempfile))
- ebib-print-tempfile
- (read-file-name "Use temp file: " "~/" nil nil)))
- (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 "\\bigskip\n\n"))
- (edb-keys-list ebib-cur-db))
- (insert "\\end{document}\n")
- (write-region (point-min) (point-max) tempfile)
- (ebib-lower)
- (find-file tempfile))))))
-
-(defun ebib-latex-database ()
- "Creates a LaTeX file that \nocite's all entries in the database."
- (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)))
- (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")
- (insert "\\nocite{*}\n\n")
- (insert (format "\\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))))))
-
-(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-virtual-db-and (not)
- "Filter 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)
- "Filter 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 "Field to filter on: "
- (cons '("any" 0)
- (mapcar '(lambda (x)
- (cons (symbol-name x) 0))
- (append ebib-unique-field-list ebib-additional-fields)))
- nil t)))
- (if (string= field "type")
- (message "Cannot filter on `type' field ")
- (setq field (intern-soft field))
- (let ((regexp (read-string "Regexp to filter with: ")))
- (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)
- ;; This is a hack: CONTAINS depends on the variable ENTRY being set to an
- ;; actual Ebib entry for its operation. 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)
- "Run 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)
- "Display 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-index-help ()
- "Displays the help message for the index buffer."
- (interactive)
- (other-window 1)
- (ebib-display-help ebib-index-buffer))
-
-;;;;;;;;;;;;;;;;
-;; entry-mode ;;
-;;;;;;;;;;;;;;;;
-
-(defvar ebib-entry-mode-map
- (let ((map (make-keymap 'ebib-entry-mode-map)))
- (suppress-keymap map)
- (define-key map [up] 'ebib-prev-field)
- (define-key map [down] 'ebib-next-field)
- (define-key map "k" 'ebib-prev-field)
- (define-key map "j" 'ebib-next-field)
- (define-key map [(control p)] 'ebib-prev-field)
- (define-key map [(control n)] 'ebib-next-field)
- (define-key map [prior] 'ebib-goto-prev-set)
- (define-key map [next] 'ebib-goto-next-set)
- (define-key map [(meta p)] 'ebib-goto-next-set)
- (define-key map [(meta n)] 'ebib-goto-prev-set)
- (define-key map " " 'ebib-goto-next-set)
- (define-key map "b" 'ebib-goto-prev-set)
- (define-key map [home] 'ebib-goto-first-field)
- (define-key map [end] 'ebib-goto-last-field)
- (define-key map "g" 'ebib-goto-first-field)
- (define-key map "G" 'ebib-goto-last-field)
- (define-key map "e" 'ebib-edit-field)
- (define-key map "q" 'ebib-quit-entry-buffer)
- (define-key map "c" 'ebib-copy-field-contents)
- (define-key map "x" 'ebib-cut-field-contents)
- (define-key map "y" 'ebib-yank-field-contents)
- (define-key map "d" 'ebib-delete-field-contents)
- (define-key map "r" 'ebib-toggle-raw)
- (define-key map "l" 'ebib-edit-multiline-field)
- (define-key map "s" 'ebib-insert-abbreviation)
- (define-key map "h" 'ebib-entry-help)
- (define-key map "\C-xb" 'disabled)
- (define-key map "\C-xk" 'disabled)
- 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 ()
- "Quit editing the entry."
- (interactive)
- (other-window 1))
-
-(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 ()
- "Move 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 ()
- "Move 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 (interactive-p) ; 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 ()
- "Move 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 ()
- "Move 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 ()
- "Move 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)
- (ebib-goto-last-field) ; if there was no further set to go to,
- ; go to the last field of the current set
- (setq ebib-current-field new-field)
- (ebib-move-to-field ebib-current-field 1))))))
-
-(defun ebib-goto-prev-set ()
- "Move 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))))))
-
-(defun ebib-edit-entry-type ()
- "Edits the type of an entry."
- ;; we want to put the completion buffer in the lower window. for this
- ;; reason, we need to switch to the other window before calling
- ;; completing-read. but in order to make sure that we return to the
- ;; entry buffer and not the index buffer when the user presses C-g, we
- ;; need to do this in an unwind-protect.
- (unwind-protect
- (progn
- (other-window 1)
- (let ((collection (ebib-create-collection ebib-entry-types-hash)))
- (if-str (new-type (completing-read "type: " collection 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)))))
- (other-window 1)))
-
-(defun ebib-edit-crossref ()
- "Edits the crossref field."
- (unwind-protect
- (progn
- (other-window 1)
- (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)))))
- (other-window 1)
- (ebib-redisplay-current-field)))
-
-;; we should modify ebib-edit-field, so that it calls the appropriate
-;; helper function, which asks the user for the new value and just returns
-;; that. storing it should then be done by ebib-edit-field, no matter what
-;; sort of field the user edits.
-
-(defun ebib-edit-field ()
- "Edits a field of a BibTeX entry."
- (interactive)
- (cond
- ((eq ebib-current-field 'type*) (ebib-edit-entry-type))
- ((eq ebib-current-field 'crossref) (ebib-edit-crossref))
- ((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
- (from-raw 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 (interactive-p) (ebib-next-field))
- (ebib-set-modified t))))))
-
-(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 (gethash ebib-current-field ebib-cur-entry-hash)))
- (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 use of this command functions 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)
- (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))
- (let ((contents (gethash ebib-current-field ebib-cur-entry-hash)))
- (if (not contents) ; if there is no value,
- (progn
- (ebib-edit-field) ; 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))
- (ebib-multiline-edit 'fields text))))
-
-(defun ebib-insert-abbreviation ()
- "Insert 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 ()
- "Displays the help message for the entry buffer."
- (interactive)
- (ebib-display-help ebib-entry-buffer))
-
-;;;;;;;;;;;;;;;;;;
-;; strings-mode ;;
-;;;;;;;;;;;;;;;;;;
-
-(defvar ebib-strings-mode-map
- (let ((map (make-keymap 'ebib-strings-mode-map)))
- (suppress-keymap map)
- (define-key map [up] 'ebib-prev-string)
- (define-key map [down] 'ebib-next-string)
- (define-key map "k" 'ebib-prev-string)
- (define-key map "j" 'ebib-next-string)
- (define-key map [(control p)] 'ebib-prev-string)
- (define-key map [(control n)] 'ebib-next-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 [prior] 'ebib-strings-page-up)
- (define-key map [next] 'ebib-strings-page-down)
- (define-key map "b" 'ebib-strings-page-up)
- (define-key map " " 'ebib-strings-page-down)
- (define-key map [(meta p)] 'ebib-strings-page-up)
- (define-key map [(meta n)] 'ebib-strings-page-down)
- (define-key map [home] 'ebib-goto-first-string)
- (define-key map [end] 'ebib-goto-last-string)
- (define-key map "q" 'ebib-quit-strings-buffer)
- (define-key map "c" 'ebib-copy-string-contents)
- (define-key map "d" 'ebib-delete-string)
- (define-key map "a" 'ebib-add-string)
- (define-key map "l" 'ebib-edit-multiline-string)
- (define-key map "x" 'ebib-export-string)
- (define-key map "X" 'ebib-export-all-strings)
- (define-key map "h" 'ebib-strings-help)
- (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 ()
- "Quit editing the @STRING definitions."
- (interactive)
- (switch-to-buffer ebib-entry-buffer)
- (other-window 1))
-
-(defun ebib-prev-string ()
- "Move 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 ()
- "Move to the next string."
- (interactive)
- (if (equal ebib-current-string (last1 (edb-strings-list ebib-cur-db)))
- (when (interactive-p) (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 ()
- "Move 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 ()
- "Move 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-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
- (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 (mapc #'(lambda (abbr)
- (if (member abbr (edb-strings-list goal-db))
- (message "@STRING definition `%s' already exists in database %d" abbr num)
- (ebib-insert-string abbr (gethash abbr (edb-strings ebib-cur-db)) goal-db t)))
- (edb-strings-list ebib-cur-db))
- (message "All @STRING definitions copied to database %d" num))))
- ;; if there is no prefix arg, we export to a file
- (let ((insert-default-directory (not ebib-export-filename)))
- (if-str (filename (read-file-name
- "Export all @STRING definitions to file: "
- "~/" nil nil ebib-export-filename))
- (with-temp-buffer
- (insert (format "\n")) ; to keep things tidy.
- (ebib-format-strings ebib-cur-db)
- (append-to-file (point-min) (point-max) filename)
- (setq ebib-export-filename filename))))))))
-
-(defun ebib-export-string (prefix)
- "Appends the current @STRING definition to a file."
- (interactive "P")
- (when ebib-current-string
- (let ((abbr ebib-current-string)
- (string (gethash ebib-current-string (edb-strings ebib-cur-db)))
- (num (ebib-prefix prefix)))
- (if num
- (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))
- ((member abbr (edb-strings-list goal-db))
- (error "@STRING definition `%s' already exists in database %d" abbr num))
- (t (ebib-insert-string abbr string goal-db t)
- (message "@STRING definition `%s' copied to database %d" abbr num))))
- (let ((insert-default-directory (not ebib-export-filename)))
- (if-str (filename (read-file-name
- (format "Export @STRING definition `%s' to file: " abbr)
- "~/" nil nil ebib-export-filename))
- (with-temp-buffer
- (insert (format "\n@STRING{%s = %s}\n"
- abbr
- string))
- (append-to-file (point-min) (point-max) filename)
- (setq ebib-export-filename filename))))))))
-
-(defun ebib-edit-multiline-string ()
- "Edits the current string in multiline-mode."
- (interactive)
- (ebib-multiline-edit 'string (to-raw (gethash ebib-current-string (edb-strings ebib-cur-db)))))
-
-(defun ebib-strings-help ()
- "Displays the help message for the strings buffer."
- (interactive)
- (ebib-display-help ebib-strings-buffer))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;
-;; multiline edit mode ;;
-;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define-derived-mode ebib-multiline-edit-mode
- text-mode "Ebib-edit"
- "Major mode for editing multiline strings in Ebib."
- ;; we redefine some basic keys because we need them to leave this buffer.
- (local-set-key "\C-xb" 'ebib-leave-multiline-edit)
- (local-set-key "\C-x\C-s" 'ebib-save-from-multiline-edit)
- (local-set-key "\C-xk" 'ebib-cancel-multiline-edit))
-
-(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!
- (switch-to-buffer ebib-multiline-buffer)
- (erase-buffer)
- (setq ebib-editing type)
- (when starttext
- (insert starttext)
- (goto-char (point-min))
- (set-buffer-modified-p nil)))
-
-(defun ebib-leave-multiline-edit ()
- "Quits the multiline edit buffer."
- (interactive)
- (ebib-store-multiline-text)
- (cond
- ((eq ebib-editing 'preamble)
- (switch-to-buffer ebib-entry-buffer)
- (other-window 1)) ; we have to switch back to the index buffer window
- ((eq ebib-editing 'fields)
- (switch-to-buffer ebib-entry-buffer)
- (ebib-redisplay-current-field)
- (ebib-next-field))
- ((eq ebib-editing 'strings)
- (switch-to-buffer ebib-strings-buffer)
- (ebib-redisplay-current-string)
- (ebib-next-string)))
- (message "Text stored."))
-
-(defun ebib-save-from-multiline-edit ()
- "Stores the text being edited in the multiline edit buffer and then saves 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-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)))
- (cond
- ((eq ebib-editing 'fields)
- (switch-to-buffer ebib-entry-buffer)
- (ebib-redisplay-current-field)) ; we have to do this, because the
- ; user may have saved with C-x C-s
- ; before
- ((eq ebib-editing 'strings)
- (switch-to-buffer ebib-strings-buffer)
- (ebib-redisplay-current-string))
- ((eq ebib-editing 'preamble)
- (switch-to-buffer ebib-entry-buffer)
- (other-window 1)))))
-
-;;;;;;;;;;;;;;;;;;;;
-;; ebib-help-mode ;;
-;;;;;;;;;;;;;;;;;;;;
-
-(defvar ebib-help-mode-map
- (let ((map (make-keymap 'ebib-help-mode-map)))
- (suppress-keymap map)
- (define-key map " " 'scroll-up)
- (define-key map "b" 'scroll-down)
- (define-key map "q" 'ebib-quit-help-buffer)
- map)
- "Keymap for the ebib help buffer.")
-
-(define-derived-mode ebib-help-mode
- fundamental-mode "Ebib-help"
- "Major mode for the Ebib help buffer."
- (setq buffer-read-only t)
- (local-set-key "\C-xb" 'ebib-quit-help-buffer)
- (local-set-key "\C-xk" 'ebib-quit-help-buffer))
-
-(defun ebib-display-help (buffer)
- "Shows the help message for Ebib-buffer BUFFER."
- (switch-to-buffer ebib-help-buffer)
- (setq ebib-before-help buffer)
- (with-buffer-writable
- (erase-buffer)
- (cond
- ((eq buffer ebib-index-buffer) (insert ebib-index-buffer-help))
- ((eq buffer ebib-entry-buffer) (insert ebib-entry-buffer-help))
- ((eq buffer ebib-strings-buffer) (insert ebib-strings-buffer-help)))
- (goto-char (point-min))))
-
-(defun ebib-quit-help-buffer ()
- "Exits the help buffer."
- (interactive)
- (cond
- ((eq ebib-before-help ebib-index-buffer)
- (switch-to-buffer ebib-entry-buffer)
- (other-window 1))
- ((eq ebib-before-help ebib-entry-buffer)
- (switch-to-buffer ebib-entry-buffer))
- ((eq ebib-before-help ebib-strings-buffer)
- (switch-to-buffer ebib-strings-buffer))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; 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")
- (save-excursion
- (save-restriction
- (if (region-active)
- (narrow-to-region (region-beginning)
- (region-end)))
- (let ((text (buffer-string)))
- (with-temp-buffer
- (insert text)
- (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-extract-bibfile ()
- (save-excursion
- (goto-char (point-min))
- (when (re-search-forward "\\\\bibliography{\\(.*?\\)}" nil t)
- (ensure-extension
- (buffer-substring-no-properties (match-beginning 1) (match-end 1))
- "bib"))))
-
-(defun ebib-get-db-from-filename (filename)
- "Returns the database struct associated with FILENAME."
- (catch 'found
- (mapc '(lambda (db)
- (if (string= (file-name-nondirectory (edb-filename db)) filename)
- (throw 'found db)))
- ebib-databases)
- nil))
-
-(defun ebib-get-local-database ()
- "Returns the database associated with the LaTeX file in the current buffer.
-
-If there is no \\bibliography command, return the current database."
- (unless ebib-local-bibtex-filename
- ;; if we don't know the .bib file yet, try to find it.
- (if (and (boundp 'TeX-master)
- (stringp TeX-master))
- ;; 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.
- (let ((texfile (ensure-extension TeX-master "tex")))
- (if (file-readable-p texfile)
- (let ((bibfile nil))
- (with-temp-buffer
- (insert-file-contents texfile)
- ;; we can only set ebib-local-bibtex-filename after the
- ;; temp buffer is killed. so we store it temporarily.
- (setq bibfile (ebib-extract-bibfile)))
- (setq ebib-local-bibtex-filename bibfile))))
- ;; and otherwise just search the current file.
- (setq ebib-local-bibtex-filename (ebib-extract-bibfile))))
- (if (null ebib-local-bibtex-filename) ; if we still don't have a bibtex filename...
- (progn
- (message "No \\bibliography command found. Using current database.")
- ebib-cur-db)
- (ebib-get-db-from-filename ebib-local-bibtex-filename)))
-
-(defun ebib-insert-bibtex-key (prefix)
- "Inserts a BibTeX key at POINT, surrounded by braces.
-
-The user is prompted for a BibTeX key and has to choose one from the
-database of the current LaTeX file, or from the current database if there
-is no \\bibliography command. Tab completion works."
- (interactive "p")
- (if (null ebib-databases)
- (error "No database loaded")
- (let ((db (ebib-get-local-database)))
- (cond
- ((null db)
- (error "Database %s not loaded." ebib-local-bibtex-filename))
- ((= (hash-table-count (edb-database db)) 0)
- (error "No entries in database %s" ebib-local-bibtex-filename))
- (t
- (let* ((collection (ebib-create-collection (edb-database db)))
- (key (completing-read "Key to insert: " collection nil t nil ebib-minibuf-hist)))
- (when key
- (insert (format (or (cdr (assoc prefix ebib-insertion-strings))
- "{%s}") key)))))))))
-
-(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)
- (if (null ebib-databases)
- (error "No database loaded")
- (let ((db (ebib-get-local-database))
- (key (read-string-at-point "\"#%'(),={} \n\t\f")))
- (cond
- ((null db)
- (error "Database %s not loaded" ebib-local-bibtex-filename))
- ((not (member key (edb-keys-list db)))
- (error "`%s' is not in database `%s'" key ebib-local-bibtex-filename))
- (t
- (with-output-to-temp-buffer "*Help*"
- (let* ((entry (gethash key (edb-database db))))
- (ebib-format-fields entry 'princ))))))))
-
-(provide 'ebib)
-
-;; we put these at the end, because they seem to mess up Emacs'
-;; syntax highlighting.
-
-(setq ebib-index-buffer-help
- "Ebib index buffer -- command key overview
-
-When no database is open, only the commands marked with * are available.
-
-Note: command keys are case-sensitive.
-
-(Press C-v to scroll down, M-v to scroll up, `q' to quit.)
-
-cursor movement:
-[up], k, C-p: go to the previous entry
-[down], j, C-n: go to the next entry
-[home], g: go to the first entry
-[end], G: go to the last entry
-[PgUp], b, M-p: scroll 10 entries up
-[PgDn], [space], M-n: scroll 10 entries down
-
-editing:
-e: edit the current entry
-E: edit the current entry's name
-a: add a new entry
-d: delete the current entry
-t: edit the @STRING definitions
-p: edit the @PREAMBLE definition
-
-searching:
-/: search the database
-n: find the next occurrence of the search string
-C-s: search for a key (incrementally)
-[return]: select the entry under the cursor (use after C-s)
-&: filter the current database with a logical AND
-|: filter the current database with a logical OR
-~: filter the current database with a logical NOT
-V: show the current filter (with prefix argument:
- reapply current filter)
-
-file handling:
-o*: open a database
-c: close the database
-s: save the database
-S: save all databases
-w: save the database under a different name
-M: merge another database
-x: export the current entry to another file
- (with prefix argument N: copy to database N)
-X: export the @PREAMBLE definition to another file
- (with prefix argument N: copy to database N)
-f: print the full filename in the minibuffer
-
-databases:
-1-9: switch to database 1-9
-J: switch to another database (accepts prefix argument)
-[right], [left]: switch previous/next database
-P: print the database
-L: LaTeX the database
-
-general:
-C: customise Ebib
-z*: put Ebib in the background
-q*: quit Ebib
-h*: show this help page
-")
-
-(setq ebib-entry-buffer-help
- "Ebib entry buffer -- command key overview
-
-Note: command keys are case-sensitive.
-
-(Press C-v to scroll down, M-v to scroll up, `q' to quit.)
-
-cursor movement:
-[up], k, C-p: go to the previous field
-[down], j, C-n: go to the next field
-[home], g: go to the first field
-[last], G: go to the last field
-[PgUp], b, M-p: go to the previous group of fields
-[PgDn], [space], M-n: go to the next group of fields
-
-editing:
-e: edit the value of the current field
-c: copy the value of the current field (value is put into the kill ring)
-x: kill the value of the current field (value is put into the kill ring)
-y: yank the most recently copied/cut string
-d: delete the value of the current entry
-r: toggle the \"rawness\" status of the current field
-l: edit the current field as multi-line
-s: insert an @STRING abbreviation into the current field
-
-general:
-q: quit the entry buffer and return to the index buffer
-h: show this help page
-")
-
-(setq ebib-strings-buffer-help
- "Ebib strings buffer -- command key overview
-
-Note: command keys are case-sensitive.
-
-(Press C-v to scroll down, M-v to scroll up, `q' to quit.)
-
-cursor movement:
-[up], k, C-p: go to the previous @STRING definition
-[down], j, C-n: go to the next @STRING definition
-[home], g: go to the first @STRING definition
-[end], G: go to the last @STRING definition
-[PgUp], b, M-p: scroll 10 @STRING definitions up
-[PgDn], [space], M-n: scroll 10 @STRING definitions down
-
-editing:
-e: edit the value of the current @STRING definition
-c: copy the value of the current @STRING definition
-d: delete the current @STRING definition
-a: add an @STRING definition
-l: edit the current @STRING as multi-line
-
-exporting:
-x: export the current @STRING definition to another file
- (with prefix argument N: copy to database N)
-X: export all @STRING definitions to another file
- (with prefix argument N: copy to database N)
-
-general:
-q: quit the strings buffer and return to the index buffer
-h: show this help page
-tt")
-
-;;; ebib ends here
+++ /dev/null
-;;; graphviz-dot-mode.el --- Mode for the dot-language used by graphviz (att).
-
-;; Copyright (C) 2002 - 2005 Pieter Pareit <pieter.pareit@scarlet.be>
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2 of
-;; the License, or (at your option) any later version.
-
-;; This program is distributed in the hope that it will be
-;; useful, but WITHOUT ANY WARRANTY; without even the implied
-;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
-;; PURPOSE. See the GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public
-;; License along with this program; if not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
-;; MA 02111-1307 USA
-
-;; Authors: Pieter Pareit <pieter.pareit@scarlet.be>
-;; Rubens Ramos <rubensr AT users.sourceforge.net>
-;; Maintainer: Pieter Pareit <pieter.pareit@planetinternet.be>
-;; Homepage: http://users.skynet.be/ppareit/projects/graphviz-dot-mode/graphviz-dot-mode.html
-;; Created: 28 Oct 2002
-;; Last modified: 24 Feb 2005
-;; Version: 0.3.4
-;; Keywords: mode dot dot-language dotlanguage graphviz graphs att
-
-;;; Commentary:
-;; Use this mode for editing files in the dot-language (www.graphviz.org and
-;; http://www.research.att.com/sw/tools/graphviz/).
-;;
-;; To use graphviz-dot-mode, add
-;; (load-file "PATH_TO_FILE/graphviz-dot-mode.el")
-;; to your ~/.emacs(.el) or ~/.xemacs/init.el
-;;
-;; The graphviz-dot-mode will do font locking, indentation, preview of graphs
-;; and eases compilation/error location. There is support for both GNU Emacs
-;; and XEmacs.
-;;
-;; Font locking is automatic, indentation uses the same commands as
-;; other modes, tab, M-j and C-M-q. Insertion of comments uses the
-;; same commands as other modes, M-; . You can compile a file using
-;; M-x compile or C-c c, after that M-x next-error will also work.
-;; There is support for viewing an generated image with C-c p.
-
-;;; Todo:
-;; * cleanup the mess of graphviz-dot-compilation-parse-errors
-;; * electric indentation is fundamentally broken, because
-;; {...} are also used for record nodes. You could argue, I suppose, that
-;; many diagrams don't need those, but it would be worth having a note (and
-;; it makes sense that the default is now for electric indentation to be
-;; off).
-
-;;; History:
-
-;; Version 0.3.4 bug fixes
-;; 24/02/2005: * fixed a bug in graphviz-dot-preview
-;; Version 0.3.3 bug fixes
-;; 13/02/2005: Reuben Thomas <rrt AT sc3d.org>
-;; * add graphviz-dot-indent-width
-;; Version 0.3.2 bug fixes
-;; 25/03/2004: Rubens Ramos <rubensr AT users.sourceforge.net>
-;; * semi-colons and brackets are added when electric
-;; behaviour is disabled.
-;; * electric characters do not behave electrically inside
-;; comments or strings.
-;; * default for electric-braces is disabled now (makes more
-;; sense I guess).
-;; * using read-from-minibuffer instead of read-shell-command
-;; for emacs.
-;; * Fixed test for easymenu, so that it works on older
-;; versions of XEmacs.
-;; * Fixed indentation error when trying to indent last brace
-;; of an empty graph.
-;; * region-active-p does not exist in emacs (21.2 at least),
-;; so removed from code
-;; * Added uncomment menu option
-;; Version 0.3.1 bug fixes
-;; 03/03/2004: * backward-word needs argument for older emacs
-;; Version 0.3 added features and fixed bugs
-;; 10/01/2004: fixed a bug in graphviz-dot-indent-graph
-;; 08/01/2004: Rubens Ramos <rubensr AT users.sourceforge.net>
-;; * added customization support
-;; * Now it works on XEmacs and Emacs
-;; * Added support to use an external Viewer
-;; * Now things do not break when dot mode is entered
-;; when there is no buffer name, but the side effect is
-;; that in this case, the compilation command is not
-;; correct.
-;; * Preview works on XEmacs and emacs.
-;; * Electric indentation on newline
-;; * Minor changes to indentation
-;; * Added keyword completion (but could be A LOT better)
-;; * There are still a couple of ugly hacks. Look for 'RR'.
-;; Version 0.2 added features
-;; 11/11/2002: added preview support.
-;; 10/11/2002: indent a graph or subgraph at once with C-M-q.
-;; 08/11/2002: relaxed rules for indentation, the may now be extra chars
-;; after beginning of graph (comment's for example).
-;; Version 0.1.2 bug fixes and naming issues
-;; 06/11/2002: renamed dot-font-lock-defaults to dot-font-lock-keywords.
-;; added some documentation to dot-colors.
-;; provided a much better way to handle my max-specpdl-size
-;; problem.
-;; added an extra autoload cookie (hope this helps, as I don't
-;; yet use autoload myself)
-;; Version 0.1.1 bug fixes
-;; 06/11/2002: added an missing attribute, for font-locking to work.
-;; fixed the regex generating, so that it only recognizes
-;; whole words
-;; 05/11/2002: there can now be extra white space chars after an '{'.
-;; 04/11/2002: Why I use max-specpdl-size is now documented, and old value
-;; gets restored.
-;; Version 0.1 initial release
-;; 02/11/2002: implemented parser for *compilation* of a .dot file.
-;; 01/11/2002: implemented compilation of an .dot file.
-;; 31/10/2002: added syntax-table to the mode.
-;; 30/10/2002: implemented indentation code.
-;; 29/10/2002: implemented all of font-lock.
-;; 28/10/2002: derived graphviz-dot-mode from fundamental-mode, started
-;; implementing font-lock.
-
-;;; Code:
-
-(defconst graphviz-dot-mode-version "0.3.3"
- "Version of `graphviz-dot-mode.el'.")
-
-(defgroup graphviz nil
- "Major mode for editing Graphviz Dot files"
- :group 'tools)
-
-(defun graphviz-dot-customize ()
- "Run \\[customize-group] for the `graphviz' group."
- (interactive)
- (customize-group 'graphviz))
-
-(defvar graphviz-dot-mode-abbrev-table nil
- "Abbrev table in use in Graphviz Dot mode buffers.")
-(define-abbrev-table 'graphviz-dot-mode-abbrev-table ())
-
-(defcustom graphviz-dot-dot-program "dot"
- "*Location of the dot program. This is used by `compile'."
- :type 'string
- :group 'graphviz)
-
-(defcustom graphviz-dot-view-command "doted %s"
- "*External program to run on the buffer. You can use `%s' in this string,
-and it will be substituted by the buffer name."
- :type 'string
- :group 'graphviz)
-
-(defcustom graphviz-dot-view-edit-command nil
- "*Whether to allow the user to edit the command to run an external
-viewer."
- :type 'boolean
- :group 'graphviz)
-
-(defcustom graphviz-dot-save-before-view t
- "*If not nil, M-x graphviz-dot-view saves the current buffer before running
-the command."
- :type 'boolean
- :group 'graphviz)
-
-(defcustom graphviz-dot-auto-indent-on-newline t
- "*If not nil, `electric-graphviz-dot-terminate-line' is executed in a line is terminated."
- :type 'boolean
- :group 'graphviz)
-
-(defcustom graphviz-dot-indent-width default-tab-width
- "*Indentation width in Graphviz Dot mode buffers."
- :type 'integer
- :group 'graphviz)
-
-(defcustom graphviz-dot-auto-indent-on-braces nil
- "*If not nil, `electric-graphviz-dot-open-brace' and `electric-graphviz-dot-close-brace' are executed when { or } are typed"
- :type 'boolean
- :group 'graphviz)
-
-(defcustom graphviz-dot-auto-indent-on-semi t
- "*If not nil, `electric-graphviz-dot-semi' is executed when semicolon is typed"
- :type 'boolean
- :group 'graphviz)
-
-(defcustom graphviz-dot-preview-extension "png"
- "*The extension to use for the compilation and preview commands. The format
-for the compilation command is
-`dot -T<extension> file.dot > file.<extension>'."
- :type 'string
- :group 'graphviz)
-
-(defcustom graphviz-dot-toggle-completions nil
- "*Non-nil means that repeated use of \
-\\<graphviz-dot-mode-map>\\[graphviz-dot-complete-word] will toggle the possible
-completions in the minibuffer. Normally, when there is more than one possible
-completion, a buffer will display all completions."
- :type 'boolean
- :group 'graphviz)
-
-(defcustom graphviz-dot-delete-completions nil
- "*Non-nil means that the completion buffer is automatically deleted when a
-key is pressed."
- :type 'boolean
- :group 'graphviz)
-
-(defcustom graphviz-dot-attr-keywords
- '("graph" "digraph" "subgraph" "node" "edge" "strict" "rankdir"
- "size" "page" "Damping" "Epsilon" "URL" "arrowhead" "arrowsize"
- "arrowtail" "bb" "bgcolor" "bottomlabel" "center" "clusterrank"
- "color" "comment" "compound" "concentrate" "constraint" "decorate"
- "dim" "dir" "distortion" "fillcolor" "fixedsize" "fontcolor"
- "fontname" "fontpath" "fontsize" "group" "headURL" "headlabel"
- "headport" "height" "label" "labelangle" "labeldistance" "labelfloat"
- "labelfontcolor" "labelfontname" "labelfontsize" "labeljust"
- "labelloc" "layer" "layers" "len" "lhead" "lp" "ltail" "margin"
- "maxiter" "mclimit" "minlen" "model" "nodesep" "normalize" "nslimit"
- "nslimit1" "ordering" "orientation" "overlap" "pack" "pagedir"
- "pencolor" "peripheries" "pin" "pos" "quantum" "rank" "ranksep"
- "ratio" "rects" "regular" "remincross" "rotate" "samehead" "sametail"
- "samplepoint" "searchsize" "sep" "shape" "shapefile" "showboxes"
- "sides" "skew" "splines" "start" "style" "stylesheet" "tailURL"
- "taillabel" "tailport" "toplabel" "vertices" "voro_margin" "weight"
- "z")
- "*Keywords for attribute names in a graph. This is used by the auto
-completion code. The actual completion tables are built when the mode
-is loaded, so changes to this are not immediately visible."
- :type '(repeat (string :tag "Keyword"))
- :group 'graphviz)
-
-(defcustom graphviz-dot-value-keywords
- '("true" "false" "normal" "inv" "dot" "invdot" "odot" "invodot"
- "none" "tee" "empty" "invempty" "diamond" "odiamond" "box" "obox"
- "open" "crow" "halfopen" "local" "global" "none" "forward" "back"
- "both" "none" "BL" "BR" "TL" "TR" "RB" "RT" "LB" "LT" ":n" ":ne" ":e"
- ":se" ":s" ":sw" ":w" ":nw" "same" "min" "source" "max" "sink" "LR"
- "box" "polygon" "ellipse" "circle" "point" "egg" "triangle"
- "plaintext" "diamond" "trapezium" "parallelogram" "house" "hexagon"
- "octagon" "doublecircle" "doubleoctagon" "tripleoctagon" "invtriangle"
- "invtrapezium" "invhouse" "Mdiamond" "Msquare" "Mcircle" "record"
- "Mrecord" "dashed" "dotted" "solid" "invis" "bold" "filled"
- "diagonals" "rounded" )
- "*Keywords for attribute values. This is used by the auto completion
-code. The actual completion tables are built when the mode is loaded,
-so changes to this are not immediately visible."
- :type '(repeat (string :tag "Keyword"))
- :group 'graphviz)
-
-;;; Font-locking:
-(defvar graphviz-dot-colors-list
- '(aliceblue antiquewhite antiquewhite1 antiquewhite2
- antiquewhite3 antiquewhite4 aquamarine aquamarine1
- aquamarine2 aquamarine3 aquamarine4 azure azure1
- azure2 azure3 azure4 beige bisque bisque1 bisque2
- bisque3 bisque4 black blanchedalmond blue blue1
- blue2 blue3 blue4 blueviolet brown brown1 brown2
- brown3 brown4 burlywood burlywood1 burlywood2
- burlywood3 burlywood4 cadetblue cadetblue1
- cadetblue2 cadetblue3 cadetblue4 chartreuse
- chartreuse1 chartreuse2 chartreuse3 chartreuse4
- chocolate chocolate1 chocolate2 chocolate3 chocolate4
- coral coral1 coral2 coral3 coral4 cornflowerblue
- cornsilk cornsilk1 cornsilk2 cornsilk3 cornsilk4
- crimson cyan cyan1 cyan2 cyan3 cyan4 darkgoldenrod
- darkgoldenrod1 darkgoldenrod2 darkgoldenrod3
- darkgoldenrod4 darkgreen darkkhaki darkolivegreen
- darkolivegreen1 darkolivegreen2 darkolivegreen3
- darkolivegreen4 darkorange darkorange1 darkorange2
- darkorange3 darkorange4 darkorchid darkorchid1
- darkorchid2 darkorchid3 darkorchid4 darksalmon
- darkseagreen darkseagreen1 darkseagreen2
- darkseagreen3 darkseagreen4 darkslateblue
- darkslategray darkslategray1 darkslategray2
- darkslategray3 darkslategray4 darkslategrey
- darkturquoise darkviolet deeppink deeppink1
- deeppink2 deeppink3 deeppink4 deepskyblue
- deepskyblue1 deepskyblue2 deepskyblue3 deepskyblue4
- dimgray dimgrey dodgerblue dodgerblue1 dodgerblue2
- dodgerblue3 dodgerblue4 firebrick firebrick1
- firebrick2 firebrick3 firebrick4 floralwhite
- forestgreen gainsboro ghostwhite gold gold1 gold2
- gold3 gold4 goldenrod goldenrod1 goldenrod2
- goldenrod3 goldenrod4 gray gray0 gray1 gray10 gray100
- gray11 gray12 gray13 gray14 gray15 gray16 gray17
- gray18 gray19 gray2 gray20 gray21 gray22 gray23
- gray24 gray25 gray26 gray27 gray28 gray29 gray3
- gray30 gray31 gray32 gray33 gray34 gray35 gray36
- gray37 gray38 gray39 gray4 gray40 gray41 gray42
- gray43 gray44 gray45 gray46 gray47 gray48 gray49
- gray5 gray50 gray51 gray52 gray53 gray54 gray55
- gray56 gray57 gray58 gray59 gray6 gray60 gray61
- gray62 gray63 gray64 gray65 gray66 gray67 gray68
- gray69 gray7 gray70 gray71 gray72 gray73 gray74
- gray75 gray76 gray77 gray78 gray79 gray8 gray80
- gray81 gray82 gray83 gray84 gray85 gray86 gray87
- gray88 gray89 gray9 gray90 gray91 gray92 gray93
- gray94 gray95 gray96 gray97 gray98 gray99 green
- green1 green2 green3 green4 greenyellow grey grey0
- grey1 grey10 grey100 grey11 grey12 grey13 grey14
- grey15 grey16 grey17 grey18 grey19 grey2 grey20
- grey21 grey22 grey23 grey24 grey25 grey26 grey27
- grey28 grey29 grey3 grey30 grey31 grey32 grey33
- grey34 grey35 grey36 grey37 grey38 grey39 grey4
- grey40 grey41 grey42 grey43 grey44 grey45 grey46
- grey47 grey48 grey49 grey5 grey50 grey51 grey52
- grey53 grey54 grey55 grey56 grey57 grey58 grey59
- grey6 grey60 grey61 grey62 grey63 grey64 grey65
- grey66 grey67 grey68 grey69 grey7 grey70 grey71
- grey72 grey73 grey74 grey75 grey76 grey77 grey78
- grey79 grey8 grey80 grey81 grey82 grey83 grey84
- grey85 grey86 grey87 grey88 grey89 grey9 grey90
- grey91 grey92 grey93 grey94 grey95 grey96 grey97
- grey98 grey99 honeydew honeydew1 honeydew2 honeydew3
- honeydew4 hotpink hotpink1 hotpink2 hotpink3 hotpink4
- indianred indianred1 indianred2 indianred3 indianred4
- indigo ivory ivory1 ivory2 ivory3 ivory4 khaki khaki1
- khaki2 khaki3 khaki4 lavender lavenderblush
- lavenderblush1 lavenderblush2 lavenderblush3
- lavenderblush4 lawngreen lemonchiffon lemonchiffon1
- lemonchiffon2 lemonchiffon3 lemonchiffon4 lightblue
- lightblue1 lightblue2 lightblue3 lightblue4
- lightcoral lightcyan lightcyan1 lightcyan2 lightcyan3
- lightcyan4 lightgoldenrod lightgoldenrod1
- lightgoldenrod2 lightgoldenrod3 lightgoldenrod4
- lightgoldenrodyellow lightgray lightgrey lightpink
- lightpink1 lightpink2 lightpink3 lightpink4
- lightsalmon lightsalmon1 lightsalmon2 lightsalmon3
- lightsalmon4 lightseagreen lightskyblue lightskyblue1
- lightskyblue2 lightskyblue3 lightskyblue4
- lightslateblue lightslategray lightslategrey
- lightsteelblue lightsteelblue1 lightsteelblue2
- lightsteelblue3 lightsteelblue4 lightyellow
- lightyellow1 lightyellow2 lightyellow3 lightyellow4
- limegreen linen magenta magenta1 magenta2 magenta3
- magenta4 maroon maroon1 maroon2 maroon3 maroon4
- mediumaquamarine mediumblue mediumorchid
- mediumorchid1 mediumorchid2 mediumorchid3
- mediumorchid4 mediumpurple mediumpurple1
- mediumpurple2 mediumpurple3 mediumpurple4
- mediumseagreen mediumslateblue mediumspringgreen
- mediumturquoise mediumvioletred midnightblue
- mintcream mistyrose mistyrose1 mistyrose2 mistyrose3
- mistyrose4 moccasin navajowhite navajowhite1
- navajowhite2 navajowhite3 navajowhite4 navy navyblue
- oldlace olivedrab olivedrap olivedrab1 olivedrab2
- olivedrap3 oragne palegoldenrod palegreen palegreen1
- palegreen2 palegreen3 palegreen4 paleturquoise
- paleturquoise1 paleturquoise2 paleturquoise3
- paleturquoise4 palevioletred palevioletred1
- palevioletred2 palevioletred3 palevioletred4
- papayawhip peachpuff peachpuff1 peachpuff2
- peachpuff3 peachpuff4 peru pink pink1 pink2 pink3
- pink4 plum plum1 plum2 plum3 plum4 powderblue
- purple purple1 purple2 purple3 purple4 red red1 red2
- red3 red4 rosybrown rosybrown1 rosybrown2 rosybrown3
- rosybrown4 royalblue royalblue1 royalblue2 royalblue3
- royalblue4 saddlebrown salmon salmon1 salmon2 salmon3
- salmon4 sandybrown seagreen seagreen1 seagreen2
- seagreen3 seagreen4 seashell seashell1 seashell2
- seashell3 seashell4 sienna sienna1 sienna2 sienna3
- sienna4 skyblue skyblue1 skyblue2 skyblue3 skyblue4
- slateblue slateblue1 slateblue2 slateblue3 slateblue4
- slategray slategray1 slategray2 slategray3 slategray4
- slategrey snow snow1 snow2 snow3 snow4 springgreen
- springgreen1 springgreen2 springgreen3 springgreen4
- steelblue steelblue1 steelblue2 steelblue3 steelblue4
- tan tan1 tan2 tan3 tan4 thistle thistle1 thistle2
- thistle3 thistle4 tomato tomato1 tomato2 tomato3
- tomato4 transparent turquoise turquoise1 turquoise2
- turquoise3 turquoise4 violet violetred violetred1
- violetred2 violetred3 violetred4 wheat wheat1 wheat2
- wheat3 wheat4 white whitesmoke yellow yellow1 yellow2
- yellow3 yellow4 yellowgreen)
- "Possible color constants in the dot language.
-The list of constant is available at http://www.research.att.com/~erg/graphviz\
-/info/colors.html")
-
-
-(defvar graphviz-dot-color-keywords
- (mapcar 'symbol-name graphviz-dot-colors-list))
-
-(defvar graphviz-attr-keywords
- (mapcar '(lambda (elm) (cons elm 0)) graphviz-dot-attr-keywords))
-
-(defvar graphviz-value-keywords
- (mapcar '(lambda (elm) (cons elm 0)) graphviz-dot-value-keywords))
-
-(defvar graphviz-color-keywords
- (mapcar '(lambda (elm) (cons elm 0)) graphviz-dot-color-keywords))
-
-;;; Key map
-(defvar graphviz-dot-mode-map ()
- "Keymap used in Graphviz Dot mode.")
-
-(if graphviz-dot-mode-map
- ()
- (let ((map (make-sparse-keymap)))
- (define-key map "\r" 'electric-graphviz-dot-terminate-line)
- (define-key map "{" 'electric-graphviz-dot-open-brace)
- (define-key map "}" 'electric-graphviz-dot-close-brace)
- (define-key map ";" 'electric-graphviz-dot-semi)
- (define-key map "\M-\t" 'graphviz-dot-complete-word)
- (define-key map "\C-\M-q" 'graphviz-dot-indent-graph)
- (define-key map "\C-cp" 'graphviz-dot-preview)
- (define-key map "\C-cc" 'compile)
- (define-key map "\C-cv" 'graphviz-dot-view)
- (define-key map "\C-c\C-c" 'comment-region)
- (define-key map "\C-c\C-u" 'graphviz-dot-uncomment-region)
- (setq graphviz-dot-mode-map map)
- ))
-
-;;; Syntax table
-(defvar graphviz-dot-mode-syntax-table nil
- "Syntax table for `graphviz-dot-mode'.")
-
-(if graphviz-dot-mode-syntax-table
- ()
- (let ((st (make-syntax-table)))
- (modify-syntax-entry ?/ ". 124b" st)
- (modify-syntax-entry ?* ". 23" st)
- (modify-syntax-entry ?\n "> b" st)
- (modify-syntax-entry ?= "." st)
- (modify-syntax-entry ?_ "_" st)
- (modify-syntax-entry ?- "_" st)
- (modify-syntax-entry ?> "." st)
- (modify-syntax-entry ?[ "(" st)
- (modify-syntax-entry ?] ")" st)
- (modify-syntax-entry ?\" "\"" st)
- (setq graphviz-dot-mode-syntax-table st)
- ))
-
-(defvar graphviz-dot-font-lock-keywords
- `(("\\(:?di\\|sub\\)?graph \\(\\sw+\\)"
- (2 font-lock-function-name-face))
- (,(regexp-opt graphviz-dot-value-keywords 'words)
- . font-lock-reference-face)
- ;; to build the font-locking for the colors,
- ;; we need more room for max-specpdl-size,
- ;; after that we take the list of symbols,
- ;; convert them to a list of strings, and make
- ;; an optimized regexp from them
- (,(let ((max-specpdl-size (max max-specpdl-size 1200)))
- (regexp-opt graphviz-dot-color-keywords))
- . font-lock-string-face)
- (,(concat
- (regexp-opt graphviz-dot-attr-keywords 'words)
- "[ \\t\\n]*=")
- ;; RR - ugly, really, but I dont know why xemacs does not work
- ;; if I change the next car to "1"...
- (0 font-lock-variable-name-face)))
- "Keyword highlighting specification for `graphviz-dot-mode'.")
-
-;;;###autoload
-(defun graphviz-dot-mode ()
- "Major mode for the dot language. \\<graphviz-dot-mode-map>
-TAB indents for graph lines.
-
-\\[graphviz-dot-indent-graph]\t- Indentaion function.
-\\[graphviz-dot-preview]\t- Previews graph in a buffer.
-\\[graphviz-dot-view]\t- Views graph in an external viewer.
-\\[graphviz-dot-indent-line]\t- Indents current line of code.
-\\[graphviz-dot-complete-word]\t- Completes the current word.
-\\[electric-graphviz-dot-terminate-line]\t- Electric newline.
-\\[electric-graphviz-dot-open-brace]\t- Electric open braces.
-\\[electric-graphviz-dot-close-brace]\t- Electric close braces.
-\\[electric-graphviz-dot-semi]\t- Electric semi colons.
-
-Variables specific to this mode:
-
- graphviz-dot-dot-program (default `dot')
- Location of the dot program.
- graphviz-dot-view-command (default `doted %s')
- Command to run when `graphviz-dot-view' is executed.
- graphviz-dot-view-edit-command (default nil)
- If the user should be asked to edit the view command.
- graphviz-dot-save-before-view (default t)
- Automatically save current buffer berore `graphviz-dot-view'.
- graphviz-dot-preview-extension (default `png')
- File type to use for `graphviz-dot-preview'.
- graphviz-dot-auto-indent-on-newline (default t)
- Whether to run `electric-graphviz-dot-terminate-line' when
- newline is entered.
- graphviz-dot-auto-indent-on-braces (default t)
- Whether to run `electric-graphviz-dot-open-brace' and
- `electric-graphviz-dot-close-brace' when braces are
- entered.
- graphviz-dot-auto-indent-on-semi (default t)
- Whether to run `electric-graphviz-dot-semi' when semi colon
- is typed.
- graphviz-dot-toggle-completions (default nil)
- If completions should be displayed in the buffer instead of a
- completion buffer when \\[graphviz-dot-complete-word] is
- pressed repeatedly.
-
-This mode can be customized by running \\[graphviz-dot-customize].
-
-Turning on Graphviz Dot mode calls the value of the variable
-`graphviz-dot-mode-hook' with no args, if that value is non-nil."
- (interactive)
- (kill-all-local-variables)
- (use-local-map graphviz-dot-mode-map)
- (setq major-mode 'graphviz-dot-mode)
- (setq mode-name "dot")
- (setq local-abbrev-table graphviz-dot-mode-abbrev-table)
- (set-syntax-table graphviz-dot-mode-syntax-table)
- (set (make-local-variable 'indent-line-function) 'graphviz-dot-indent-line)
- (set (make-local-variable 'comment-start) "//")
- (set (make-local-variable 'comment-start-skip) "/\\*+ *\\|//+ *")
- (set (make-local-variable 'font-lock-defaults)
- '(graphviz-dot-font-lock-keywords))
- ;; RR - If user is running this in the scratch buffer, there is no
- ;; buffer file name...
- (if (buffer-file-name)
- (set (make-local-variable 'compile-command)
- (concat graphviz-dot-dot-program
- " -T" graphviz-dot-preview-extension " "
- buffer-file-name
- " > "
- (file-name-sans-extension
- buffer-file-name)
- "." graphviz-dot-preview-extension)))
- (set (make-local-variable 'compilation-parse-errors-function)
- 'graphviz-dot-compilation-parse-errors)
- (if dot-menu
- (easy-menu-add dot-menu))
- (run-hooks 'graphviz-dot-mode-hook)
- )
-
-;;;; Menu definitions
-
-(defvar dot-menu nil
- "Menu for Graphviz Dot Mode.
-This menu will get created automatically if you have the `easymenu'
-package. Note that the latest X/Emacs releases contain this package.")
-
-(and (condition-case nil
- (require 'easymenu)
- (error nil))
- (easy-menu-define
- dot-menu graphviz-dot-mode-map "Graphviz Mode menu"
- '("Graphviz"
- ["Indent Graph" graphviz-dot-indent-graph t]
- ["Comment Out Region" comment-region (mark)]
- ["Uncomment Region" graphviz-dot-uncomment-region (mark)]
- "-"
- ["Compile" compile t]
- ["Preview" graphviz-dot-preview
- (and (buffer-file-name)
- (not (buffer-modified-p)))]
- ["External Viewer" graphviz-dot-view (buffer-file-name)]
- "-"
- ["Customize..." graphviz-dot-customize t]
- )))
-
-;;;; Compilation
-
-;; note on graphviz-dot-compilation-parse-errors:
-;; It would nicer if we could just use compilation-error-regexp-alist
-;; to do that, 3 options:
-;; - still write dot-compilation-parse-errors, don't build
-;; a return list, but modify the *compilation* buffer
-;; in a way compilation-error-regexp-alist recognizes the
-;; format.
-;; to do that, I should globally change compilation-parse-function
-;; to this function, and call the old value of comp..-parse-fun..
-;; to provide the return value.
-;; two drawbacks are that, every compilation would be run through
-;; this function (performance) and that in autoload there would
-;; be a chance that this function would not yet be known.
-;; - let the compilation run through a filter that would
-;; modify the output of dot or neato:
-;; dot -Tpng input.dot | filter
-;; drawback: ugly, extra work for user, extra decency ...
-;; no-option
-;; - modify dot and neato !!! (PP:15/02/2005 seems to have happend,
-;; so version 0.4.0 should clean this mess up!)
-(defun graphviz-dot-compilation-parse-errors (limit-search find-at-least)
- "Parse the current buffer for dot errors.
-See variable `compilation-parse-errors-functions' for interface."
- (interactive)
- (save-excursion
- (set-buffer "*compilation*")
- (goto-char (point-min))
- (setq compilation-error-list nil)
- (let (buffer-of-error)
- (while (not (eobp))
- (cond
- ((looking-at "^dot\\( -[^ ]+\\)* \\(.*\\)")
- (setq buffer-of-error (find-file-noselect
- (buffer-substring-no-properties
- (nth 4 (match-data t))
- (nth 5 (match-data t))))))
- ((looking-at ".*:.*line \\([0-9]+\\)")
- (let ((line-of-error
- (string-to-number (buffer-substring-no-properties
- (nth 2 (match-data t))
- (nth 3 (match-data t))))))
- (setq compilation-error-list
- (cons
- (cons
- (point-marker)
- (save-excursion
- (set-buffer buffer-of-error)
- (goto-line line-of-error)
- (beginning-of-line)
- (point-marker)))
- compilation-error-list))))
- (t t))
- (forward-line 1)) )))
-
-;;;;
-;;;; Indentation
-;;;;
-(defun graphviz-dot-uncomment-region (begin end)
- "Uncomments a region of code."
- (interactive "r")
- (comment-region begin end '(4)))
-
-(defun graphviz-dot-indent-line ()
- "Indent current line of dot code."
- (interactive)
- (if (bolp)
- (graphviz-dot-real-indent-line)
- (save-excursion
- (graphviz-dot-real-indent-line))))
-
-(defun graphviz-dot-real-indent-line ()
- "Indent current line of dot code."
- (beginning-of-line)
- (cond
- ((bobp)
- ;; simple case, indent to 0
- (indent-line-to 0))
- ((looking-at "^[ \t]*}[ \t]*$")
- ;; block closing, deindent relative to previous line
- (indent-line-to (save-excursion
- (forward-line -1)
- (max 0 (- (current-indentation) graphviz-dot-indent-width)))))
- ;; other cases need to look at previous lines
- (t
- (indent-line-to (save-excursion
- (forward-line -1)
- (cond
- ((looking-at "\\(^.*{[^}]*$\\)")
- ;; previous line opened a block
- ;; indent to that line
- (+ (current-indentation) graphviz-dot-indent-width))
- ((and (not (looking-at ".*\\[.*\\].*"))
- (looking-at ".*\\[.*")) ; TODO:PP : can be 1 regex
- ;; previous line started filling
- ;; attributes, intend to that start
- (search-forward "[")
- (current-column))
- ((and (not (looking-at ".*\\[.*\\].*"))
- (looking-at ".*\\].*")) ; TODO:PP : "
- ;; previous line stopped filling
- ;; attributes, find the line that started
- ;; filling them and indent to that line
- (while (or (looking-at ".*\\[.*\\].*")
- (not (looking-at ".*\\[.*"))) ; TODO:PP : "
- (forward-line -1))
- (current-indentation))
- (t
- ;; default case, indent the
- ;; same as previous line
- (current-indentation)) ))) )))
-
-(defun graphviz-dot-indent-graph ()
- "Indent the graph/digraph/subgraph where point is at.
-This will first teach the beginning of the graph were point is at, and
-then indent this and each subgraph in it."
- (interactive)
- (save-excursion
- ;; position point at start of graph
- (while (not (or (looking-at "\\(^.*{[^}]*$\\)") (bobp)))
- (forward-line -1))
- ;; bracket { one +; bracket } one -
- (let ((bracket-count 0))
- (while
- (progn
- (cond
- ;; update bracket-count
- ((looking-at "\\(^.*{[^}]*$\\)")
- (setq bracket-count (+ bracket-count 1)))
- ;; update bracket-count
- ((looking-at "^[ \t]*}[ \t]*$")
- (setq bracket-count (- bracket-count 1))))
- ;; indent this line and move on
- (graphviz-dot-indent-line)
- (forward-line 1)
- ;; as long as we are not completed or at end of buffer
- (and (> bracket-count 0) (not (eobp))))))))
-
-;;;;
-;;;; Electric indentation
-;;;;
-(defun graphviz-dot-comment-or-string-p ()
- (let ((state (parse-partial-sexp (point-min) (point))))
- (or (nth 4 state) (nth 3 state))))
-
-(defun graphviz-dot-newline-and-indent ()
- (save-excursion
- (beginning-of-line)
- (skip-chars-forward " \t")
- (graphviz-dot-indent-line))
- (delete-horizontal-space)
- (newline)
- (graphviz-dot-indent-line))
-
-(defun electric-graphviz-dot-terminate-line ()
- "Terminate line and indent next line."
- (interactive)
- (if graphviz-dot-auto-indent-on-newline
- (graphviz-dot-newline-and-indent)
- (newline)))
-
-(defun electric-graphviz-dot-open-brace ()
- "Terminate line and indent next line."
- (interactive)
- (insert "{")
- (if (and graphviz-dot-auto-indent-on-braces
- (not (graphviz-dot-comment-or-string-p)))
- (graphviz-dot-newline-and-indent)))
-
-(defun electric-graphviz-dot-close-brace ()
- "Terminate line and indent next line."
- (interactive)
- (insert "}")
- (if (and graphviz-dot-auto-indent-on-braces
- (not (graphviz-dot-comment-or-string-p)))
- (progn
- (save-excursion
- (beginning-of-line)
- (skip-chars-forward " \t")
- (graphviz-dot-indent-line))
- (newline)
- (graphviz-dot-indent-line))))
-
-(defun electric-graphviz-dot-semi ()
- "Terminate line and indent next line."
- (interactive)
- (insert ";")
- (if (and graphviz-dot-auto-indent-on-semi
- (not (graphviz-dot-comment-or-string-p)))
- (graphviz-dot-newline-and-indent)))
-
-;;;;
-;;;; Preview
-;;;;
-(defun graphviz-dot-preview ()
- "Shows an example of the current dot file in an emacs buffer.
-This assumes that we are running GNU Emacs or XEmacs under a windowing system.
-See `image-file-name-extensions' for customizing the files that can be
-loaded in GNU Emacs, and `image-formats-alist' for XEmacs."
- (interactive)
- ;; unsafe to compile ourself, ask it to the user
- (if (buffer-modified-p)
- (message "Buffer needs to be compiled.")
- (if (string-match "XEmacs" emacs-version)
- ;; things are easier in XEmacs...
- (find-file-other-window (concat (file-name-sans-extension
- buffer-file-name)
- "." graphviz-dot-preview-extension))
- ;; run through all the extensions for images
- (let ((l image-file-name-extensions))
- (while
- (let ((f (concat (file-name-sans-extension (buffer-file-name))
- "."
- (car l))))
- ;; see if a file matches, might be best also to check
- ;; if file is up to date TODO:PP
- (if (file-exists-p f)
- (progn (auto-image-file-mode 1)
- ;; OK, this is ugly, I would need to
- ;; know how I can reload a file in an existing buffer
- (if (get-buffer "*preview*")
- (kill-buffer "*preview*"))
- (set-buffer (find-file-noselect f))
- (rename-buffer "*preview*")
- (display-buffer (get-buffer "*preview*"))
- ;; stop iterating
- '())
- ;; will stop iterating when l is nil
- (setq l (cdr l)))))
- ;; each extension tested and nothing found, let user know
- (when (eq l '())
- (message "No image found."))))))
-
-;;;;
-;;;; View
-;;;;
-(defun graphviz-dot-view ()
- "Runs an external viewer. This creates an external process every time it
-is executed. If `graphviz-dot-save-before-view' is set, the current
-buffer is saved before the command is executed."
- (interactive)
- (let ((cmd (if graphviz-dot-view-edit-command
- (if (string-match "XEmacs" emacs-version)
- (read-shell-command "View command: "
- (format graphviz-dot-view-command
- (buffer-file-name)))
- (read-from-minibuffer "View command: "
- (format graphviz-dot-view-command
- (buffer-file-name))))
- (format graphviz-dot-view-command (buffer-file-name)))))
- (if graphviz-dot-save-before-view
- (save-buffer))
- (setq novaproc (start-process-shell-command
- (downcase mode-name) nil cmd))
- (message (format "Executing `%s'..." cmd))))
-
-;;;;
-;;;; Completion
-;;;;
-(defvar graphviz-dot-str nil)
-(defvar graphviz-dot-all nil)
-(defvar graphviz-dot-pred nil)
-(defvar graphviz-dot-buffer-to-use nil)
-(defvar graphviz-dot-flag nil)
-
-(defun graphviz-dot-get-state ()
- "Returns the syntax state of the current point."
- (let ((state (parse-partial-sexp (point-min) (point))))
- (cond
- ((nth 4 state) 'comment)
- ((nth 3 state) 'string)
- ((not (nth 1 state)) 'out)
- (t (save-excursion
- (skip-chars-backward "^[,=\\[]{};")
- (backward-char)
- (cond
- ((looking-at "[\\[,]{};") 'attribute)
- ((looking-at "=") (progn
- (backward-word 1)
- (if (looking-at "[a-zA-Z]*color")
- 'color
- 'value)))
- (t 'other)))))))
-
-(defun graphviz-dot-get-keywords ()
- "Return possible completions for a word"
- (let ((state (graphviz-dot-get-state)))
- (cond
- ((equal state 'comment) ())
- ((equal state 'string) ())
- ((equal state 'out) graphviz-attr-keywords)
- ((equal state 'value) graphviz-value-keywords)
- ((equal state 'color) graphviz-color-keywords)
- ((equal state 'attribute) graphviz-attr-keywords)
- (t graphviz-attr-keywords))))
-
-(defvar graphviz-dot-last-word-numb 0)
-(defvar graphviz-dot-last-word-shown nil)
-(defvar graphviz-dot-last-completions nil)
-
-(defun graphviz-dot-complete-word ()
- "Complete word at current point."
- (interactive)
- (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
- (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))
- (graphviz-dot-str (buffer-substring b e))
- (allcomp (if (and graphviz-dot-toggle-completions
- (string= graphviz-dot-last-word-shown
- graphviz-dot-str))
- graphviz-dot-last-completions
- (all-completions graphviz-dot-str
- (graphviz-dot-get-keywords))))
- (match (if graphviz-dot-toggle-completions
- "" (try-completion
- graphviz-dot-str (mapcar '(lambda (elm)
- (cons elm 0)) allcomp)))))
- ;; Delete old string
- (delete-region b e)
-
- ;; Toggle-completions inserts whole labels
- (if graphviz-dot-toggle-completions
- (progn
- ;; Update entry number in list
- (setq graphviz-dot-last-completions allcomp
- graphviz-dot-last-word-numb
- (if (>= graphviz-dot-last-word-numb (1- (length allcomp)))
- 0
- (1+ graphviz-dot-last-word-numb)))
- (setq graphviz-dot-last-word-shown
- (elt allcomp graphviz-dot-last-word-numb))
- ;; Display next match or same string if no match was found
- (if (not (null allcomp))
- (insert "" graphviz-dot-last-word-shown)
- (insert "" graphviz-dot-str)
- (message "(No match)")))
- ;; The other form of completion does not necessarily do that.
-
- ;; Insert match if found, or the original string if no match
- (if (or (null match) (equal match 't))
- (progn (insert "" graphviz-dot-str)
- (message "(No match)"))
- (insert "" match))
- ;; Give message about current status of completion
- (cond ((equal match 't)
- (if (not (null (cdr allcomp)))
- (message "(Complete but not unique)")
- (message "(Sole completion)")))
- ;; Display buffer if the current completion didn't help
- ;; on completing the label.
- ((and (not (null (cdr allcomp))) (= (length graphviz-dot-str)
- (length match)))
- (with-output-to-temp-buffer "*Completions*"
- (display-completion-list allcomp))
- ;; Wait for a keypress. Then delete *Completion* window
- (momentary-string-display "" (point))
- (if graphviz-dot-delete-completions
- (delete-window
- (get-buffer-window (get-buffer "*Completions*"))))
- )))))
-
-;;;###autoload
-(add-to-list 'auto-mode-alist '("\\.dot\\'" . graphviz-dot-mode))
-
-;;; graphviz-dot-mode.el ends here
-
projects / lib.git / commitdiff