From: Don Armstrong Date: Mon, 25 Mar 2024 00:01:16 +0000 (-0700) Subject: load beancount from straight; remove unused el files X-Git-Url: https://git.donarmstrong.com/?p=lib.git;a=commitdiff_plain;h=57355d630c5b9472f9b77eddfb17886931784080 load beancount from straight; remove unused el files --- diff --git a/emacs_el/configuration/don-configuration.org b/emacs_el/configuration/don-configuration.org index 4a545bd..d54c0b8 100644 --- a/emacs_el/configuration/don-configuration.org +++ b/emacs_el/configuration/don-configuration.org @@ -1490,9 +1490,12 @@ From http://julien.danjou.info/projects/emacs-packages#rainbow-mode, this colori ** Beancount #+BEGIN_SRC emacs-lisp (use-package beancount - :straight nil + :straight (beancount + :type git + :host github + :repo "cnsunyour/beancount.el") :load-path "~/lib/emacs_el/beancount-mode/" - :mode "\\.beancount\\'" + :mode "\\.bean\\(?:count\\)?\\'" ) #+END_SRC diff --git a/emacs_el/dna-mode.el b/emacs_el/dna-mode.el deleted file mode 100644 index 5433ea1..0000000 --- a/emacs_el/dna-mode.el +++ /dev/null @@ -1,590 +0,0 @@ -;;; dna-mode.el --- a major mode for editing dna sequences -;; -;; ~harley/share/emacs/pkg/dna/dna-mode.el --- -;; -;; $Id: dna-mode.el,v 1.40 2004/04/20 19:03:04 harley Exp $ -;; - -;; Author: Harley Gorrell -;; URL: http://www.mahalito.net/~harley/elisp/dna-mode.el -;; License: GPL v2 -;; Keywords: dna, emacs, editing - -;;; Commentary: -;; * A collection of functions for editing DNA sequences. It -;; provides functions to make editing dna in Emacs easier. -;; -;; Dna-mode will: -;; * Fontify keywords and line numbers in sequences. -;; * Fontify bases when font-lock-mode is disabled. -;; * Incrementally search dna over pads and numbers. -;; * Complement and reverse complement a region. -;; * Move over bases and entire sequences. -;; * Detect sequence files by content. - -;;; Installation: -;; -------------------- -;; Here are two suggested ways for installing this package. -;; You can choose to autoload it when needed, or load it -;; each time emacs is started. Put one of the following -;; sections in your .emacs: -;; -;; ---Autoload: -;; (autoload 'dna-mode "dna-mode" "Major mode for dna" t) -;; (add-to-list -;; 'auto-mode-alist -;; '("\\.\\(fasta\\|fa\\|exp\\|ace\\|gb\\)\\'" . dna-mode)) -;; (add-hook 'dna-mode-hook 'turn-on-font-lock) -;; -;; ---Load: -;; (setq dna-do-setup-on-load t) -;; (load "/pathname/dna-mode") -;; -;; The dna-isearch-forward function (and isearch in general) -;; is much more useful with something like the following: -;; (make-face 'isearch) -;; (set-face-background 'isearch "yellow") -;; (setq-default search-highlight t) - -;;; History: -;; 2003-03-16: Updated URL and contact info -;; 2004-04-20: Added dna-color-bases-region to the keymap for Mike. - -;;; User customizable vars start here - -;;; Code: -(defvar dna-mode-hook nil - "*Hook to setup `dna-mode'.") - -(defvar dna-mode-load-hook nil - "*Hook to run when `dna-mode' is loaded.") - -(defvar dna-setup-on-load nil - "*If not nil setup dna mode on load by running `dna-`add-hook's'.") - -;; Bases -(defvar dna-valid-base-regexp - "[-*:acgtmrwsykvhdbxnACGTMRWSYKVHDBXN]" - "*A regexp which matches a single base.") - -(defvar dna-base-complement-list - '((?- . ?-) (?n . ?n) (?* . ?*) (?x . ?x) (?: . ?:) ; identity - (?a . ?t) (?c . ?g) (?g . ?c) (?t . ?a) ; single - (?m . ?k) (?r . ?y) (?w . ?w) (?s . ?s) (?y . ?r) (?k . ?m) ; double - (?v . ?b) (?h . ?d) (?d . ?h) (?b . ?v) ; triple - ) - "*List of bases and their complements. -Bases should be lowercase, as they are upcased when the `vector is made.") - -;; These are the colors used when coloring bases. -(defvar dna-base-color-a "blue") -(defvar dna-base-color-c "black") -(defvar dna-base-color-g "green") -(defvar dna-base-color-t "red") - -;; Dna-isearch -(defvar dna-cruft-regexp "[* 0-9\t\n]" - "*Regexp to match cruft which may appear between bases. -Skip over it during dna-motion and dna-isearch.") - -(defvar dna-isearch-case-fold-search t - "*Case fold dna-isearches if set.") - -;; Sequence -(defvar dna-sequence-start-regexp - "^\\(>\\|ID\\|LOCUS\\|DNA\\)" - "A regexp which matches the start of a sequence.") - -;;; End of user customizable vars - -;;; Start of internal vars and code - -(defvar dna-base-complement-vector - (let ((c-vec (make-vector 256 nil)) - (c-list dna-base-complement-list)) - (while c-list - (aset c-vec (car (car c-list)) (cdr (car c-list))) - (aset c-vec (upcase (car (car c-list))) (upcase (cdr (car c-list)))) - (setq c-list (cdr c-list))) - c-vec) - "A vector of upper and lower case bases and their complements.") - -;; I also use "Alt" as C-c is too much to type for cursor motions. -(defvar dna-mode-map - (let ((map (make-sparse-keymap))) - ;; Ctrl bindings - (define-key map "\C-c\C-f" 'dna-forward-base) - (define-key map "\C-cf" 'dna-forward-base) - (define-key map "\C-c\C-b" 'dna-backward-base) - (define-key map "\C-cb" 'dna-backward-base) - (define-key map "\C-c\C-s" 'dna-isearch-forward) - (define-key map "\C-cs" 'dna-isearch-forward) - (define-key map "\C-cr" 'dna-reverse-complement-region) - (define-key map "\C-cc" 'dna-complement-region) - (define-key map "\C-c#" 'dna-count-bases-region) - (define-key map "\M-\C-h" 'dna-mark-sequence) - (define-key map "\M-\C-a" 'dna-beginning-of-sequence) - (define-key map "\M-\C-e" 'dna-end-of-sequence) - ;; base coloring - (define-key map "\C-cg" 'dna-color-bases-region) - (define-key map "\C-cl" 'font-lock-mode) - ;; XEmacs does not like the Alt bindings - (when (not (string-match "XEmacs" (emacs-version))) - (define-key map [A-right] 'dna-forward-base) - (define-key map [A-left] 'dna-backward-base) - (define-key map [A-up] 'dna-beginning-of-sequence) - (define-key map [A-down] 'dna-end-of-sequence) - (define-key map [?\A-\C-s] 'dna-isearch-forward)) - map) - "The local keymap for `dna-mode'.") - -;;;###autoload -(defun dna-mode () - "Major mode for editing DNA sequences. - -This mode also customizes isearch to search over line breaks. -Use \\[universal-argument] Number as a prefix to dna-forward-base to move that -many bases. This skips line breaks and spaces. - -dna-color-bases-region disables font-lock-mode automaticly -as they cant work together. \\[dna-color-bases-region] turns font-lock-mode back on. - -\\{dna-mode-map}" - (interactive) - ;; - (kill-all-local-variables) - (setq mode-name "dna") - (setq major-mode 'dna-mode) - (use-local-map dna-mode-map) - ;; - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(dna-font-lock-keywords)) - ;; - (make-local-variable 'dna-valid-base-regexp) - (make-local-variable 'dna-sequence-start-regexp) - (make-local-variable 'dna-cruft-regexp) - (make-local-variable 'dna-isearch-case-fold-search) - ;; - (run-hooks 'dna-mode-hook)) - -;; Keywords -;; Todo: Seperate the keywords into a list for each format, rather -;; than one for all. -(defvar dna-font-lock-keywords - '( - ;; Fasta - ("^\\(>\\)\\([-_.|a-zA-Z0-9]+\\)\\([ \t]+.*\\)?" - (1 font-lock-keyword-face) - (2 font-lock-function-name-face) - (3 font-lock-comment-face nil t)) - - ;; Exp - ("^\\(ID\\) +\\([-_.a-zA-Z_0-9]+\\)" - (1 font-lock-keyword-face) (2 font-lock-function-name-face)) - ("^\\(CC\\|SQ\\)\\([ \t]\\(.*\\)\\)?$" - (1 font-lock-keyword-face) (3 font-lock-comment-face nil t)) - ("^\\(\\sw\\sw\\)[ \t]" - (1 font-lock-keyword-face)) - ("^\\(//\\)" - (1 font-lock-keyword-face)) - - ;; Ace (phrap output) - ("^\\(DNA\\|Sequence\\|BaseQuality\\) +\\([-_.a-zA-Z_0-9]+\\)" - (1 font-lock-keyword-face) (2 font-lock-function-name-face)) - - ;; Genbank - ("^\\(LOCUS\\) +\\([-_.a-zA-Z_0-9]+\\)";; are '-_.' allowed? - (1 font-lock-keyword-face) (2 font-lock-function-name-face)) - "ORIGIN" - - ; More genbank keywords... - "ACCESSION" "AUTHORS" "AUTHORS" "BASE COUNT" "DEFINITION" - "FEATURES" "JOURNAL" "JOURNAL" "KEYWORDS" "MEDLINE" "NID" - "ORGANISM" "REFERENCE" "SEGMENT" "SOURCE" "TITLE" - - ;; line numbers... - ("^[ \t]*\\([0-9]+\\)" - (1 font-lock-string-face)) - - ;; others...? - ) - "Expressions to hilight in `dna-mode'.") - - -;;; Setup functions -(defun dna-find-file-func () - "Invoke `dna-mode' if the buffer look like a sequence. -and another mode is not active. -This function is added to `find-file-hooks'." - (if (and (eq major-mode 'fundamental-mode) - (looking-at dna-sequence-start-regexp)) - (dna-mode))) - -;;;###autoload -(defun dna-add-hooks () - "Add a default set of dna-hooks. -These hooks will activate `dna-mode' when visiting a file -which has a dna-like name (.fasta or .gb) or whose contents -looks like dna. It will also turn enable fontification for `dna-mode'." - (add-hook 'dna-mode-hook 'turn-on-font-lock) - (add-hook 'find-file-hooks 'dna-find-file-func) - (add-to-list - 'auto-mode-alist - '("\\.\\(fasta\\|fa\\|exp\\|ace\\|gb\\)\\'" . dna-mode))) - -;; Setup hooks on request when this mode is loaded. -(if dna-setup-on-load - (dna-add-hooks)) - -(defun dna-next-char-func () - "Should never be called. Overridden in `dna-forward-base'." - (error "This shouldnt have been called")) - -;; Motion -(defun dna-forward-base (count) - "Move forward COUNT bases. Move backward if negative. -Skip over dna-isearch-cruft. Stop on non-base or -non-whitespace characters." - (interactive "p") - (let ((c 0) - (abscount (abs count)) - (dir (if (< count 0) -1 1)) - dna-next-char-func - bstr) - ;; - (fset 'dna-next-char-func (if (< dir 0) 'preceding-char 'following-char)) - ;; - (while (< c abscount) - (setq bstr (char-to-string (dna-next-char-func))) - (cond - ((string-match dna-valid-base-regexp bstr) - (forward-char dir) - (setq c (1+ c))) - ((string-match dna-cruft-regexp bstr) - (forward-char dir)) - (t - (message "Moved %d bases forward." c) - (setq abscount c)))) ; stop the while - - ;; Move over trailing junk when moving forward - (if (= dir 1) - (while (string-match dna-cruft-regexp - (char-to-string (dna-next-char-func))) - (forward-char dir)) - ) - ;; return the distance moved - (* dir abscount))) - -;; aaaaaaaaaa cccccccccc | gggggggggg tttttttttt - -(defun dna-backward-base (count) - "Move backward COUNT bases. See `dna-forward-base'." - (interactive "p") - (dna-forward-base (- count))) - -(defun dna-beginning-of-sequence () - "Move the start of the sequence or the buffer." - (interactive) - (goto-char - (or - (search-backward-regexp dna-sequence-start-regexp (point-min) t) - (point-min)))) - -(defun dna-end-of-sequence () - "Move to the end of the sequence or the buffer." - (interactive) - (end-of-line) - (skip-syntax-forward "-") - (let ((seqstart - (search-forward-regexp dna-sequence-start-regexp (point-max) t))) - (if seqstart (progn - (goto-char seqstart) - (beginning-of-line)) - (goto-char (point-max))))) - -(defun dna-mark-sequence () - "Put point at the beginning of a sequence, mark at end." - (interactive) - (dna-end-of-sequence) - (set-mark (point)) - (dna-beginning-of-sequence)) - -(defun dna-count-bases-region (d-start d-end) - "Count the number of bases in the region D-START to D-END. -Echos the number of bases counted. -If an invalid base is found, stops on the base and signals an error." - (interactive "r") - (let ((basecount 0)) - (goto-char d-start) - (while (< (point) d-end) - (cond - ((looking-at dna-valid-base-regexp) - (setq basecount (1+ basecount)) - (forward-char 1)) - ((looking-at dna-cruft-regexp) - (forward-char 1)) - (t - (error "Bad base found. '%s'" - (buffer-substring (point) (1+ (point))))) - )) - (message "There are %d bases in the region." basecount) - basecount)) - -;;; reverse and complement -(defun dna-complement-base-list (base) - "Complement the BASE using a list based method. -Returns the complement of the base. -It can also be used to test if the character is a base, -as all bases should have a complement." - (cdr (assq base dna-base-complement-list))) - -(defun dna-complement-base (base) - "Complement a BASE using a vector based method. -See `dna-complement-base-list' for more info." - (aref dna-base-complement-vector base)) - -(defun dna-complement (base) - "Look up the complement of the BASE and print a message. -Handy for us CS types." - (interactive "cComplement of base:") - (message "Complement of '%c' is '%c'." base (dna-complement-base base))) - -(defun dna-complement-region (r-start r-end) - "Complement a region of bases from R-START to R-END. -Complement a region of the buffer by deleting it and -inserting the complements, base by base. Non-bases are -passed over unchanged." - (interactive "r") - (let (r-string r-length r-point r-base r-cbase) - (goto-char r-start) - (setq r-string (buffer-substring-no-properties r-start r-end)) - (setq r-length (length r-string)) - (delete-region r-start r-end) - (setq r-point 0) - (while (< r-point r-length) - (setq r-base (aref r-string r-point)) - (setq r-cbase (dna-complement-base r-base)) - (insert (if r-cbase r-cbase r-base)) - (setq r-point (1+ r-point))))) - -;;;###autoload -(defun dna-reverse-complement-region (r-start r-end) - "Reverse complement a region of dna from R-START to R-END. -Works by deleting the region and inserting bases reversed -and complemented, while entering non-bases in the order -found." - (interactive "r") - (let (r-string r-length r-base r-cbase r-point r-mark) - (goto-char r-start) - (setq r-string (buffer-substring-no-properties r-start r-end)) - (setq r-length (length r-string)) - (setq r-mark (1- r-length)) - (setq r-point 0) - - ;; goodbye - (delete-region r-start r-end) - - ;; insert the bases from back to front base by base - ;; insert non-bases from front to back to preserve spacing - (while (< r-point r-length) - (setq r-base (aref r-string r-point)) - (setq r-cbase (dna-complement-base r-base)) - (if r-cbase - (progn - ;; it is a base. find the reverse and complement it - (while (not (dna-complement-base (aref r-string r-mark))) - (setq r-mark (1- r-mark))) - (insert (dna-complement-base (aref r-string r-mark))) - (setq r-mark (1- r-mark)) ) - ;; not a base, no change - (insert r-base)) - (setq r-point (1+ r-point))))) - -;; format -(defun dna-guess-format-func () - "Guess the format of the sequence the point is at or after. -Returns the format or nil." - (save-excursion - (end-of-line) - (dna-beginning-of-sequence) - (cond - ((looking-at "^>") 'fasta) - ((looking-at "^DNA") 'phrap) - ((looking-at "^ID") 'exp) - (t nil)))) - -(defun dna-guess-format () - "Guess and print the format of the sequence." - (interactive) - (message "%s" (dna-guess-format-func))) - -;;; dna-isearch stuff -(defun dna-isearch-mangle-str (str) - "Mangle the string STR into a regexp to search over cruft in sequence. -Inserts a regexp between each base which matches sequence formatting cruft. -For example, if `dna-cruft-regexp' is '[ ]', -the search string 'acgt' would transformed into 'a[ ]*c[ ]*g[ ]*t[ ]*'" - (let ((i 0) (out "")) - (while (< i (length str)) - (setq out (concat out (substring str i (1+ i)) dna-cruft-regexp "*")) - (setq i (1+ i))) - out)) - -(defadvice isearch-message-prefix (around dna-isearch-ismp) - "Set the isearch prompt string to show dna search is active. -This serves as a warning that the string is being mangled." - ad-do-it - (setq ad-return-value (concat "DNA " ad-return-value))) - -(defadvice isearch-search (around dna-isearch-iss) - "The advice used to mangle the search string in isearch." - (let ((isearch-regexp t) - ;; force case folding - (isearch-case-fold-search dna-isearch-case-fold-search) - (isearch-string (dna-isearch-mangle-str isearch-string)) ) - ad-do-it)) - -;;;###autoload -(defun dna-isearch-forward () - "Isearch forward on dna sequence. -Enable the `dna-mode' search string mangling advice and start the search." - (interactive) - ;; Enable the prompt - (ad-enable-advice 'isearch-message-prefix 'around 'dna-isearch-ismp) - (ad-activate 'isearch-message-prefix) - ;; Enable the mangling - (ad-enable-advice 'isearch-search 'around 'dna-isearch-iss) - (ad-activate 'isearch-search) - - ;; run the search - (isearch-forward) - - ;; - (ad-disable-advice 'isearch-message-prefix 'around 'dna-isearch-ismp) - (ad-activate 'isearch-message-prefix) - ;; - (ad-disable-advice 'isearch-search 'around 'dna-isearch-iss) - (ad-activate 'isearch-search)) - -;;; Work with columns of sequences. - -(defun dna-column-select-func () - "Return the start and end of the column as a cons. -Point is moved forward one." - (let (s m e) - (setq m (point)) - ;; work our way up - (while (looking-at dna-valid-base-regexp) - (setq s (point)) - (previous-line 1)) - (goto-char m) - ;; work our way down - (while (looking-at dna-valid-base-regexp) - (setq e (point)) - (next-line 1)) - (goto-char m) - ;; return the start and end of the column - (cons s (1+ e)))) - -(defun dna-column-select () - "Select the current column of text. -Sets the mark at the top and the point at the bottom of a non-blank column." - (interactive) - (let ((se (dna-column-select-func))) - (goto-char (car se)) - (push-mark) - (goto-char (cdr se)))) - -(defvar dna-column-pad "*" - "Character to use when inserting a column of pads.") - -(defun dna-column-insert-pad () - "Insert a column of pads." - (interactive) - (save-excursion - (let ((se (dna-column-select-func))) - (string-rectangle (car se) (cdr se) dna-column-pad)))) - -(defun dna-column-delete () - "Delete the current column of dna." - (interactive) - (save-excursion - (let ((se (dna-column-select-func))) - (kill-rectangle (car se) (cdr se))))) - -;;; Per base colors - -(defun dna-base-color-make-faces (&optional force) - "Build a face to display bases with. FORCE remakes the faces." - (when (or (not (facep 'dna-face-t)) force) - (let ((base-list '("a" "c" "g" "t")) - base base-face) - (while base-list - (setq base (car base-list)) - (setq base-face (intern (concat "dna-base-face-" base))) - (make-face base-face) - (set-face-foreground - base-face (symbol-value (intern (concat "dna-base-color-" base)))) - (setq base-list (cdr base-list)))))) - -;; Make faces on load -(dna-base-color-make-faces t) - -(defvar dna-color-bases-auto t - "Automaticly deactivate `font-lock-mode' when `dna-color-bases' is run. -See dna-color-bases for details.") -;; (setq dna-color-bases-auto t) - -(defun dna-color-bases-region (s e) - "Color the bases in the region S to E. -NOTE: The function `font-lock-mode' will undo the work of this -function if activated. Disable it before using this -function. If `dna-color-bases-auto' is set then `font-lock-mode' -is deactivated automatically." - (interactive "r") - (if (and dna-color-bases-auto font-lock-mode) - (font-lock-mode -1)) - (if font-lock-mode - (error "Font-lock-mode is on -- deactivate it")) - (save-excursion - (let (c) - (goto-char s) - (while (< s e) - (setq c (downcase (char-after s))) - (cond - ((eq c ?a) - (set-text-properties s (+ s 1) '(face dna-base-face-a))) - ((eq c ?c) (+ s 1) - (set-text-properties s (+ s 1) '(face dna-base-face-c))) - ((eq c ?g) (+ s 1) - (set-text-properties s (+ s 1) '(face dna-base-face-g))) - ((eq c ?t) (+ s 1) - (set-text-properties s (+ s 1) '(face dna-base-face-t))) - (t nil)) - (setq s (+ s 1)))))) - -(defun dna-uncolor-bases-region (s e) - "Uncolor the bases from S to E." - (interactive "r") - (remove-text-properties s e '(face nil))) - -;;; Functions for me. - -;; I like to datestamp sequences I work with. -(defvar dna-timestamp-format "%Y%m%d" - "Format of the time stamp which `dna-timestamp-seq' uses.") - -(defun dna-timestamp-seq () - "Insert the current date into the sequence. -Assumes fasta format." - (interactive) - (end-of-line) - (dna-beginning-of-sequence) - (end-of-line) - (insert " " (format-time-string dna-timestamp-format (current-time)))) - -;; done loading -(run-hooks 'dna-mode-load-hook) -(provide 'dna-mode) - -;;; dna-mode.el ends here diff --git a/emacs_el/ebib.el b/emacs_el/ebib.el deleted file mode 100644 index 37e8ccd..0000000 --- a/emacs_el/ebib.el +++ /dev/null @@ -1,3161 +0,0 @@ -;; 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 diff --git a/emacs_el/fixme.el b/emacs_el/fixme.el deleted file mode 100644 index be652c6..0000000 --- a/emacs_el/fixme.el +++ /dev/null @@ -1,97 +0,0 @@ -;;; fixme.el --- AUC-TeX style file for FiXme - -;; Copyright (C) 2000, 2002, 2004, 2006 Didier Verna. - -;; Author: Didier Verna -;; Maintainer: Didier Verna -;; Created: Tue Apr 18 14:49:29 2000 -;; Last Revision: Tue Oct 19 18:07:27 2004 -;; Keywords: tex abbrev data - -;; This file is part of FiXme. - -;; FiXme may be distributed and/or modified under the -;; conditions of the LaTeX Project Public License, either version 1.1 -;; of this license or (at your option) any later version. -;; The latest version of this license is in -;; http://www.latex-project.org/lppl.txt -;; and version 1.1 or later is part of all distributions of LaTeX -;; version 1999/06/01 or later. - -;; FiXme consists of all files listed in the file `README'. - - -;;; Commentary: - -;; Contents management by FCM version 0.1-b2. - - -;;; Code: - -(TeX-add-style-hook "fixme" - (function - (lambda () - (TeX-add-symbols - '("fixmelogo") - - '("listoffixmes") - '("listfixmename") - - '("FXInline") - '("FXMargin") - '("FXMarginClue") - '("FXFootnote") - '("FXUser") - '("fixmeindexname") - '("FXIndex") - - '("FXNote") - '("FXWarning") - '("FXError") - '("FXFatal") - - '("fixmenoteprefix") - '("fixmenoteindexname") - '("fixmewarningprefix") - '("fixmewarningindexname") - '("fixmeerrorprefix") - '("fixmeerrorindexname") - '("fixmefatalprefix") - '("fixmefatalindexname") - - '("thefixmecount") - '("thefixmenotecount") - '("thefixmewarningcount") - '("thefixmeerrorcount") - '("thefixmefatalcount") - - '("fxnote" [ "Layout" ] "Note") - '("fxwarning" [ "Layout" ] "Warning") - '("fxerror" [ "Layout" ] "Error") - '("fixme" [ "Layout" ] "FiXme") - - ;; Obsolete stuff: - '("FiXmeInline") - '("FiXmeMargin") - '("FiXmeFootnote") - '("FiXmeIndex") - '("FiXmeInfo") - '("FiXmeWarning") - '("FiXmeUser") - ) - (LaTeX-add-environments - '("anfxnote") - '("anfxwarning") - '("anfxerror") - '("afixme") - ) - ))) - - - - -;;; Local variables: -;;; eval: (put 'TeX-add-style-hook 'lisp-indent-function 1) -;;; End: - -;;; fixme.el ends here diff --git a/emacs_el/glusterfs-mode.el b/emacs_el/glusterfs-mode.el deleted file mode 100644 index fdad286..0000000 --- a/emacs_el/glusterfs-mode.el +++ /dev/null @@ -1,112 +0,0 @@ -;;; Copyright (C) 2007, 2008 Z RESEARCH Inc. -;;; -;;; 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. -;;; - -(defvar glusterfs-mode-hook nil) - -;; (defvar glusterfs-mode-map -;; (let ((glusterfs-mode-map (make-keymap))) -;; (define-key glusterfs-mode-map "\C-j" 'newline-and-indent) -;; glusterfs-mode-map) -;; "Keymap for WPDL major mode") - -(add-to-list 'auto-mode-alist '("\\.vol\\'" . glusterfs-mode)) - -(defconst glusterfs-font-lock-keywords-1 - (list - ; "cluster/{unify,afr,stripe}" - ; "performance/{io-cache,io-threads,write-behind,read-ahead,stat-prefetch}" - ; "protocol/{client/server}" - ; "features/{trash,posix-locks,fixed-id,filter}" - ; "stroage/posix" - ; "encryption/rot-13" - ; "debug/trace" - '("\\<\\(cluster/\\(unify\\|afr\\|stripe\\)\\|\\performance/\\(io-\\(cache\\|threads\\)\\|write-behind\\|read-ahead\\|stat-prefetch\\|booster\\)\\|protocol/\\(server\\|client\\)\\|features/\\(trash\\|posix-locks\\|fixed-id\\|path-converter\\|filter\\)\\|storage/\\(posix\\|bdb\\)\\|encryption/rot-13\\|debug/trace\\)\\>" . font-lock-keyword-face)) -"Additional Keywords to highlight in GlusterFS mode.") - -(defconst glusterfs-font-lock-keywords-2 - (append glusterfs-font-lock-keywords-1 - (list - ; "replicate" "namespace" "scheduler" "remote-subvolume" "remote-host" - ; "auth.addr" "block-size" "remote-port" "listen-port" "transport-type" - ; "limits.min-free-disk" "directory" - ; TODO: add all the keys here. - '("\\<\\(inode-lru-limit\\|replicate\\|namespace\\|scheduler\\|username\\|password\\|allow\\|reject\\|block-size\\|listen-port\\|transport-type\\|directory\\|page-size\\|page-count\\|aggregate-size\\|non-blocking-io\\|client-volume-filename\\|bind-address\\|self-heal\\|read-only-subvolumes\\|read-subvolume\\|thread-count\\|cache-size\\|window-size\\|force-revalidate-timeout\\|priority\\|include\\|exclude\\|remote-\\(host\\|subvolume\\|port\\)\\|auth.\\(addr\\|login\\)\\|limits.\\(min-disk-free\\|transaction-size\\|ib-verbs-\\(work-request-\\(send-\\|recv-\\(count\\|size\\)\\)\\|port\\|mtu\\|device-name\\)\\)\\)\ \\>" . font-lock-constant-face))) - "option keys in GlusterFS mode.") - -(defconst glusterfs-font-lock-keywords-3 - (append glusterfs-font-lock-keywords-2 - (list - ; "option" "volume" "end-volume" "subvolumes" "type" - '("\\<\\(option\ \\|volume\ \\|subvolumes\ \\|type\ \\|end-volume\\)\\>" . font-lock-builtin-face))) - ;'((regexp-opt (" option " "^volume " "^end-volume" "subvolumes " " type ") t) . font-lock-builtin-face)) - "Minimal highlighting expressions for GlusterFS mode.") - - -(defvar glusterfs-font-lock-keywords glusterfs-font-lock-keywords-3 - "Default highlighting expressions for GlusterFS mode.") - -(defvar glusterfs-mode-syntax-table - (let ((glusterfs-mode-syntax-table (make-syntax-table))) - (modify-syntax-entry ?\# "<" glusterfs-mode-syntax-table) - (modify-syntax-entry ?* ". 23" glusterfs-mode-syntax-table) - (modify-syntax-entry ?\n ">#" glusterfs-mode-syntax-table) - glusterfs-mode-syntax-table) - "Syntax table for glusterfs-mode") - -;; TODO: add an indentation table - -(defun glusterfs-indent-line () - "Indent current line as GlusterFS code" - (interactive) - (beginning-of-line) - (if (bobp) - (indent-line-to 0) ; First line is always non-indented - (let ((not-indented t) cur-indent) - (if (looking-at "^[ \t]*volume\ ") - (progn - (save-excursion - (forward-line -1) - (setq not-indented nil) - (setq cur-indent 0)))) - (if (looking-at "^[ \t]*end-volume") - (progn - (save-excursion - (forward-line -1) - (setq cur-indent 0)) - (if (< cur-indent 0) ; We can't indent past the left margin - (setq cur-indent 0))) - (save-excursion - (while not-indented ; Iterate backwards until we find an indentation hint - (progn - (setq cur-indent 4) ; Do the actual indenting - (setq not-indented nil))))) - (if cur-indent - (indent-line-to cur-indent) - (indent-line-to 0))))) - -(defun glusterfs-mode () - (interactive) - (kill-all-local-variables) - ;; (use-local-map glusterfs-mode-map) - (set-syntax-table glusterfs-mode-syntax-table) - (set (make-local-variable 'indent-line-function) 'glusterfs-indent-line) - (set (make-local-variable 'font-lock-defaults) '(glusterfs-font-lock-keywords)) - (setq major-mode 'glusterfs-mode) - (setq mode-name "GlusterFS") - (run-hooks 'glusterfs-mode-hook)) - -(provide 'glusterfs-mode) diff --git a/emacs_el/graphviz-dot-mode.el b/emacs_el/graphviz-dot-mode.el deleted file mode 100644 index ebaa1aa..0000000 --- a/emacs_el/graphviz-dot-mode.el +++ /dev/null @@ -1,919 +0,0 @@ -;;; graphviz-dot-mode.el --- Mode for the dot-language used by graphviz (att). - -;; Copyright (C) 2002 - 2005 Pieter Pareit - -;; 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 -;; Rubens Ramos -;; Maintainer: Pieter Pareit -;; 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 -;; * add graphviz-dot-indent-width -;; Version 0.3.2 bug fixes -;; 25/03/2004: Rubens Ramos -;; * 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 -;; * 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 file.dot > file.'." - :type 'string - :group 'graphviz) - -(defcustom graphviz-dot-toggle-completions nil - "*Non-nil means that repeated use of \ -\\\\[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. \\ -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 -